X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utils%2Fh2ph.PL;h=e46ac208fcd159a5c6dadc9175b6673c46a3607f;hb=4a5826852ee095d233fab172b67097a331a21e42;hp=c6cd99a57651677b84bad1ba2a16ff1260862632;hpb=09f4278941fe925f20d703828b105fac98aebb69;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/utils/h2ph.PL b/utils/h2ph.PL
index c6cd99a..e46ac20 100644
--- a/utils/h2ph.PL
+++ b/utils/h2ph.PL
@@ -58,13 +58,14 @@ my $Dest_dir = $opt_d || $Config{installsitearch};
 die "Destination directory $Dest_dir doesn't exist or isn't a directory\n"
     unless -d $Dest_dir;
 
-my @isatype = split(' ',<<END);
+my @isatype = qw(
 	char	uchar	u_char
 	short	ushort	u_short
 	int	uint	u_int
 	long	ulong	u_long
 	FILE	key_t	caddr_t
-END
+	float	double	size_t
+);
 
 my %isatype;
 @isatype{@isatype} = (1) x @isatype;
@@ -141,11 +142,12 @@ while (defined (my $file = next_file())) {
 			    $curargs{$arg} = 1;
 			}
 			$args =~ s/\b(\w)/\$$1/g;
-			$args = "local($args) = \@_;\n$t    ";
+			$args = "my($args) = \@_;\n$t    ";
 		    }
 		    s/^\s+//;
 		    expr();
 		    $new =~ s/(["\\])/\\$1/g;       #"]);
+		  EMIT:
 		    $new = reindent($new);
 		    $args = reindent($args);
 		    if ($t ne '') {
@@ -274,6 +276,8 @@ while (defined (my $file = next_file())) {
 		chomp $next;
 		# drop "#define FOO FOO" in enums
 		$next =~ s/^\s*#\s*define\s+(\w+)\s+\1\s*$//;
+		# #defines in enums (aliases)
+		$next =~ s/^\s*#\s*define\s+(\w+)\s+(\w+)\s*$/$1 = $2,/;
 		$_ .= $next;
 		print OUT "# $next\n" if $opt_D;
 	    }
@@ -286,6 +290,7 @@ while (defined (my $file = next_file())) {
 	    my $enum_val = -1;
 	    foreach my $enum (@enum_subs) {
 		my ($enum_name, $enum_value) = $enum =~ /^([a-zA-Z_]\w*)(=.+)?$/;
+		$enum_name or next;
 		$enum_value =~ s/^=//;
 		$enum_val = (length($enum_value) ? $enum_value : $enum_val + 1);
 		if ($opt_h) {
@@ -300,20 +305,26 @@ while (defined (my $file = next_file())) {
 			       "unless defined(\&$enum_name);\n");
 		}
 	    }
-	} elsif (/^(?:__extension__\s+)?extern\s+__inline(?:__)?\s+/) { # { for vi
+	} elsif (/^(?:__extension__\s+)?(?:extern|static)\s+(?:__)?inline(?:__)?\s+/
+	    and !/;\s*$/ and !/{\s*}\s*$/)
+	{ # { for vi
 	    # This is a hack to parse the inline functions in the glibc headers.
-	    # Warning: massive kludge ahead. We suppose inline functions are mainly
-	    # constructed like macros.
+	    # Warning: massive kludge ahead. We suppose inline functions
+	    # are mainly constructed like macros.
 	    while (1) {
 		last unless defined ($next = next_line($file));
 		chomp $next;
-		undef $_, last if $next =~ /__THROW\s*;/;
+		undef $_, last if $next =~ /__THROW\s*;/
+			       or $next =~ /^(__extension__|extern|static)\b/;
 		$_ .= " $next";
 		print OUT "# $next\n" if $opt_D;
 		last if $next =~ /^}|^{.*}\s*$/;
 	    }
 	    next if not defined; # because it's only a prototype
-	    s/\b(__extension__|extern|__inline(?:__)?)\b//g;
+	    s/\b(__extension__|extern|static|(?:__)?inline(?:__)?)\b//g;
+	    # violently drop #ifdefs
+	    s/#\s*if.*?#\s*endif//g
+		and print OUT "# some #ifdef were dropped here -- fill in the blanks\n";
 	    if (s/^(?:\w|\s|\*)*\s(\w+)\s*//) {
 		$name = $1;
 	    } else {
@@ -330,30 +341,39 @@ while (defined (my $file = next_file())) {
 	    }
 	    $args = (
 		@args
-		? "local(" . (join ',', map "\$$_", @args) . ") = \@_;\n$t    "
+		? "my(" . (join ',', map "\$$_", @args) . ") = \@_;\n$t    "
 		: ""
 	    );
 	    my $proto = @args ? '' : '() ';
 	    $new = '';
 	    s/\breturn\b//g; # "return" doesn't occur in macros usually...
 	    expr();
+	    # try to find and perlify local C variables
+	    our @local_variables = (); # needs to be a our(): (?{...}) bug workaround
+	    {
+		use re "eval";
+		my $typelist = join '|', keys %isatype;
+		$new =~ s['
+		  (?:(?:un)?signed\s+)?
+		  (?:long\s+)?
+		  (?:$typelist)\s+
+		  (\w+)
+		  (?{ push @local_variables, $1 })
+		  ']
+		 [my \$$1]gx;
+		$new =~ s['
+		  (?:(?:un)?signed\s+)?
+		  (?:long\s+)?
+		  (?:$typelist)\s+
+		  ' \s+ &(\w+) \s* ;
+		  (?{ push @local_variables, $1 })
+		  ]
+		 [my \$$1;]gx;
+	     }
+	    $new =~ s/&$_\b/\$$_/g for @local_variables;
 	    $new =~ s/(["\\])/\\$1/g;       #"]);
-	    $new = reindent($new);
-	    $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 $proto\{\n$t    ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
-		    $eval_index++;
-		} else {
-		    print OUT $t,
-		    "eval 'sub $name $proto\{\n$t    ${args}eval q($new);\n$t}' unless defined(\&$name);\n";
-		}
-	    } else {
-		print OUT "unless(defined(\&$name)) {\n    sub $name $proto\{\n\t${args}eval q($new);\n    }\n}\n";
-	    }
-	    %curargs = ();
+	    # now that's almost like a macro (we hope)
+	    goto EMIT;
 	}
     }
     $Is_converted{$file} = 1;
@@ -374,6 +394,7 @@ if ($opt_e && (scalar(keys %bad_file) > 0)) {
 exit $Exit;
 
 sub expr {
+    $new = '"(assembly code)"' and return if /\b__asm__\b/; # freak out.
     my $joined_args;
     if(keys(%curargs)) {
 	$joined_args = join('|', keys(%curargs));
@@ -382,7 +403,7 @@ sub expr {
 	s/^\&\&// && do { $new .= " &&"; next;}; # handle && operator
 	s/^\&([\(a-z\)]+)/$1/i;	# hack for things that take the address of
 	s/^(\s+)//		&& do {$new .= ' '; next;};
-	s/^0X([0-9A-F]+)[UL]*//i 
+	s/^0X([0-9A-F]+)[UL]*//i
 	    && do {my $hex = $1;
 		   $hex =~ s/^0+//;
 		   if (length $hex > 8 && !$Config{use64bitint}) {
@@ -518,7 +539,7 @@ sub next_line
 
         while (length $in) {
             if ($pre_sub_tri_graphs) {
-                # Preprocess all tri-graphs 
+                # Preprocess all tri-graphs
                 # including things stuck in quoted string constants.
                 $in =~ s/\?\?=/#/g;                         # | ??=|  #|
                 $in =~ s/\?\?\!/|/g;                        # | ??!|  ||
@@ -531,17 +552,19 @@ sub next_line
                 $in =~ s/\?\?>/}/g;                         # | ??>|  }|
             }
 	    if ($in =~ /^\#ifdef __LANGUAGE_PASCAL__/) {
-                # Tru64 disassembler.h evilness: mixed C and Pascal.
+		# Tru64 disassembler.h evilness: mixed C and Pascal.
 		while (<IN>) {
-		    last if /^\#endif/; 
+		    last if /^\#endif/;
 		}
+		$in = "";
 		next READ;
 	    }
 	    if ($in =~ /^extern inline / && # Inlined assembler.
 		$^O eq 'linux' && $file =~ m!(?:^|/)asm/[^/]+\.h$!) {
- 		while (<IN>) {
-		    last if /^}/; 
+		while (<IN>) {
+		    last if /^}/;
 		}
+		$in = "";
 		next READ;
 	    }
             if ($in =~ s/\\$//) {                           # \-newline
@@ -711,9 +734,15 @@ sub queue_includes_from
 # 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;
-
+    my $from_gcc    = `LC_ALL=C $Config{cc} -v 2>&1`;
+    if( !( $from_gcc =~ s:^Reading specs from (.*?)/specs\b.*:$1/include:s ) )
+    { # gcc-4+ :
+       $from_gcc   = `LC_ALL=C $Config{cc} -print-search-dirs 2>&1`;
+       if ( !($from_gcc =~ s/^install:\s*([^\s]+[^\s\/])([\s\/]*).*$/$1\/include/s) )
+       {
+           $from_gcc = '';
+       };
+    };
     length($from_gcc) ? ($from_gcc, $Config{usrinc}) : ($Config{usrinc});
 }