X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/9aec1e06323f04fc8a0ba5b398f709df6957228e..4c31e473d8698ee4d43e3e2b98feb4fae2cdcc94:/utils/c2ph.PL diff --git a/utils/c2ph.PL b/utils/c2ph.PL index dfe9f24..39545e3 100644 --- a/utils/c2ph.PL +++ b/utils/c2ph.PL @@ -2,6 +2,29 @@ use Config; use File::Basename qw(&basename &dirname); +use Cwd; +use subs qw(link); + +sub link { # This is a cut-down version of installperl:link(). + my($from,$to) = @_; + my($success) = 0; + + eval { + CORE::link($from, $to) + ? $success++ + : ($from =~ m#^/afs/# || $to =~ m#^/afs/#) + ? die "AFS" # okay inside eval {} + : die "Couldn't link $from to $to: $!\n"; + }; + if ($@) { + warn $@; + require File::Copy; + File::Copy::copy($from, $to) + ? $success++ + : warn "Couldn't copy $from to $to: $!\n"; + } + $success; +} # List explicitly here the variables you want Configure to # generate. Metaconfig only looks for shell variables, so you @@ -12,11 +35,10 @@ use File::Basename qw(&basename &dirname); # This forces PL files to create target in same directory as PL file. # This is so that make depend always knows where to find PL derivatives. -chdir(dirname($0)); -($file = basename($0)) =~ s/\.PL$//; -$file =~ s/\.pl$// - if ($Config{'osname'} eq 'VMS' or - $Config{'osname'} eq 'OS2'); # "case-forgiving" +$origdir = cwd; +chdir dirname($0); +$file = basename($0, '.PL'); +$file .= '.com' if $^O eq 'VMS'; open OUT,">$file" or die "Can't create $file: $!"; @@ -26,9 +48,9 @@ print "Extracting $file (with variable substitutions)\n"; # You can use $Config{...} to use Configure variables. print OUT <<"!GROK!THIS!"; -$Config{'startperl'} - eval 'exec perl -S \$0 "\$@"' - if 0; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; !GROK!THIS! # In the following, perl variables are not expanded during extraction. @@ -47,7 +69,7 @@ print OUT <<'!NO!SUBS!'; =head1 NAME -c2ph,pstruct - Dump C structures as generated from 'cc -g -S' stabs +c2ph, pstruct - Dump C structures as generated from C stabs =head1 SYNOPSIS @@ -96,44 +118,44 @@ 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. + 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 @@ -141,10 +163,10 @@ 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 +BSD/GCC-style stabs. The B<-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 +To learn more, just type a bogus option, like B<-\?>, 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. @@ -162,9 +184,9 @@ 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, +the C structures, 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 +sgtty structure was laid out differently, your program broke. Which is a shame. We've had Larry's h2ph translator, which helped, but that only works on @@ -194,7 +216,7 @@ them in terms of packages and functions. Consider the following program: 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 +fields are just their own names. Plus the following accessor functions are provided for your convenience: struct This takes no arguments, and is merely the number of first-level @@ -252,12 +274,13 @@ compiler and gcc. Anyway, here it is. Should run on perl v4 or greater. Maybe less. ---tom + --tom =cut $RCSID = '$Id: c2ph,v 1.7 95/10/28 10:41:47 tchrist Exp Locker: tchrist $'; +use File::Temp; ###################################################################### @@ -331,13 +354,25 @@ delete $intrinsics{'null'}; $indent = 2; $CC = 'cc'; -$CFLAGS = '-g -S'; +!NO!SUBS! + +if (($Config{gccversion} || '') =~ /^(\d+)\.(\d+)/ + and ($1 > 3 or ($1 == 3 and $2 >= 2))) { + print OUT q/$CFLAGS = '-gstabs -S';/; +} else { + print OUT q/$CFLAGS = '-g -S';/; +} + +print OUT <<'!NO!SUBS!'; + $DEFINES = ''; $perl++ if $0 =~ m#/?c2ph$#; require 'getopts.pl'; +use File::Temp 'tempdir'; + eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift; &Getopts('aixdpvtnws:') || &usage(0); @@ -433,7 +468,7 @@ EOF $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 + contains stab information. All other lines will be ignored. At most one *.s file should be supplied. EOF @@ -446,6 +481,13 @@ sub defvar { printf "%-16s%-15s %s\n", $var, eval "\$$var", $msg; } +sub safedir { + $SAFEDIR = File::Temp::tempdir("c2ph.XXXXXX", TMPDIR => 1, CLEANUP => 1) + unless (defined($SAFEDIR)); +} + +undef $SAFEDIR; + $recurse = 1; if (@ARGV) { @@ -461,14 +503,15 @@ if (@ARGV) { } elsif (@ARGV == 1 && $ARGV[0] =~ /\.c$/) { local($dir, $file) = $ARGV[0] =~ m#(.*/)?(.*)$#; - $chdir = "cd $dir; " if $dir; + $chdir = "cd $dir && " if $dir; &system("$chdir$CC $CFLAGS $DEFINES $file") && exit 1; $ARGV[0] =~ s/\.c$/.s/; } else { - $TMP = "/tmp/c2ph.$$.c"; + &safedir; + $TMP = "$SAFEDIR/c2ph.$$.c"; &system("cat @ARGV > $TMP") && exit 1; - &system("cd /tmp; $CC $CFLAGS $DEFINES $TMP") && exit 1; + &system("cd $SAFEDIR && $CC $CFLAGS $DEFINES $TMP") && exit 1; unlink $TMP; $TMP =~ s/\.c$/.s/; @ARGV = ($TMP); @@ -1239,7 +1282,8 @@ sub fetch_template { } sub compute_intrinsics { - local($TMP) = "/tmp/c2ph-i.$$.c"; + &safedir; + local($TMP) = "$SAFEDIR/c2ph-i.$$.c"; open (TMP, ">$TMP") || die "can't open $TMP: $!"; select(TMP); @@ -1253,7 +1297,7 @@ main() { EOF for $type (@intrinsics) { - next if !type || $type eq 'void' || $type =~ /complex/; # sun stuff + next if !$type || $type eq 'void' || $type =~ /complex/; # sun stuff print <<"EOF"; printf(mask,sizeof($type), "$type"); EOF @@ -1267,7 +1311,7 @@ EOF close TMP; select(STDOUT); - open(PIPE, "cd /tmp && $CC $TMP && /tmp/a.out|"); + open(PIPE, "cd $SAFEDIR && $CC $TMP && $SAFEDIR/a.out|"); while () { chop; split(' ',$_,2);; @@ -1276,7 +1320,7 @@ EOF $intrinsics{$_[1]} = $template{$_[0]}; } close(PIPE) || die "couldn't read intrinsics!"; - unlink($TMP, '/tmp/a.out'); + unlink($TMP, "$SAFEDIR/a.out"); print STDERR "done\n" if $trace; } @@ -1391,6 +1435,13 @@ 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; +print "Linking $file to pstruct.\n"; +if (defined $Config{d_link}) { + link $file, 'pstruct'; +} else { + unshift @INC, '../lib'; + require File::Copy; + File::Copy::syscopy('c2ph', 'pstruct'); +} exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; +chdir $origdir;