1N/A# List explicitly here the variables you want Configure to 1N/A# generate. Metaconfig only looks for shell variables, so you 1N/A# have to mention them as if they were shell variables, not 1N/A# %Config entries. Thus you write 1N/A# to ensure Configure will look for $Config{startperl}. 1N/A# Wanted: $archlibexp 1N/A# This forces PL files to create target in same directory as PL file. 1N/A# This is so that make depend always knows where to find PL derivatives. 1N/Aopen OUT,
">$file" or die "Can't create $file: $!";
1N/Aprint "Extracting $file (with variable substitutions)\n";
1N/A# In this section, perl variables will be expanded during extraction. 1N/A# You can use $Config{...} to use Configure variables. 1N/A eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' 1N/A# In the following, perl variables are not expanded during extraction. 1N/A# Make sure read permissions for all are set: 1N/Aif (
defined umask && (
umask() &
0444)) {
1N/A umask (
umask() & ~
0444);
1N/Adie "-r and -a options are mutually exclusive\n" if ($
opt_r and $
opt_a);
1N/Adie "Destination directory $Dest_dir doesn't exist or isn't a directory\n" 1N/A # Recover from header files with unbalanced cpp directives 1N/A # $eval_index goes into ``#line'' directives, to help locate syntax errors: 1N/A print "$file -> $outfile\n" unless $
opt_Q;
1N/A if ($
opt_a) {
# automagic mode: locate header file in @inc_dirs 1N/A open(
IN,
"$file") || (($
Exit =
1),(
warn "Can't open $file: $!\n"),
next);
1N/A open(
OUT,
">$Dest_dir/$outfile") ||
die "Can't create $outfile: $!\n";
1N/A "require '_h2ph_pre.ph';\n\n",
1N/A "no warnings 'redefine';\n\n";
1N/A if (s/^\s*\
#\s*//) { 1N/A s/\(\w+\s*\(\*\)\s*\(\w*\)\)\s*(-?\d+)/$
1/;
# (int (*)(foo_t))0 1N/A if (s/^\(([\w,\s]*)\)//) {
1N/A $
arg =~ s/^\s*([^\s].*[^\s])\s*$/$
1/;
1N/A $
args =
"local($args) = \@_;\n$t ";
1N/A $
new =~ s/([
"\\])/\\$1/g; #"]);
1N/A $
new =~ s/([
'\\])/\\$1/g; #']);
1N/A "eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name $proto\{\n$t ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
1N/A "eval 'sub $name $proto\{\n$t ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
1N/A print OUT "unless(defined(\&$name)) {\n sub $name $proto\{\n\t${args}eval q($new);\n }\n}\n";
1N/A $
new =~ s/([
'\\])/\\$1/g; #']);
1N/A print OUT $t,
"eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name () {",$
new,
";}' unless defined(\&$name);\n";
1N/A print OUT $t,
"eval 'sub $name () {",$
new,
";}' unless defined(\&$name);\n";
1N/A # Shunt around such directives as `#define FOO FOO': 1N/A print OUT $t,
"unless(defined(\&$name)) {\n sub $name () {\t",$
new,
";}\n}\n";
1N/A print OUT ($t,
"my(\@REM);\n");
1N/A "my(\%INCD) = map { \$INC{\$_} => 1 } ",
1N/A "(grep { \$_ eq \"$incl\" } ",
1N/A "\@REM = map { \"\$_/$incl\" } ",
1N/A "(grep { not exists(\$INCD{\"\$_/$incl\"})",
1N/A " and -f \"\$_/$incl\" } \@INC);\n");
1N/A "\@REM = map { \"\$_/$incl\" } ",
1N/A "(grep {-r \"\$_/$incl\" } \@INC);\n");
1N/A "require \"\$REM[0]\" if \@REM;\n");
1N/A "warn(\$\@) if \$\@;\n");
1N/A print OUT $t,
"require '$incl';\n";
1N/A print OUT $t,
"if(defined(&$1)) {\n";
1N/A print OUT $t,
"unless(defined(&$1)) {\n";
1N/A }
elsif (s/^
if\s+//) {
1N/A print OUT $t,
"}\n elsif($new) {\n";
1N/A }
elsif(/^
undef\s+(\w+)/) {
1N/A print OUT $t,
"undef(&$1) if defined(&$1);\n";
1N/A print OUT $t,
"die(\"",
quotemeta($
1),
"\");\n";
1N/A print OUT $t,
"warn(\"",
quotemeta($
1),
"\");\n";
1N/A until(/\{[^}]*\}.*;/ || /;/) {
1N/A # drop "#define FOO FOO" in enums 1N/A $
next =~ s/^\s*
#\s*define\s+(\w+)\s+\1\s*$//; 1N/A s/
#\s*if.*?#\s*endif//g; # drop #ifdefs 1N/A "eval(\"\\n#line $eval_index $outfile\\n",
1N/A "sub $enum_name () \{ $enum_val; \}\") ",
1N/A "unless defined(\&$enum_name);\n");
1N/A "eval(\"sub $enum_name () \{ $enum_val; \}\") ",
1N/A "unless defined(\&$enum_name);\n");
1N/A warn "Was unable to convert the following files:\n";
1N/A s/^\&\&// &&
do { $
new .=
" &&";
next;};
# handle && operator 1N/A s/^\&([\(a-z\)]+)/$
1/i;
# hack for things that take the address of 1N/A s/^(\s+)// &&
do {$
new .=
' ';
next;};
1N/A # Croak if nv_preserves_uv_bits < 64 ? 1N/A 2**
32 *
hex(
substr($
hex,
0, -
8));
1N/A # The above will produce "errorneus" code 1N/A # if the hex constant was e.g. inside UINT64_C 1N/A # macro, but then again, h2ph is an approximation. 1N/A s/^(-?\d+\.\d+E[-+]?\d+)[
FL]?//i &&
do {$
new .= $
1;
next;};
1N/A s/^(\d+)\s*[
LU]*//i &&
do {$
new .= $
1;
next;};
1N/A s/^(
"(\\"|[^
"])*")// &&
do {$
new .= $
1;
next;};
1N/A s/^
'((\\"|[^"])*)'// &&
do {
1N/A # replace "sizeof(foo)" with "{foo}" 1N/A # also, remove * (C dereference operator) to avoid perl syntax 1N/A # problems. Where the %sizeof array comes from is anyone's 1N/A # guess (c2ph?), but this at least avoids fatal syntax errors. 1N/A # Behavior is undefined if sizeof() delimiters are unbalanced. 1N/A # This code was modified to able to handle constructs like this: 1N/A # sizeof(*(p)), which appear in the HP-UX 10.01 header files. 1N/A my $
lvl =
1;
# already saw one open paren 1N/A # tack { on the front, and skip it in the loop 1N/A # find balanced closing paren 1N/A # tack } on the end, replacing ) 1N/A # remove pesky * operators within the sizeof argument 1N/A # Eliminate typedefs 1N/A /\(([\w\s]+)[\*\s]*\)\s*[\w\(]/ &&
do {
1N/A foreach (
split /\s+/, $
1) {
# Make sure all the words are types, 1N/A last unless ($
isatype{$_}
or $_
eq 'struct' or $_
eq 'union');
1N/A s/\([\w\s]+[\*\s]*\)// &&
next;
# then eliminate them. 1N/A s/^([
_A-Z]\w*(\[[^\]]+\])?((\.|->)[
_A-Z]\w*(\[[^\]]+\])?)+)//i &&
do {
1N/A $
id =~ s/(\.|(->))([^\.\-]*)/->\{$
3\}/g;
1N/A while($
id =~ /\[\s*([^\$\&\d\]]+)\]/) {
1N/A if ($
id eq 'struct' || $
id eq 'union') {
1N/A while (s/^\s+(\w+)//) { $
id .=
' ' . $
1; }
1N/A }
elsif ($
id eq 'defined') {
1N/A }
elsif (/^\s*\(/) {
1N/A s/^\s*\((\w),/(
"$1",/
if $
id =~ /^
_IO[
WR]*$/i;
# cheat 1N/A }
elsif ($
new =~ /\(\s*$/ && /^[\s*]*\)/) {
1N/A $
new .=
'(defined(&' . $
id .
') ? &' . $
id .
' : 0)';
1N/A s/^(.)// &&
do {
if ($
1 ne '#') { $
new .= $
1; }
next;};
1N/A # Preprocess all tri-graphs 1N/A # including things stuck in quoted string constants. 1N/A $
in =~ s/\?\?=/
#/g; # | ??=| #| 1N/A $
in =~ s/\?\?\!/|/g;
# | ??!| || 1N/A $
in =~ s/\?\?
'/^/g; # | ??'| ^|
1N/A $
in =~ s/\?\?\(/[/g;
# | ??(| [| 1N/A $
in =~ s/\?\?\)/]/g;
# | ??)| ]| 1N/A $
in =~ s/\?\?\-/~/g;
# | ??-| ~| 1N/A $
in =~ s/\?\?\//\\/g;
# | ??/| \| 1N/A $
in =~ s/\?\?</{/g;
# | ??<| {| 1N/A $
in =~ s/\?\?>/}/g;
# | ??>| }| 1N/A if ($
in =~ /^\
#ifdef __LANGUAGE_PASCAL__/) { 1N/A # Tru64 disassembler.h evilness: mixed C and Pascal. 1N/A $^O
eq 'linux' && $
file =~ m!(?:^|/)
asm/[^/]+\.h$!) {
1N/A if ($
in =~ s/\\$//) {
# \-newline 1N/A }
elsif ($
in =~ s/^([^
"'\\\/]+)//) { # Passthrough 1N/A }
elsif ($
in =~ s/^(\\.)//) {
# \... 1N/A }
elsif ($
in =~ /^
'/) { # '...
1N/A if ($
in =~ s/^(
'(\\.|[^'\\])*
')//) { 1N/A }
elsif ($
in =~ /^
"/) { # "...
1N/A if ($
in =~ s/^(
"(\\.|[^"\\])*
")//) { 1N/A }
elsif ($
in =~ s/^\/\/.*//) {
# //... 1N/A }
elsif ($
in =~ m/^\/\*/) {
# /*... 1N/A # C comment removal adapted from perlfaq6: 1N/A if ($
in =~ s/^\/\*[^*]*\*+([^\/*][^*]*\*+)*\///) {
1N/A }
else {
# Incomplete /* */ 1N/A }
elsif ($
in =~ s/^(\/)//) {
# /... 1N/A }
elsif ($
in =~ s/^([^\
'\"\\\/]+)//) { 1N/A }
elsif ($^O
eq 'linux' &&
1N/A warn "Cannot parse $file:\n$in\n";
1N/A die "Cannot parse:\n$in\n";
1N/A# Handle recursive subdirectories without getting a grotesquely big stack. 1N/A# Could this be implemented using File::Find? 1N/A print STDERR "Skipping `$file': not a file or directory\n";
1N/A# Put all the files in $directory into @ARGV for processing. 1N/A next if ($_
eq '.' or $_
eq '..');
1N/A # expand_glob() is going to be called until $ARGV[0] isn't a 1N/A # directory; so push directories, and unshift everything else. 1N/A if (-d
"$directory/$_") {
push @
ARGV,
"$directory/$_" }
1N/A else {
unshift @
ARGV,
"$directory/$_" }
1N/A# Given $file, a symbolic link to a directory in the C include directory, 1N/A# make an equivalent symbolic link in $Dest_dir, if we can figure out how. 1N/A# Otherwise, just duplicate the file or directory. 1N/A # The target of a parent or absolute link could leave the $Dest_dir 1N/A # hierarchy, so let's put all of the contents of $dirlink (actually, 1N/A # the contents of $target) into @ARGV; as a side effect down the 1N/A # line, $dirlink will get created as an _actual_ directory. 1N/A if (-l
"$Dest_dir/$dirlink") {
1N/A unlink "$Dest_dir/$dirlink" or 1N/A print STDERR "Could not remove link $Dest_dir/$dirlink: $!\n";
1N/A if (
eval 'symlink($target, "$Dest_dir/$dirlink")') {
1N/A print "Linking $target -> $Dest_dir/$dirlink\n";
1N/A # Make sure that the link _links_ to something: 1N/A if (! -e
"$Dest_dir/$target") {
1N/A print STDERR "Could not create $Dest_dir/$target/\n";
1N/A print STDERR "Could not symlink $target -> $Dest_dir/$dirlink: $!\n";
1N/A# Push all #included files in $file onto our stack, except for STDIN 1N/A# and files we've already processed. 1N/A while (/\\$/) {
# Handle continuation lines 1N/A if ($
line =~ /^
#\s*include\s+<(.*?)>/) { 1N/A# Determine include directories; $Config{usrinc} should be enough for (all 1N/A# non-GCC?) C compilers, but gcc uses an additional include directory. 1N/A# Create "_h2ph_pre.ph", if it doesn't exist or was built by a different 1N/A # Increment $VERSION every time this function is modified: 1N/A # Can we skip building the preamble file? 1N/A # Extract version number from first line of preamble: 1N/A # Don't build preamble if a compatible preamble exists: 1N/A open PREAMBLE,
">$preamble" or die "Cannot open $preamble: $!";
1N/A print PREAMBLE "# This file was created by h2ph version $VERSION\n";
1N/A "unless (defined &$_) { sub $_() { $1 } }\n\n";
1N/A "unless (defined &$_) { sub $_() { &$define{$_} } }\n\n";
1N/A "unless (defined &$_) { sub $_() { \"",
1N/A# %Config contains information on macros that are pre-defined by the 1N/A# system's compiler. We need this information to make the .ph files 1N/A# function with perl as the .h files do with cc. 1N/A @
Config{
'ccsymbols',
'cppsymbols',
'cppccsymbols'};
1N/A # Split compiler pre-definitions into `key=value' pairs: 1N/A############################################################################## 1N/Ah2ph - convert .h C header files to .ph Perl header files 1N/AB<h2ph [-d destination directory] [-r | -a] [-l] [headerfiles]> 1N/Aconverts any C header files specified to the corresponding Perl header file 1N/AThe output files are placed in the hierarchy rooted at Perl's 1N/Aarchitecture dependent library directory. You can specify a different 1N/Ahierarchy with a B<-d> switch. 1N/AIf run with no arguments, filters standard input to standard output. 1N/A=item -d destination_dir 1N/APut the resulting B<.ph> files beneath B<destination_dir>, instead of 1N/Abeneath the default Perl library location (C<$Config{'installsitsearch'}>). 1N/ARun recursively; if any of B<headerfiles> are directories, then run I<h2ph> 1N/Aon all files in those directories (and their subdirectories, etc.). B<-r> 1N/Aand B<-a> are mutually exclusive. 1N/ARun automagically; convert B<headerfiles>, as well as any B<.h> files 1N/Awhich they include. This option will search for B<.h> files in all 1N/Adirectories which your C compiler ordinarily uses. B<-a> and B<-r> are 1N/ASymbolic links will be replicated in the destination directory. If B<-l> 1N/Ais not specified, then links are skipped over. 1N/APut ``hints'' in the .ph files which will help in locating problems with 1N/AI<h2ph>. In those cases when you B<require> a B<.ph> file containing syntax 1N/Aerrors, instead of the cryptic 1N/A [ some error condition ] at (eval mmm) line nnn 1N/Ayou will see the slightly more helpful 1N/A [ some error condition ] at filename.ph line nnn 1N/AHowever, the B<.ph> files almost double in size when built using B<-h>. 1N/AInclude the code from the B<.h> file as a comment in the B<.ph> file. 1N/AThis is primarily used for debugging I<h2ph>. 1N/A``Quiet'' mode; don't print out the names of the files being converted. 1N/ANo environment variables are used. 1N/AThe usual warnings if it can't read or write the files involved. 1N/ADoesn't construct the %sizeof array for you. 1N/AIt doesn't handle all C constructs, but it does attempt to isolate 1N/Adefinitions inside evals so that you can get at the definitions 1N/Athat it can translate. 1N/AIt's only intended as a rough tool. 1N/AYou may need to dicker with the files produced. 1N/AYou have to run this program by hand; it's not run as part of the Perl 1N/ADoesn't handle complicated expressions built piecemeal, a la: 1N/ADoesn't necessarily locate all of your C compiler's internally-defined 1N/Aclose OUT or die "Can't close $file: $!";
1N/Achmod 0755, $
file or die "Can't reset permissions for $file: $!\n";
1N/Aexec(
"$Config{'eunicefix'} $file")
if $
Config{
'eunicefix'}
ne ':';