X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utils%2Fh2ph.PL;h=0b0208b0ca40df1a551fa142f5e3bc0d5a9a3b8f;hb=fcbfa962e80dc16f8db1afaeb5287e8a393d3942;hp=2c685e0383e52db2702050f44057fd5335147dea;hpb=ee580363108be8ac33155650c6c18d2e5cf051f3;p=p5sagit%2Fp5-mst-13.2.git diff --git a/utils/h2ph.PL b/utils/h2ph.PL index 2c685e0..0b0208b 100644 --- a/utils/h2ph.PL +++ b/utils/h2ph.PL @@ -2,6 +2,7 @@ use Config; use File::Basename qw(basename dirname); +use Cwd; # List explicitly here the variables you want Configure to # generate. Metaconfig only looks for shell variables, so you @@ -13,6 +14,7 @@ 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. +$origdir = cwd; chdir dirname($0); $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; @@ -38,7 +40,9 @@ use Config; use File::Path qw(mkpath); use Getopt::Std; -getopts('Dd:rlh'); +getopts('Dd:rlhaQ'); +die "-r and -a options are mutually exclusive\n" if ($opt_r and $opt_a); +@inc_dirs = inc_dirs() if $opt_a; my $Exit = 0; @@ -59,6 +63,8 @@ $inif = 0; @ARGV = ('-') unless @ARGV; +build_preamble_if_necessary(); + while (defined ($file = next_file())) { if (-l $file and -d $file) { link_if_possible($file) if ($opt_l); @@ -77,14 +83,24 @@ while (defined ($file = next_file())) { open(OUT, ">-"); } else { ($outfile = $file) =~ s/\.h$/.ph/ || next; - print "$file -> $outfile\n"; + print "$file -> $outfile\n" unless $opt_Q; if ($file =~ m|^(.*)/|) { $dir = $1; mkpath "$Dest_dir/$dir"; } + + if ($opt_a) { # automagic mode: locate header file in @inc_dirs + foreach (@inc_dirs) { + chdir $_; + last if -f $file; + } + } + open(IN,"$file") || (($Exit = 1),(warn "Can't open $file: $!\n"),next); open(OUT,">$Dest_dir/$outfile") || die "Can't create $outfile: $!\n"; } + + print OUT "require '_h2ph_pre.ph';\n\n"; while () { chop; while (/\\$/) { @@ -93,6 +109,7 @@ while (defined ($file = next_file())) { chop; } print OUT "# $_\n" if $opt_D; + if (s:/\*:\200:g) { s:\*/:\201:g; s/\200[^\201]*\201//g; # delete single line comments @@ -102,7 +119,7 @@ while (defined ($file = next_file())) { redo; } } - if (s/^\s*#\s*//) { + if (s/^\s*\#\s*//) { if (s/^define\s+(\w+)//) { $name = $1; $new = ''; @@ -146,6 +163,7 @@ while (defined ($file = next_file())) { $args = reindent($args); if ($t ne '') { $new =~ s/(['\\])/\\$1/g; #']); + if ($opt_h) { print OUT $t,"eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name () {",$new,";}' unless defined(\&$name);\n"; $eval_index++; @@ -153,6 +171,9 @@ while (defined ($file = next_file())) { print OUT $t,"eval 'sub $name () {",$new,";}' unless defined(\&$name);\n"; } } else { + # Shunt around such directives as `#define FOO FOO': + next if " \&$name" eq $new; + print OUT $t,"unless(defined(\&$name)) {\n sub $name () {\t",$new,";}\n}\n"; } } @@ -161,37 +182,25 @@ while (defined ($file = next_file())) { print OUT $t,"require '$incl';\n"; } elsif(/^include_next\s*[<"](.*)[>"]/) { ($incl = $1) =~ s/\.h$/.ph/; - # should've read up on #include_next properly before attempting - # to implement it... - # - #print OUT $t, "{\n"; - #$tab += 4; - #$t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - #print OUT $t, "my(\$INC) = shift(\@INC);\n"; - #print OUT $t, "require '$incl';\n"; - #print OUT $t, "unshift(\@INC, \$INC);}\n"; - #$tab -= 4; - #$t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - #print OUT $t, "}\n"; - # - # try this instead: - print OUT ($t, "my(\$i) = 0;\n"); - print OUT ($t, "if(exists(\$INC{$incl})) {\n"); - $tab += 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - print OUT ($t, "++\$i while (\$i <= \$#INC", - " and \$INC[\$i].'/$incl' ne \$INC{'$incl'});\n"); - print OUT ($t, "\$i = 0 if \$INC[\$i].'/$incl' ne", - " \$INC{'$incl'};\n"); - $tab -= 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - print OUT ($t, "}\n"); print OUT ($t, - "eval(\"require '\" . ", - "(\$i ? \$INC[\$i].'/' : '') . \"\$incl';\");"); - # any better? require is smart enough not to try and include a - # file twice, i believe, so require-ing the same actual file - # should end up just being a null operation... + "eval {\n"); + $tab += 4; + $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); + print OUT ($t, + "my(\%INCD) = map { \$INC{\$_} => 1 } ", + "(grep { \$_ eq \"$incl\" } keys(\%INC));\n"); + print OUT ($t, + "my(\@REM) = map { \"\$_/$incl\" } ", + "(grep { not exists(\$INCD{\"\$_/$incl\"})", + "and -f \"\$_/$incl\" } \@INC);\n"); + print OUT ($t, + "require \"\$REM[0]\" if \@REM;\n"); + $tab -= 4; + $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); + print OUT ($t, + "};\n"); + print OUT ($t, + "warn(\$\@) if \$\@;\n"); } elsif (/^ifdef\s+(\w+)/) { print OUT $t,"if(defined(&$1)) {\n"; $tab += 4; @@ -230,16 +239,49 @@ while (defined ($file = next_file())) { print OUT $t,"}\n"; } elsif(/^undef\s+(\w+)/) { print OUT $t, "undef(&$1) if defined(&$1);\n"; + } elsif(/^error\s+(".*")/) { + print OUT $t, "die($1);\n"; } elsif(/^error\s+(.*)/) { - print OUT $t, "die(\"$1\");\n"; + print OUT $t, "die(\"", quotemeta($1), "\");\n"; } elsif(/^warning\s+(.*)/) { - print OUT $t, "warn(\"$1\");\n"; + print OUT $t, "warn(\"", quotemeta($1), "\");\n"; } elsif(/^ident\s+(.*)/) { print OUT $t, "# $1\n"; } + } elsif(/^\s*(typedef\s*)?enum\s*(\s+[a-zA-Z_]\w*\s*)?\{/) { + until(/\}.*?;/) { + chomp($next = ); + $_ .= $next; + print OUT "# $next\n" if $opt_D; + } + s@/\*.*?\*/@@g; + s/\s+/ /g; + /^\s?(typedef\s?)?enum\s?([a-zA-Z_]\w*)?\s?\{(.*)\}\s?([a-zA-Z_]\w*)?\s?;/; + ($enum_subs = $3) =~ s/\s//g; + @enum_subs = split(/,/, $enum_subs); + $enum_val = -1; + for $enum (@enum_subs) { + ($enum_name, $enum_value) = $enum =~ /^([a-zA-Z_]\w*)(=.+)?$/; + $enum_value =~ s/^=//; + $enum_val = (length($enum_value) ? $enum_value : $enum_val + 1); + if ($opt_h) { + print OUT ($t, + "eval(\"\\n#line $eval_index $outfile\\n", + "sub $enum_name () \{ $enum_val; \}\") ", + "unless defined(\&$enum_name);\n"); + ++ $eval_index; + } else { + print OUT ($t, + "eval(\"sub $enum_name () \{ $enum_val; \}\") ", + "unless defined(\&$enum_name);\n"); + } + } } } print OUT "1;\n"; + + $is_converted{$file} = 1; + queue_includes_from($file) if ($opt_a); } exit $Exit; @@ -380,7 +422,9 @@ sub next_file } else { print STDERR "Skipping directory `$file'\n"; } - } else { + } elsif ($opt_a) { + return $file; + } else { print STDERR "Skipping `$file': not a file or directory\n"; } } @@ -402,11 +446,8 @@ sub expand_glob # expand_glob() is going to be called until $ARGV[0] isn't a # directory; so push directories, and unshift everything else. - if (-d "$directory/$_") { - push @ARGV, "$directory/$_"; - } else { - unshift @ARGV, "$directory/$_"; - } + if (-d "$directory/$_") { push @ARGV, "$directory/$_" } + else { unshift @ARGV, "$directory/$_" } } closedir DIR; } @@ -431,12 +472,13 @@ sub link_if_possible unlink "$Dest_dir/$dirlink" or print STDERR "Could not remove link $Dest_dir/$dirlink: $!\n"; } + if (eval 'symlink($target, "$Dest_dir/$dirlink")') { print "Linking $target -> $Dest_dir/$dirlink\n"; # Make sure that the link _links_ to something: if (! -e "$Dest_dir/$target") { - mkdir("$Dest_dir/$target", 0755) or + mkpath("$Dest_dir/$target", 0755) or print STDERR "Could not create $Dest_dir/$target/\n"; } } else { @@ -446,6 +488,108 @@ sub link_if_possible } +# Push all #included files in $file onto our stack, except for STDIN +# and files we've already processed. +sub queue_includes_from +{ + my ($file) = @_; + my $line; + + return if ($file eq "-"); + + open HEADER, $file or return; + while (defined($line =
)) { + while (/\\$/) { # Handle continuation lines + chop $line; + $line .=
; + } + + if ($line =~ /^#\s*include\s+<(.*?)>/) { + push(@ARGV, $1) unless $is_converted{$1}; + } + } + close HEADER; +} + + +# Determine include directories; $Config{usrinc} should be enough for (all +# non-GCC?) C compilers, but gcc uses an additional include directory. +sub inc_dirs +{ + my $from_gcc = `$Config{cc} -v 2>&1`; + $from_gcc =~ s:^Reading specs from (.*?)/specs\b.*:$1/include:s; + + length($from_gcc) ? ($from_gcc, $Config{usrinc}) : ($Config{usrinc}); +} + + +# Create "_h2ph_pre.ph", if it doesn't exist or was built by a different +# version of h2ph. +sub build_preamble_if_necessary +{ + # Increment $VERSION every time this function is modified: + my $VERSION = 2; + my $preamble = "$Dest_dir/_h2ph_pre.ph"; + + # Can we skip building the preamble file? + if (-r $preamble) { + # Extract version number from first line of preamble: + open PREAMBLE, $preamble or die "Cannot open $preamble: $!"; + my $line = ; + $line =~ /(\b\d+\b)/; + close PREAMBLE or die "Cannot close $preamble: $!"; + + # Don't build preamble if a compatible preamble exists: + return if $1 == $VERSION; + } + + my (%define) = _extract_cc_defines(); + + open PREAMBLE, ">$preamble" or die "Cannot open $preamble: $!"; + print PREAMBLE "# This file was created by h2ph version $VERSION\n"; + + foreach (sort keys %define) { + if ($opt_D) { + print PREAMBLE "# $_=$define{$_}\n"; + } + + if ($define{$_} =~ /^\d+$/) { + print PREAMBLE + "unless (defined &$_) { sub $_() { $define{$_} } }\n\n"; + } elsif ($define{$_} =~ /^\w+$/) { + print PREAMBLE + "unless (defined &$_) { sub $_() { &$define{$_} } }\n\n"; + } else { + print PREAMBLE + "unless (defined &$_) { sub $_() { \"", + quotemeta($define{$_}), "\" } }\n\n"; + } + } + close PREAMBLE or die "Cannot close $preamble: $!"; +} + + +# %Config contains information on macros that are pre-defined by the +# system's compiler. We need this information to make the .ph files +# function with perl as the .h files do with cc. +sub _extract_cc_defines +{ + my %define; + my $allsymbols = join " ", @Config{ccsymbols, cppsymbols, cppccsymbols}; + + # Split compiler pre-definitions into `key=value' pairs: + foreach (split /\s+/, $allsymbols) { + /(.+?)=(.+)/ and $define{$1} = $2; + + if ($opt_D) { + print STDERR "$_: $1 -> $2\n"; + } + } + + return %define; +} + + 1; ############################################################################## @@ -457,7 +601,7 @@ h2ph - convert .h C header files to .ph Perl header files =head1 SYNOPSIS -B +B =head1 DESCRIPTION @@ -490,7 +634,15 @@ beneath the default Perl library location (C<$Config{'installsitsearch'}>). =item -r Run recursively; if any of B are directories, then run I -on all files in those directories (and their subdirectories, etc.). +on all files in those directories (and their subdirectories, etc.). B<-r> +and B<-a> are mutually exclusive. + +=item -a + +Run automagically; convert B, as well as any B<.h> files +which they include. This option will search for B<.h> files in all +directories which your C compiler ordinarily uses. B<-a> and B<-r> are +mutually exclusive. =item -l @@ -511,6 +663,15 @@ you will see the slightly more helpful However, the B<.ph> files almost double in size when built using B<-h>. +=item -D + +Include the code from the B<.h> file as a comment in the B<.ph> file. +This is primarily used for debugging I. + +=item -Q + +``Quiet'' mode; don't print out the names of the files being converted. + =back =head1 ENVIRONMENT @@ -547,6 +708,24 @@ that it can translate. It's only intended as a rough tool. You may need to dicker with the files produced. +Doesn't run with C + +You have to run this program by hand; it's not run as part of the Perl +installation. + +Doesn't handle complicated expressions built piecemeal, a la: + + enum { + FIRST_VALUE, + SECOND_VALUE, + #ifdef ABC + THIRD_VALUE + #endif + }; + +Doesn't necessarily locate all of your C compiler's internally-defined +symbols. + =cut !NO!SUBS! @@ -554,3 +733,4 @@ You may need to dicker with the files produced. close OUT or die "Can't close $file: $!"; chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; +chdir $origdir;