X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utils%2Fh2ph.PL;h=0b0208b0ca40df1a551fa142f5e3bc0d5a9a3b8f;hb=023851150e19d9fc4a9b3320c50e7fc5ccec014f;hp=730c2259e730b4a8d75094ba18e8c65133c74787;hpb=1d3434b8c1ecb43ba830424cfca969ab84444ed7;p=p5sagit%2Fp5-mst-13.2.git diff --git a/utils/h2ph.PL b/utils/h2ph.PL index 730c225..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,7 @@ use Config; use File::Path qw(mkpath); use Getopt::Std; -getopts('Dd:rlha'); +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; @@ -61,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); @@ -79,7 +83,7 @@ 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"; @@ -95,6 +99,8 @@ while (defined ($file = next_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 (/\\$/) { @@ -103,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 @@ -112,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 = ''; @@ -156,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++; @@ -163,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"; } } @@ -171,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; @@ -240,13 +239,43 @@ 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"; @@ -494,6 +523,73 @@ sub inc_dirs } +# 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; ############################################################################## @@ -572,6 +668,10 @@ However, the B<.ph> files almost double in size when built using B<-h>. 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 @@ -608,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! @@ -615,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;