From tchrist@convex.COM Fri Jul 26 15:05:23 1991
To: Perl-Users@fuggles.acc.Virginia.EDU
From: tchrist@convex.COM (Tom Christiansen)
Crossposted-To: alt.sources.patches
Subject: Re: pstruct -- a C structure formatter; AKA c2ph, a C to perl header translator
Date: 25 Jul 91 23:21:03 GMT
Reply-To: tchrist@convex.COM (Tom Christiansen)

Here is a patch to make c2ph understand the stabs put out by Sun systems
(and to use "cd" cause Sun's sh doesn't understand "chdir"!), as well as
few consessions for gcc on an HP as well.  Not much else very new; a couple
pretty minor bug fixes.  The diffs are only 20% of the original, so you
get straight diffs.  If you want a complete version having missed or
munged the first post, just send me mail.

--tom

13c13
< $RCSID = '$Id: c2ph,v 1.1 91/07/25 03:05:58 tchrist Exp $';
---
> $RCSID = '$Id: c2ph,v 1.2 91/07/25 18:13:13 tchrist Exp $';
29a30
>     'short unsigned int',	'S',
34a36,37
>     'unsigned long',		'L',
>     'long unsigned int',	'L',
60a64
>     'short unsigned int',	'2',
66a71
>     'long unsigned int',	'4',
92c97
< &Getopts('aixdpvtnws:') || &usage;
---
> &Getopts('aixdpvtnws:') || &usage(0);
108a114,120
> sub PLUMBER {
>     select(STDERR);
>     print "oops, apperent pager foulup\n";
>     $isatty++;
>     &usage(1);
> } 
> 
109a122
>     local($oops) = @_;
112c125
<     } else {
---
>     } elsif (!$oops) {
117c130,131
< 	open (PIPE, "|". $ENV{PAGER} || 'more');
---
> 	open (PIPE, "|". ($ENV{PAGER} || 'more'));
> 	$SIG{PIPE} = PLUMBER;
204c218
< 	$chdir = "chdir $dir; " if $dir;
---
> 	$chdir = "cd $dir; " if $dir;
211c225
< 	&system("chdir /tmp; $CC $CFLAGS $DEFINES $TMP") && exit 1;
---
> 	&system("cd /tmp; $CC $CFLAGS $DEFINES $TMP") && exit 1;
225c239
< # $| = 1;
---
> $| = 1 if $debug;
233c247
< 	    print STDERR "reading from @ARGV: ";
---
> 	    print STDERR "reading from " . (@ARGV ? "@ARGV" : "<STDIN>").": ";
309c323
< }
---
> 	? \$${mname}'typedef[\$${mname}'index] 
343a358
> 
398c413
<     next unless /:[\$\w]+=[\*\$\w]+/;
---
>     next unless /:[\$\w]+(\(\d+,\d+\))?=[\*\$\w]+/;  # (\d+,\d+) is for sun
417,419c432,438
<     if (/(([ \w]+):t\d+)?=r?\d+(;\d+;\d+;)?/) {  # the ?'s are for gcc
< 	push(@intrinsics, $2);
< 	; # machine intrinsic type
---
>     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; 
> 	next;
423c442
< 	= /^([\$ \w]+):([ustT])(\d+)(=[rufs*](\d+))?(.*)$/) 
---
> 	= /^([\$ \w]+):([ustT])(\d+|\(\d+,\d+\))(=[rufs*](\d+))?(.*)$/) 
425c444
< 	; # normal stuff, just full through
---
> 	$typeno = &typeno($typeno);  # sun foolery
469,471c488,492
<     elsif (s/((\w+):t\d+)?=r?\d+(;\d+;\d+;)?//) {  # the ?'s are for gcc
< 	push(@intrinsics, $1);
< 	; # machine intrinsic type
---
>     elsif (s/((\w+):t(\d+|\(\d+,\d+\)))?=r?(;\d+;\d+;)?//) {  # the ?'s are for gcc
> 	push(@intrinsics, $2);
> 	$typeno = &typeno($3);
> 	$type[$typeno] = $2;
> 	print STDERR "intrinsic $2 in new type $typeno\n" if $debug; 
480a502,506
> sub typeno {  # sun thinks types are (0,27) instead of just 27
>     local($_) = @_;
>     s/\(\d+,(\d+)\)/$1/;
>     $_;
> } 
560,561d585
< 	    $template = &scrunch(&fetch_template($type) x 
< 			    ($count ? &scripts2count($count) : 1));
563c587,589
< 	    if ($nesting == 1) {
---
> 	    if ($perl && $nesting == 1) {
> 		$template = &scrunch(&fetch_template($type) x 
> 				($count ? &scripts2count($count) : 1));
598a625,636
>     if ($build_templates && !defined $sizeof{$name}) {
> 	local($fmt) = &scrunch($template{$sname});
> 	print STDERR "no size for $name, punting with $fmt..." if $debug;
> 	eval '$sizeof{$name} = length(pack($fmt, ()))';
> 	if ($@) {
> 	    chop $@;
> 	    warn "couldn't get size for \$name: $@";
> 	} else {
> 	    print STDERR $sizeof{$name}, "\n" if $debUg;
> 	}
>     } 
> 
615a654,656
>     warn "pdecl: $pdecl\n" if $debug;
> 
>     $pdecl =~ s/\(\d+,(\d+)\)/$1/g;
707c748
<     local($typeno);
---
>     local($typeno,$sou);
713c754
< 	#if (! $1) { s/;//; next; } 
---
> 	warn "sdecl $_\n" if $debug;
716,717c757,758
< 	} elsif (s/(\d+)=([us])(\d+)//) { # this is why i don't write compilers for living
< 	    $typeno = $1;
---
> 	} elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # 
> 	    $typeno = &typeno($1);
736c777
< 	elsif (s/^(\d*),(\d+),(\d+);//) {
---
> 	elsif (s/^(\d+|\(\d+,\d+\))?,(\d+),(\d+);//) {
738c779,780
< 	    $typeno = $1 if $1;
---
> 	    &panic("no length?") unless $length;
> 	    $typeno = &typeno($1) if $1;
740,741c782,783
< 	elsif (s/^(\d+(=[*f]\d*)+),(\d+),(\d+);//) {
< 	    ($pdecl, $start, $length) =  ($1,$3,$4); 
---
> 	elsif (s/^((\d+|\(\d+,\d+\))(=[*f](\d+|\(\d+,\d+\)))+),(\d+),(\d+);//) {
> 	    ($pdecl, $start, $length) =  ($1,$5,$6); 
744,745c786,789
< 	elsif (s/(\d+)=([us])(\d+)//) { # the dratted anon struct
< 	    if (defined($type[$1])) {
---
> 	elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # the dratted anon struct
> 	    ($typeno, $sou) = ($1, $2);
> 	    $typeno = &typeno($typeno);
> 	    if (defined($type[$typeno])) {
748,749c792,793
< 		print "type $1 is $prefix.$fieldname\n" if $debug;
< 		$type[$1] = "$prefix.$fieldname" unless defined $type[$1];
---
> 		print "anon type $typeno is $prefix.$fieldname\n" if $debug;
> 		$type[$typeno] = "$prefix.$fieldname" unless defined $type[$typeno];
751,753d794
< 	    print "anon struct for $prefix.$fieldname\n" if $debug;
< 	    $typeno = $1;
< 	    $type[$1] = "$prefix.$fieldname";
755c796,798
< 	    &sou($name,$2);
---
> 	    &sou($name,$sou);
> 	    print "anon ".($isastruct{$name}) ? "struct":"union"." for $prefix.$fieldname\n" if $debug;
> 	    $type[$typeno] = "$prefix.$fieldname";
765,766c808
< 	print "field $fieldname of $prefix is type $typeno, $type[$typeno]\n" if $debug;
< 
---
> 	&panic("no length for $prefix.$fieldname") unless $length;
866a909,910
>     &panic("why do you care?") unless $perl;
> 
923c967
<     open(PIPE, "chdir /tmp && $CC $TMP && /tmp/a.out|");
---
>     open(PIPE, "cd /tmp && $CC $TMP && /tmp/a.out|");
931c975
<     close(PIPE) || warn "couldn't read intrinsics!";
---
>     close(PIPE) || die "couldn't read intrinsics!";
980c1024
<     for ($i = 1; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
---
>     for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {