1*0Sstevel@tonic-gate#!/usr/local/bin/perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateuse Config; 4*0Sstevel@tonic-gateuse File::Basename qw(basename dirname); 5*0Sstevel@tonic-gateuse Cwd; 6*0Sstevel@tonic-gate 7*0Sstevel@tonic-gate# List explicitly here the variables you want Configure to 8*0Sstevel@tonic-gate# generate. Metaconfig only looks for shell variables, so you 9*0Sstevel@tonic-gate# have to mention them as if they were shell variables, not 10*0Sstevel@tonic-gate# %Config entries. Thus you write 11*0Sstevel@tonic-gate# $startperl 12*0Sstevel@tonic-gate# to ensure Configure will look for $Config{startperl}. 13*0Sstevel@tonic-gate# Wanted: $archlibexp 14*0Sstevel@tonic-gate 15*0Sstevel@tonic-gate# This forces PL files to create target in same directory as PL file. 16*0Sstevel@tonic-gate# This is so that make depend always knows where to find PL derivatives. 17*0Sstevel@tonic-gate$origdir = cwd; 18*0Sstevel@tonic-gatechdir dirname($0); 19*0Sstevel@tonic-gate$file = basename($0, '.PL'); 20*0Sstevel@tonic-gate$file .= '.com' if $^O eq 'VMS'; 21*0Sstevel@tonic-gate 22*0Sstevel@tonic-gateopen OUT,">$file" or die "Can't create $file: $!"; 23*0Sstevel@tonic-gate 24*0Sstevel@tonic-gateprint "Extracting $file (with variable substitutions)\n"; 25*0Sstevel@tonic-gate 26*0Sstevel@tonic-gate# In this section, perl variables will be expanded during extraction. 27*0Sstevel@tonic-gate# You can use $Config{...} to use Configure variables. 28*0Sstevel@tonic-gate 29*0Sstevel@tonic-gateprint OUT <<"!GROK!THIS!"; 30*0Sstevel@tonic-gate$Config{startperl} 31*0Sstevel@tonic-gate eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' 32*0Sstevel@tonic-gate if \$running_under_some_shell; 33*0Sstevel@tonic-gate!GROK!THIS! 34*0Sstevel@tonic-gate 35*0Sstevel@tonic-gate# In the following, perl variables are not expanded during extraction. 36*0Sstevel@tonic-gate 37*0Sstevel@tonic-gateprint OUT <<'!NO!SUBS!'; 38*0Sstevel@tonic-gate 39*0Sstevel@tonic-gateuse strict; 40*0Sstevel@tonic-gate 41*0Sstevel@tonic-gateuse Config; 42*0Sstevel@tonic-gateuse File::Path qw(mkpath); 43*0Sstevel@tonic-gateuse Getopt::Std; 44*0Sstevel@tonic-gate 45*0Sstevel@tonic-gate# Make sure read permissions for all are set: 46*0Sstevel@tonic-gateif (defined umask && (umask() & 0444)) { 47*0Sstevel@tonic-gate umask (umask() & ~0444); 48*0Sstevel@tonic-gate} 49*0Sstevel@tonic-gate 50*0Sstevel@tonic-gategetopts('Dd:rlhaQe'); 51*0Sstevel@tonic-gateuse vars qw($opt_D $opt_d $opt_r $opt_l $opt_h $opt_a $opt_Q $opt_e); 52*0Sstevel@tonic-gatedie "-r and -a options are mutually exclusive\n" if ($opt_r and $opt_a); 53*0Sstevel@tonic-gatemy @inc_dirs = inc_dirs() if $opt_a; 54*0Sstevel@tonic-gate 55*0Sstevel@tonic-gatemy $Exit = 0; 56*0Sstevel@tonic-gate 57*0Sstevel@tonic-gatemy $Dest_dir = $opt_d || $Config{installsitearch}; 58*0Sstevel@tonic-gatedie "Destination directory $Dest_dir doesn't exist or isn't a directory\n" 59*0Sstevel@tonic-gate unless -d $Dest_dir; 60*0Sstevel@tonic-gate 61*0Sstevel@tonic-gatemy @isatype = split(' ',<<END); 62*0Sstevel@tonic-gate char uchar u_char 63*0Sstevel@tonic-gate short ushort u_short 64*0Sstevel@tonic-gate int uint u_int 65*0Sstevel@tonic-gate long ulong u_long 66*0Sstevel@tonic-gate FILE key_t caddr_t 67*0Sstevel@tonic-gateEND 68*0Sstevel@tonic-gate 69*0Sstevel@tonic-gatemy %isatype; 70*0Sstevel@tonic-gate@isatype{@isatype} = (1) x @isatype; 71*0Sstevel@tonic-gatemy $inif = 0; 72*0Sstevel@tonic-gatemy %Is_converted; 73*0Sstevel@tonic-gatemy %bad_file = (); 74*0Sstevel@tonic-gate 75*0Sstevel@tonic-gate@ARGV = ('-') unless @ARGV; 76*0Sstevel@tonic-gate 77*0Sstevel@tonic-gatebuild_preamble_if_necessary(); 78*0Sstevel@tonic-gate 79*0Sstevel@tonic-gatesub reindent($) { 80*0Sstevel@tonic-gate my($text) = shift; 81*0Sstevel@tonic-gate $text =~ s/\n/\n /g; 82*0Sstevel@tonic-gate $text =~ s/ /\t/g; 83*0Sstevel@tonic-gate $text; 84*0Sstevel@tonic-gate} 85*0Sstevel@tonic-gate 86*0Sstevel@tonic-gatemy ($t, $tab, %curargs, $new, $eval_index, $dir, $name, $args, $outfile); 87*0Sstevel@tonic-gatemy ($incl, $incl_type, $next); 88*0Sstevel@tonic-gatewhile (defined (my $file = next_file())) { 89*0Sstevel@tonic-gate if (-l $file and -d $file) { 90*0Sstevel@tonic-gate link_if_possible($file) if ($opt_l); 91*0Sstevel@tonic-gate next; 92*0Sstevel@tonic-gate } 93*0Sstevel@tonic-gate 94*0Sstevel@tonic-gate # Recover from header files with unbalanced cpp directives 95*0Sstevel@tonic-gate $t = ''; 96*0Sstevel@tonic-gate $tab = 0; 97*0Sstevel@tonic-gate 98*0Sstevel@tonic-gate # $eval_index goes into ``#line'' directives, to help locate syntax errors: 99*0Sstevel@tonic-gate $eval_index = 1; 100*0Sstevel@tonic-gate 101*0Sstevel@tonic-gate if ($file eq '-') { 102*0Sstevel@tonic-gate open(IN, "-"); 103*0Sstevel@tonic-gate open(OUT, ">-"); 104*0Sstevel@tonic-gate } else { 105*0Sstevel@tonic-gate ($outfile = $file) =~ s/\.h$/.ph/ || next; 106*0Sstevel@tonic-gate print "$file -> $outfile\n" unless $opt_Q; 107*0Sstevel@tonic-gate if ($file =~ m|^(.*)/|) { 108*0Sstevel@tonic-gate $dir = $1; 109*0Sstevel@tonic-gate mkpath "$Dest_dir/$dir"; 110*0Sstevel@tonic-gate } 111*0Sstevel@tonic-gate 112*0Sstevel@tonic-gate if ($opt_a) { # automagic mode: locate header file in @inc_dirs 113*0Sstevel@tonic-gate foreach (@inc_dirs) { 114*0Sstevel@tonic-gate chdir $_; 115*0Sstevel@tonic-gate last if -f $file; 116*0Sstevel@tonic-gate } 117*0Sstevel@tonic-gate } 118*0Sstevel@tonic-gate 119*0Sstevel@tonic-gate open(IN,"$file") || (($Exit = 1),(warn "Can't open $file: $!\n"),next); 120*0Sstevel@tonic-gate open(OUT,">$Dest_dir/$outfile") || die "Can't create $outfile: $!\n"; 121*0Sstevel@tonic-gate } 122*0Sstevel@tonic-gate 123*0Sstevel@tonic-gate print OUT 124*0Sstevel@tonic-gate "require '_h2ph_pre.ph';\n\n", 125*0Sstevel@tonic-gate "no warnings 'redefine';\n\n"; 126*0Sstevel@tonic-gate 127*0Sstevel@tonic-gate while (defined (local $_ = next_line($file))) { 128*0Sstevel@tonic-gate if (s/^\s*\#\s*//) { 129*0Sstevel@tonic-gate if (s/^define\s+(\w+)//) { 130*0Sstevel@tonic-gate $name = $1; 131*0Sstevel@tonic-gate $new = ''; 132*0Sstevel@tonic-gate s/\s+$//; 133*0Sstevel@tonic-gate s/\(\w+\s*\(\*\)\s*\(\w*\)\)\s*(-?\d+)/$1/; # (int (*)(foo_t))0 134*0Sstevel@tonic-gate if (s/^\(([\w,\s]*)\)//) { 135*0Sstevel@tonic-gate $args = $1; 136*0Sstevel@tonic-gate my $proto = '() '; 137*0Sstevel@tonic-gate if ($args ne '') { 138*0Sstevel@tonic-gate $proto = ''; 139*0Sstevel@tonic-gate foreach my $arg (split(/,\s*/,$args)) { 140*0Sstevel@tonic-gate $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/; 141*0Sstevel@tonic-gate $curargs{$arg} = 1; 142*0Sstevel@tonic-gate } 143*0Sstevel@tonic-gate $args =~ s/\b(\w)/\$$1/g; 144*0Sstevel@tonic-gate $args = "local($args) = \@_;\n$t "; 145*0Sstevel@tonic-gate } 146*0Sstevel@tonic-gate s/^\s+//; 147*0Sstevel@tonic-gate expr(); 148*0Sstevel@tonic-gate $new =~ s/(["\\])/\\$1/g; #"]); 149*0Sstevel@tonic-gate $new = reindent($new); 150*0Sstevel@tonic-gate $args = reindent($args); 151*0Sstevel@tonic-gate if ($t ne '') { 152*0Sstevel@tonic-gate $new =~ s/(['\\])/\\$1/g; #']); 153*0Sstevel@tonic-gate if ($opt_h) { 154*0Sstevel@tonic-gate print OUT $t, 155*0Sstevel@tonic-gate "eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name $proto\{\n$t ${args}eval q($new);\n$t}' unless defined(\&$name);\n"; 156*0Sstevel@tonic-gate $eval_index++; 157*0Sstevel@tonic-gate } else { 158*0Sstevel@tonic-gate print OUT $t, 159*0Sstevel@tonic-gate "eval 'sub $name $proto\{\n$t ${args}eval q($new);\n$t}' unless defined(\&$name);\n"; 160*0Sstevel@tonic-gate } 161*0Sstevel@tonic-gate } else { 162*0Sstevel@tonic-gate print OUT "unless(defined(\&$name)) {\n sub $name $proto\{\n\t${args}eval q($new);\n }\n}\n"; 163*0Sstevel@tonic-gate } 164*0Sstevel@tonic-gate %curargs = (); 165*0Sstevel@tonic-gate } else { 166*0Sstevel@tonic-gate s/^\s+//; 167*0Sstevel@tonic-gate expr(); 168*0Sstevel@tonic-gate $new = 1 if $new eq ''; 169*0Sstevel@tonic-gate $new = reindent($new); 170*0Sstevel@tonic-gate $args = reindent($args); 171*0Sstevel@tonic-gate if ($t ne '') { 172*0Sstevel@tonic-gate $new =~ s/(['\\])/\\$1/g; #']); 173*0Sstevel@tonic-gate 174*0Sstevel@tonic-gate if ($opt_h) { 175*0Sstevel@tonic-gate print OUT $t,"eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name () {",$new,";}' unless defined(\&$name);\n"; 176*0Sstevel@tonic-gate $eval_index++; 177*0Sstevel@tonic-gate } else { 178*0Sstevel@tonic-gate print OUT $t,"eval 'sub $name () {",$new,";}' unless defined(\&$name);\n"; 179*0Sstevel@tonic-gate } 180*0Sstevel@tonic-gate } else { 181*0Sstevel@tonic-gate # Shunt around such directives as `#define FOO FOO': 182*0Sstevel@tonic-gate next if " \&$name" eq $new; 183*0Sstevel@tonic-gate 184*0Sstevel@tonic-gate print OUT $t,"unless(defined(\&$name)) {\n sub $name () {\t",$new,";}\n}\n"; 185*0Sstevel@tonic-gate } 186*0Sstevel@tonic-gate } 187*0Sstevel@tonic-gate } elsif (/^(include|import|include_next)\s*[<\"](.*)[>\"]/) { 188*0Sstevel@tonic-gate $incl_type = $1; 189*0Sstevel@tonic-gate $incl = $2; 190*0Sstevel@tonic-gate if (($incl_type eq 'include_next') || 191*0Sstevel@tonic-gate ($opt_e && exists($bad_file{$incl}))) { 192*0Sstevel@tonic-gate $incl =~ s/\.h$/.ph/; 193*0Sstevel@tonic-gate print OUT ($t, 194*0Sstevel@tonic-gate "eval {\n"); 195*0Sstevel@tonic-gate $tab += 4; 196*0Sstevel@tonic-gate $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); 197*0Sstevel@tonic-gate print OUT ($t, "my(\@REM);\n"); 198*0Sstevel@tonic-gate if ($incl_type eq 'include_next') { 199*0Sstevel@tonic-gate print OUT ($t, 200*0Sstevel@tonic-gate "my(\%INCD) = map { \$INC{\$_} => 1 } ", 201*0Sstevel@tonic-gate "(grep { \$_ eq \"$incl\" } ", 202*0Sstevel@tonic-gate "keys(\%INC));\n"); 203*0Sstevel@tonic-gate print OUT ($t, 204*0Sstevel@tonic-gate "\@REM = map { \"\$_/$incl\" } ", 205*0Sstevel@tonic-gate "(grep { not exists(\$INCD{\"\$_/$incl\"})", 206*0Sstevel@tonic-gate " and -f \"\$_/$incl\" } \@INC);\n"); 207*0Sstevel@tonic-gate } else { 208*0Sstevel@tonic-gate print OUT ($t, 209*0Sstevel@tonic-gate "\@REM = map { \"\$_/$incl\" } ", 210*0Sstevel@tonic-gate "(grep {-r \"\$_/$incl\" } \@INC);\n"); 211*0Sstevel@tonic-gate } 212*0Sstevel@tonic-gate print OUT ($t, 213*0Sstevel@tonic-gate "require \"\$REM[0]\" if \@REM;\n"); 214*0Sstevel@tonic-gate $tab -= 4; 215*0Sstevel@tonic-gate $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); 216*0Sstevel@tonic-gate print OUT ($t, 217*0Sstevel@tonic-gate "};\n"); 218*0Sstevel@tonic-gate print OUT ($t, 219*0Sstevel@tonic-gate "warn(\$\@) if \$\@;\n"); 220*0Sstevel@tonic-gate } else { 221*0Sstevel@tonic-gate $incl =~ s/\.h$/.ph/; 222*0Sstevel@tonic-gate print OUT $t,"require '$incl';\n"; 223*0Sstevel@tonic-gate } 224*0Sstevel@tonic-gate } elsif (/^ifdef\s+(\w+)/) { 225*0Sstevel@tonic-gate print OUT $t,"if(defined(&$1)) {\n"; 226*0Sstevel@tonic-gate $tab += 4; 227*0Sstevel@tonic-gate $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); 228*0Sstevel@tonic-gate } elsif (/^ifndef\s+(\w+)/) { 229*0Sstevel@tonic-gate print OUT $t,"unless(defined(&$1)) {\n"; 230*0Sstevel@tonic-gate $tab += 4; 231*0Sstevel@tonic-gate $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); 232*0Sstevel@tonic-gate } elsif (s/^if\s+//) { 233*0Sstevel@tonic-gate $new = ''; 234*0Sstevel@tonic-gate $inif = 1; 235*0Sstevel@tonic-gate expr(); 236*0Sstevel@tonic-gate $inif = 0; 237*0Sstevel@tonic-gate print OUT $t,"if($new) {\n"; 238*0Sstevel@tonic-gate $tab += 4; 239*0Sstevel@tonic-gate $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); 240*0Sstevel@tonic-gate } elsif (s/^elif\s+//) { 241*0Sstevel@tonic-gate $new = ''; 242*0Sstevel@tonic-gate $inif = 1; 243*0Sstevel@tonic-gate expr(); 244*0Sstevel@tonic-gate $inif = 0; 245*0Sstevel@tonic-gate $tab -= 4; 246*0Sstevel@tonic-gate $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); 247*0Sstevel@tonic-gate print OUT $t,"}\n elsif($new) {\n"; 248*0Sstevel@tonic-gate $tab += 4; 249*0Sstevel@tonic-gate $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); 250*0Sstevel@tonic-gate } elsif (/^else/) { 251*0Sstevel@tonic-gate $tab -= 4; 252*0Sstevel@tonic-gate $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); 253*0Sstevel@tonic-gate print OUT $t,"} else {\n"; 254*0Sstevel@tonic-gate $tab += 4; 255*0Sstevel@tonic-gate $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); 256*0Sstevel@tonic-gate } elsif (/^endif/) { 257*0Sstevel@tonic-gate $tab -= 4; 258*0Sstevel@tonic-gate $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); 259*0Sstevel@tonic-gate print OUT $t,"}\n"; 260*0Sstevel@tonic-gate } elsif(/^undef\s+(\w+)/) { 261*0Sstevel@tonic-gate print OUT $t, "undef(&$1) if defined(&$1);\n"; 262*0Sstevel@tonic-gate } elsif(/^error\s+(".*")/) { 263*0Sstevel@tonic-gate print OUT $t, "die($1);\n"; 264*0Sstevel@tonic-gate } elsif(/^error\s+(.*)/) { 265*0Sstevel@tonic-gate print OUT $t, "die(\"", quotemeta($1), "\");\n"; 266*0Sstevel@tonic-gate } elsif(/^warning\s+(.*)/) { 267*0Sstevel@tonic-gate print OUT $t, "warn(\"", quotemeta($1), "\");\n"; 268*0Sstevel@tonic-gate } elsif(/^ident\s+(.*)/) { 269*0Sstevel@tonic-gate print OUT $t, "# $1\n"; 270*0Sstevel@tonic-gate } 271*0Sstevel@tonic-gate } elsif(/^\s*(typedef\s*)?enum\s*(\s+[a-zA-Z_]\w*\s*)?/) { 272*0Sstevel@tonic-gate until(/\{[^}]*\}.*;/ || /;/) { 273*0Sstevel@tonic-gate last unless defined ($next = next_line($file)); 274*0Sstevel@tonic-gate chomp $next; 275*0Sstevel@tonic-gate # drop "#define FOO FOO" in enums 276*0Sstevel@tonic-gate $next =~ s/^\s*#\s*define\s+(\w+)\s+\1\s*$//; 277*0Sstevel@tonic-gate $_ .= $next; 278*0Sstevel@tonic-gate print OUT "# $next\n" if $opt_D; 279*0Sstevel@tonic-gate } 280*0Sstevel@tonic-gate s/#\s*if.*?#\s*endif//g; # drop #ifdefs 281*0Sstevel@tonic-gate s@/\*.*?\*/@@g; 282*0Sstevel@tonic-gate s/\s+/ /g; 283*0Sstevel@tonic-gate next unless /^\s?(typedef\s?)?enum\s?([a-zA-Z_]\w*)?\s?\{(.*)\}\s?([a-zA-Z_]\w*)?\s?;/; 284*0Sstevel@tonic-gate (my $enum_subs = $3) =~ s/\s//g; 285*0Sstevel@tonic-gate my @enum_subs = split(/,/, $enum_subs); 286*0Sstevel@tonic-gate my $enum_val = -1; 287*0Sstevel@tonic-gate foreach my $enum (@enum_subs) { 288*0Sstevel@tonic-gate my ($enum_name, $enum_value) = $enum =~ /^([a-zA-Z_]\w*)(=.+)?$/; 289*0Sstevel@tonic-gate $enum_value =~ s/^=//; 290*0Sstevel@tonic-gate $enum_val = (length($enum_value) ? $enum_value : $enum_val + 1); 291*0Sstevel@tonic-gate if ($opt_h) { 292*0Sstevel@tonic-gate print OUT ($t, 293*0Sstevel@tonic-gate "eval(\"\\n#line $eval_index $outfile\\n", 294*0Sstevel@tonic-gate "sub $enum_name () \{ $enum_val; \}\") ", 295*0Sstevel@tonic-gate "unless defined(\&$enum_name);\n"); 296*0Sstevel@tonic-gate ++ $eval_index; 297*0Sstevel@tonic-gate } else { 298*0Sstevel@tonic-gate print OUT ($t, 299*0Sstevel@tonic-gate "eval(\"sub $enum_name () \{ $enum_val; \}\") ", 300*0Sstevel@tonic-gate "unless defined(\&$enum_name);\n"); 301*0Sstevel@tonic-gate } 302*0Sstevel@tonic-gate } 303*0Sstevel@tonic-gate } 304*0Sstevel@tonic-gate } 305*0Sstevel@tonic-gate $Is_converted{$file} = 1; 306*0Sstevel@tonic-gate if ($opt_e && exists($bad_file{$file})) { 307*0Sstevel@tonic-gate unlink($Dest_dir . '/' . $outfile); 308*0Sstevel@tonic-gate $next = ''; 309*0Sstevel@tonic-gate } else { 310*0Sstevel@tonic-gate print OUT "1;\n"; 311*0Sstevel@tonic-gate queue_includes_from($file) if ($opt_a); 312*0Sstevel@tonic-gate } 313*0Sstevel@tonic-gate} 314*0Sstevel@tonic-gate 315*0Sstevel@tonic-gateif ($opt_e && (scalar(keys %bad_file) > 0)) { 316*0Sstevel@tonic-gate warn "Was unable to convert the following files:\n"; 317*0Sstevel@tonic-gate warn "\t" . join("\n\t",sort(keys %bad_file)) . "\n"; 318*0Sstevel@tonic-gate} 319*0Sstevel@tonic-gate 320*0Sstevel@tonic-gateexit $Exit; 321*0Sstevel@tonic-gate 322*0Sstevel@tonic-gatesub expr { 323*0Sstevel@tonic-gate my $joined_args; 324*0Sstevel@tonic-gate if(keys(%curargs)) { 325*0Sstevel@tonic-gate $joined_args = join('|', keys(%curargs)); 326*0Sstevel@tonic-gate } 327*0Sstevel@tonic-gate while ($_ ne '') { 328*0Sstevel@tonic-gate s/^\&\&// && do { $new .= " &&"; next;}; # handle && operator 329*0Sstevel@tonic-gate s/^\&([\(a-z\)]+)/$1/i; # hack for things that take the address of 330*0Sstevel@tonic-gate s/^(\s+)// && do {$new .= ' '; next;}; 331*0Sstevel@tonic-gate s/^0X([0-9A-F]+)[UL]*//i 332*0Sstevel@tonic-gate && do {my $hex = $1; 333*0Sstevel@tonic-gate $hex =~ s/^0+//; 334*0Sstevel@tonic-gate if (length $hex > 8 && !$Config{use64bitint}) { 335*0Sstevel@tonic-gate # Croak if nv_preserves_uv_bits < 64 ? 336*0Sstevel@tonic-gate $new .= hex(substr($hex, -8)) + 337*0Sstevel@tonic-gate 2**32 * hex(substr($hex, 0, -8)); 338*0Sstevel@tonic-gate # The above will produce "errorneus" code 339*0Sstevel@tonic-gate # if the hex constant was e.g. inside UINT64_C 340*0Sstevel@tonic-gate # macro, but then again, h2ph is an approximation. 341*0Sstevel@tonic-gate } else { 342*0Sstevel@tonic-gate $new .= lc("0x$hex"); 343*0Sstevel@tonic-gate } 344*0Sstevel@tonic-gate next;}; 345*0Sstevel@tonic-gate s/^(-?\d+\.\d+E[-+]?\d+)[FL]?//i && do {$new .= $1; next;}; 346*0Sstevel@tonic-gate s/^(\d+)\s*[LU]*//i && do {$new .= $1; next;}; 347*0Sstevel@tonic-gate s/^("(\\"|[^"])*")// && do {$new .= $1; next;}; 348*0Sstevel@tonic-gate s/^'((\\"|[^"])*)'// && do { 349*0Sstevel@tonic-gate if ($curargs{$1}) { 350*0Sstevel@tonic-gate $new .= "ord('\$$1')"; 351*0Sstevel@tonic-gate } else { 352*0Sstevel@tonic-gate $new .= "ord('$1')"; 353*0Sstevel@tonic-gate } 354*0Sstevel@tonic-gate next; 355*0Sstevel@tonic-gate }; 356*0Sstevel@tonic-gate # replace "sizeof(foo)" with "{foo}" 357*0Sstevel@tonic-gate # also, remove * (C dereference operator) to avoid perl syntax 358*0Sstevel@tonic-gate # problems. Where the %sizeof array comes from is anyone's 359*0Sstevel@tonic-gate # guess (c2ph?), but this at least avoids fatal syntax errors. 360*0Sstevel@tonic-gate # Behavior is undefined if sizeof() delimiters are unbalanced. 361*0Sstevel@tonic-gate # This code was modified to able to handle constructs like this: 362*0Sstevel@tonic-gate # sizeof(*(p)), which appear in the HP-UX 10.01 header files. 363*0Sstevel@tonic-gate s/^sizeof\s*\(// && do { 364*0Sstevel@tonic-gate $new .= '$sizeof'; 365*0Sstevel@tonic-gate my $lvl = 1; # already saw one open paren 366*0Sstevel@tonic-gate # tack { on the front, and skip it in the loop 367*0Sstevel@tonic-gate $_ = "{" . "$_"; 368*0Sstevel@tonic-gate my $index = 1; 369*0Sstevel@tonic-gate # find balanced closing paren 370*0Sstevel@tonic-gate while ($index <= length($_) && $lvl > 0) { 371*0Sstevel@tonic-gate $lvl++ if substr($_, $index, 1) eq "("; 372*0Sstevel@tonic-gate $lvl-- if substr($_, $index, 1) eq ")"; 373*0Sstevel@tonic-gate $index++; 374*0Sstevel@tonic-gate } 375*0Sstevel@tonic-gate # tack } on the end, replacing ) 376*0Sstevel@tonic-gate substr($_, $index - 1, 1) = "}"; 377*0Sstevel@tonic-gate # remove pesky * operators within the sizeof argument 378*0Sstevel@tonic-gate substr($_, 0, $index - 1) =~ s/\*//g; 379*0Sstevel@tonic-gate next; 380*0Sstevel@tonic-gate }; 381*0Sstevel@tonic-gate # Eliminate typedefs 382*0Sstevel@tonic-gate /\(([\w\s]+)[\*\s]*\)\s*[\w\(]/ && do { 383*0Sstevel@tonic-gate foreach (split /\s+/, $1) { # Make sure all the words are types, 384*0Sstevel@tonic-gate last unless ($isatype{$_} or $_ eq 'struct' or $_ eq 'union'); 385*0Sstevel@tonic-gate } 386*0Sstevel@tonic-gate s/\([\w\s]+[\*\s]*\)// && next; # then eliminate them. 387*0Sstevel@tonic-gate }; 388*0Sstevel@tonic-gate # struct/union member, including arrays: 389*0Sstevel@tonic-gate s/^([_A-Z]\w*(\[[^\]]+\])?((\.|->)[_A-Z]\w*(\[[^\]]+\])?)+)//i && do { 390*0Sstevel@tonic-gate my $id = $1; 391*0Sstevel@tonic-gate $id =~ s/(\.|(->))([^\.\-]*)/->\{$3\}/g; 392*0Sstevel@tonic-gate $id =~ s/\b([^\$])($joined_args)/$1\$$2/g if length($joined_args); 393*0Sstevel@tonic-gate while($id =~ /\[\s*([^\$\&\d\]]+)\]/) { 394*0Sstevel@tonic-gate my($index) = $1; 395*0Sstevel@tonic-gate $index =~ s/\s//g; 396*0Sstevel@tonic-gate if(exists($curargs{$index})) { 397*0Sstevel@tonic-gate $index = "\$$index"; 398*0Sstevel@tonic-gate } else { 399*0Sstevel@tonic-gate $index = "&$index"; 400*0Sstevel@tonic-gate } 401*0Sstevel@tonic-gate $id =~ s/\[\s*([^\$\&\d\]]+)\]/[$index]/; 402*0Sstevel@tonic-gate } 403*0Sstevel@tonic-gate $new .= " (\$$id)"; 404*0Sstevel@tonic-gate }; 405*0Sstevel@tonic-gate s/^([_a-zA-Z]\w*)// && do { 406*0Sstevel@tonic-gate my $id = $1; 407*0Sstevel@tonic-gate if ($id eq 'struct' || $id eq 'union') { 408*0Sstevel@tonic-gate s/^\s+(\w+)//; 409*0Sstevel@tonic-gate $id .= ' ' . $1; 410*0Sstevel@tonic-gate $isatype{$id} = 1; 411*0Sstevel@tonic-gate } elsif ($id =~ /^((un)?signed)|(long)|(short)$/) { 412*0Sstevel@tonic-gate while (s/^\s+(\w+)//) { $id .= ' ' . $1; } 413*0Sstevel@tonic-gate $isatype{$id} = 1; 414*0Sstevel@tonic-gate } 415*0Sstevel@tonic-gate if ($curargs{$id}) { 416*0Sstevel@tonic-gate $new .= "\$$id"; 417*0Sstevel@tonic-gate $new .= '->' if /^[\[\{]/; 418*0Sstevel@tonic-gate } elsif ($id eq 'defined') { 419*0Sstevel@tonic-gate $new .= 'defined'; 420*0Sstevel@tonic-gate } elsif (/^\s*\(/) { 421*0Sstevel@tonic-gate s/^\s*\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i; # cheat 422*0Sstevel@tonic-gate $new .= " &$id"; 423*0Sstevel@tonic-gate } elsif ($isatype{$id}) { 424*0Sstevel@tonic-gate if ($new =~ /{\s*$/) { 425*0Sstevel@tonic-gate $new .= "'$id'"; 426*0Sstevel@tonic-gate } elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) { 427*0Sstevel@tonic-gate $new =~ s/\(\s*$//; 428*0Sstevel@tonic-gate s/^[\s*]*\)//; 429*0Sstevel@tonic-gate } else { 430*0Sstevel@tonic-gate $new .= q(').$id.q('); 431*0Sstevel@tonic-gate } 432*0Sstevel@tonic-gate } else { 433*0Sstevel@tonic-gate if ($inif && $new !~ /defined\s*\($/) { 434*0Sstevel@tonic-gate $new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)'; 435*0Sstevel@tonic-gate } elsif (/^\[/) { 436*0Sstevel@tonic-gate $new .= " \$$id"; 437*0Sstevel@tonic-gate } else { 438*0Sstevel@tonic-gate $new .= ' &' . $id; 439*0Sstevel@tonic-gate } 440*0Sstevel@tonic-gate } 441*0Sstevel@tonic-gate next; 442*0Sstevel@tonic-gate }; 443*0Sstevel@tonic-gate s/^(.)// && do { if ($1 ne '#') { $new .= $1; } next;}; 444*0Sstevel@tonic-gate } 445*0Sstevel@tonic-gate} 446*0Sstevel@tonic-gate 447*0Sstevel@tonic-gate 448*0Sstevel@tonic-gatesub next_line 449*0Sstevel@tonic-gate{ 450*0Sstevel@tonic-gate my $file = shift; 451*0Sstevel@tonic-gate my ($in, $out); 452*0Sstevel@tonic-gate my $pre_sub_tri_graphs = 1; 453*0Sstevel@tonic-gate 454*0Sstevel@tonic-gate READ: while (not eof IN) { 455*0Sstevel@tonic-gate $in .= <IN>; 456*0Sstevel@tonic-gate chomp $in; 457*0Sstevel@tonic-gate next unless length $in; 458*0Sstevel@tonic-gate 459*0Sstevel@tonic-gate while (length $in) { 460*0Sstevel@tonic-gate if ($pre_sub_tri_graphs) { 461*0Sstevel@tonic-gate # Preprocess all tri-graphs 462*0Sstevel@tonic-gate # including things stuck in quoted string constants. 463*0Sstevel@tonic-gate $in =~ s/\?\?=/#/g; # | ??=| #| 464*0Sstevel@tonic-gate $in =~ s/\?\?\!/|/g; # | ??!| || 465*0Sstevel@tonic-gate $in =~ s/\?\?'/^/g; # | ??'| ^| 466*0Sstevel@tonic-gate $in =~ s/\?\?\(/[/g; # | ??(| [| 467*0Sstevel@tonic-gate $in =~ s/\?\?\)/]/g; # | ??)| ]| 468*0Sstevel@tonic-gate $in =~ s/\?\?\-/~/g; # | ??-| ~| 469*0Sstevel@tonic-gate $in =~ s/\?\?\//\\/g; # | ??/| \| 470*0Sstevel@tonic-gate $in =~ s/\?\?</{/g; # | ??<| {| 471*0Sstevel@tonic-gate $in =~ s/\?\?>/}/g; # | ??>| }| 472*0Sstevel@tonic-gate } 473*0Sstevel@tonic-gate if ($in =~ /^\#ifdef __LANGUAGE_PASCAL__/) { 474*0Sstevel@tonic-gate # Tru64 disassembler.h evilness: mixed C and Pascal. 475*0Sstevel@tonic-gate while (<IN>) { 476*0Sstevel@tonic-gate last if /^\#endif/; 477*0Sstevel@tonic-gate } 478*0Sstevel@tonic-gate next READ; 479*0Sstevel@tonic-gate } 480*0Sstevel@tonic-gate if ($in =~ /^extern inline / && # Inlined assembler. 481*0Sstevel@tonic-gate $^O eq 'linux' && $file =~ m!(?:^|/)asm/[^/]+\.h$!) { 482*0Sstevel@tonic-gate while (<IN>) { 483*0Sstevel@tonic-gate last if /^}/; 484*0Sstevel@tonic-gate } 485*0Sstevel@tonic-gate next READ; 486*0Sstevel@tonic-gate } 487*0Sstevel@tonic-gate if ($in =~ s/\\$//) { # \-newline 488*0Sstevel@tonic-gate $out .= ' '; 489*0Sstevel@tonic-gate next READ; 490*0Sstevel@tonic-gate } elsif ($in =~ s/^([^"'\\\/]+)//) { # Passthrough 491*0Sstevel@tonic-gate $out .= $1; 492*0Sstevel@tonic-gate } elsif ($in =~ s/^(\\.)//) { # \... 493*0Sstevel@tonic-gate $out .= $1; 494*0Sstevel@tonic-gate } elsif ($in =~ /^'/) { # '... 495*0Sstevel@tonic-gate if ($in =~ s/^('(\\.|[^'\\])*')//) { 496*0Sstevel@tonic-gate $out .= $1; 497*0Sstevel@tonic-gate } else { 498*0Sstevel@tonic-gate next READ; 499*0Sstevel@tonic-gate } 500*0Sstevel@tonic-gate } elsif ($in =~ /^"/) { # "... 501*0Sstevel@tonic-gate if ($in =~ s/^("(\\.|[^"\\])*")//) { 502*0Sstevel@tonic-gate $out .= $1; 503*0Sstevel@tonic-gate } else { 504*0Sstevel@tonic-gate next READ; 505*0Sstevel@tonic-gate } 506*0Sstevel@tonic-gate } elsif ($in =~ s/^\/\/.*//) { # //... 507*0Sstevel@tonic-gate # fall through 508*0Sstevel@tonic-gate } elsif ($in =~ m/^\/\*/) { # /*... 509*0Sstevel@tonic-gate # C comment removal adapted from perlfaq6: 510*0Sstevel@tonic-gate if ($in =~ s/^\/\*[^*]*\*+([^\/*][^*]*\*+)*\///) { 511*0Sstevel@tonic-gate $out .= ' '; 512*0Sstevel@tonic-gate } else { # Incomplete /* */ 513*0Sstevel@tonic-gate next READ; 514*0Sstevel@tonic-gate } 515*0Sstevel@tonic-gate } elsif ($in =~ s/^(\/)//) { # /... 516*0Sstevel@tonic-gate $out .= $1; 517*0Sstevel@tonic-gate } elsif ($in =~ s/^([^\'\"\\\/]+)//) { 518*0Sstevel@tonic-gate $out .= $1; 519*0Sstevel@tonic-gate } elsif ($^O eq 'linux' && 520*0Sstevel@tonic-gate $file =~ m!(?:^|/)linux/byteorder/pdp_endian\.h$! && 521*0Sstevel@tonic-gate $in =~ s!\'T KNOW!!) { 522*0Sstevel@tonic-gate $out =~ s!I DON$!I_DO_NOT_KNOW!; 523*0Sstevel@tonic-gate } else { 524*0Sstevel@tonic-gate if ($opt_e) { 525*0Sstevel@tonic-gate warn "Cannot parse $file:\n$in\n"; 526*0Sstevel@tonic-gate $bad_file{$file} = 1; 527*0Sstevel@tonic-gate $in = ''; 528*0Sstevel@tonic-gate $out = undef; 529*0Sstevel@tonic-gate last READ; 530*0Sstevel@tonic-gate } else { 531*0Sstevel@tonic-gate die "Cannot parse:\n$in\n"; 532*0Sstevel@tonic-gate } 533*0Sstevel@tonic-gate } 534*0Sstevel@tonic-gate } 535*0Sstevel@tonic-gate 536*0Sstevel@tonic-gate last READ if $out =~ /\S/; 537*0Sstevel@tonic-gate } 538*0Sstevel@tonic-gate 539*0Sstevel@tonic-gate return $out; 540*0Sstevel@tonic-gate} 541*0Sstevel@tonic-gate 542*0Sstevel@tonic-gate 543*0Sstevel@tonic-gate# Handle recursive subdirectories without getting a grotesquely big stack. 544*0Sstevel@tonic-gate# Could this be implemented using File::Find? 545*0Sstevel@tonic-gatesub next_file 546*0Sstevel@tonic-gate{ 547*0Sstevel@tonic-gate my $file; 548*0Sstevel@tonic-gate 549*0Sstevel@tonic-gate while (@ARGV) { 550*0Sstevel@tonic-gate $file = shift @ARGV; 551*0Sstevel@tonic-gate 552*0Sstevel@tonic-gate if ($file eq '-' or -f $file or -l $file) { 553*0Sstevel@tonic-gate return $file; 554*0Sstevel@tonic-gate } elsif (-d $file) { 555*0Sstevel@tonic-gate if ($opt_r) { 556*0Sstevel@tonic-gate expand_glob($file); 557*0Sstevel@tonic-gate } else { 558*0Sstevel@tonic-gate print STDERR "Skipping directory `$file'\n"; 559*0Sstevel@tonic-gate } 560*0Sstevel@tonic-gate } elsif ($opt_a) { 561*0Sstevel@tonic-gate return $file; 562*0Sstevel@tonic-gate } else { 563*0Sstevel@tonic-gate print STDERR "Skipping `$file': not a file or directory\n"; 564*0Sstevel@tonic-gate } 565*0Sstevel@tonic-gate } 566*0Sstevel@tonic-gate 567*0Sstevel@tonic-gate return undef; 568*0Sstevel@tonic-gate} 569*0Sstevel@tonic-gate 570*0Sstevel@tonic-gate 571*0Sstevel@tonic-gate# Put all the files in $directory into @ARGV for processing. 572*0Sstevel@tonic-gatesub expand_glob 573*0Sstevel@tonic-gate{ 574*0Sstevel@tonic-gate my ($directory) = @_; 575*0Sstevel@tonic-gate 576*0Sstevel@tonic-gate $directory =~ s:/$::; 577*0Sstevel@tonic-gate 578*0Sstevel@tonic-gate opendir DIR, $directory; 579*0Sstevel@tonic-gate foreach (readdir DIR) { 580*0Sstevel@tonic-gate next if ($_ eq '.' or $_ eq '..'); 581*0Sstevel@tonic-gate 582*0Sstevel@tonic-gate # expand_glob() is going to be called until $ARGV[0] isn't a 583*0Sstevel@tonic-gate # directory; so push directories, and unshift everything else. 584*0Sstevel@tonic-gate if (-d "$directory/$_") { push @ARGV, "$directory/$_" } 585*0Sstevel@tonic-gate else { unshift @ARGV, "$directory/$_" } 586*0Sstevel@tonic-gate } 587*0Sstevel@tonic-gate closedir DIR; 588*0Sstevel@tonic-gate} 589*0Sstevel@tonic-gate 590*0Sstevel@tonic-gate 591*0Sstevel@tonic-gate# Given $file, a symbolic link to a directory in the C include directory, 592*0Sstevel@tonic-gate# make an equivalent symbolic link in $Dest_dir, if we can figure out how. 593*0Sstevel@tonic-gate# Otherwise, just duplicate the file or directory. 594*0Sstevel@tonic-gatesub link_if_possible 595*0Sstevel@tonic-gate{ 596*0Sstevel@tonic-gate my ($dirlink) = @_; 597*0Sstevel@tonic-gate my $target = eval 'readlink($dirlink)'; 598*0Sstevel@tonic-gate 599*0Sstevel@tonic-gate if ($target =~ m:^\.\./: or $target =~ m:^/:) { 600*0Sstevel@tonic-gate # The target of a parent or absolute link could leave the $Dest_dir 601*0Sstevel@tonic-gate # hierarchy, so let's put all of the contents of $dirlink (actually, 602*0Sstevel@tonic-gate # the contents of $target) into @ARGV; as a side effect down the 603*0Sstevel@tonic-gate # line, $dirlink will get created as an _actual_ directory. 604*0Sstevel@tonic-gate expand_glob($dirlink); 605*0Sstevel@tonic-gate } else { 606*0Sstevel@tonic-gate if (-l "$Dest_dir/$dirlink") { 607*0Sstevel@tonic-gate unlink "$Dest_dir/$dirlink" or 608*0Sstevel@tonic-gate print STDERR "Could not remove link $Dest_dir/$dirlink: $!\n"; 609*0Sstevel@tonic-gate } 610*0Sstevel@tonic-gate 611*0Sstevel@tonic-gate if (eval 'symlink($target, "$Dest_dir/$dirlink")') { 612*0Sstevel@tonic-gate print "Linking $target -> $Dest_dir/$dirlink\n"; 613*0Sstevel@tonic-gate 614*0Sstevel@tonic-gate # Make sure that the link _links_ to something: 615*0Sstevel@tonic-gate if (! -e "$Dest_dir/$target") { 616*0Sstevel@tonic-gate mkpath("$Dest_dir/$target", 0755) or 617*0Sstevel@tonic-gate print STDERR "Could not create $Dest_dir/$target/\n"; 618*0Sstevel@tonic-gate } 619*0Sstevel@tonic-gate } else { 620*0Sstevel@tonic-gate print STDERR "Could not symlink $target -> $Dest_dir/$dirlink: $!\n"; 621*0Sstevel@tonic-gate } 622*0Sstevel@tonic-gate } 623*0Sstevel@tonic-gate} 624*0Sstevel@tonic-gate 625*0Sstevel@tonic-gate 626*0Sstevel@tonic-gate# Push all #included files in $file onto our stack, except for STDIN 627*0Sstevel@tonic-gate# and files we've already processed. 628*0Sstevel@tonic-gatesub queue_includes_from 629*0Sstevel@tonic-gate{ 630*0Sstevel@tonic-gate my ($file) = @_; 631*0Sstevel@tonic-gate my $line; 632*0Sstevel@tonic-gate 633*0Sstevel@tonic-gate return if ($file eq "-"); 634*0Sstevel@tonic-gate 635*0Sstevel@tonic-gate open HEADER, $file or return; 636*0Sstevel@tonic-gate while (defined($line = <HEADER>)) { 637*0Sstevel@tonic-gate while (/\\$/) { # Handle continuation lines 638*0Sstevel@tonic-gate chop $line; 639*0Sstevel@tonic-gate $line .= <HEADER>; 640*0Sstevel@tonic-gate } 641*0Sstevel@tonic-gate 642*0Sstevel@tonic-gate if ($line =~ /^#\s*include\s+<(.*?)>/) { 643*0Sstevel@tonic-gate push(@ARGV, $1) unless $Is_converted{$1}; 644*0Sstevel@tonic-gate } 645*0Sstevel@tonic-gate } 646*0Sstevel@tonic-gate close HEADER; 647*0Sstevel@tonic-gate} 648*0Sstevel@tonic-gate 649*0Sstevel@tonic-gate 650*0Sstevel@tonic-gate# Determine include directories; $Config{usrinc} should be enough for (all 651*0Sstevel@tonic-gate# non-GCC?) C compilers, but gcc uses an additional include directory. 652*0Sstevel@tonic-gatesub inc_dirs 653*0Sstevel@tonic-gate{ 654*0Sstevel@tonic-gate my $from_gcc = `$Config{cc} -v 2>&1`; 655*0Sstevel@tonic-gate $from_gcc =~ s:^Reading specs from (.*?)/specs\b.*:$1/include:s; 656*0Sstevel@tonic-gate 657*0Sstevel@tonic-gate length($from_gcc) ? ($from_gcc, $Config{usrinc}) : ($Config{usrinc}); 658*0Sstevel@tonic-gate} 659*0Sstevel@tonic-gate 660*0Sstevel@tonic-gate 661*0Sstevel@tonic-gate# Create "_h2ph_pre.ph", if it doesn't exist or was built by a different 662*0Sstevel@tonic-gate# version of h2ph. 663*0Sstevel@tonic-gatesub build_preamble_if_necessary 664*0Sstevel@tonic-gate{ 665*0Sstevel@tonic-gate # Increment $VERSION every time this function is modified: 666*0Sstevel@tonic-gate my $VERSION = 2; 667*0Sstevel@tonic-gate my $preamble = "$Dest_dir/_h2ph_pre.ph"; 668*0Sstevel@tonic-gate 669*0Sstevel@tonic-gate # Can we skip building the preamble file? 670*0Sstevel@tonic-gate if (-r $preamble) { 671*0Sstevel@tonic-gate # Extract version number from first line of preamble: 672*0Sstevel@tonic-gate open PREAMBLE, $preamble or die "Cannot open $preamble: $!"; 673*0Sstevel@tonic-gate my $line = <PREAMBLE>; 674*0Sstevel@tonic-gate $line =~ /(\b\d+\b)/; 675*0Sstevel@tonic-gate close PREAMBLE or die "Cannot close $preamble: $!"; 676*0Sstevel@tonic-gate 677*0Sstevel@tonic-gate # Don't build preamble if a compatible preamble exists: 678*0Sstevel@tonic-gate return if $1 == $VERSION; 679*0Sstevel@tonic-gate } 680*0Sstevel@tonic-gate 681*0Sstevel@tonic-gate my (%define) = _extract_cc_defines(); 682*0Sstevel@tonic-gate 683*0Sstevel@tonic-gate open PREAMBLE, ">$preamble" or die "Cannot open $preamble: $!"; 684*0Sstevel@tonic-gate print PREAMBLE "# This file was created by h2ph version $VERSION\n"; 685*0Sstevel@tonic-gate 686*0Sstevel@tonic-gate foreach (sort keys %define) { 687*0Sstevel@tonic-gate if ($opt_D) { 688*0Sstevel@tonic-gate print PREAMBLE "# $_=$define{$_}\n"; 689*0Sstevel@tonic-gate } 690*0Sstevel@tonic-gate 691*0Sstevel@tonic-gate if ($define{$_} =~ /^(\d+)U?L{0,2}$/i) { 692*0Sstevel@tonic-gate print PREAMBLE 693*0Sstevel@tonic-gate "unless (defined &$_) { sub $_() { $1 } }\n\n"; 694*0Sstevel@tonic-gate } elsif ($define{$_} =~ /^\w+$/) { 695*0Sstevel@tonic-gate print PREAMBLE 696*0Sstevel@tonic-gate "unless (defined &$_) { sub $_() { &$define{$_} } }\n\n"; 697*0Sstevel@tonic-gate } else { 698*0Sstevel@tonic-gate print PREAMBLE 699*0Sstevel@tonic-gate "unless (defined &$_) { sub $_() { \"", 700*0Sstevel@tonic-gate quotemeta($define{$_}), "\" } }\n\n"; 701*0Sstevel@tonic-gate } 702*0Sstevel@tonic-gate } 703*0Sstevel@tonic-gate close PREAMBLE or die "Cannot close $preamble: $!"; 704*0Sstevel@tonic-gate} 705*0Sstevel@tonic-gate 706*0Sstevel@tonic-gate 707*0Sstevel@tonic-gate# %Config contains information on macros that are pre-defined by the 708*0Sstevel@tonic-gate# system's compiler. We need this information to make the .ph files 709*0Sstevel@tonic-gate# function with perl as the .h files do with cc. 710*0Sstevel@tonic-gatesub _extract_cc_defines 711*0Sstevel@tonic-gate{ 712*0Sstevel@tonic-gate my %define; 713*0Sstevel@tonic-gate my $allsymbols = join " ", 714*0Sstevel@tonic-gate @Config{'ccsymbols', 'cppsymbols', 'cppccsymbols'}; 715*0Sstevel@tonic-gate 716*0Sstevel@tonic-gate # Split compiler pre-definitions into `key=value' pairs: 717*0Sstevel@tonic-gate foreach (split /\s+/, $allsymbols) { 718*0Sstevel@tonic-gate /(.+?)=(.+)/ and $define{$1} = $2; 719*0Sstevel@tonic-gate 720*0Sstevel@tonic-gate if ($opt_D) { 721*0Sstevel@tonic-gate print STDERR "$_: $1 -> $2\n"; 722*0Sstevel@tonic-gate } 723*0Sstevel@tonic-gate } 724*0Sstevel@tonic-gate 725*0Sstevel@tonic-gate return %define; 726*0Sstevel@tonic-gate} 727*0Sstevel@tonic-gate 728*0Sstevel@tonic-gate 729*0Sstevel@tonic-gate1; 730*0Sstevel@tonic-gate 731*0Sstevel@tonic-gate############################################################################## 732*0Sstevel@tonic-gate__END__ 733*0Sstevel@tonic-gate 734*0Sstevel@tonic-gate=head1 NAME 735*0Sstevel@tonic-gate 736*0Sstevel@tonic-gateh2ph - convert .h C header files to .ph Perl header files 737*0Sstevel@tonic-gate 738*0Sstevel@tonic-gate=head1 SYNOPSIS 739*0Sstevel@tonic-gate 740*0Sstevel@tonic-gateB<h2ph [-d destination directory] [-r | -a] [-l] [headerfiles]> 741*0Sstevel@tonic-gate 742*0Sstevel@tonic-gate=head1 DESCRIPTION 743*0Sstevel@tonic-gate 744*0Sstevel@tonic-gateI<h2ph> 745*0Sstevel@tonic-gateconverts any C header files specified to the corresponding Perl header file 746*0Sstevel@tonic-gateformat. 747*0Sstevel@tonic-gateIt is most easily run while in /usr/include: 748*0Sstevel@tonic-gate 749*0Sstevel@tonic-gate cd /usr/include; h2ph * sys/* 750*0Sstevel@tonic-gate 751*0Sstevel@tonic-gateor 752*0Sstevel@tonic-gate 753*0Sstevel@tonic-gate cd /usr/include; h2ph * sys/* arpa/* netinet/* 754*0Sstevel@tonic-gate 755*0Sstevel@tonic-gateor 756*0Sstevel@tonic-gate 757*0Sstevel@tonic-gate cd /usr/include; h2ph -r -l . 758*0Sstevel@tonic-gate 759*0Sstevel@tonic-gateThe output files are placed in the hierarchy rooted at Perl's 760*0Sstevel@tonic-gatearchitecture dependent library directory. You can specify a different 761*0Sstevel@tonic-gatehierarchy with a B<-d> switch. 762*0Sstevel@tonic-gate 763*0Sstevel@tonic-gateIf run with no arguments, filters standard input to standard output. 764*0Sstevel@tonic-gate 765*0Sstevel@tonic-gate=head1 OPTIONS 766*0Sstevel@tonic-gate 767*0Sstevel@tonic-gate=over 4 768*0Sstevel@tonic-gate 769*0Sstevel@tonic-gate=item -d destination_dir 770*0Sstevel@tonic-gate 771*0Sstevel@tonic-gatePut the resulting B<.ph> files beneath B<destination_dir>, instead of 772*0Sstevel@tonic-gatebeneath the default Perl library location (C<$Config{'installsitsearch'}>). 773*0Sstevel@tonic-gate 774*0Sstevel@tonic-gate=item -r 775*0Sstevel@tonic-gate 776*0Sstevel@tonic-gateRun recursively; if any of B<headerfiles> are directories, then run I<h2ph> 777*0Sstevel@tonic-gateon all files in those directories (and their subdirectories, etc.). B<-r> 778*0Sstevel@tonic-gateand B<-a> are mutually exclusive. 779*0Sstevel@tonic-gate 780*0Sstevel@tonic-gate=item -a 781*0Sstevel@tonic-gate 782*0Sstevel@tonic-gateRun automagically; convert B<headerfiles>, as well as any B<.h> files 783*0Sstevel@tonic-gatewhich they include. This option will search for B<.h> files in all 784*0Sstevel@tonic-gatedirectories which your C compiler ordinarily uses. B<-a> and B<-r> are 785*0Sstevel@tonic-gatemutually exclusive. 786*0Sstevel@tonic-gate 787*0Sstevel@tonic-gate=item -l 788*0Sstevel@tonic-gate 789*0Sstevel@tonic-gateSymbolic links will be replicated in the destination directory. If B<-l> 790*0Sstevel@tonic-gateis not specified, then links are skipped over. 791*0Sstevel@tonic-gate 792*0Sstevel@tonic-gate=item -h 793*0Sstevel@tonic-gate 794*0Sstevel@tonic-gatePut ``hints'' in the .ph files which will help in locating problems with 795*0Sstevel@tonic-gateI<h2ph>. In those cases when you B<require> a B<.ph> file containing syntax 796*0Sstevel@tonic-gateerrors, instead of the cryptic 797*0Sstevel@tonic-gate 798*0Sstevel@tonic-gate [ some error condition ] at (eval mmm) line nnn 799*0Sstevel@tonic-gate 800*0Sstevel@tonic-gateyou will see the slightly more helpful 801*0Sstevel@tonic-gate 802*0Sstevel@tonic-gate [ some error condition ] at filename.ph line nnn 803*0Sstevel@tonic-gate 804*0Sstevel@tonic-gateHowever, the B<.ph> files almost double in size when built using B<-h>. 805*0Sstevel@tonic-gate 806*0Sstevel@tonic-gate=item -D 807*0Sstevel@tonic-gate 808*0Sstevel@tonic-gateInclude the code from the B<.h> file as a comment in the B<.ph> file. 809*0Sstevel@tonic-gateThis is primarily used for debugging I<h2ph>. 810*0Sstevel@tonic-gate 811*0Sstevel@tonic-gate=item -Q 812*0Sstevel@tonic-gate 813*0Sstevel@tonic-gate``Quiet'' mode; don't print out the names of the files being converted. 814*0Sstevel@tonic-gate 815*0Sstevel@tonic-gate=back 816*0Sstevel@tonic-gate 817*0Sstevel@tonic-gate=head1 ENVIRONMENT 818*0Sstevel@tonic-gate 819*0Sstevel@tonic-gateNo environment variables are used. 820*0Sstevel@tonic-gate 821*0Sstevel@tonic-gate=head1 FILES 822*0Sstevel@tonic-gate 823*0Sstevel@tonic-gate /usr/include/*.h 824*0Sstevel@tonic-gate /usr/include/sys/*.h 825*0Sstevel@tonic-gate 826*0Sstevel@tonic-gateetc. 827*0Sstevel@tonic-gate 828*0Sstevel@tonic-gate=head1 AUTHOR 829*0Sstevel@tonic-gate 830*0Sstevel@tonic-gateLarry Wall 831*0Sstevel@tonic-gate 832*0Sstevel@tonic-gate=head1 SEE ALSO 833*0Sstevel@tonic-gate 834*0Sstevel@tonic-gateperl(1) 835*0Sstevel@tonic-gate 836*0Sstevel@tonic-gate=head1 DIAGNOSTICS 837*0Sstevel@tonic-gate 838*0Sstevel@tonic-gateThe usual warnings if it can't read or write the files involved. 839*0Sstevel@tonic-gate 840*0Sstevel@tonic-gate=head1 BUGS 841*0Sstevel@tonic-gate 842*0Sstevel@tonic-gateDoesn't construct the %sizeof array for you. 843*0Sstevel@tonic-gate 844*0Sstevel@tonic-gateIt doesn't handle all C constructs, but it does attempt to isolate 845*0Sstevel@tonic-gatedefinitions inside evals so that you can get at the definitions 846*0Sstevel@tonic-gatethat it can translate. 847*0Sstevel@tonic-gate 848*0Sstevel@tonic-gateIt's only intended as a rough tool. 849*0Sstevel@tonic-gateYou may need to dicker with the files produced. 850*0Sstevel@tonic-gate 851*0Sstevel@tonic-gateYou have to run this program by hand; it's not run as part of the Perl 852*0Sstevel@tonic-gateinstallation. 853*0Sstevel@tonic-gate 854*0Sstevel@tonic-gateDoesn't handle complicated expressions built piecemeal, a la: 855*0Sstevel@tonic-gate 856*0Sstevel@tonic-gate enum { 857*0Sstevel@tonic-gate FIRST_VALUE, 858*0Sstevel@tonic-gate SECOND_VALUE, 859*0Sstevel@tonic-gate #ifdef ABC 860*0Sstevel@tonic-gate THIRD_VALUE 861*0Sstevel@tonic-gate #endif 862*0Sstevel@tonic-gate }; 863*0Sstevel@tonic-gate 864*0Sstevel@tonic-gateDoesn't necessarily locate all of your C compiler's internally-defined 865*0Sstevel@tonic-gatesymbols. 866*0Sstevel@tonic-gate 867*0Sstevel@tonic-gate=cut 868*0Sstevel@tonic-gate 869*0Sstevel@tonic-gate!NO!SUBS! 870*0Sstevel@tonic-gate 871*0Sstevel@tonic-gateclose OUT or die "Can't close $file: $!"; 872*0Sstevel@tonic-gatechmod 0755, $file or die "Can't reset permissions for $file: $!\n"; 873*0Sstevel@tonic-gateexec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; 874*0Sstevel@tonic-gatechdir $origdir; 875