Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # ========== Copyright Header Begin ========================================== |
2 | # | |
3 | # OpenSPARC T2 Processor File: Application.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::Application; | |
38 | ||
39 | use strict; | |
40 | ||
41 | use File::Copy; | |
42 | ||
43 | use Midas::AttrBlock; | |
44 | use Midas::Configure; | |
45 | use Midas::Globals; | |
46 | use Midas::Command; | |
47 | use Midas::Segment; | |
48 | use Midas::Paths; | |
49 | use Midas::Error; | |
50 | use Midas::Preprocess ':all'; | |
51 | require Midas::Section; | |
52 | ||
53 | ||
54 | use fields qw(name filetag sections srcfile srcline args | |
55 | is_linked external_path goldfinger_cmds | |
56 | ); | |
57 | ||
58 | ############################################################################## | |
59 | ||
60 | sub new { | |
61 | my $this = shift; | |
62 | my %args = @_; | |
63 | ||
64 | unless (ref $this) { | |
65 | $this = fields::new($this); | |
66 | } | |
67 | ||
68 | $this->set_defaults(); | |
69 | ||
70 | foreach my $key (keys %args) { | |
71 | $this->{$key} = $args{$key}; | |
72 | } | |
73 | ||
74 | $this->parse_args() if defined $this->{args}; | |
75 | ||
76 | return $this; | |
77 | } | |
78 | ||
79 | ############################################################################## | |
80 | ||
81 | sub set_defaults { | |
82 | my $this = shift; | |
83 | $this->{sections} = [] unless defined $this->{sections}; | |
84 | $this->{goldfinger_cmds} = [] unless defined $this->{goldfinger_cmds}; | |
85 | $this->{is_linked} = 0; | |
86 | } | |
87 | ||
88 | ############################################################################## | |
89 | ||
90 | sub name { | |
91 | my $this = shift; | |
92 | return $this->{name}; | |
93 | } | |
94 | ||
95 | ############################################################################## | |
96 | ||
97 | sub parse_args { | |
98 | my $this = shift; | |
99 | ||
100 | my $args = $this->{args}; | |
101 | $args =~ s/\s//g; | |
102 | my @args = split /,/, $args; | |
103 | foreach my $arg (@args) { | |
104 | if($args =~ /FILE\=(\S+)/i) { | |
105 | $this->{is_linked} = 1; | |
106 | $this->{external_path} = $1; | |
107 | ||
108 | $this->copy_external_to_build_dir(); | |
109 | } | |
110 | } | |
111 | } | |
112 | ||
113 | ############################################################################## | |
114 | ||
115 | sub is_blank { | |
116 | my $this = shift; | |
117 | ||
118 | return 0 if @{$this->{sections}}; | |
119 | return 0 if $this->{is_linked}; | |
120 | return 1; | |
121 | } | |
122 | ||
123 | ############################################################################## | |
124 | ||
125 | sub copy_external_to_build_dir { | |
126 | my $this = shift; | |
127 | ||
128 | ||
129 | my @search = get_includes($CONFIG{link_paths}); | |
130 | my $local_exe = path_to_build_file($this->exe_name(), $STATE); | |
131 | ||
132 | foreach my $testdir (@search) { | |
133 | my $testfile = File::Spec->catfile($testdir, $this->{external_path}); | |
134 | if(-e $testfile) { | |
135 | chat "Copying $testfile to $local_exe\n"; | |
136 | copy($testfile, $local_exe); | |
137 | last; | |
138 | } | |
139 | } | |
140 | ||
141 | if(not -e $local_exe) { | |
142 | fatal "Couldn't find \"$this->{external_path}\" in search path: @search\n", | |
143 | M_FILE; | |
144 | } | |
145 | } | |
146 | ||
147 | ############################################################################## | |
148 | ||
149 | sub filetag { | |
150 | my $this = shift; | |
151 | ||
152 | return '' if($this->name() eq 'default'); | |
153 | ||
154 | my $tag = lc $this->{name}; | |
155 | $tag =~ s/\.//; | |
156 | $tag =~ s/\.$//; | |
157 | return $tag; | |
158 | } | |
159 | ||
160 | ############################################################################## | |
161 | ||
162 | sub is_linked { | |
163 | my $this = shift; | |
164 | return $this->{is_linked}; | |
165 | } | |
166 | ||
167 | ############################################################################## | |
168 | ||
169 | sub exe_name { | |
170 | my $this = shift; | |
171 | ||
172 | return $this->expand_file($CONFIG{local_exe}); | |
173 | } | |
174 | ||
175 | ############################################################################## | |
176 | ||
177 | sub ldscr_name { | |
178 | my $this = shift; | |
179 | ||
180 | return $this->expand_file($CONFIG{local_ldscr}); | |
181 | ||
182 | } | |
183 | ||
184 | ############################################################################## | |
185 | ||
186 | sub expand_file { | |
187 | my $this = shift; | |
188 | my $file = shift; | |
189 | my $name = $this->{name}; | |
190 | ||
191 | my $filetag = $this->filetag(); | |
192 | ||
193 | $filetag = '.' . $filetag unless ($filetag =~ /^\./ or $filetag eq ''); | |
194 | $file =~ s/\*/${filetag}/; | |
195 | return $file; | |
196 | } | |
197 | ||
198 | ############################################################################## | |
199 | ||
200 | sub add_section { | |
201 | my $this = shift; | |
202 | my $section = shift; | |
203 | ||
204 | if($this->{is_linked}) { | |
205 | my $appname = $this->{name}; | |
206 | my $secname = $section->{name}; | |
207 | my $srcfile = $section->{srcfile}; | |
208 | my $srcline = $section->{srcline}; | |
209 | fatal "Application $appname cannot contain SECTIONs\n" . | |
210 | "($secname at file=$srcfile, line=$srcline\n", M_SECSYNTAX; | |
211 | } | |
212 | ||
213 | push @{$this->{sections}}, $section; | |
214 | } | |
215 | ||
216 | ############################################################################## | |
217 | ||
218 | sub add_goldfinger_cmd { | |
219 | my $this = shift; | |
220 | my $cmdstring = shift; | |
221 | ||
222 | push @{$this->{goldfinger_cmds}}, $cmdstring; | |
223 | } | |
224 | ||
225 | ############################################################################## | |
226 | ||
227 | sub get_sec_list { | |
228 | my $this = shift; | |
229 | return @{ $this->{sections} }; | |
230 | } | |
231 | ||
232 | ############################################################################## | |
233 | ||
234 | sub write_to_goldfinger { | |
235 | my $this = shift; | |
236 | my $fh = shift; | |
237 | ||
238 | my $app_name = $this->name(); | |
239 | my $exe_name = $this->exe_name(); | |
240 | my $exe = path_to_build_file($exe_name, $STATE); | |
241 | my $srcfile = $this->{srcfile}; | |
242 | my $srcline = $this->{srcline}; | |
243 | ||
244 | print $fh "APP $app_name\n"; | |
245 | print $fh "\n"; | |
246 | print $fh " ELF_FILE = \"$exe\";\n"; | |
247 | print $fh " SRC_FILE = \"$srcfile\";\n" if defined $srcfile; | |
248 | print $fh " SRC_LINE = $srcline;\n" if defined $srcline; | |
249 | print $fh "\n"; | |
250 | ||
251 | my @sections = $this->get_sec_list(); | |
252 | ||
253 | ||
254 | foreach my $section (@sections) { | |
255 | foreach my $seg (Midas::Segment->all_names()) { | |
256 | my @attrs = $section->get_segment_attrs($seg); | |
257 | next unless @attrs; | |
258 | ||
259 | my $linkname = $section->get_segment_link_name($seg); | |
260 | ||
261 | foreach my $attr (@attrs) { | |
262 | $attr->write_to_goldfinger($seg, $linkname, $fh); | |
263 | } | |
264 | } | |
265 | } | |
266 | ||
267 | print $fh "\n"; | |
268 | ||
269 | foreach my $cmd (@{$this->{goldfinger_cmds}}) { | |
270 | print $fh "$cmd\n"; | |
271 | print $fh "\n"; | |
272 | } | |
273 | ||
274 | print $fh "END APP\n"; | |
275 | print $fh "\n"; | |
276 | } | |
277 | ||
278 | ############################################################################## | |
279 | ||
280 | sub print_debug { | |
281 | my $this = shift; | |
282 | ||
283 | chat "App: $this->{name}\n", 3; | |
284 | foreach my $sec (@{$this->{sections}}) { | |
285 | my $str = ''; | |
286 | $str .= " Section: \"$sec->{name}\" "; | |
287 | ||
288 | my @link_attrs = $sec->get_link_attrs(); | |
289 | ||
290 | foreach my $seg (Midas::Segment->all_names()) { | |
291 | my $va = $link_attrs[0]->get_segment_va($seg); | |
292 | $str .= "${seg}_va=$va " if defined $va; | |
293 | } | |
294 | ||
295 | chat "$str\n", 3 if $str =~ /\S/; | |
296 | } | |
297 | } | |
298 | ||
299 | ############################################################################## | |
300 | 1; |