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
# 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: $!";
# 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.
=head1 NAME
-c2ph,pstruct - Dump C structures as generated from 'cc -g -S' stabs
+c2ph, pstruct - Dump C structures as generated from C<cc -g -S> stabs
=head1 SYNOPSIS
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
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.
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
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
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;
######################################################################
$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);
$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
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) {
}
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);
}
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);
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
close TMP;
select(STDOUT);
- open(PIPE, "cd /tmp && $CC $TMP && /tmp/a.out|");
+ open(PIPE, "cd $SAFEDIR && $CC $TMP && $SAFEDIR/a.out|");
while (<PIPE>) {
chop;
split(' ',$_,2);;
$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;
}
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;
https://perl5.git.perl.org / perl5.git / blobdiff