Initial commit of OpenSPARC T2 design and verification files.
[OpenSPARC-T2-DV] / tools / perlmod / Midas / 3.32 / lib / site_perl / 5.8.0 / Midas / Setup.pm
CommitLineData
86530b38
AT
1# ========== Copyright Header Begin ==========================================
2#
3# OpenSPARC T2 Processor File: Setup.pm
4# Copyright (C) 1995-2007 Sun Microsystems, Inc. All Rights Reserved
5# 4150 Network Circle, Santa Clara, California 95054, U.S.A.
6#
7# * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
8#
9# This program is free software; you can redistribute it and/or modify
10# it under the terms of the GNU General Public License as published by
11# the Free Software Foundation; version 2 of the License.
12#
13# This program is distributed in the hope that it will be useful,
14# but WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16# GNU General Public License for more details.
17#
18# You should have received a copy of the GNU General Public License
19# along with this program; if not, write to the Free Software
20# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21#
22# For the avoidance of doubt, and except that if any non-GPL license
23# choice is available it will apply instead, Sun elects to use only
24# the General Public License version 2 (GPLv2) at this time for any
25# software where a choice of GPL license versions is made
26# available with the language indicating that GPLv2 or any later version
27# may be used, or where a choice of which version of the GPL is applied is
28# otherwise unspecified.
29#
30# Please contact Sun Microsystems, Inc., 4150 Network Circle, Santa Clara,
31# CA 95054 USA or visit www.sun.com if you need additional information or
32# have any questions.
33#
34# ========== Copyright Header End ============================================
35# -*- perl -*-
36
37package Midas::Setup;
38use strict;
39use warnings;
40
41use IO::File;
42
43use Midas::Command;
44use Midas::Paths;
45use Midas::Section;
46use Midas::MMU;
47use Midas::Configure;
48use Midas::State;
49use Midas::Globals;
50use Midas::Error;
51
52require Exporter;
53
54our @ISA = qw(Exporter);
55our @EXPORT = qw(setup_files);
56our @EXPORT_OK = qw();
57our %EXPORT_TAGS = (
58 all => [qw(
59 setup_files
60 bring_local
61 split_perl_assembly
62 ),
63 ],
64 internals => [qw(
65 ),
66 ],
67 );
68
69Exporter::export_ok_tags('all');
70
71##############################################################################
72
73# SETUP SECTION
74#
75# These functions prepare a diag for further processing. The external
76# interface is the setup_files) function.
77
78##############################################################################
79
80# setup_files($diag) - Exported function
81
82# Prepares a diag for processing:
83#
84# 1. If $STATE is undefined, create a new Midas::State object
85# 2. Create build directory if it doesn't already exist
86# 3. cd into build directory
87# 4. Copy diag from specified path to build directory (default name
88# is diag.src).
89# 5. Split diag.src into perl and assembly parts
90#
91# Return value is the Midas::State object used. The function also has
92# the side effect of changing the working directory to the build directory.
93
94
95##############################################################################
96
97sub setup_files {
98 my $diag_path = shift;
99
100 banner "SETUP PHASE";
101
102 chat "### Will build in directory \"" .
103 $STATE->get_build_dir('-abs') .
104 "\"\n";
105
106 bring_local($diag_path);
107
108 cd $STATE->get_build_dir();
109
110 my $pushd = Midas::Paths->pushd($STATE->get_build_dir());
111
112 split_perl_assembly();
113
114}
115
116##############################################################################
117
118# build_local($diag)
119#
120# Creates build_directory if it doesn't already exist.
121# Copies $diag into build_directory.
122# If the diag is a .pal diag, it runs PAL to convert it.
123
124##############################################################################
125
126sub bring_local {
127 my $diag_path = shift;
128
129 my $build_dir = $STATE->get_build_dir('-abs');
130
131 my $src = path_to_build_file($CONFIG{local_src}, $STATE);
132 if(not -d $build_dir) {
133 run_command("mkdir $build_dir", -errcode => M_DIR);
134 $STATE->set_created_build_dir(1);
135 } else {
136 my @intermed_files = map { path_to_build_file(exists $CONFIG{$_} ?
137 $CONFIG{$_} : $_, $STATE) }
138 @{$CONFIG{intermed_files}};
139
140 my $files_str = join ' ', @intermed_files;
141 run_command("rm -f $files_str", -errcode => M_FILE) if @intermed_files;
142 }
143
144 if($diag_path =~ /\.pal$/) {
145 my $pal_opt = join ' ', @{$CONFIG{pal_opt}};
146 $pal_opt .= ' ' if length $pal_opt;
147 my $pal_diag_args = join ' ', @{$CONFIG{pal_diag_args}};
148 run_command("$CONFIG{pal_cmd} $pal_opt$diag_path $pal_diag_args > $src");
149 } else {
150 run_command("cp $diag_path $src", -errcode => M_FILE);
151 }
152 run_command("chmod ug+w $src", -verbose => 3, -errcode => M_FILE);
153}
154
155##############################################################################
156
157# split_perl_assembly()
158#
159# Splits the diag.src into diag.s and diag.pl (of course, default names
160# can be changed in Configure). Everything in diag.src before __PERL__ goes
161# in diag.s. Everything after goes in diag.pl
162
163##############################################################################
164
165sub split_perl_assembly {
166 my $src = path_to_build_file($CONFIG{local_src}, $STATE);
167 my $s = path_to_build_file($CONFIG{local_s}, $STATE);
168 my $pl = path_to_build_file($CONFIG{local_pl}, $STATE);
169
170 my $src_fh = IO::File->new("<$src") or fatal "Can't open $src: $!\n", M_FILE;
171 my $s_fh = IO::File->new(">$s") or fatal "Can't open $s: $!\n", M_FILE;
172 my $pl_fh;
173
174 chat "Splitting $src into $s and $pl (if necessary).\n";
175
176 while(<$src_fh>) {
177
178 if(defined $pl_fh) {
179 $pl_fh->print($_);
180 } elsif(/^\s*__PERL__/) {
181 chat "$src conitains perl code, so creating $pl\n", 2;
182 $pl_fh = IO::File->new(">$pl") or fatal "Can't open $pl: $!\n", M_FILE;
183 } else {
184 $s_fh->print($_);
185 }
186
187 }
188 # just in case the user didn't end with a newline
189 $s_fh->print("\n");
190 $pl_fh->print("\n") if defined $pl_fh;
191
192 undef $src_fh;
193 undef $s_fh;
194 undef $pl_fh;
195}
196
197##############################################################################
1981;