projects / OpenSPARC-T2-DV / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Initial commit of OpenSPARC T2 design and verification files.
[OpenSPARC-T2-DV] / tools / perl-5.8.0 / bin / c2ph
CommitLineData
86530b38
AT		 1#!/import/bw/tools/local/perl-5.8.0/bin/perl
2 eval 'exec /import/bw/tools/local/perl-5.8.0/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 strutures, 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, you 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
228
229######################################################################
230
231# some handy data definitions. many of these can be reset later.
232
233$bitorder = 'b'; # ascending; set to B for descending bit fields
234
235%intrinsics =
236%template = (
237 'char', 'c',
238 'unsigned char', 'C',
239 'short', 's',
240 'short int', 's',
241 'unsigned short', 'S',
242 'unsigned short int', 'S',
243 'short unsigned int', 'S',
244 'int', 'i',
245 'unsigned int', 'I',
246 'long', 'l',
247 'long int', 'l',
248 'unsigned long', 'L',
249 'unsigned long', 'L',
250 'long unsigned int', 'L',
251 'unsigned long int', 'L',
252 'long long', 'q',
253 'long long int', 'q',
254 'unsigned long long', 'Q',
255 'unsigned long long int', 'Q',
256 'float', 'f',
257 'double', 'd',
258 'pointer', 'p',
259 'null', 'x',
260 'neganull', 'X',
261 'bit', $bitorder,
262);
263
264&buildscrunchlist;
265delete $intrinsics{'neganull'};
266delete $intrinsics{'bit'};
267delete $intrinsics{'null'};
268
269# use -s to recompute sizes
270%sizeof = (
271 'char', '1',
272 'unsigned char', '1',
273 'short', '2',
274 'short int', '2',
275 'unsigned short', '2',
276 'unsigned short int', '2',
277 'short unsigned int', '2',
278 'int', '4',
279 'unsigned int', '4',
280 'long', '4',
281 'long int', '4',
282 'unsigned long', '4',
283 'unsigned long int', '4',
284 'long unsigned int', '4',
285 'long long', '8',
286 'long long int', '8',
287 'unsigned long long', '8',
288 'unsigned long long int', '8',
289 'float', '4',
290 'double', '8',
291 'pointer', '4',
292);
293
294($type_width, $member_width, $offset_width, $size_width) = (20, 20, 6, 5);
295
296($offset_fmt, $size_fmt) = ('d', 'd');
297
298$indent = 2;
299
300$CC = 'cc';
301$CFLAGS = '-g -S';
302$DEFINES = '';
303
304$perl++ if $0 =~ m#/?c2ph$#;
305
306require 'getopts.pl';
307
308eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
309
310&Getopts('aixdpvtnws:') || &usage(0);
311
312$opt_d && $debug++;
313$opt_t && $trace++;
314$opt_p && $perl++;
315$opt_v && $verbose++;
316$opt_n && ($perl = 0);
317
318if ($opt_w) {
319 ($type_width, $member_width, $offset_width) = (45, 35, 8);
320}
321if ($opt_x) {
322 ($offset_fmt, $offset_width, $size_fmt, $size_width) = ( 'x', '08', 'x', 04 );
323}
324
325eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
326
327sub PLUMBER {
328 select(STDERR);
329 print "oops, apperent pager foulup\n";
330 $isatty++;
331 &usage(1);
332}
333
334sub usage {
335 local($oops) = @_;
336 unless (-t STDOUT) {
337 select(STDERR);
338 } elsif (!$oops) {
339 $isatty++;
340 $| = 1;
341 print "hit <RETURN> for further explanation: ";
342 <STDIN>;
343 open (PIPE, "|". ($ENV{PAGER} || 'more'));
344 $SIG{PIPE} = PLUMBER;
345 select(PIPE);
346 }
347
348 print "usage: $0 [-dpnP] [var=val] [files ...]\n";
349
350 exit unless $isatty;
351
352 print <<EOF;
353
354Options:
355
356-w wide; short for: type_width=45 member_width=35 offset_width=8
357-x hex; short for: offset_fmt=x offset_width=08 size_fmt=x size_width=04
358
359-n do not generate perl code (default when invoked as pstruct)
360-p generate perl code (default when invoked as c2ph)
361-v generate perl code, with C decls as comments
362
363-i do NOT recompute sizes for intrinsic datatypes
364-a dump information on intrinsics also
365
366-t trace execution
367-d spew reams of debugging output
368
369-slist give comma-separated list a structures to dump
370
371
372Var Name Default Value Meaning
373
374EOF
375
376 &defvar('CC', 'which_compiler to call');
377 &defvar('CFLAGS', 'how to generate *.s files with stabs');
378 &defvar('DEFINES','any extra cflags or cpp defines, like -I, -D, -U');
379
380 print "\n";
381
382 &defvar('type_width', 'width of type field (column 1)');
383 &defvar('member_width', 'width of member field (column 2)');
384 &defvar('offset_width', 'width of offset field (column 3)');
385 &defvar('size_width', 'width of size field (column 4)');
386
387 print "\n";
388
389 &defvar('offset_fmt', 'sprintf format type for offset');
390 &defvar('size_fmt', 'sprintf format type for size');
391
392 print "\n";
393
394 &defvar('indent', 'how far to indent each nesting level');
395
396 print <<'EOF';
397
398 If any *.[ch] files are given, these will be catted together into
399 a temporary *.c file and sent through:
400 $CC $CFLAGS $DEFINES
401 and the resulting *.s groped for stab information. If no files are
402 supplied, then stdin is read directly with the assumption that it
403 contains stab information. All other liens will be ignored. At
404 most one *.s file should be supplied.
405
406EOF
407 close PIPE;
408 exit 1;
409}
410
411sub defvar {
412 local($var, $msg) = @_;
413 printf "%-16s%-15s %s\n", $var, eval "\$$var", $msg;
414}
415
416$recurse = 1;
417
418if (@ARGV) {
419 if (grep(!/\.[csh]$/,@ARGV)) {
420 warn "Only *.[csh] files expected!\n";
421 &usage;
422 }
423 elsif (grep(/\.s$/,@ARGV)) {
424 if (@ARGV > 1) {
425 warn "Only one *.s file allowed!\n";
426 &usage;
427 }
428 }
429 elsif (@ARGV == 1 && $ARGV[0] =~ /\.c$/) {
430 local($dir, $file) = $ARGV[0] =~ m#(.*/)?(.*)$#;
431 $chdir = "cd $dir; " if $dir;
432 &system("$chdir$CC $CFLAGS $DEFINES $file") && exit 1;
433 $ARGV[0] =~ s/\.c$/.s/;
434 }
435 else {
436 $TMP = "/tmp/c2ph.$$.c";
437 &system("cat @ARGV > $TMP") && exit 1;
438 &system("cd /tmp; $CC $CFLAGS $DEFINES $TMP") && exit 1;
439 unlink $TMP;
440 $TMP =~ s/\.c$/.s/;
441 @ARGV = ($TMP);
442 }
443}
444
445if ($opt_s) {
446 for (split(/[\s,]+/, $opt_s)) {
447 $interested{$_}++;
448 }
449}
450
451
452$| = 1 if $debug;
453
454main: {
455
456 if ($trace) {
457 if (-t && !@ARGV) {
458 print STDERR "reading from your keyboard: ";
459 } else {
460 print STDERR "reading from " . (@ARGV ? "@ARGV" : "<STDIN>").": ";
461 }
462 }
463
464STAB: while (<>) {
465 if ($trace && !($. % 10)) {
466 $lineno = $..'';
467 print STDERR $lineno, "\b" x length($lineno);
468 }
469 next unless /^\s*\.stabs\s+/;
470 $line = $_;
471 s/^\s*\.stabs\s+//;
472 if (s/\\\\"[d,]+$//) {
473 $saveline .= $line;
474 $savebar = $_;
475 next STAB;
476 }
477 if ($saveline) {
478 s/^"//;
479 $_ = $savebar . $_;
480 $line = $saveline;
481 }
482 &stab;
483 $savebar = $saveline = undef;
484 }
485 print STDERR "$.\n" if $trace;
486 unlink $TMP if $TMP;
487
488 &compute_intrinsics if $perl && !$opt_i;
489
490 print STDERR "resolving types\n" if $trace;
491
492 &resolve_types;
493 &adjust_start_addrs;
494
495 $sum = 2 + $type_width + $member_width;
496 $pmask1 = "%-${type_width}s %-${member_width}s";
497 $pmask2 = "%-${sum}s %${offset_width}${offset_fmt}%s %${size_width}${size_fmt}%s";
498
499
500
501 if ($perl) {
502 # resolve template -- should be in stab define order, but even this isn't enough.
503 print STDERR "\nbuilding type templates: " if $trace;
504 for $i (reverse 0..$#type) {
505 next unless defined($name = $type[$i]);
506 next unless defined $struct{$name};
507 ($iname = $name) =~ s/\..*//;
508 $build_recursed = 0;
509 &build_template($name) unless defined $template{&psou($name)} ||
510 $opt_s && !$interested{$iname};
511 }
512 print STDERR "\n\n" if $trace;
513 }
514
515 print STDERR "dumping structs: " if $trace;
516
517 local($iam);
518
519
520
521 foreach $name (sort keys %struct) {
522 ($iname = $name) =~ s/\..*//;
523 next if $opt_s && !$interested{$iname};
524 print STDERR "$name " if $trace;
525
526 undef @sizeof;
527 undef @typedef;
528 undef @offsetof;
529 undef @indices;
530 undef @typeof;
531 undef @fieldnames;
532
533 $mname = &munge($name);
534
535 $fname = &psou($name);
536
537 print "# " if $perl && $verbose;
538 $pcode = '';
539 print "$fname {\n" if !$perl || $verbose;
540 $template{$fname} = &scrunch($template{$fname}) if $perl;
541 &pstruct($name,$name,0);
542 print "# " if $perl && $verbose;
543 print "}\n" if !$perl || $verbose;
544 print "\n" if $perl && $verbose;
545
546 if ($perl) {
547 print "$pcode";
548
549 printf("\nsub %-32s { %4d; }\n\n", "${mname}'struct", $countof{$name});
550
551 print <<EOF;
552sub ${mname}'typedef {
553 local(\$${mname}'index) = shift;
554 defined \$${mname}'index
555 ? \$${mname}'typedef[\$${mname}'index]
556 : \$${mname}'typedef;
557}
558EOF
559
560 print <<EOF;
561sub ${mname}'sizeof {
562 local(\$${mname}'index) = shift;
563 defined \$${mname}'index
564 ? \$${mname}'sizeof[\$${mname}'index]
565 : \$${mname}'sizeof;
566}
567EOF
568
569 print <<EOF;
570sub ${mname}'offsetof {
571 local(\$${mname}'index) = shift;
572 defined \$${mname}index
573 ? \$${mname}'offsetof[\$${mname}'index]
574 : \$${mname}'sizeof;
575}
576EOF
577
578 print <<EOF;
579sub ${mname}'typeof {
580 local(\$${mname}'index) = shift;
581 defined \$${mname}index
582 ? \$${mname}'typeof[\$${mname}'index]
583 : '$name';
584}
585EOF
586
587 print <<EOF;
588sub ${mname}'fieldnames {
589 \@${mname}'fieldnames;
590}
591EOF
592
593 $iam = ($isastruct{$name} && 's') || ($isaunion{$name} && 'u');
594
595 print <<EOF;
596sub ${mname}'isastruct {
597 '$iam';
598}
599EOF
600
601 print "\$${mname}'typedef = '" . &scrunch($template{$fname})
602 . "';\n";
603
604 print "\$${mname}'sizeof = $sizeof{$name};\n\n";
605
606
607 print "\@${mname}'indices = (", &squishseq(@indices), ");\n";
608
609 print "\n";
610
611 print "\@${mname}'typedef[\@${mname}'indices] = (",
612 join("\n\t", '', @typedef), "\n );\n\n";
613 print "\@${mname}'sizeof[\@${mname}'indices] = (",
614 join("\n\t", '', @sizeof), "\n );\n\n";
615 print "\@${mname}'offsetof[\@${mname}'indices] = (",
616 join("\n\t", '', @offsetof), "\n );\n\n";
617 print "\@${mname}'typeof[\@${mname}'indices] = (",
618 join("\n\t", '', @typeof), "\n );\n\n";
619 print "\@${mname}'fieldnames[\@${mname}'indices] = (",
620 join("\n\t", '', @fieldnames), "\n );\n\n";
621
622 $template_printed{$fname}++;
623 $size_printed{$fname}++;
624 }
625 print "\n";
626 }
627
628 print STDERR "\n" if $trace;
629
630 unless ($perl && $opt_a) {
631 print "\n1;\n" if $perl;
632 exit;
633 }
634
635
636
637 foreach $name (sort bysizevalue keys %intrinsics) {
638 next if $size_printed{$name};
639 print '$',&munge($name),"'sizeof = ", $sizeof{$name}, ";\n";
640 }
641
642 print "\n";
643
644 sub bysizevalue { $sizeof{$a} <=> $sizeof{$b}; }
645
646
647 foreach $name (sort keys %intrinsics) {
648 print '$',&munge($name),"'typedef = '", $template{$name}, "';\n";
649 }
650
651 print "\n1;\n" if $perl;
652
653 exit;
654}
655
656########################################################################################
657
658
659sub stab {
660 next unless $continued || /:[\$\w]+(\(\d+,\d+\))?=[\*\$\w]+/; # (\d+,\d+) is for sun
661 s/"// || next;
662 s/",([x\d]+),([x\d]+),([x\d]+),.*// || next;
663
664 next if /^\s*$/;
665
666 $size = $3 if $3;
667 $_ = $continued . $_ if length($continued);
668 if (s/\\\\$//) {
669 # if last 2 chars of string are '\\' then stab is continued
670 # in next stab entry
671 chop;
672 $continued = $_;
673 next;
674 }
675 $continued = '';
676
677
678 $line = $_;
679
680 if (($name, $pdecl) = /^([\$ \w]+):[tT]((\d+)(=[rufs*](\d+))+)$/) {
681 print "$name is a typedef for some funky pointers: $pdecl\n" if $debug;
682 &pdecl($pdecl);
683 next;
684 }
685
686
687
688 if (/(([ \w]+):t(\d+|\(\d+,\d+\)))=r?(\d+|\(\d+,\d+\))(;\d+;\d+;)?/) {
689 local($ident) = $2;
690 push(@intrinsics, $ident);
691 $typeno = &typeno($3);
692 $type[$typeno] = $ident;
693 print STDERR "intrinsic $ident in new type $typeno\n" if $debug;
694 next;
695 }
696
697 if (($name, $typeordef, $typeno, $extra, $struct, $_)
698 = /^([\$ \w]+):([ustT])(\d+|\(\d+,\d+\))(=[rufs*](\d+))?(.*)$/)
699 {
700 $typeno = &typeno($typeno); # sun foolery
701 }
702 elsif (/^[\$\w]+:/) {
703 next; # variable
704 }
705 else {
706 warn "can't grok stab: <$_> in: $line " if $_;
707 next;
708 }
709
710 #warn "got size $size for $name\n";
711 $sizeof{$name} = $size if $size;
712
713 s/;[-\d]*;[-\d]*;$//; # we don't care about ranges
714
715 $typenos{$name} = $typeno;
716
717 unless (defined $type[$typeno]) {
718 &panic("type 0??") unless $typeno;
719 $type[$typeno] = $name unless defined $type[$typeno];
720 printf "new type $typeno is $name" if $debug;
721 if ($extra =~ /\*/ && defined $type[$struct]) {
722 print ", a typedef for a pointer to " , $type[$struct] if $debug;
723 }
724 } else {
725 printf "%s is type %d", $name, $typeno if $debug;
726 print ", a typedef for " , $type[$typeno] if $debug;
727 }
728 print "\n" if $debug;
729 #next unless $extra =~ /[su*]/;
730
731 #$type[$struct] = $name;
732
733 if ($extra =~ /[us*]/) {
734 &sou($name, $extra);
735 $_ = &sdecl($name, $_, 0);
736 }
737 elsif (/^=ar/) {
738 print "it's a bare array typedef -- that's pretty sick\n" if $debug;
739 $_ = "$typeno$_";
740 $scripts = '';
741 $_ = &adecl($_,1);
742
743 }
744 elsif (s/((\w+):t(\d+|\(\d+,\d+\)))?=r?(;\d+;\d+;)?//) { # the ?'s are for gcc
745 push(@intrinsics, $2);
746 $typeno = &typeno($3);
747 $type[$typeno] = $2;
748 print STDERR "intrinsic $2 in new type $typeno\n" if $debug;
749 }
750 elsif (s/^=e//) { # blessed be thy compiler; mine won't do this
751 &edecl;
752 }
753 else {
754 warn "Funny remainder for $name on line $_ left in $line " if $_;
755 }
756}
757
758sub typeno { # sun thinks types are (0,27) instead of just 27
759 local($_) = @_;
760 s/\(\d+,(\d+)\)/$1/;
761 $_;
762}
763
764sub pstruct {
765 local($what,$prefix,$base) = @_;
766 local($field, $fieldname, $typeno, $count, $offset, $entry);
767 local($fieldtype);
768 local($type, $tname);
769 local($mytype, $mycount, $entry2);
770 local($struct_count) = 0;
771 local($pad, $revpad, $length, $prepad, $lastoffset, $lastlength, $fmt);
772 local($bits,$bytes);
773 local($template);
774
775
776 local($mname) = &munge($name);
777
778 sub munge {
779 local($_) = @_;
780 s/[\s\$\.]/_/g;
781 $_;
782 }
783
784 local($sname) = &psou($what);
785
786 $nesting++;
787
788 for $field (split(/;/, $struct{$what})) {
789 $pad = $prepad = 0;
790 $entry = '';
791 ($fieldname, $typeno, $count, $offset, $length) = split(/,/, $field);
792
793 $type = $type[$typeno];
794
795 $type =~ /([^[]*)(\[.*\])?/;
796 $mytype = $1;
797 $count .= $2;
798 $fieldtype = &psou($mytype);
799
800 local($fname) = &psou($name);
801
802 if ($build_templates) {
803
804 $pad = ($offset - ($lastoffset + $lastlength))/8
805 if defined $lastoffset;
806
807 if (! $finished_template{$sname}) {
808 if ($isaunion{$what}) {
809 $template{$sname} .= 'X' x $revpad . ' ' if $revpad;
810 } else {
811 $template{$sname} .= 'x' x $pad . ' ' if $pad;
812 }
813 }
814
815 $template = &fetch_template($type);
816 &repeat_template($template,$count);
817
818 if (! $finished_template{$sname}) {
819 $template{$sname} .= $template;
820 }
821
822 $revpad = $length/8 if $isaunion{$what};
823
824 ($lastoffset, $lastlength) = ($offset, $length);
825
826 } else {
827 print '# ' if $perl && $verbose;
828 $entry = sprintf($pmask1,
829 ' ' x ($nesting * $indent) . $fieldtype,
830 "$prefix.$fieldname" . $count);
831
832 $entry =~ s/(\*+)( )/$2$1/;
833
834 printf $pmask2,
835 $entry,
836 ($base+$offset)/8,
837 ($bits = ($base+$offset)%8) ? ".$bits" : " ",
838 $length/8,
839 ($bits = $length % 8) ? ".$bits": ""
840 if !$perl || $verbose;
841
842 if ($perl) {
843 $template = &fetch_template($type);
844 &repeat_template($template,$count);
845 }
846
847 if ($perl && $nesting == 1) {
848
849 push(@sizeof, int($length/8) .",\t# $fieldname");
850 push(@offsetof, int($offset/8) .",\t# $fieldname");
851 local($little) = &scrunch($template);
852 push(@typedef, "'$little', \t# $fieldname");
853 $type =~ s/(struct|union) //;
854 push(@typeof, "'$mytype" . ($count ? $count : '') .
855 "',\t# $fieldname");
856 push(@fieldnames, "'$fieldname',");
857 }
858
859 print ' ', ' ' x $indent x $nesting, $template
860 if $perl && $verbose;
861
862 print "\n" if !$perl || $verbose;
863
864 }
865 if ($perl) {
866 local($mycount) = defined $struct{$mytype} ? $countof{$mytype} : 1;
867 $mycount *= &scripts2count($count) if $count;
868 if ($nesting==1 && !$build_templates) {
869 $pcode .= sprintf("sub %-32s { %4d; }\n",
870 "${mname}'${fieldname}", $struct_count);
871 push(@indices, $struct_count);
872 }
873 $struct_count += $mycount;
874 }
875
876
877 &pstruct($type, "$prefix.$fieldname", $base+$offset)
878 if $recurse && defined $struct{$type};
879 }
880
881 $countof{$what} = $struct_count unless defined $countof{$whati};
882
883 $template{$sname} .= '$' if $build_templates;
884 $finished_template{$sname}++;
885
886 if ($build_templates && !defined $sizeof{$name}) {
887 local($fmt) = &scrunch($template{$sname});
888 print STDERR "no size for $name, punting with $fmt..." if $debug;
889 eval '$sizeof{$name} = length(pack($fmt, ()))';
890 if ($@) {
891 chop $@;
892 warn "couldn't get size for \$name: $@";
893 } else {
894 print STDERR $sizeof{$name}, "\n" if $debUg;
895 }
896 }
897
898 --$nesting;
899}
900
901
902sub psize {
903 local($me) = @_;
904 local($amstruct) = $struct{$me} ? 'struct ' : '';
905
906 print '$sizeof{\'', $amstruct, $me, '\'} = ';
907 printf "%d;\n", $sizeof{$me};
908}
909
910sub pdecl {
911 local($pdecl) = @_;
912 local(@pdecls);
913 local($tname);
914
915 warn "pdecl: $pdecl\n" if $debug;
916
917 $pdecl =~ s/\(\d+,(\d+)\)/$1/g;
918 $pdecl =~ s/\*//g;
919 @pdecls = split(/=/, $pdecl);
920 $typeno = $pdecls[0];
921 $tname = pop @pdecls;
922
923 if ($tname =~ s/^f//) { $tname = "$tname&"; }
924 #else { $tname = "$tname*"; }
925
926 for (reverse @pdecls) {
927 $tname .= s/^f// ? "&" : "*";
928 #$tname =~ s/^f(.*)/$1&/;
929 print "type[$_] is $tname\n" if $debug;
930 $type[$_] = $tname unless defined $type[$_];
931 }
932}
933
934
935
936sub adecl {
937 ($arraytype, $unknown, $lower, $upper) = ();
938 #local($typeno);
939 # global $typeno, @type
940 local($_, $typedef) = @_;
941
942 while (s/^((\d+|\(\d+,\d+\))=)?ar(\d+|\(\d+,\d+\));//) {
943 ($arraytype, $unknown) = ($2, $3);
944 $arraytype = &typeno($arraytype);
945 $unknown = &typeno($unknown);
946 if (s/^(\d+);(\d+);//) {
947 ($lower, $upper) = ($1, $2);
948 $scripts .= '[' . ($upper+1) . ']';
949 } else {
950 warn "can't find array bounds: $_";
951 }
952 }
953 if (s/^([(,)\d*f=]*),(\d+),(\d+);//) {
954 ($start, $length) = ($2, $3);
955 $whatis = $1;
956 if ($whatis =~ /^(\d+|\(\d+,\d+\))=/) {
957 $typeno = &typeno($1);
958 &pdecl($whatis);
959 } else {
960 $typeno = &typeno($whatis);
961 }
962 } elsif (s/^(\d+)(=[*suf]\d*)//) {
963 local($whatis) = $2;
964
965 if ($whatis =~ /[f*]/) {
966 &pdecl($whatis);
967 } elsif ($whatis =~ /[su]/) { #
968 print "$prefix.$fieldname is an array$scripts anon structs; disgusting\n"
969 if $debug;
970 #$type[$typeno] = $name unless defined $type[$typeno];
971 ##printf "new type $typeno is $name" if $debug;
972 $typeno = $1;
973 $type[$typeno] = "$prefix.$fieldname";
974 local($name) = $type[$typeno];
975 &sou($name, $whatis);
976 $_ = &sdecl($name, $_, $start+$offset);
977 1;
978 $start = $start{$name};
979 $offset = $sizeof{$name};
980 $length = $offset;
981 } else {
982 warn "what's this? $whatis in $line ";
983 }
984 } elsif (/^\d+$/) {
985 $typeno = $_;
986 } else {
987 warn "bad array stab: $_ in $line ";
988 next STAB;
989 }
990 #local($wasdef) = defined($type[$typeno]) && $debug;
991 #if ($typedef) {
992 #print "redefining $type[$typeno] to " if $wasdef;
993 #$type[$typeno] = "$whatis$scripts"; # unless defined $type[$typeno];
994 #print "$type[$typeno]\n" if $wasdef;
995 #} else {
996 #$type[$arraytype] = $type[$typeno] unless defined $type[$arraytype];
997 #}
998 $type[$arraytype] = "$type[$typeno]$scripts" if defined $type[$typeno];
999 print "type[$arraytype] is $type[$arraytype]\n" if $debug;
1000 print "$prefix.$fieldname is an array of $type[$arraytype]\n" if $debug;
1001 $_;
1002}
1003
1004
1005
1006sub sdecl {
1007 local($prefix, $_, $offset) = @_;
1008
1009 local($fieldname, $scripts, $type, $arraytype, $unknown,
1010 $whatis, $pdecl, $upper,$lower, $start,$length) = ();
1011 local($typeno,$sou);
1012
1013
1014SFIELD:
1015 while (/^([^;]+);/) {
1016 $scripts = '';
1017 warn "sdecl $_\n" if $debug;
1018 if (s/^([\$\w]+)://) {
1019 $fieldname = $1;
1020 } elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { #
1021 $typeno = &typeno($1);
1022 $type[$typeno] = "$prefix.$fieldname";
1023 local($name) = "$prefix.$fieldname";
1024 &sou($name,$2);
1025 $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
1026 $start = $start{$name};
1027 $offset += $sizeof{$name};
1028 #print "done with anon, start is $start, offset is $offset\n";
1029 #next SFIELD;
1030 } else {
1031 warn "weird field $_ of $line" if $debug;
1032 next STAB;
1033 #$fieldname = &gensym;
1034 #$_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
1035 }
1036
1037 if (/^(\d+|\(\d+,\d+\))=ar/) {
1038 $_ = &adecl($_);
1039 }
1040 elsif (s/^(\d+|\(\d+,\d+\))?,(\d+),(\d+);//) {
1041 ($start, $length) = ($2, $3);
1042 &panic("no length?") unless $length;
1043 $typeno = &typeno($1) if $1;
1044 }
1045 elsif (s/^(\d+)=xs\w+:,(\d+),(\d+);//) {
1046 ($start, $length) = ($2, $3);
1047 &panic("no length?") unless $length;
1048 $typeno = &typeno($1) if $1;
1049 }
1050 elsif (s/^((\d+|\(\d+,\d+\))(=[*f](\d+|\(\d+,\d+\)))+),(\d+),(\d+);//) {
1051 ($pdecl, $start, $length) = ($1,$5,$6);
1052 &pdecl($pdecl);
1053 }
1054 elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # the dratted anon struct
1055 ($typeno, $sou) = ($1, $2);
1056 $typeno = &typeno($typeno);
1057 if (defined($type[$typeno])) {
1058 warn "now how did we get type $1 in $fieldname of $line?";
1059 } else {
1060 print "anon type $typeno is $prefix.$fieldname\n" if $debug;
1061 $type[$typeno] = "$prefix.$fieldname" unless defined $type[$typeno];
1062 };
1063 local($name) = "$prefix.$fieldname";
1064 &sou($name,$sou);
1065 print "anon ".($isastruct{$name}) ? "struct":"union"." for $prefix.$fieldname\n" if $debug;
1066 $type[$typeno] = "$prefix.$fieldname";
1067 $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
1068 $start = $start{$name};
1069 $length = $sizeof{$name};
1070 }
1071 else {
1072 warn "can't grok stab for $name ($_) in line $line ";
1073 next STAB;
1074 }
1075
1076 &panic("no length for $prefix.$fieldname") unless $length;
1077 $struct{$name} .= join(',', $fieldname, $typeno, $scripts, $start, $length) . ';';
1078 }
1079 if (s/;\d*,(\d+),(\d+);//) {
1080 local($start, $size) = ($1, $2);
1081 $sizeof{$prefix} = $size;
1082 print "start of $prefix is $start, size of $sizeof{$prefix}\n" if $debug;
1083 $start{$prefix} = $start;
1084 }
1085 $_;
1086}
1087
1088sub edecl {
1089 s/;$//;
1090 $enum{$name} = $_;
1091 $_ = '';
1092}
1093
1094sub resolve_types {
1095 local($sou);
1096 for $i (0 .. $#type) {
1097 next unless defined $type[$i];
1098 $_ = $type[$i];
1099 unless (/\d/) {
1100 print "type[$i] $type[$i]\n" if $debug;
1101 next;
1102 }
1103 print "type[$i] $_ ==> " if $debug;
1104 s/^(\d+)(\**)\&\*(\**)/"$2($3".&type($1) . ')()'/e;
1105 s/^(\d+)\&/&type($1)/e;
1106 s/^(\d+)/&type($1)/e;
1107 s/(\*+)([^*]+)(\*+)/$1$3$2/;
1108 s/\((\*+)(\w+)(\*+)\)/$3($1$2)/;
1109 s/^(\d+)([\*\[].*)/&type($1).$2/e;
1110 #s/(\d+)(\*|(\[[\[\]\d\*]+]\])+)/&type($1).$2/ge;
1111 $type[$i] = $_;
1112 print "$_\n" if $debug;
1113 }
1114}
1115sub type { &psou($type[$_[0]] || "<UNDEFINED>"); }
1116
1117sub adjust_start_addrs {
1118 for (sort keys %start) {
1119 ($basename = $_) =~ s/\.[^.]+$//;
1120 $start{$_} += $start{$basename};
1121 print "start: $_ @ $start{$_}\n" if $debug;
1122 }
1123}
1124
1125sub sou {
1126 local($what, $_) = @_;
1127 /u/ && $isaunion{$what}++;
1128 /s/ && $isastruct{$what}++;
1129}
1130
1131sub psou {
1132 local($what) = @_;
1133 local($prefix) = '';
1134 if ($isaunion{$what}) {
1135 $prefix = 'union ';
1136 } elsif ($isastruct{$what}) {
1137 $prefix = 'struct ';
1138 }
1139 $prefix . $what;
1140}
1141
1142sub scrunch {
1143 local($_) = @_;
1144
1145 return '' if $_ eq '';
1146
1147 study;
1148
1149 s/\$//g;
1150 s/ / /g;
1151 1 while s/(\w) \1/$1$1/g;
1152
1153 # i wanna say this, but perl resists my efforts:
1154 # s/(\w)(\1+)/$2 . length($1)/ge;
1155
1156 &quick_scrunch;
1157
1158 s/ $//;
1159
1160 $_;
1161}
1162
1163sub buildscrunchlist {
1164 $scrunch_code = "sub quick_scrunch {\n";
1165 for (values %intrinsics) {
1166 $scrunch_code .= "\ts/(${_}{2,})/'$_' . length(\$1)/ge;\n";
1167 }
1168 $scrunch_code .= "}\n";
1169 print "$scrunch_code" if $debug;
1170 eval $scrunch_code;
1171 &panic("can't eval scrunch_code $@ \nscrunch_code") if $@;
1172}
1173
1174sub fetch_template {
1175 local($mytype) = @_;
1176 local($fmt);
1177 local($count) = 1;
1178
1179 &panic("why do you care?") unless $perl;
1180
1181 if ($mytype =~ s/(\[\d+\])+$//) {
1182 $count .= $1;
1183 }
1184
1185 if ($mytype =~ /\*/) {
1186 $fmt = $template{'pointer'};
1187 }
1188 elsif (defined $template{$mytype}) {
1189 $fmt = $template{$mytype};
1190 }
1191 elsif (defined $struct{$mytype}) {
1192 if (!defined $template{&psou($mytype)}) {
1193 &build_template($mytype) unless $mytype eq $name;
1194 }
1195 elsif ($template{&psou($mytype)} !~ /\$$/) {
1196 #warn "incomplete template for $mytype\n";
1197 }
1198 $fmt = $template{&psou($mytype)} || '?';
1199 }
1200 else {
1201 warn "unknown fmt for $mytype\n";
1202 $fmt = '?';
1203 }
1204
1205 $fmt x $count . ' ';
1206}
1207
1208sub compute_intrinsics {
1209 local($TMP) = "/tmp/c2ph-i.$$.c";
1210 open (TMP, ">$TMP") || die "can't open $TMP: $!";
1211 select(TMP);
1212
1213 print STDERR "computing intrinsic sizes: " if $trace;
1214
1215 undef %intrinsics;
1216
1217 print <<'EOF';
1218main() {
1219 char *mask = "%d %s\n";
1220EOF
1221
1222 for $type (@intrinsics) {
1223 next if !$type || $type eq 'void' || $type =~ /complex/; # sun stuff
1224 print <<"EOF";
1225 printf(mask,sizeof($type), "$type");
1226EOF
1227 }
1228
1229 print <<'EOF';
1230 printf(mask,sizeof(char *), "pointer");
1231 exit(0);
1232}
1233EOF
1234 close TMP;
1235
1236 select(STDOUT);
1237 open(PIPE, "cd /tmp && $CC $TMP && /tmp/a.out|");
1238 while (<PIPE>) {
1239 chop;
1240 split(' ',$_,2);;
1241 print "intrinsic $_[1] is size $_[0]\n" if $debug;
1242 $sizeof{$_[1]} = $_[0];
1243 $intrinsics{$_[1]} = $template{$_[0]};
1244 }
1245 close(PIPE) || die "couldn't read intrinsics!";
1246 unlink($TMP, '/tmp/a.out');
1247 print STDERR "done\n" if $trace;
1248}
1249
1250sub scripts2count {
1251 local($_) = @_;
1252
1253 s/^\[//;
1254 s/\]$//;
1255 s/\]\[/*/g;
1256 $_ = eval;
1257 &panic("$_: $@") if $@;
1258 $_;
1259}
1260
1261sub system {
1262 print STDERR "@_\n" if $trace;
1263 system @_;
1264}
1265
1266sub build_template {
1267 local($name) = @_;
1268
1269 &panic("already got a template for $name") if defined $template{$name};
1270
1271 local($build_templates) = 1;
1272
1273 local($lparen) = '(' x $build_recursed;
1274 local($rparen) = ')' x $build_recursed;
1275
1276 print STDERR "$lparen$name$rparen " if $trace;
1277 $build_recursed++;
1278 &pstruct($name,$name,0);
1279 print STDERR "TEMPLATE for $name is ", $template{&psou($name)}, "\n" if $debug;
1280 --$build_recursed;
1281}
1282
1283
1284sub panic {
1285
1286 select(STDERR);
1287
1288 print "\npanic: @_\n";
1289
1290 exit 1 if $] <= 4.003; # caller broken
1291
1292 local($i,$_);
1293 local($p,$f,$l,$s,$h,$a,@a,@sub);
1294 for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
1295 @a = @DB'args;
1296 for (@a) {
1297 if (/^StB\000/ && length($_) == length($_main{'_main'})) {
1298 $_ = sprintf("%s",$_);
1299 }
1300 else {
1301 s/'/\\'/g;
1302 s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
1303 s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
1304 s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
1305 }
1306 }
1307 $w = $w ? '@ = ' : '$ = ';
1308 $a = $h ? '(' . join(', ', @a) . ')' : '';
1309 push(@sub, "$w&$s$a from file $f line $l\n");
1310 last if $signal;
1311 }
1312 for ($i=0; $i <= $#sub; $i++) {
1313 last if $signal;
1314 print $sub[$i];
1315 }
1316 exit 1;
1317}
1318
1319sub squishseq {
1320 local($num);
1321 local($last) = -1e8;
1322 local($string);
1323 local($seq) = '..';
1324
1325 while (defined($num = shift)) {
1326 if ($num == ($last + 1)) {
1327 $string .= $seq unless $inseq++;
1328 $last = $num;
1329 next;
1330 } elsif ($inseq) {
1331 $string .= $last unless $last == -1e8;
1332 }
1333
1334 $string .= ',' if defined $string;
1335 $string .= $num;
1336 $last = $num;
1337 $inseq = 0;
1338 }
1339 $string .= $last if $inseq && $last != -e18;
1340 $string;
1341}
1342
1343sub repeat_template {
1344 # local($template, $scripts) = @_; have to change caller's values
1345
1346 if ( $_[1] ) {
1347 local($ncount) = &scripts2count($_[1]);
1348 if ($_[0] =~ /^\s*c\s*$/i) {
1349 $_[0] = "A$ncount ";
1350 $_[1] = '';
1351 } else {
1352 $_[0] = $template x $ncount;
1353 }
1354 }
1355}
Full OpenSPARC design & verification tarball including full HDL.