projects / OpenSPARC-T2-SAM / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Initial commit of OpenSPARC T2 architecture model.
[OpenSPARC-T2-SAM] / sam-t2 / devtools / v8plus / bin / c2ph
CommitLineData
920dae64
AT		 1#!/import/archperf/ws/devtools/4/v8plus/bin/perl
2 eval 'exec /import/archperf/ws/devtools/4/v8plus/bin/perl -S $0 ${1+"$@"}'
3 if $running_under_some_shell;
4#
5#
6# c2ph (aka pstruct)
7# Tom Christiansen, <tchrist@convex.com>
8#
9# As pstruct, dump C structures as generated from 'cc -g -S' stabs.
10# As c2ph, do this PLUS generate perl code for getting at the structures.
11#
12# See the usage message for more. If this isn't enough, read the code.
13#
14
15=head1 NAME
16
17c2ph, pstruct - Dump C structures as generated from C<cc -g -S> stabs
18
19=head1 SYNOPSIS
20
21 c2ph [-dpnP] [var=val] [files ...]
22
23=head2 OPTIONS
24
25 Options:
26
27 -w wide; short for: type_width=45 member_width=35 offset_width=8
28 -x hex; short for: offset_fmt=x offset_width=08 size_fmt=x size_width=04
29
30 -n do not generate perl code (default when invoked as pstruct)
31 -p generate perl code (default when invoked as c2ph)
32 -v generate perl code, with C decls as comments
33
34 -i do NOT recompute sizes for intrinsic datatypes
35 -a dump information on intrinsics also
36
37 -t trace execution
38 -d spew reams of debugging output
39
40 -slist give comma-separated list a structures to dump
41
42=head1 DESCRIPTION
43
44The following is the old c2ph.doc documentation by Tom Christiansen
45<tchrist@perl.com>
46Date: 25 Jul 91 08:10:21 GMT
47
48Once upon a time, I wrote a program called pstruct. It was a perl
49program that tried to parse out C structures and display their member
50offsets for you. This was especially useful for people looking at
51binary dumps or poking around the kernel.
52
53Pstruct was not a pretty program. Neither was it particularly robust.
54The problem, you see, was that the C compiler was much better at parsing
55C than I could ever hope to be.
56
57So I got smart: I decided to be lazy and let the C compiler parse the C,
58which would spit out debugger stabs for me to read. These were much
59easier to parse. It's still not a pretty program, but at least it's more
60robust.
61
62Pstruct takes any .c or .h files, or preferably .s ones, since that's
63the format it is going to massage them into anyway, and spits out
64listings like this:
65
66 struct tty {
67 int tty.t_locker 000 4
68 int tty.t_mutex_index 004 4
69 struct tty * tty.t_tp_virt 008 4
70 struct clist tty.t_rawq 00c 20
71 int tty.t_rawq.c_cc 00c 4
72 int tty.t_rawq.c_cmax 010 4
73 int tty.t_rawq.c_cfx 014 4
74 int tty.t_rawq.c_clx 018 4
75 struct tty * tty.t_rawq.c_tp_cpu 01c 4
76 struct tty * tty.t_rawq.c_tp_iop 020 4
77 unsigned char * tty.t_rawq.c_buf_cpu 024 4
78 unsigned char * tty.t_rawq.c_buf_iop 028 4
79 struct clist tty.t_canq 02c 20
80 int tty.t_canq.c_cc 02c 4
81 int tty.t_canq.c_cmax 030 4
82 int tty.t_canq.c_cfx 034 4
83 int tty.t_canq.c_clx 038 4
84 struct tty * tty.t_canq.c_tp_cpu 03c 4
85 struct tty * tty.t_canq.c_tp_iop 040 4
86 unsigned char * tty.t_canq.c_buf_cpu 044 4
87 unsigned char * tty.t_canq.c_buf_iop 048 4
88 struct clist tty.t_outq 04c 20
89 int tty.t_outq.c_cc 04c 4
90 int tty.t_outq.c_cmax 050 4
91 int tty.t_outq.c_cfx 054 4
92 int tty.t_outq.c_clx 058 4
93 struct tty * tty.t_outq.c_tp_cpu 05c 4
94 struct tty * tty.t_outq.c_tp_iop 060 4
95 unsigned char * tty.t_outq.c_buf_cpu 064 4
96 unsigned char * tty.t_outq.c_buf_iop 068 4
97 (*int)() tty.t_oproc_cpu 06c 4
98 (*int)() tty.t_oproc_iop 070 4
99 (*int)() tty.t_stopproc_cpu 074 4
100 (*int)() tty.t_stopproc_iop 078 4
101 struct thread * tty.t_rsel 07c 4
102
103etc.
104
105
106Actually, this was generated by a particular set of options. You can control
107the formatting of each column, whether you prefer wide or fat, hex or decimal,
108leading zeroes or whatever.
109
110All you need to be able to use this is a C compiler than generates
111BSD/GCC-style stabs. The B<-g> option on native BSD compilers and GCC
112should get this for you.
113
114To learn more, just type a bogus option, like B<-\?>, and a long usage message
115will be provided. There are a fair number of possibilities.
116
117If you're only a C programmer, than this is the end of the message for you.
118You can quit right now, and if you care to, save off the source and run it
119when you feel like it. Or not.
120
121
122
123But if you're a perl programmer, then for you I have something much more
124wondrous than just a structure offset printer.
125
126You see, if you call pstruct by its other incybernation, c2ph, you have a code
127generator that translates C code into perl code! Well, structure and union
128declarations at least, but that's quite a bit.
129
130Prior to this point, anyone programming in perl who wanted to interact
131with C programs, like the kernel, was forced to guess the layouts of
132the C structures, and then hardwire these into his program. Of course,
133when you took your wonderfully crafted program to a system where the
134sgtty structure was laid out differently, your program broke. Which is
135a shame.
136
137We've had Larry's h2ph translator, which helped, but that only works on
138cpp symbols, not real C, which was also very much needed. What I offer
139you is a symbolic way of getting at all the C structures. I've couched
140them in terms of packages and functions. Consider the following program:
141
142 #!/usr/local/bin/perl
143
144 require 'syscall.ph';
145 require 'sys/time.ph';
146 require 'sys/resource.ph';
147
148 $ru = "\0" x &rusage'sizeof();
149
150 syscall(&SYS_getrusage, &RUSAGE_SELF, $ru) && die "getrusage: $!";
151
152 @ru = unpack($t = &rusage'typedef(), $ru);
153
154 $utime = $ru[ &rusage'ru_utime + &timeval'tv_sec ]
155 + ($ru[ &rusage'ru_utime + &timeval'tv_usec ]) / 1e6;
156
157 $stime = $ru[ &rusage'ru_stime + &timeval'tv_sec ]
158 + ($ru[ &rusage'ru_stime + &timeval'tv_usec ]) / 1e6;
159
160 printf "you have used %8.3fs+%8.3fu seconds.\n", $utime, $stime;
161
162
163As you see, the name of the package is the name of the structure. Regular
164fields are just their own names. Plus the following accessor functions are
165provided for your convenience:
166
167 struct This takes no arguments, and is merely the number of first-level
168 elements in the structure. You would use this for indexing
169 into arrays of structures, perhaps like this
170
171
172 $usec = $u[ &user'u_utimer
173 + (&ITIMER_VIRTUAL * &itimerval'struct)
174 + &itimerval'it_value
175 + &timeval'tv_usec
176 ];
177
178 sizeof Returns the bytes in the structure, or the member if
179 you pass it an argument, such as
180
181 &rusage'sizeof(&rusage'ru_utime)
182
183 typedef This is the perl format definition for passing to pack and
184 unpack. If you ask for the typedef of a nothing, you get
185 the whole structure, otherwise you get that of the member
186 you ask for. Padding is taken care of, as is the magic to
187 guarantee that a union is unpacked into all its aliases.
188 Bitfields are not quite yet supported however.
189
190 offsetof This function is the byte offset into the array of that
191 member. You may wish to use this for indexing directly
192 into the packed structure with vec() if you're too lazy
193 to unpack it.
194
195 typeof Not to be confused with the typedef accessor function, this
196 one returns the C type of that field. This would allow
197 you to print out a nice structured pretty print of some
198 structure without knoning anything about it beforehand.
199 No args to this one is a noop. Someday I'll post such
200 a thing to dump out your u structure for you.
201
202
203The way I see this being used is like basically this:
204
205 % h2ph <some_include_file.h > /usr/lib/perl/tmp.ph
206 % c2ph some_include_file.h >> /usr/lib/perl/tmp.ph
207 % install
208
209It's a little tricker with c2ph because you have to get the includes right.
210I can't know this for your system, but it's not usually too terribly difficult.
211
212The code isn't pretty as I mentioned -- I never thought it would be a 1000-
213line program when I started, or I might not have begun. :-) But I would have
214been less cavalier in how the parts of the program communicated with each
215other, etc. It might also have helped if I didn't have to divine the makeup
216of the stabs on the fly, and then account for micro differences between my
217compiler and gcc.
218
219Anyway, here it is. Should run on perl v4 or greater. Maybe less.
220
221
222 --tom
223
224=cut
225
226$RCSID = '$Id: c2ph,v 1.7 95/10/28 10:41:47 tchrist Exp Locker: tchrist $';
227
228use File::Temp;
229
230######################################################################
231
232# some handy data definitions. many of these can be reset later.
233
234$bitorder = 'b'; # ascending; set to B for descending bit fields
235
236%intrinsics =
237%template = (
238 'char', 'c',
239 'unsigned char', 'C',
240 'short', 's',
241 'short int', 's',
242 'unsigned short', 'S',
243 'unsigned short int', 'S',
244 'short unsigned int', 'S',
245 'int', 'i',
246 'unsigned int', 'I',
247 'long', 'l',
248 'long int', 'l',
249 'unsigned long', 'L',
250 'unsigned long', 'L',
251 'long unsigned int', 'L',
252 'unsigned long int', 'L',
253 'long long', 'q',
254 'long long int', 'q',
255 'unsigned long long', 'Q',
256 'unsigned long long int', 'Q',
257 'float', 'f',
258 'double', 'd',
259 'pointer', 'p',
260 'null', 'x',
261 'neganull', 'X',
262 'bit', $bitorder,
263);
264
265&buildscrunchlist;
266delete $intrinsics{'neganull'};
267delete $intrinsics{'bit'};
268delete $intrinsics{'null'};
269
270# use -s to recompute sizes
271%sizeof = (
272 'char', '1',
273 'unsigned char', '1',
274 'short', '2',
275 'short int', '2',
276 'unsigned short', '2',
277 'unsigned short int', '2',
278 'short unsigned int', '2',
279 'int', '4',
280 'unsigned int', '4',
281 'long', '4',
282 'long int', '4',
283 'unsigned long', '4',
284 'unsigned long int', '4',
285 'long unsigned int', '4',
286 'long long', '8',
287 'long long int', '8',
288 'unsigned long long', '8',
289 'unsigned long long int', '8',
290 'float', '4',
291 'double', '8',
292 'pointer', '4',
293);
294
295($type_width, $member_width, $offset_width, $size_width) = (20, 20, 6, 5);
296
297($offset_fmt, $size_fmt) = ('d', 'd');
298
299$indent = 2;
300
301$CC = 'cc';
302$CFLAGS = '-g -S';
303$DEFINES = '';
304
305$perl++ if $0 =~ m#/?c2ph$#;
306
307require 'getopts.pl';
308
309use File::Temp 'tempdir';
310
311eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
312
313&Getopts('aixdpvtnws:') || &usage(0);
314
315$opt_d && $debug++;
316$opt_t && $trace++;
317$opt_p && $perl++;
318$opt_v && $verbose++;
319$opt_n && ($perl = 0);
320
321if ($opt_w) {
322 ($type_width, $member_width, $offset_width) = (45, 35, 8);
323}
324if ($opt_x) {
325 ($offset_fmt, $offset_width, $size_fmt, $size_width) = ( 'x', '08', 'x', 04 );
326}
327
328eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
329
330sub PLUMBER {
331 select(STDERR);
332 print "oops, apperent pager foulup\n";
333 $isatty++;
334 &usage(1);
335}
336
337sub usage {
338 local($oops) = @_;
339 unless (-t STDOUT) {
340 select(STDERR);
341 } elsif (!$oops) {
342 $isatty++;
343 $| = 1;
344 print "hit <RETURN> for further explanation: ";
345 <STDIN>;
346 open (PIPE, "|". ($ENV{PAGER} || 'more'));
347 $SIG{PIPE} = PLUMBER;
348 select(PIPE);
349 }
350
351 print "usage: $0 [-dpnP] [var=val] [files ...]\n";
352
353 exit unless $isatty;
354
355 print <<EOF;
356
357Options:
358
359-w wide; short for: type_width=45 member_width=35 offset_width=8
360-x hex; short for: offset_fmt=x offset_width=08 size_fmt=x size_width=04
361
362-n do not generate perl code (default when invoked as pstruct)
363-p generate perl code (default when invoked as c2ph)
364-v generate perl code, with C decls as comments
365
366-i do NOT recompute sizes for intrinsic datatypes
367-a dump information on intrinsics also
368
369-t trace execution
370-d spew reams of debugging output
371
372-slist give comma-separated list a structures to dump
373
374
375Var Name Default Value Meaning
376
377EOF
378
379 &defvar('CC', 'which_compiler to call');
380 &defvar('CFLAGS', 'how to generate *.s files with stabs');
381 &defvar('DEFINES','any extra cflags or cpp defines, like -I, -D, -U');
382
383 print "\n";
384
385 &defvar('type_width', 'width of type field (column 1)');
386 &defvar('member_width', 'width of member field (column 2)');
387 &defvar('offset_width', 'width of offset field (column 3)');
388 &defvar('size_width', 'width of size field (column 4)');
389
390 print "\n";
391
392 &defvar('offset_fmt', 'sprintf format type for offset');
393 &defvar('size_fmt', 'sprintf format type for size');
394
395 print "\n";
396
397 &defvar('indent', 'how far to indent each nesting level');
398
399 print <<'EOF';
400
401 If any *.[ch] files are given, these will be catted together into
402 a temporary *.c file and sent through:
403 $CC $CFLAGS $DEFINES
404 and the resulting *.s groped for stab information. If no files are
405 supplied, then stdin is read directly with the assumption that it
406 contains stab information. All other lines will be ignored. At
407 most one *.s file should be supplied.
408
409EOF
410 close PIPE;
411 exit 1;
412}
413
414sub defvar {
415 local($var, $msg) = @_;
416 printf "%-16s%-15s %s\n", $var, eval "\$$var", $msg;
417}
418
419sub safedir {
420 $SAFEDIR = File::Temp::tempdir("c2ph.XXXXXX", TMPDIR => 1, CLEANUP => 1)
421 unless (defined($SAFEDIR));
422}
423
424undef $SAFEDIR;
425
426$recurse = 1;
427
428if (@ARGV) {
429 if (grep(!/\.[csh]$/,@ARGV)) {
430 warn "Only *.[csh] files expected!\n";
431 &usage;
432 }
433 elsif (grep(/\.s$/,@ARGV)) {
434 if (@ARGV > 1) {
435 warn "Only one *.s file allowed!\n";
436 &usage;
437 }
438 }
439 elsif (@ARGV == 1 && $ARGV[0] =~ /\.c$/) {
440 local($dir, $file) = $ARGV[0] =~ m#(.*/)?(.*)$#;
441 $chdir = "cd $dir && " if $dir;
442 &system("$chdir$CC $CFLAGS $DEFINES $file") && exit 1;
443 $ARGV[0] =~ s/\.c$/.s/;
444 }
445 else {
446 &safedir;
447 $TMP = "$SAFEDIR/c2ph.$$.c";
448 &system("cat @ARGV > $TMP") && exit 1;
449 &system("cd $SAFEDIR && $CC $CFLAGS $DEFINES $TMP") && exit 1;
450 unlink $TMP;
451 $TMP =~ s/\.c$/.s/;
452 @ARGV = ($TMP);
453 }
454}
455
456if ($opt_s) {
457 for (split(/[\s,]+/, $opt_s)) {
458 $interested{$_}++;
459 }
460}
461
462
463$| = 1 if $debug;
464
465main: {
466
467 if ($trace) {
468 if (-t && !@ARGV) {
469 print STDERR "reading from your keyboard: ";
470 } else {
471 print STDERR "reading from " . (@ARGV ? "@ARGV" : "<STDIN>").": ";
472 }
473 }
474
475STAB: while (<>) {
476 if ($trace && !($. % 10)) {
477 $lineno = $..'';
478 print STDERR $lineno, "\b" x length($lineno);
479 }
480 next unless /^\s*\.stabs\s+/;
481 $line = $_;
482 s/^\s*\.stabs\s+//;
483 if (s/\\\\"[d,]+$//) {
484 $saveline .= $line;
485 $savebar = $_;
486 next STAB;
487 }
488 if ($saveline) {
489 s/^"//;
490 $_ = $savebar . $_;
491 $line = $saveline;
492 }
493 &stab;
494 $savebar = $saveline = undef;
495 }
496 print STDERR "$.\n" if $trace;
497 unlink $TMP if $TMP;
498
499 &compute_intrinsics if $perl && !$opt_i;
500
501 print STDERR "resolving types\n" if $trace;
502
503 &resolve_types;
504 &adjust_start_addrs;
505
506 $sum = 2 + $type_width + $member_width;
507 $pmask1 = "%-${type_width}s %-${member_width}s";
508 $pmask2 = "%-${sum}s %${offset_width}${offset_fmt}%s %${size_width}${size_fmt}%s";
509
510
511
512 if ($perl) {
513 # resolve template -- should be in stab define order, but even this isn't enough.
514 print STDERR "\nbuilding type templates: " if $trace;
515 for $i (reverse 0..$#type) {
516 next unless defined($name = $type[$i]);
517 next unless defined $struct{$name};
518 ($iname = $name) =~ s/\..*//;
519 $build_recursed = 0;
520 &build_template($name) unless defined $template{&psou($name)} ||
521 $opt_s && !$interested{$iname};
522 }
523 print STDERR "\n\n" if $trace;
524 }
525
526 print STDERR "dumping structs: " if $trace;
527
528 local($iam);
529
530
531
532 foreach $name (sort keys %struct) {
533 ($iname = $name) =~ s/\..*//;
534 next if $opt_s && !$interested{$iname};
535 print STDERR "$name " if $trace;
536
537 undef @sizeof;
538 undef @typedef;
539 undef @offsetof;
540 undef @indices;
541 undef @typeof;
542 undef @fieldnames;
543
544 $mname = &munge($name);
545
546 $fname = &psou($name);
547
548 print "# " if $perl && $verbose;
549 $pcode = '';
550 print "$fname {\n" if !$perl || $verbose;
551 $template{$fname} = &scrunch($template{$fname}) if $perl;
552 &pstruct($name,$name,0);
553 print "# " if $perl && $verbose;
554 print "}\n" if !$perl || $verbose;
555 print "\n" if $perl && $verbose;
556
557 if ($perl) {
558 print "$pcode";
559
560 printf("\nsub %-32s { %4d; }\n\n", "${mname}'struct", $countof{$name});
561
562 print <<EOF;
563sub ${mname}'typedef {
564 local(\$${mname}'index) = shift;
565 defined \$${mname}'index
566 ? \$${mname}'typedef[\$${mname}'index]
567 : \$${mname}'typedef;
568}
569EOF
570
571 print <<EOF;
572sub ${mname}'sizeof {
573 local(\$${mname}'index) = shift;
574 defined \$${mname}'index
575 ? \$${mname}'sizeof[\$${mname}'index]
576 : \$${mname}'sizeof;
577}
578EOF
579
580 print <<EOF;
581sub ${mname}'offsetof {
582 local(\$${mname}'index) = shift;
583 defined \$${mname}index
584 ? \$${mname}'offsetof[\$${mname}'index]
585 : \$${mname}'sizeof;
586}
587EOF
588
589 print <<EOF;
590sub ${mname}'typeof {
591 local(\$${mname}'index) = shift;
592 defined \$${mname}index
593 ? \$${mname}'typeof[\$${mname}'index]
594 : '$name';
595}
596EOF
597
598 print <<EOF;
599sub ${mname}'fieldnames {
600 \@${mname}'fieldnames;
601}
602EOF
603
604 $iam = ($isastruct{$name} && 's') || ($isaunion{$name} && 'u');
605
606 print <<EOF;
607sub ${mname}'isastruct {
608 '$iam';
609}
610EOF
611
612 print "\$${mname}'typedef = '" . &scrunch($template{$fname})
613 . "';\n";
614
615 print "\$${mname}'sizeof = $sizeof{$name};\n\n";
616
617
618 print "\@${mname}'indices = (", &squishseq(@indices), ");\n";
619
620 print "\n";
621
622 print "\@${mname}'typedef[\@${mname}'indices] = (",
623 join("\n\t", '', @typedef), "\n );\n\n";
624 print "\@${mname}'sizeof[\@${mname}'indices] = (",
625 join("\n\t", '', @sizeof), "\n );\n\n";
626 print "\@${mname}'offsetof[\@${mname}'indices] = (",
627 join("\n\t", '', @offsetof), "\n );\n\n";
628 print "\@${mname}'typeof[\@${mname}'indices] = (",
629 join("\n\t", '', @typeof), "\n );\n\n";
630 print "\@${mname}'fieldnames[\@${mname}'indices] = (",
631 join("\n\t", '', @fieldnames), "\n );\n\n";
632
633 $template_printed{$fname}++;
634 $size_printed{$fname}++;
635 }
636 print "\n";
637 }
638
639 print STDERR "\n" if $trace;
640
641 unless ($perl && $opt_a) {
642 print "\n1;\n" if $perl;
643 exit;
644 }
645
646
647
648 foreach $name (sort bysizevalue keys %intrinsics) {
649 next if $size_printed{$name};
650 print '$',&munge($name),"'sizeof = ", $sizeof{$name}, ";\n";
651 }
652
653 print "\n";
654
655 sub bysizevalue { $sizeof{$a} <=> $sizeof{$b}; }
656
657
658 foreach $name (sort keys %intrinsics) {
659 print '$',&munge($name),"'typedef = '", $template{$name}, "';\n";
660 }
661
662 print "\n1;\n" if $perl;
663
664 exit;
665}
666
667########################################################################################
668
669
670sub stab {
671 next unless $continued || /:[\$\w]+(\(\d+,\d+\))?=[\*\$\w]+/; # (\d+,\d+) is for sun
672 s/"// || next;
673 s/",([x\d]+),([x\d]+),([x\d]+),.*// || next;
674
675 next if /^\s*$/;
676
677 $size = $3 if $3;
678 $_ = $continued . $_ if length($continued);
679 if (s/\\\\$//) {
680 # if last 2 chars of string are '\\' then stab is continued
681 # in next stab entry
682 chop;
683 $continued = $_;
684 next;
685 }
686 $continued = '';
687
688
689 $line = $_;
690
691 if (($name, $pdecl) = /^([\$ \w]+):[tT]((\d+)(=[rufs*](\d+))+)$/) {
692 print "$name is a typedef for some funky pointers: $pdecl\n" if $debug;
693 &pdecl($pdecl);
694 next;
695 }
696
697
698
699 if (/(([ \w]+):t(\d+|\(\d+,\d+\)))=r?(\d+|\(\d+,\d+\))(;\d+;\d+;)?/) {
700 local($ident) = $2;
701 push(@intrinsics, $ident);
702 $typeno = &typeno($3);
703 $type[$typeno] = $ident;
704 print STDERR "intrinsic $ident in new type $typeno\n" if $debug;
705 next;
706 }
707
708 if (($name, $typeordef, $typeno, $extra, $struct, $_)
709 = /^([\$ \w]+):([ustT])(\d+|\(\d+,\d+\))(=[rufs*](\d+))?(.*)$/)
710 {
711 $typeno = &typeno($typeno); # sun foolery
712 }
713 elsif (/^[\$\w]+:/) {
714 next; # variable
715 }
716 else {
717 warn "can't grok stab: <$_> in: $line " if $_;
718 next;
719 }
720
721 #warn "got size $size for $name\n";
722 $sizeof{$name} = $size if $size;
723
724 s/;[-\d]*;[-\d]*;$//; # we don't care about ranges
725
726 $typenos{$name} = $typeno;
727
728 unless (defined $type[$typeno]) {
729 &panic("type 0??") unless $typeno;
730 $type[$typeno] = $name unless defined $type[$typeno];
731 printf "new type $typeno is $name" if $debug;
732 if ($extra =~ /\*/ && defined $type[$struct]) {
733 print ", a typedef for a pointer to " , $type[$struct] if $debug;
734 }
735 } else {
736 printf "%s is type %d", $name, $typeno if $debug;
737 print ", a typedef for " , $type[$typeno] if $debug;
738 }
739 print "\n" if $debug;
740 #next unless $extra =~ /[su*]/;
741
742 #$type[$struct] = $name;
743
744 if ($extra =~ /[us*]/) {
745 &sou($name, $extra);
746 $_ = &sdecl($name, $_, 0);
747 }
748 elsif (/^=ar/) {
749 print "it's a bare array typedef -- that's pretty sick\n" if $debug;
750 $_ = "$typeno$_";
751 $scripts = '';
752 $_ = &adecl($_,1);
753
754 }
755 elsif (s/((\w+):t(\d+|\(\d+,\d+\)))?=r?(;\d+;\d+;)?//) { # the ?'s are for gcc
756 push(@intrinsics, $2);
757 $typeno = &typeno($3);
758 $type[$typeno] = $2;
759 print STDERR "intrinsic $2 in new type $typeno\n" if $debug;
760 }
761 elsif (s/^=e//) { # blessed be thy compiler; mine won't do this
762 &edecl;
763 }
764 else {
765 warn "Funny remainder for $name on line $_ left in $line " if $_;
766 }
767}
768
769sub typeno { # sun thinks types are (0,27) instead of just 27
770 local($_) = @_;
771 s/\(\d+,(\d+)\)/$1/;
772 $_;
773}
774
775sub pstruct {
776 local($what,$prefix,$base) = @_;
777 local($field, $fieldname, $typeno, $count, $offset, $entry);
778 local($fieldtype);
779 local($type, $tname);
780 local($mytype, $mycount, $entry2);
781 local($struct_count) = 0;
782 local($pad, $revpad, $length, $prepad, $lastoffset, $lastlength, $fmt);
783 local($bits,$bytes);
784 local($template);
785
786
787 local($mname) = &munge($name);
788
789 sub munge {
790 local($_) = @_;
791 s/[\s\$\.]/_/g;
792 $_;
793 }
794
795 local($sname) = &psou($what);
796
797 $nesting++;
798
799 for $field (split(/;/, $struct{$what})) {
800 $pad = $prepad = 0;
801 $entry = '';
802 ($fieldname, $typeno, $count, $offset, $length) = split(/,/, $field);
803
804 $type = $type[$typeno];
805
806 $type =~ /([^[]*)(\[.*\])?/;
807 $mytype = $1;
808 $count .= $2;
809 $fieldtype = &psou($mytype);
810
811 local($fname) = &psou($name);
812
813 if ($build_templates) {
814
815 $pad = ($offset - ($lastoffset + $lastlength))/8
816 if defined $lastoffset;
817
818 if (! $finished_template{$sname}) {
819 if ($isaunion{$what}) {
820 $template{$sname} .= 'X' x $revpad . ' ' if $revpad;
821 } else {
822 $template{$sname} .= 'x' x $pad . ' ' if $pad;
823 }
824 }
825
826 $template = &fetch_template($type);
827 &repeat_template($template,$count);
828
829 if (! $finished_template{$sname}) {
830 $template{$sname} .= $template;
831 }
832
833 $revpad = $length/8 if $isaunion{$what};
834
835 ($lastoffset, $lastlength) = ($offset, $length);
836
837 } else {
838 print '# ' if $perl && $verbose;
839 $entry = sprintf($pmask1,
840 ' ' x ($nesting * $indent) . $fieldtype,
841 "$prefix.$fieldname" . $count);
842
843 $entry =~ s/(\*+)( )/$2$1/;
844
845 printf $pmask2,
846 $entry,
847 ($base+$offset)/8,
848 ($bits = ($base+$offset)%8) ? ".$bits" : " ",
849 $length/8,
850 ($bits = $length % 8) ? ".$bits": ""
851 if !$perl || $verbose;
852
853 if ($perl) {
854 $template = &fetch_template($type);
855 &repeat_template($template,$count);
856 }
857
858 if ($perl && $nesting == 1) {
859
860 push(@sizeof, int($length/8) .",\t# $fieldname");
861 push(@offsetof, int($offset/8) .",\t# $fieldname");
862 local($little) = &scrunch($template);
863 push(@typedef, "'$little', \t# $fieldname");
864 $type =~ s/(struct|union) //;
865 push(@typeof, "'$mytype" . ($count ? $count : '') .
866 "',\t# $fieldname");
867 push(@fieldnames, "'$fieldname',");
868 }
869
870 print ' ', ' ' x $indent x $nesting, $template
871 if $perl && $verbose;
872
873 print "\n" if !$perl || $verbose;
874
875 }
876 if ($perl) {
877 local($mycount) = defined $struct{$mytype} ? $countof{$mytype} : 1;
878 $mycount *= &scripts2count($count) if $count;
879 if ($nesting==1 && !$build_templates) {
880 $pcode .= sprintf("sub %-32s { %4d; }\n",
881 "${mname}'${fieldname}", $struct_count);
882 push(@indices, $struct_count);
883 }
884 $struct_count += $mycount;
885 }
886
887
888 &pstruct($type, "$prefix.$fieldname", $base+$offset)
889 if $recurse && defined $struct{$type};
890 }
891
892 $countof{$what} = $struct_count unless defined $countof{$whati};
893
894 $template{$sname} .= '$' if $build_templates;
895 $finished_template{$sname}++;
896
897 if ($build_templates && !defined $sizeof{$name}) {
898 local($fmt) = &scrunch($template{$sname});
899 print STDERR "no size for $name, punting with $fmt..." if $debug;
900 eval '$sizeof{$name} = length(pack($fmt, ()))';
901 if ($@) {
902 chop $@;
903 warn "couldn't get size for \$name: $@";
904 } else {
905 print STDERR $sizeof{$name}, "\n" if $debUg;
906 }
907 }
908
909 --$nesting;
910}
911
912
913sub psize {
914 local($me) = @_;
915 local($amstruct) = $struct{$me} ? 'struct ' : '';
916
917 print '$sizeof{\'', $amstruct, $me, '\'} = ';
918 printf "%d;\n", $sizeof{$me};
919}
920
921sub pdecl {
922 local($pdecl) = @_;
923 local(@pdecls);
924 local($tname);
925
926 warn "pdecl: $pdecl\n" if $debug;
927
928 $pdecl =~ s/\(\d+,(\d+)\)/$1/g;
929 $pdecl =~ s/\*//g;
930 @pdecls = split(/=/, $pdecl);
931 $typeno = $pdecls[0];
932 $tname = pop @pdecls;
933
934 if ($tname =~ s/^f//) { $tname = "$tname&"; }
935 #else { $tname = "$tname*"; }
936
937 for (reverse @pdecls) {
938 $tname .= s/^f// ? "&" : "*";
939 #$tname =~ s/^f(.*)/$1&/;
940 print "type[$_] is $tname\n" if $debug;
941 $type[$_] = $tname unless defined $type[$_];
942 }
943}
944
945
946
947sub adecl {
948 ($arraytype, $unknown, $lower, $upper) = ();
949 #local($typeno);
950 # global $typeno, @type
951 local($_, $typedef) = @_;
952
953 while (s/^((\d+|\(\d+,\d+\))=)?ar(\d+|\(\d+,\d+\));//) {
954 ($arraytype, $unknown) = ($2, $3);
955 $arraytype = &typeno($arraytype);
956 $unknown = &typeno($unknown);
957 if (s/^(\d+);(\d+);//) {
958 ($lower, $upper) = ($1, $2);
959 $scripts .= '[' . ($upper+1) . ']';
960 } else {
961 warn "can't find array bounds: $_";
962 }
963 }
964 if (s/^([(,)\d*f=]*),(\d+),(\d+);//) {
965 ($start, $length) = ($2, $3);
966 $whatis = $1;
967 if ($whatis =~ /^(\d+|\(\d+,\d+\))=/) {
968 $typeno = &typeno($1);
969 &pdecl($whatis);
970 } else {
971 $typeno = &typeno($whatis);
972 }
973 } elsif (s/^(\d+)(=[*suf]\d*)//) {
974 local($whatis) = $2;
975
976 if ($whatis =~ /[f*]/) {
977 &pdecl($whatis);
978 } elsif ($whatis =~ /[su]/) { #
979 print "$prefix.$fieldname is an array$scripts anon structs; disgusting\n"
980 if $debug;
981 #$type[$typeno] = $name unless defined $type[$typeno];
982 ##printf "new type $typeno is $name" if $debug;
983 $typeno = $1;
984 $type[$typeno] = "$prefix.$fieldname";
985 local($name) = $type[$typeno];
986 &sou($name, $whatis);
987 $_ = &sdecl($name, $_, $start+$offset);
988 1;
989 $start = $start{$name};
990 $offset = $sizeof{$name};
991 $length = $offset;
992 } else {
993 warn "what's this? $whatis in $line ";
994 }
995 } elsif (/^\d+$/) {
996 $typeno = $_;
997 } else {
998 warn "bad array stab: $_ in $line ";
999 next STAB;
1000 }
1001 #local($wasdef) = defined($type[$typeno]) && $debug;
1002 #if ($typedef) {
1003 #print "redefining $type[$typeno] to " if $wasdef;
1004 #$type[$typeno] = "$whatis$scripts"; # unless defined $type[$typeno];
1005 #print "$type[$typeno]\n" if $wasdef;
1006 #} else {
1007 #$type[$arraytype] = $type[$typeno] unless defined $type[$arraytype];
1008 #}
1009 $type[$arraytype] = "$type[$typeno]$scripts" if defined $type[$typeno];
1010 print "type[$arraytype] is $type[$arraytype]\n" if $debug;
1011 print "$prefix.$fieldname is an array of $type[$arraytype]\n" if $debug;
1012 $_;
1013}
1014
1015
1016
1017sub sdecl {
1018 local($prefix, $_, $offset) = @_;
1019
1020 local($fieldname, $scripts, $type, $arraytype, $unknown,
1021 $whatis, $pdecl, $upper,$lower, $start,$length) = ();
1022 local($typeno,$sou);
1023
1024
1025SFIELD:
1026 while (/^([^;]+);/) {
1027 $scripts = '';
1028 warn "sdecl $_\n" if $debug;
1029 if (s/^([\$\w]+)://) {
1030 $fieldname = $1;
1031 } elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { #
1032 $typeno = &typeno($1);
1033 $type[$typeno] = "$prefix.$fieldname";
1034 local($name) = "$prefix.$fieldname";
1035 &sou($name,$2);
1036 $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
1037 $start = $start{$name};
1038 $offset += $sizeof{$name};
1039 #print "done with anon, start is $start, offset is $offset\n";
1040 #next SFIELD;
1041 } else {
1042 warn "weird field $_ of $line" if $debug;
1043 next STAB;
1044 #$fieldname = &gensym;
1045 #$_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
1046 }
1047
1048 if (/^(\d+|\(\d+,\d+\))=ar/) {
1049 $_ = &adecl($_);
1050 }
1051 elsif (s/^(\d+|\(\d+,\d+\))?,(\d+),(\d+);//) {
1052 ($start, $length) = ($2, $3);
1053 &panic("no length?") unless $length;
1054 $typeno = &typeno($1) if $1;
1055 }
1056 elsif (s/^(\d+)=xs\w+:,(\d+),(\d+);//) {
1057 ($start, $length) = ($2, $3);
1058 &panic("no length?") unless $length;
1059 $typeno = &typeno($1) if $1;
1060 }
1061 elsif (s/^((\d+|\(\d+,\d+\))(=[*f](\d+|\(\d+,\d+\)))+),(\d+),(\d+);//) {
1062 ($pdecl, $start, $length) = ($1,$5,$6);
1063 &pdecl($pdecl);
1064 }
1065 elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # the dratted anon struct
1066 ($typeno, $sou) = ($1, $2);
1067 $typeno = &typeno($typeno);
1068 if (defined($type[$typeno])) {
1069 warn "now how did we get type $1 in $fieldname of $line?";
1070 } else {
1071 print "anon type $typeno is $prefix.$fieldname\n" if $debug;
1072 $type[$typeno] = "$prefix.$fieldname" unless defined $type[$typeno];
1073 };
1074 local($name) = "$prefix.$fieldname";
1075 &sou($name,$sou);
1076 print "anon ".($isastruct{$name}) ? "struct":"union"." for $prefix.$fieldname\n" if $debug;
1077 $type[$typeno] = "$prefix.$fieldname";
1078 $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
1079 $start = $start{$name};
1080 $length = $sizeof{$name};
1081 }
1082 else {
1083 warn "can't grok stab for $name ($_) in line $line ";
1084 next STAB;
1085 }
1086
1087 &panic("no length for $prefix.$fieldname") unless $length;
1088 $struct{$name} .= join(',', $fieldname, $typeno, $scripts, $start, $length) . ';';
1089 }
1090 if (s/;\d*,(\d+),(\d+);//) {
1091 local($start, $size) = ($1, $2);
1092 $sizeof{$prefix} = $size;
1093 print "start of $prefix is $start, size of $sizeof{$prefix}\n" if $debug;
1094 $start{$prefix} = $start;
1095 }
1096 $_;
1097}
1098
1099sub edecl {
1100 s/;$//;
1101 $enum{$name} = $_;
1102 $_ = '';
1103}
1104
1105sub resolve_types {
1106 local($sou);
1107 for $i (0 .. $#type) {
1108 next unless defined $type[$i];
1109 $_ = $type[$i];
1110 unless (/\d/) {
1111 print "type[$i] $type[$i]\n" if $debug;
1112 next;
1113 }
1114 print "type[$i] $_ ==> " if $debug;
1115 s/^(\d+)(\**)\&\*(\**)/"$2($3".&type($1) . ')()'/e;
1116 s/^(\d+)\&/&type($1)/e;
1117 s/^(\d+)/&type($1)/e;
1118 s/(\*+)([^*]+)(\*+)/$1$3$2/;
1119 s/\((\*+)(\w+)(\*+)\)/$3($1$2)/;
1120 s/^(\d+)([\*\[].*)/&type($1).$2/e;
1121 #s/(\d+)(\*|(\[[\[\]\d\*]+]\])+)/&type($1).$2/ge;
1122 $type[$i] = $_;
1123 print "$_\n" if $debug;
1124 }
1125}
1126sub type { &psou($type[$_[0]] || "<UNDEFINED>"); }
1127
1128sub adjust_start_addrs {
1129 for (sort keys %start) {
1130 ($basename = $_) =~ s/\.[^.]+$//;
1131 $start{$_} += $start{$basename};
1132 print "start: $_ @ $start{$_}\n" if $debug;
1133 }
1134}
1135
1136sub sou {
1137 local($what, $_) = @_;
1138 /u/ && $isaunion{$what}++;
1139 /s/ && $isastruct{$what}++;
1140}
1141
1142sub psou {
1143 local($what) = @_;
1144 local($prefix) = '';
1145 if ($isaunion{$what}) {
1146 $prefix = 'union ';
1147 } elsif ($isastruct{$what}) {
1148 $prefix = 'struct ';
1149 }
1150 $prefix . $what;
1151}
1152
1153sub scrunch {
1154 local($_) = @_;
1155
1156 return '' if $_ eq '';
1157
1158 study;
1159
1160 s/\$//g;
1161 s/ / /g;
1162 1 while s/(\w) \1/$1$1/g;
1163
1164 # i wanna say this, but perl resists my efforts:
1165 # s/(\w)(\1+)/$2 . length($1)/ge;
1166
1167 &quick_scrunch;
1168
1169 s/ $//;
1170
1171 $_;
1172}
1173
1174sub buildscrunchlist {
1175 $scrunch_code = "sub quick_scrunch {\n";
1176 for (values %intrinsics) {
1177 $scrunch_code .= "\ts/(${_}{2,})/'$_' . length(\$1)/ge;\n";
1178 }
1179 $scrunch_code .= "}\n";
1180 print "$scrunch_code" if $debug;
1181 eval $scrunch_code;
1182 &panic("can't eval scrunch_code $@ \nscrunch_code") if $@;
1183}
1184
1185sub fetch_template {
1186 local($mytype) = @_;
1187 local($fmt);
1188 local($count) = 1;
1189
1190 &panic("why do you care?") unless $perl;
1191
1192 if ($mytype =~ s/(\[\d+\])+$//) {
1193 $count .= $1;
1194 }
1195
1196 if ($mytype =~ /\*/) {
1197 $fmt = $template{'pointer'};
1198 }
1199 elsif (defined $template{$mytype}) {
1200 $fmt = $template{$mytype};
1201 }
1202 elsif (defined $struct{$mytype}) {
1203 if (!defined $template{&psou($mytype)}) {
1204 &build_template($mytype) unless $mytype eq $name;
1205 }
1206 elsif ($template{&psou($mytype)} !~ /\$$/) {
1207 #warn "incomplete template for $mytype\n";
1208 }
1209 $fmt = $template{&psou($mytype)} || '?';
1210 }
1211 else {
1212 warn "unknown fmt for $mytype\n";
1213 $fmt = '?';
1214 }
1215
1216 $fmt x $count . ' ';
1217}
1218
1219sub compute_intrinsics {
1220 &safedir;
1221 local($TMP) = "$SAFEDIR/c2ph-i.$$.c";
1222 open (TMP, ">$TMP") || die "can't open $TMP: $!";
1223 select(TMP);
1224
1225 print STDERR "computing intrinsic sizes: " if $trace;
1226
1227 undef %intrinsics;
1228
1229 print <<'EOF';
1230main() {
1231 char *mask = "%d %s\n";
1232EOF
1233
1234 for $type (@intrinsics) {
1235 next if !$type || $type eq 'void' || $type =~ /complex/; # sun stuff
1236 print <<"EOF";
1237 printf(mask,sizeof($type), "$type");
1238EOF
1239 }
1240
1241 print <<'EOF';
1242 printf(mask,sizeof(char *), "pointer");
1243 exit(0);
1244}
1245EOF
1246 close TMP;
1247
1248 select(STDOUT);
1249 open(PIPE, "cd $SAFEDIR && $CC $TMP && $SAFEDIR/a.out|");
1250 while (<PIPE>) {
1251 chop;
1252 split(' ',$_,2);;
1253 print "intrinsic $_[1] is size $_[0]\n" if $debug;
1254 $sizeof{$_[1]} = $_[0];
1255 $intrinsics{$_[1]} = $template{$_[0]};
1256 }
1257 close(PIPE) || die "couldn't read intrinsics!";
1258 unlink($TMP, '$SAFEDIR/a.out');
1259 print STDERR "done\n" if $trace;
1260}
1261
1262sub scripts2count {
1263 local($_) = @_;
1264
1265 s/^\[//;
1266 s/\]$//;
1267 s/\]\[/*/g;
1268 $_ = eval;
1269 &panic("$_: $@") if $@;
1270 $_;
1271}
1272
1273sub system {
1274 print STDERR "@_\n" if $trace;
1275 system @_;
1276}
1277
1278sub build_template {
1279 local($name) = @_;
1280
1281 &panic("already got a template for $name") if defined $template{$name};
1282
1283 local($build_templates) = 1;
1284
1285 local($lparen) = '(' x $build_recursed;
1286 local($rparen) = ')' x $build_recursed;
1287
1288 print STDERR "$lparen$name$rparen " if $trace;
1289 $build_recursed++;
1290 &pstruct($name,$name,0);
1291 print STDERR "TEMPLATE for $name is ", $template{&psou($name)}, "\n" if $debug;
1292 --$build_recursed;
1293}
1294
1295
1296sub panic {
1297
1298 select(STDERR);
1299
1300 print "\npanic: @_\n";
1301
1302 exit 1 if $] <= 4.003; # caller broken
1303
1304 local($i,$_);
1305 local($p,$f,$l,$s,$h,$a,@a,@sub);
1306 for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
1307 @a = @DB'args;
1308 for (@a) {
1309 if (/^StB\000/ && length($_) == length($_main{'_main'})) {
1310 $_ = sprintf("%s",$_);
1311 }
1312 else {
1313 s/'/\\'/g;
1314 s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
1315 s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
1316 s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
1317 }
1318 }
1319 $w = $w ? '@ = ' : '$ = ';
1320 $a = $h ? '(' . join(', ', @a) . ')' : '';
1321 push(@sub, "$w&$s$a from file $f line $l\n");
1322 last if $signal;
1323 }
1324 for ($i=0; $i <= $#sub; $i++) {
1325 last if $signal;
1326 print $sub[$i];
1327 }
1328 exit 1;
1329}
1330
1331sub squishseq {
1332 local($num);
1333 local($last) = -1e8;
1334 local($string);
1335 local($seq) = '..';
1336
1337 while (defined($num = shift)) {
1338 if ($num == ($last + 1)) {
1339 $string .= $seq unless $inseq++;
1340 $last = $num;
1341 next;
1342 } elsif ($inseq) {
1343 $string .= $last unless $last == -1e8;
1344 }
1345
1346 $string .= ',' if defined $string;
1347 $string .= $num;
1348 $last = $num;
1349 $inseq = 0;
1350 }
1351 $string .= $last if $inseq && $last != -e18;
1352 $string;
1353}
1354
1355sub repeat_template {
1356 # local($template, $scripts) = @_; have to change caller's values
1357
1358 if ( $_[1] ) {
1359 local($ncount) = &scripts2count($_[1]);
1360 if ($_[0] =~ /^\s*c\s*$/i) {
1361 $_[0] = "A$ncount ";
1362 $_[1] = '';
1363 } else {
1364 $_[0] = $template x $ncount;
1365 }
1366 }
1367}
Full OpenSPARC architecture tarball including simulator, hypervisor, and OBP.