Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # ========== Copyright Header Begin ========================================== |
2 | # | |
3 | # OpenSPARC T2 Processor File: Script.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 | package DiagList::Script; | |
36 | ||
37 | use strict; | |
38 | ||
39 | use DiagList::Objects; | |
40 | use DiagList::Output; | |
41 | use DiagList::Settings; | |
42 | ||
43 | ||
44 | use Getopt::Long; | |
45 | use Pod::Usage; | |
46 | use File::Spec; | |
47 | use File::Basename; | |
48 | use File::Find; | |
49 | ||
50 | require Exporter; | |
51 | ||
52 | our @ISA = qw(Exporter); | |
53 | our @EXPORT = qw(dlist construct_dlist get_diag_display build_tags); | |
54 | our @EXPORT_OK = qw( $Default_cpp_cmd $Default_cpp_args ); | |
55 | ||
56 | our $Default_cpp_cmd = 'bw_cpp'; | |
57 | our $Default_cpp_args = '-undef -B'; | |
58 | ||
59 | my %opt = | |
60 | ( | |
61 | cpp_cmd => $Default_cpp_cmd, | |
62 | cpp_args => $Default_cpp_args, | |
63 | stdinc => 1, | |
64 | nocpp => 0, | |
65 | ); | |
66 | ||
67 | my @options = | |
68 | qw( | |
69 | h | |
70 | nocpp | |
71 | cpp=s | |
72 | cpp_args=s | |
73 | stdinc! | |
74 | I=s@ | |
75 | D=s@ | |
76 | diag_root=s | |
77 | diaglist=s | |
78 | group=s | |
79 | buildtag:s | |
80 | find | |
81 | q | |
82 | ); | |
83 | ||
84 | my ($GMAXLEN, $BMAXLEN, $NMAXLEN); | |
85 | ||
86 | ############################################################################### | |
87 | ||
88 | sub dlist { | |
89 | my @args = @_; | |
90 | ||
91 | local (@ARGV) = @args; | |
92 | ||
93 | # Make -D and -I options more palatable to GetOptions | |
94 | @ARGV = map { /^(-[DI])(\S.*)/ ? ($1, $2) : $_ } @ARGV; | |
95 | ||
96 | if(not GetOptions(\%opt, @options)) { | |
97 | pod2usage(-exitval => 'NOEXIT', | |
98 | -verbose => 1); | |
99 | return -1; | |
100 | } | |
101 | ||
102 | if($opt{h}) { | |
103 | pod2usage(-exitval => 'NOEXIT', -verbose => 2); | |
104 | return 0; | |
105 | } | |
106 | ||
107 | if(not defined $opt{diaglist}) { | |
108 | ||
109 | if(not defined $opt{diag_root}) { | |
110 | die "dlist: Must set \$DV_ROOT or use -diag_root or -diaglist.\n" | |
111 | unless exists $ENV{DV_ROOT}; | |
112 | $opt{diag_root} = File::Spec->catdir($ENV{DV_ROOT}, 'verif', 'diag'); | |
113 | } | |
114 | ||
115 | $opt{diaglist} = File::Spec->catfile($opt{diag_root}, 'master_diaglist'); | |
116 | ||
117 | } | |
118 | ||
119 | if(defined $opt{find} and $opt{find} and not defined $opt{diag_root}) { | |
120 | die "dlist: Must set \$DV_ROOT or use -diag_root with -find\n" unless exists $ENV{DV_ROOT}; | |
121 | $opt{diag_root} = File::Spec->catdir($ENV{DV_ROOT}, 'verif', 'diag'); | |
122 | } | |
123 | ||
124 | $opt{q} = 1 if $opt{find}; | |
125 | ||
126 | die "dlist: Diag list \"$opt{diaglist}\" not found.\n" | |
127 | unless -e $opt{diaglist}; | |
128 | ||
129 | my $dlist = construct_dlist(\%opt); | |
130 | ||
131 | build_tags($dlist, $opt{buildtag}, \%opt) if defined $opt{buildtag}; | |
132 | ||
133 | my $diagname = shift @ARGV; | |
134 | #pod2usage(-exitval => -1, -verbose => 1, | |
135 | # -message => "You must specify a diag name!\n") | |
136 | # unless defined $diagname; | |
137 | ||
138 | ||
139 | my ($alias, $group, $nametag); | |
140 | ||
141 | $group = $opt{group}; | |
142 | ||
143 | if(defined $diagname) { | |
144 | if($diagname =~ /^(\S+):(\S+)$/) { | |
145 | $alias = $1; | |
146 | $nametag = $2; | |
147 | $group = $opt{group}; | |
148 | } else { | |
149 | $alias = $diagname; | |
150 | } | |
151 | } | |
152 | ||
153 | ||
154 | my @display_list; | |
155 | if(not defined $group) { | |
156 | if(defined $diagname) { | |
157 | foreach my $gr ($dlist->group_list()) { | |
158 | push @display_list, get_diag_display($dlist, $alias, $nametag, $gr, | |
159 | \%opt); | |
160 | } | |
161 | } else { | |
162 | foreach my $gr ($dlist->group_list()) { | |
163 | $OUT->print_status("Group: $gr\n"); | |
164 | } | |
165 | } | |
166 | ||
167 | } else { | |
168 | ||
169 | if(defined $diagname) { | |
170 | push @display_list, get_diag_display($dlist, $alias, $nametag, $group, | |
171 | \%opt); | |
172 | } else { | |
173 | my $g_obj = $dlist->find_group($group); | |
174 | die "dlist: Group \"$group\" not found!\n" unless defined $g_obj; | |
175 | foreach my $bt ($g_obj->build_tags()) { | |
176 | my @diags = $g_obj->list_diags($bt); | |
177 | foreach my $diagname (@diags) { | |
178 | my $d_obj = $g_obj->find_diag($bt, $diagname); | |
179 | $alias = $d_obj->get_alias(); | |
180 | $nametag = $d_obj->get_nametag(); | |
181 | ||
182 | push @display_list, get_diag_display($dlist, $alias, $nametag, $group, | |
183 | \%opt); | |
184 | ||
185 | } | |
186 | } | |
187 | } | |
188 | ||
189 | } | |
190 | ||
191 | @display_list = sort { $a->{name} cmp $b->{name} } @display_list; | |
192 | ||
193 | $GMAXLEN = maxlen( map { $_->{group} } @display_list); | |
194 | $BMAXLEN = maxlen( map { $_->{buildtag} } @display_list); | |
195 | $NMAXLEN = maxlen( map { $_->{name} } @display_list); | |
196 | ||
197 | if($opt{find}) { | |
198 | my %findhash; | |
199 | foreach my $elem (@display_list) { | |
200 | my $file = $elem->{diag}->get_file(); | |
201 | if(exists $findhash{$file}) { | |
202 | $elem->{full} = $findhash{$file}; | |
203 | } else { | |
204 | $elem->{full} = find_file($file, $opt{diag_root}); | |
205 | $findhash{$file} = $elem->{full}; | |
206 | } | |
207 | } | |
208 | } else { | |
209 | foreach my $elem (@display_list) { | |
210 | $elem->{full} = ''; | |
211 | } | |
212 | } | |
213 | ||
214 | if($opt{q}) { | |
215 | # All I'm printing is the filename, so only grab one entry for each name | |
216 | # Otherwise, I'll get lots of messy duplicates | |
217 | @display_list = values %{{ map { $_->{name} . $_->{full}, $_ } @display_list}}; | |
218 | } | |
219 | ||
220 | foreach my $elem (@display_list) { | |
221 | $elem->display(\%opt); | |
222 | } | |
223 | return 0; | |
224 | } | |
225 | ||
226 | ############################################################################### | |
227 | ############################################################################## | |
228 | ||
229 | { | |
230 | package DisplayEntry; | |
231 | ||
232 | use DiagList::Output; | |
233 | ||
234 | use fields qw( name buildtag group diag full ); | |
235 | ||
236 | ############################################################################ | |
237 | ||
238 | sub new { | |
239 | my $class = shift; | |
240 | my %args = @_; | |
241 | ||
242 | my $this = fields::new($class); | |
243 | foreach my $key (keys %args) { | |
244 | $this->{$key} = $args{$key}; | |
245 | } | |
246 | return $this; | |
247 | } | |
248 | ||
249 | ############################################################################ | |
250 | ||
251 | sub display { | |
252 | my $this = shift; | |
253 | my $opt = shift; | |
254 | ||
255 | my $npad = ' ' x ($NMAXLEN - length $this->{name}); | |
256 | ||
257 | $OUT->print_status("$this->{name}$npad"); | |
258 | if($opt->{q}) { | |
259 | my $file = $this->{diag}->get_file(); | |
260 | $file = $this->{full} if $opt->{find}; | |
261 | $OUT->print_status(" $file"); | |
262 | } else { | |
263 | my $gpad = ' ' x ($GMAXLEN - length $this->{group}); | |
264 | my $bpad = ' ' x ($BMAXLEN - length $this->{buildtag}); | |
265 | $OUT->print_status(" "); | |
266 | $OUT->print_status("gr=$this->{group}$gpad "); | |
267 | $OUT->print_status("build=$this->{buildtag}$bpad "); | |
268 | $OUT->print_status(" " . $this->{diag}->get_cmdline()); | |
269 | } | |
270 | $OUT->print_status("\n"); | |
271 | ||
272 | } | |
273 | ||
274 | ############################################################################ | |
275 | } | |
276 | ||
277 | ############################################################################## | |
278 | ||
279 | sub get_diag_display { | |
280 | my $dlist = shift; | |
281 | my $alias = shift; | |
282 | my $nametag = shift; | |
283 | my $group = shift; | |
284 | my $opt = shift; | |
285 | ||
286 | my @groups; | |
287 | die "dlist: No group specified!\n" unless defined $group; | |
288 | my $g = $dlist->find_group($group); | |
289 | die "dlist: No group \"$group\" specified!\n" unless defined $g; | |
290 | ||
291 | my @list; | |
292 | ||
293 | foreach my $bt ($g->build_tags()) { | |
294 | my $dhash = $g->diag_hash($bt); | |
295 | my @keys = keys %$dhash; | |
296 | foreach my $key (@keys) { | |
297 | if($key =~ /^$alias:(\S+)/) { | |
298 | next if defined $nametag && $nametag ne $1; | |
299 | push @list, DisplayEntry->new( buildtag => $bt, name => $key, | |
300 | group => $group, diag => $dhash->{$key}); | |
301 | } | |
302 | } | |
303 | } | |
304 | ||
305 | return @list; | |
306 | ||
307 | ||
308 | } | |
309 | ||
310 | ############################################################################## | |
311 | ||
312 | sub find_file { | |
313 | my $file = shift; | |
314 | my $root = shift; | |
315 | ||
316 | die("dlist: Can't find with root \"$root\": No such directory.\n") | |
317 | unless -d $root; | |
318 | ||
319 | my $found; | |
320 | my $found_ref = \$found; | |
321 | my $wanted = sub { | |
322 | if($file eq $_) { | |
323 | $$found_ref = $File::Find::name; | |
324 | } | |
325 | }; | |
326 | ||
327 | find($wanted, $root); | |
328 | ||
329 | $found = "<could_not_find>" unless defined $found; | |
330 | ||
331 | return $found; | |
332 | } | |
333 | ||
334 | ############################################################################## | |
335 | ||
336 | sub build_tags { | |
337 | my $dlist = shift; | |
338 | my $buildtag = shift; | |
339 | my $opt = shift; | |
340 | ||
341 | if($buildtag ne '') { | |
342 | local ($_); | |
343 | my %thash = map { $_, 1 } $dlist->build_list(); | |
344 | die "dlist: Build tag $buildtag not defined\n" | |
345 | unless exists $thash{$buildtag}; | |
346 | if($opt->{q}) { | |
347 | $OUT->print_status("$buildtag\n"); | |
348 | } else { | |
349 | $OUT->print_status("$buildtag " . $dlist->build_args($buildtag) . "\n"); | |
350 | } | |
351 | } else { | |
352 | my @tags = $dlist->build_list(); | |
353 | my $maxlen = maxlen(@tags); | |
354 | foreach my $bt (@tags) { | |
355 | my $pad = ' ' x ($maxlen - length $bt); | |
356 | if($opt->{q}) { | |
357 | $OUT->print_status("$bt\n"); | |
358 | } else { | |
359 | $OUT->print_status("$bt$pad " . $dlist->build_args($bt) . "\n"); | |
360 | } | |
361 | ||
362 | } | |
363 | } | |
364 | ||
365 | exit(0); | |
366 | } | |
367 | ||
368 | ############################################################################## | |
369 | ||
370 | sub maxlen { | |
371 | my @list = @_; | |
372 | ||
373 | my $maxlen = 0; | |
374 | foreach my $elem (@list) { | |
375 | $maxlen = ((length $elem) > $maxlen) ? length $elem : $maxlen; | |
376 | } | |
377 | return $maxlen; | |
378 | } | |
379 | ||
380 | ############################################################################## | |
381 | ||
382 | sub construct_dlist { | |
383 | my $opt = shift; | |
384 | ||
385 | my $dlist; | |
386 | if($opt->{nocpp}) { | |
387 | $dlist = DiagList->new($opt->{diaglist}); | |
388 | } else { | |
389 | ||
390 | local($_, *PIPE); | |
391 | ||
392 | my $cmd = "$opt->{cpp_cmd} $opt->{cpp_args} "; | |
393 | my @incs; | |
394 | if($opt->{stdinc}) { | |
395 | my $abs = File::Spec->rel2abs($opt->{diaglist}); | |
396 | my $dir = dirname $abs; | |
397 | push @incs, $dir; | |
398 | } | |
399 | push @incs, @{$opt->{I}} if defined $opt->{I}; | |
400 | if(@incs) { | |
401 | $cmd .= join ' ', (map { "-I$_" } @incs); | |
402 | $cmd .= ' '; | |
403 | } | |
404 | ||
405 | my @defs; | |
406 | push @defs, @{$opt->{D}} if defined $opt->{D}; | |
407 | if(@defs) { | |
408 | $cmd .= join ' ', (map { "-D$_" } @defs); | |
409 | $cmd .= ' '; | |
410 | } | |
411 | ||
412 | $cmd .= $opt->{diaglist}; | |
413 | ||
414 | open(PIPE, "$cmd |") or die "dlist: Can't start command \"$cmd\": $!\n"; | |
415 | ||
416 | $dlist = DiagList->new($opt->{diaglist}, \*PIPE); | |
417 | ||
418 | close(PIPE); | |
419 | } | |
420 | return $dlist; | |
421 | } | |
422 | ||
423 | ||
424 | ############################################################################## | |
425 | 1; |