diff options
Diffstat (limited to 'utils')
| -rw-r--r-- | utils/c2ph.PL | 474 |
1 files changed, 343 insertions, 131 deletions
diff --git a/utils/c2ph.PL b/utils/c2ph.PL index b5049b3d11..dfe9f24db8 100644 --- a/utils/c2ph.PL +++ b/utils/c2ph.PL @@ -38,13 +38,224 @@ print OUT <<'!NO!SUBS!'; # # c2ph (aka pstruct) # Tom Christiansen, <tchrist@convex.com> -# +# # As pstruct, dump C structures as generated from 'cc -g -S' stabs. # As c2ph, do this PLUS generate perl code for getting at the structures. # # See the usage message for more. If this isn't enough, read the code. # +=head1 NAME + +c2ph,pstruct - Dump C structures as generated from 'cc -g -S' stabs + +=head1 SYNOPSIS + + c2ph [-dpnP] [var=val] [files ...] + +=head2 OPTIONS + + Options: + + -w wide; short for: type_width=45 member_width=35 offset_width=8 + -x hex; short for: offset_fmt=x offset_width=08 size_fmt=x size_width=04 + + -n do not generate perl code (default when invoked as pstruct) + -p generate perl code (default when invoked as c2ph) + -v generate perl code, with C decls as comments + + -i do NOT recompute sizes for intrinsic datatypes + -a dump information on intrinsics also + + -t trace execution + -d spew reams of debugging output + + -slist give comma-separated list a structures to dump + +=head1 DESCRIPTION + +The following is the old c2ph.doc documentation by Tom Christiansen +<tchrist@perl.com> +Date: 25 Jul 91 08:10:21 GMT + +Once upon a time, I wrote a program called pstruct. It was a perl +program that tried to parse out C structures and display their member +offsets for you. This was especially useful for people looking at +binary dumps or poking around the kernel. + +Pstruct was not a pretty program. Neither was it particularly robust. +The problem, you see, was that the C compiler was much better at parsing +C than I could ever hope to be. + +So I got smart: I decided to be lazy and let the C compiler parse the C, +which would spit out debugger stabs for me to read. These were much +easier to parse. It's still not a pretty program, but at least it's more +robust. + +Pstruct takes any .c or .h files, or preferably .s ones, since that's +the format it is going to massage them into anyway, and spits out +listings like this: + +struct tty { + int tty.t_locker 000 4 + int tty.t_mutex_index 004 4 + struct tty * tty.t_tp_virt 008 4 + struct clist tty.t_rawq 00c 20 + int tty.t_rawq.c_cc 00c 4 + int tty.t_rawq.c_cmax 010 4 + int tty.t_rawq.c_cfx 014 4 + int tty.t_rawq.c_clx 018 4 + struct tty * tty.t_rawq.c_tp_cpu 01c 4 + struct tty * tty.t_rawq.c_tp_iop 020 4 + unsigned char * tty.t_rawq.c_buf_cpu 024 4 + unsigned char * tty.t_rawq.c_buf_iop 028 4 + struct clist tty.t_canq 02c 20 + int tty.t_canq.c_cc 02c 4 + int tty.t_canq.c_cmax 030 4 + int tty.t_canq.c_cfx 034 4 + int tty.t_canq.c_clx 038 4 + struct tty * tty.t_canq.c_tp_cpu 03c 4 + struct tty * tty.t_canq.c_tp_iop 040 4 + unsigned char * tty.t_canq.c_buf_cpu 044 4 + unsigned char * tty.t_canq.c_buf_iop 048 4 + struct clist tty.t_outq 04c 20 + int tty.t_outq.c_cc 04c 4 + int tty.t_outq.c_cmax 050 4 + int tty.t_outq.c_cfx 054 4 + int tty.t_outq.c_clx 058 4 + struct tty * tty.t_outq.c_tp_cpu 05c 4 + struct tty * tty.t_outq.c_tp_iop 060 4 + unsigned char * tty.t_outq.c_buf_cpu 064 4 + unsigned char * tty.t_outq.c_buf_iop 068 4 + (*int)() tty.t_oproc_cpu 06c 4 + (*int)() tty.t_oproc_iop 070 4 + (*int)() tty.t_stopproc_cpu 074 4 + (*int)() tty.t_stopproc_iop 078 4 + struct thread * tty.t_rsel 07c 4 + + etc. + + +Actually, this was generated by a particular set of options. You can control +the formatting of each column, whether you prefer wide or fat, hex or decimal, +leading zeroes or whatever. + +All you need to be able to use this is a C compiler than generates +BSD/GCC-style stabs. The -g option on native BSD compilers and GCC +should get this for you. + +To learn more, just type a bogus option, like -\?, and a long usage message +will be provided. There are a fair number of possibilities. + +If you're only a C programmer, than this is the end of the message for you. +You can quit right now, and if you care to, save off the source and run it +when you feel like it. Or not. + + + +But if you're a perl programmer, then for you I have something much more +wondrous than just a structure offset printer. + +You see, if you call pstruct by its other incybernation, c2ph, you have a code +generator that translates C code into perl code! Well, structure and union +declarations at least, but that's quite a bit. + +Prior to this point, anyone programming in perl who wanted to interact +with C programs, like the kernel, was forced to guess the layouts of +the C strutures, and then hardwire these into his program. Of course, +when you took your wonderfully crafted program to a system where the +sgtty structure was laid out differently, you program broke. Which is +a shame. + +We've had Larry's h2ph translator, which helped, but that only works on +cpp symbols, not real C, which was also very much needed. What I offer +you is a symbolic way of getting at all the C structures. I've couched +them in terms of packages and functions. Consider the following program: + + #!/usr/local/bin/perl + + require 'syscall.ph'; + require 'sys/time.ph'; + require 'sys/resource.ph'; + + $ru = "\0" x &rusage'sizeof(); + + syscall(&SYS_getrusage, &RUSAGE_SELF, $ru) && die "getrusage: $!"; + + @ru = unpack($t = &rusage'typedef(), $ru); + + $utime = $ru[ &rusage'ru_utime + &timeval'tv_sec ] + + ($ru[ &rusage'ru_utime + &timeval'tv_usec ]) / 1e6; + + $stime = $ru[ &rusage'ru_stime + &timeval'tv_sec ] + + ($ru[ &rusage'ru_stime + &timeval'tv_usec ]) / 1e6; + + printf "you have used %8.3fs+%8.3fu seconds.\n", $utime, $stime; + + +As you see, the name of the package is the name of the structure. Regular +fields are just their own names. Plus the follwoing accessor functions are +provided for your convenience: + + struct This takes no arguments, and is merely the number of first-level + elements in the structure. You would use this for indexing + into arrays of structures, perhaps like this + + + $usec = $u[ &user'u_utimer + + (&ITIMER_VIRTUAL * &itimerval'struct) + + &itimerval'it_value + + &timeval'tv_usec + ]; + + sizeof Returns the bytes in the structure, or the member if + you pass it an argument, such as + + &rusage'sizeof(&rusage'ru_utime) + + typedef This is the perl format definition for passing to pack and + unpack. If you ask for the typedef of a nothing, you get + the whole structure, otherwise you get that of the member + you ask for. Padding is taken care of, as is the magic to + guarantee that a union is unpacked into all its aliases. + Bitfields are not quite yet supported however. + + offsetof This function is the byte offset into the array of that + member. You may wish to use this for indexing directly + into the packed structure with vec() if you're too lazy + to unpack it. + + typeof Not to be confused with the typedef accessor function, this + one returns the C type of that field. This would allow + you to print out a nice structured pretty print of some + structure without knoning anything about it beforehand. + No args to this one is a noop. Someday I'll post such + a thing to dump out your u structure for you. + + +The way I see this being used is like basically this: + + % h2ph <some_include_file.h > /usr/lib/perl/tmp.ph + % c2ph some_include_file.h >> /usr/lib/perl/tmp.ph + % install + +It's a little tricker with c2ph because you have to get the includes right. +I can't know this for your system, but it's not usually too terribly difficult. + +The code isn't pretty as I mentioned -- I never thought it would be a 1000- +line program when I started, or I might not have begun. :-) But I would have +been less cavalier in how the parts of the program communicated with each +other, etc. It might also have helped if I didn't have to divine the makeup +of the stabs on the fly, and then account for micro differences between my +compiler and gcc. + +Anyway, here it is. Should run on perl v4 or greater. Maybe less. + + +--tom + +=cut + $RCSID = '$Id: c2ph,v 1.7 95/10/28 10:41:47 tchrist Exp Locker: tchrist $'; @@ -54,7 +265,7 @@ $RCSID = '$Id: c2ph,v 1.7 95/10/28 10:41:47 tchrist Exp Locker: tchrist $'; $bitorder = 'b'; # ascending; set to B for descending bit fields -%intrinsics = +%intrinsics = %template = ( 'char', 'c', 'unsigned char', 'C', @@ -81,7 +292,7 @@ $bitorder = 'b'; # ascending; set to B for descending bit fields 'null', 'x', 'neganull', 'X', 'bit', $bitorder, -); +); &buildscrunchlist; delete $intrinsics{'neganull'}; @@ -139,7 +350,7 @@ $opt_n && ($perl = 0); if ($opt_w) { ($type_width, $member_width, $offset_width) = (45, 35, 8); -} +} if ($opt_x) { ($offset_fmt, $offset_width, $size_fmt, $size_width) = ( 'x', '08', 'x', 04 ); } @@ -151,7 +362,7 @@ sub PLUMBER { print "oops, apperent pager foulup\n"; $isatty++; &usage(1); -} +} sub usage { local($oops) = @_; @@ -165,7 +376,7 @@ sub usage { open (PIPE, "|". ($ENV{PAGER} || 'more')); $SIG{PIPE} = PLUMBER; select(PIPE); - } + } print "usage: $0 [-dpnP] [var=val] [files ...]\n"; @@ -219,7 +430,7 @@ EOF If any *.[ch] files are given, these will be catted together into a temporary *.c file and sent through: - $CC $CFLAGS $DEFINES + $CC $CFLAGS $DEFINES and the resulting *.s groped for stab information. If no files are supplied, then stdin is read directly with the assumption that it contains stab information. All other liens will be ignored. At @@ -228,12 +439,12 @@ EOF EOF close PIPE; exit 1; -} +} sub defvar { local($var, $msg) = @_; printf "%-16s%-15s %s\n", $var, eval "\$$var", $msg; -} +} $recurse = 1; @@ -241,19 +452,19 @@ if (@ARGV) { if (grep(!/\.[csh]$/,@ARGV)) { warn "Only *.[csh] files expected!\n"; &usage; - } + } elsif (grep(/\.s$/,@ARGV)) { - if (@ARGV > 1) { + if (@ARGV > 1) { warn "Only one *.s file allowed!\n"; &usage; } - } + } elsif (@ARGV == 1 && $ARGV[0] =~ /\.c$/) { local($dir, $file) = $ARGV[0] =~ m#(.*/)?(.*)$#; $chdir = "cd $dir; " if $dir; &system("$chdir$CC $CFLAGS $DEFINES $file") && exit 1; $ARGV[0] =~ s/\.c$/.s/; - } + } else { $TMP = "/tmp/c2ph.$$.c"; &system("cat @ARGV > $TMP") && exit 1; @@ -261,14 +472,14 @@ if (@ARGV) { unlink $TMP; $TMP =~ s/\.c$/.s/; @ARGV = ($TMP); - } + } } if ($opt_s) { for (split(/[\s,]+/, $opt_s)) { $interested{$_}++; - } -} + } +} $| = 1 if $debug; @@ -276,7 +487,7 @@ $| = 1 if $debug; main: { if ($trace) { - if (-t && !@ARGV) { + if (-t && !@ARGV) { print STDERR "reading from your keyboard: "; } else { print STDERR "reading from " . (@ARGV ? "@ARGV" : "<STDIN>").": "; @@ -287,21 +498,21 @@ STAB: while (<>) { if ($trace && !($. % 10)) { $lineno = $..''; print STDERR $lineno, "\b" x length($lineno); - } + } next unless /^\s*\.stabs\s+/; $line = $_; - s/^\s*\.stabs\s+//; + s/^\s*\.stabs\s+//; if (s/\\\\"[d,]+$//) { $saveline .= $line; $savebar = $_; next STAB; - } + } if ($saveline) { s/^"//; $_ = $savebar . $_; $line = $saveline; - } - &stab; + } + &stab; $savebar = $saveline = undef; } print STDERR "$.\n" if $trace; @@ -315,7 +526,7 @@ STAB: while (<>) { &adjust_start_addrs; $sum = 2 + $type_width + $member_width; - $pmask1 = "%-${type_width}s %-${member_width}s"; + $pmask1 = "%-${type_width}s %-${member_width}s"; $pmask2 = "%-${sum}s %${offset_width}${offset_fmt}%s %${size_width}${size_fmt}%s"; @@ -330,7 +541,7 @@ STAB: while (<>) { $build_recursed = 0; &build_template($name) unless defined $template{&psou($name)} || $opt_s && !$interested{$iname}; - } + } print STDERR "\n\n" if $trace; } @@ -358,11 +569,11 @@ STAB: while (<>) { print "# " if $perl && $verbose; $pcode = ''; - print "$fname {\n" if !$perl || $verbose; + print "$fname {\n" if !$perl || $verbose; $template{$fname} = &scrunch($template{$fname}) if $perl; - &pstruct($name,$name,0); + &pstruct($name,$name,0); print "# " if $perl && $verbose; - print "}\n" if !$perl || $verbose; + print "}\n" if !$perl || $verbose; print "\n" if $perl && $verbose; if ($perl) { @@ -371,56 +582,56 @@ STAB: while (<>) { printf("\nsub %-32s { %4d; }\n\n", "${mname}'struct", $countof{$name}); print <<EOF; -sub ${mname}'typedef { +sub ${mname}'typedef { local(\$${mname}'index) = shift; - defined \$${mname}'index - ? \$${mname}'typedef[\$${mname}'index] + defined \$${mname}'index + ? \$${mname}'typedef[\$${mname}'index] : \$${mname}'typedef; } EOF print <<EOF; -sub ${mname}'sizeof { +sub ${mname}'sizeof { local(\$${mname}'index) = shift; - defined \$${mname}'index - ? \$${mname}'sizeof[\$${mname}'index] + defined \$${mname}'index + ? \$${mname}'sizeof[\$${mname}'index] : \$${mname}'sizeof; } EOF print <<EOF; -sub ${mname}'offsetof { +sub ${mname}'offsetof { local(\$${mname}'index) = shift; - defined \$${mname}index - ? \$${mname}'offsetof[\$${mname}'index] + defined \$${mname}index + ? \$${mname}'offsetof[\$${mname}'index] : \$${mname}'sizeof; } EOF print <<EOF; -sub ${mname}'typeof { +sub ${mname}'typeof { local(\$${mname}'index) = shift; - defined \$${mname}index - ? \$${mname}'typeof[\$${mname}'index] + defined \$${mname}index + ? \$${mname}'typeof[\$${mname}'index] : '$name'; } EOF - + print <<EOF; -sub ${mname}'fieldnames { - \@${mname}'fieldnames; +sub ${mname}'fieldnames { + \@${mname}'fieldnames; } EOF $iam = ($isastruct{$name} && 's') || ($isaunion{$name} && 'u'); - + print <<EOF; -sub ${mname}'isastruct { - '$iam'; +sub ${mname}'isastruct { + '$iam'; } EOF - print "\$${mname}'typedef = '" . &scrunch($template{$fname}) + print "\$${mname}'typedef = '" . &scrunch($template{$fname}) . "';\n"; print "\$${mname}'sizeof = $sizeof{$name};\n\n"; @@ -443,13 +654,13 @@ EOF $template_printed{$fname}++; $size_printed{$fname}++; - } + } print "\n"; } print STDERR "\n" if $trace; - unless ($perl && $opt_a) { + unless ($perl && $opt_a) { print "\n1;\n" if $perl; exit; } @@ -471,7 +682,7 @@ EOF } print "\n1;\n" if $perl; - + exit; } @@ -507,27 +718,27 @@ sub stab { - if (/(([ \w]+):t(\d+|\(\d+,\d+\)))=r?(\d+|\(\d+,\d+\))(;\d+;\d+;)?/) { + if (/(([ \w]+):t(\d+|\(\d+,\d+\)))=r?(\d+|\(\d+,\d+\))(;\d+;\d+;)?/) { local($ident) = $2; push(@intrinsics, $ident); $typeno = &typeno($3); $type[$typeno] = $ident; - print STDERR "intrinsic $ident in new type $typeno\n" if $debug; + print STDERR "intrinsic $ident in new type $typeno\n" if $debug; next; } - if (($name, $typeordef, $typeno, $extra, $struct, $_) - = /^([\$ \w]+):([ustT])(\d+|\(\d+,\d+\))(=[rufs*](\d+))?(.*)$/) + if (($name, $typeordef, $typeno, $extra, $struct, $_) + = /^([\$ \w]+):([ustT])(\d+|\(\d+,\d+\))(=[rufs*](\d+))?(.*)$/) { $typeno = &typeno($typeno); # sun foolery - } + } elsif (/^[\$\w]+:/) { next; # variable } - else { + else { warn "can't grok stab: <$_> in: $line " if $_; next; - } + } #warn "got size $size for $name\n"; $sizeof{$name} = $size if $size; @@ -546,7 +757,7 @@ sub stab { } else { printf "%s is type %d", $name, $typeno if $debug; print ", a typedef for " , $type[$typeno] if $debug; - } + } print "\n" if $debug; #next unless $extra =~ /[su*]/; @@ -567,27 +778,27 @@ sub stab { push(@intrinsics, $2); $typeno = &typeno($3); $type[$typeno] = $2; - print STDERR "intrinsic $2 in new type $typeno\n" if $debug; + print STDERR "intrinsic $2 in new type $typeno\n" if $debug; } elsif (s/^=e//) { # blessed be thy compiler; mine won't do this &edecl; - } + } else { warn "Funny remainder for $name on line $_ left in $line " if $_; - } + } } sub typeno { # sun thinks types are (0,27) instead of just 27 local($_) = @_; s/\(\d+,(\d+)\)/$1/; $_; -} +} sub pstruct { - local($what,$prefix,$base) = @_; - local($field, $fieldname, $typeno, $count, $offset, $entry); + local($what,$prefix,$base) = @_; + local($field, $fieldname, $typeno, $count, $offset, $entry); local($fieldtype); - local($type, $tname); + local($type, $tname); local($mytype, $mycount, $entry2); local($struct_count) = 0; local($pad, $revpad, $length, $prepad, $lastoffset, $lastlength, $fmt); @@ -597,7 +808,7 @@ sub pstruct { local($mname) = &munge($name); - sub munge { + sub munge { local($_) = @_; s/[\s\$\.]/_/g; $_; @@ -609,8 +820,8 @@ sub pstruct { for $field (split(/;/, $struct{$what})) { $pad = $prepad = 0; - $entry = ''; - ($fieldname, $typeno, $count, $offset, $length) = split(/,/, $field); + $entry = ''; + ($fieldname, $typeno, $count, $offset, $length) = split(/,/, $field); $type = $type[$typeno]; @@ -623,7 +834,7 @@ sub pstruct { if ($build_templates) { - $pad = ($offset - ($lastoffset + $lastlength))/8 + $pad = ($offset - ($lastoffset + $lastlength))/8 if defined $lastoffset; if (! $finished_template{$sname}) { @@ -645,13 +856,13 @@ sub pstruct { ($lastoffset, $lastlength) = ($offset, $length); - } else { + } else { print '# ' if $perl && $verbose; $entry = sprintf($pmask1, ' ' x ($nesting * $indent) . $fieldtype, - "$prefix.$fieldname" . $count); + "$prefix.$fieldname" . $count); - $entry =~ s/(\*+)( )/$2$1/; + $entry =~ s/(\*+)( )/$2$1/; printf $pmask2, $entry, @@ -683,21 +894,21 @@ sub pstruct { print "\n" if !$perl || $verbose; - } + } if ($perl) { local($mycount) = defined $struct{$mytype} ? $countof{$mytype} : 1; $mycount *= &scripts2count($count) if $count; if ($nesting==1 && !$build_templates) { - $pcode .= sprintf("sub %-32s { %4d; }\n", + $pcode .= sprintf("sub %-32s { %4d; }\n", "${mname}'${fieldname}", $struct_count); push(@indices, $struct_count); } $struct_count += $mycount; - } + } - &pstruct($type, "$prefix.$fieldname", $base+$offset) - if $recurse && defined $struct{$type}; + &pstruct($type, "$prefix.$fieldname", $base+$offset) + if $recurse && defined $struct{$type}; } $countof{$what} = $struct_count unless defined $countof{$whati}; @@ -715,18 +926,18 @@ sub pstruct { } else { print STDERR $sizeof{$name}, "\n" if $debUg; } - } + } --$nesting; } sub psize { - local($me) = @_; + local($me) = @_; local($amstruct) = $struct{$me} ? 'struct ' : ''; - print '$sizeof{\'', $amstruct, $me, '\'} = '; - printf "%d;\n", $sizeof{$me}; + print '$sizeof{\'', $amstruct, $me, '\'} = '; + printf "%d;\n", $sizeof{$me}; } sub pdecl { @@ -737,20 +948,20 @@ sub pdecl { warn "pdecl: $pdecl\n" if $debug; $pdecl =~ s/\(\d+,(\d+)\)/$1/g; - $pdecl =~ s/\*//g; - @pdecls = split(/=/, $pdecl); + $pdecl =~ s/\*//g; + @pdecls = split(/=/, $pdecl); $typeno = $pdecls[0]; $tname = pop @pdecls; - if ($tname =~ s/^f//) { $tname = "$tname&"; } - #else { $tname = "$tname*"; } + if ($tname =~ s/^f//) { $tname = "$tname&"; } + #else { $tname = "$tname*"; } for (reverse @pdecls) { - $tname .= s/^f// ? "&" : "*"; + $tname .= s/^f// ? "&" : "*"; #$tname =~ s/^f(.*)/$1&/; print "type[$_] is $tname\n" if $debug; $type[$_] = $tname unless defined $type[$_]; - } + } } @@ -762,18 +973,18 @@ sub adecl { local($_, $typedef) = @_; while (s/^((\d+|\(\d+,\d+\))=)?ar(\d+|\(\d+,\d+\));//) { - ($arraytype, $unknown) = ($2, $3); + ($arraytype, $unknown) = ($2, $3); $arraytype = &typeno($arraytype); $unknown = &typeno($unknown); if (s/^(\d+);(\d+);//) { - ($lower, $upper) = ($1, $2); - $scripts .= '[' . ($upper+1) . ']'; + ($lower, $upper) = ($1, $2); + $scripts .= '[' . ($upper+1) . ']'; } else { - warn "can't find array bounds: $_"; - } + warn "can't find array bounds: $_"; + } } if (s/^([(,)\d*f=]*),(\d+),(\d+);//) { - ($start, $length) = ($2, $3); + ($start, $length) = ($2, $3); $whatis = $1; if ($whatis =~ /^(\d+|\(\d+,\d+\))=/) { $typeno = &typeno($1); @@ -782,12 +993,12 @@ sub adecl { $typeno = &typeno($whatis); } } elsif (s/^(\d+)(=[*suf]\d*)//) { - local($whatis) = $2; + local($whatis) = $2; if ($whatis =~ /[f*]/) { - &pdecl($whatis); - } elsif ($whatis =~ /[su]/) { # - print "$prefix.$fieldname is an array$scripts anon structs; disgusting\n" + &pdecl($whatis); + } elsif ($whatis =~ /[su]/) { # + print "$prefix.$fieldname is an array$scripts anon structs; disgusting\n" if $debug; #$type[$typeno] = $name unless defined $type[$typeno]; ##printf "new type $typeno is $name" if $debug; @@ -802,15 +1013,15 @@ sub adecl { $length = $offset; } else { warn "what's this? $whatis in $line "; - } + } } elsif (/^\d+$/) { $typeno = $_; } else { warn "bad array stab: $_ in $line "; next STAB; - } + } #local($wasdef) = defined($type[$typeno]) && $debug; - #if ($typedef) { + #if ($typedef) { #print "redefining $type[$typeno] to " if $wasdef; #$type[$typeno] = "$whatis$scripts"; # unless defined $type[$typeno]; #print "$type[$typeno]\n" if $wasdef; @@ -837,9 +1048,9 @@ SFIELD: while (/^([^;]+);/) { $scripts = ''; warn "sdecl $_\n" if $debug; - if (s/^([\$\w]+)://) { + if (s/^([\$\w]+)://) { $fieldname = $1; - } elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # + } elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # $typeno = &typeno($1); $type[$typeno] = "$prefix.$fieldname"; local($name) = "$prefix.$fieldname"; @@ -865,13 +1076,13 @@ SFIELD: $typeno = &typeno($1) if $1; } elsif (s/^(\d+)=xs\w+:,(\d+),(\d+);//) { - ($start, $length) = ($2, $3); + ($start, $length) = ($2, $3); &panic("no length?") unless $length; $typeno = &typeno($1) if $1; } elsif (s/^((\d+|\(\d+,\d+\))(=[*f](\d+|\(\d+,\d+\)))+),(\d+),(\d+);//) { - ($pdecl, $start, $length) = ($1,$5,$6); - &pdecl($pdecl); + ($pdecl, $start, $length) = ($1,$5,$6); + &pdecl($pdecl); } elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # the dratted anon struct ($typeno, $sou) = ($1, $2); @@ -886,24 +1097,24 @@ SFIELD: &sou($name,$sou); print "anon ".($isastruct{$name}) ? "struct":"union"." for $prefix.$fieldname\n" if $debug; $type[$typeno] = "$prefix.$fieldname"; - $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset); + $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset); $start = $start{$name}; $length = $sizeof{$name}; } else { - warn "can't grok stab for $name ($_) in line $line "; - next STAB; + warn "can't grok stab for $name ($_) in line $line "; + next STAB; } &panic("no length for $prefix.$fieldname") unless $length; $struct{$name} .= join(',', $fieldname, $typeno, $scripts, $start, $length) . ';'; } if (s/;\d*,(\d+),(\d+);//) { - local($start, $size) = ($1, $2); + local($start, $size) = ($1, $2); $sizeof{$prefix} = $size; - print "start of $prefix is $start, size of $sizeof{$prefix}\n" if $debug; - $start{$prefix} = $start; - } + print "start of $prefix is $start, size of $sizeof{$prefix}\n" if $debug; + $start{$prefix} = $start; + } $_; } @@ -911,7 +1122,7 @@ sub edecl { s/;$//; $enum{$name} = $_; $_ = ''; -} +} sub resolve_types { local($sou); @@ -924,8 +1135,8 @@ sub resolve_types { } print "type[$i] $_ ==> " if $debug; s/^(\d+)(\**)\&\*(\**)/"$2($3".&type($1) . ')()'/e; - s/^(\d+)\&/&type($1)/e; - s/^(\d+)/&type($1)/e; + s/^(\d+)\&/&type($1)/e; + s/^(\d+)/&type($1)/e; s/(\*+)([^*]+)(\*+)/$1$3$2/; s/\((\*+)(\w+)(\*+)\)/$3($1$2)/; s/^(\d+)([\*\[].*)/&type($1).$2/e; @@ -934,7 +1145,7 @@ sub resolve_types { print "$_\n" if $debug; } } -sub type { &psou($type[$_[0]] || "<UNDEFINED>"); } +sub type { &psou($type[$_[0]] || "<UNDEFINED>"); } sub adjust_start_addrs { for (sort keys %start) { @@ -986,12 +1197,12 @@ sub buildscrunchlist { $scrunch_code = "sub quick_scrunch {\n"; for (values %intrinsics) { $scrunch_code .= "\ts/(${_}{2,})/'$_' . length(\$1)/ge;\n"; - } + } $scrunch_code .= "}\n"; print "$scrunch_code" if $debug; eval $scrunch_code; &panic("can't eval scrunch_code $@ \nscrunch_code") if $@; -} +} sub fetch_template { local($mytype) = @_; @@ -1002,27 +1213,27 @@ sub fetch_template { if ($mytype =~ s/(\[\d+\])+$//) { $count .= $1; - } + } if ($mytype =~ /\*/) { $fmt = $template{'pointer'}; - } + } elsif (defined $template{$mytype}) { $fmt = $template{$mytype}; - } + } elsif (defined $struct{$mytype}) { if (!defined $template{&psou($mytype)}) { &build_template($mytype) unless $mytype eq $name; - } + } elsif ($template{&psou($mytype)} !~ /\$$/) { #warn "incomplete template for $mytype\n"; - } + } $fmt = $template{&psou($mytype)} || '?'; - } + } else { warn "unknown fmt for $mytype\n"; $fmt = '?'; - } + } $fmt x $count . ' '; } @@ -1046,7 +1257,7 @@ EOF print <<"EOF"; printf(mask,sizeof($type), "$type"); EOF - } + } print <<'EOF'; printf(mask,sizeof(char *), "pointer"); @@ -1063,11 +1274,11 @@ EOF print "intrinsic $_[1] is size $_[0]\n" if $debug; $sizeof{$_[1]} = $_[0]; $intrinsics{$_[1]} = $template{$_[0]}; - } + } close(PIPE) || die "couldn't read intrinsics!"; unlink($TMP, '/tmp/a.out'); print STDERR "done\n" if $trace; -} +} sub scripts2count { local($_) = @_; @@ -1083,9 +1294,9 @@ sub scripts2count { sub system { print STDERR "@_\n" if $trace; system @_; -} +} -sub build_template { +sub build_template { local($name) = @_; &panic("already got a template for $name") if defined $template{$name}; @@ -1136,7 +1347,7 @@ sub panic { print $sub[$i]; } exit 1; -} +} sub squishseq { local($num); @@ -1165,7 +1376,7 @@ sub squishseq { sub repeat_template { # local($template, $scripts) = @_; have to change caller's values - if ( $_[1] ) { + if ( $_[1] ) { local($ncount) = &scripts2count($_[1]); if ($_[0] =~ /^\s*c\s*$/i) { $_[0] = "A$ncount "; @@ -1180,5 +1391,6 @@ sub repeat_template { close OUT or die "Can't close $file: $!"; chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; unlink 'pstruct'; +print "Linking c2ph to pstruct.\n"; link c2ph, pstruct; exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; |