Commit | Line | Data |
---|---|---|
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 | ||
37 | package Midas::Setup; | |
38 | use strict; | |
39 | use warnings; | |
40 | ||
41 | use IO::File; | |
42 | ||
43 | use Midas::Command; | |
44 | use Midas::Paths; | |
45 | use Midas::Section; | |
46 | use Midas::MMU; | |
47 | use Midas::Configure; | |
48 | use Midas::State; | |
49 | use Midas::Globals; | |
50 | use Midas::Error; | |
51 | ||
52 | require Exporter; | |
53 | ||
54 | our @ISA = qw(Exporter); | |
55 | our @EXPORT = qw(setup_files); | |
56 | our @EXPORT_OK = qw(); | |
57 | our %EXPORT_TAGS = ( | |
58 | all => [qw( | |
59 | setup_files | |
60 | bring_local | |
61 | split_perl_assembly | |
62 | ), | |
63 | ], | |
64 | internals => [qw( | |
65 | ), | |
66 | ], | |
67 | ); | |
68 | ||
69 | Exporter::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 | ||
97 | sub 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 | ||
126 | sub 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 | ||
165 | sub 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 | ############################################################################## | |
198 | 1; |