X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=embed.pl;h=9e5c62b4828d8c606931cfbd140ed239c5d196a1;hb=8aa8f774be44d46814d4ddbad03e302f1eb37338;hp=548294a38e67aef7232210de7c9ce443f76651e9;hpb=7f1be197b379d10925884de5897372b0bdcbff6d;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/embed.pl b/embed.pl
index 548294a..9e5c62b 100755
--- a/embed.pl
+++ b/embed.pl
@@ -3,6 +3,11 @@
 require 5.003;	# keep this compatible, an old perl is all we may have before
                 # we build the new one
 
+BEGIN {
+    # Get function prototypes
+    require 'regen.pl';
+}
+
 #
 # See database of global and static function prototypes in embed.fnc
 # This is used to generate prototype headers under various configurations,
@@ -32,14 +37,14 @@ Edit those files and run 'make regen_headers' to effect changes.
 EOW
 
     if ($file =~ m:\.[ch]$:) {
-$warning =~ s:^: * :gm;
-$warning =~ s: +$::gm;
-$warning =~ s: :/:;
-$warning =~ s:$:/:;
+	$warning =~ s:^: * :gm;
+	$warning =~ s: +$::gm;
+	$warning =~ s: :/:;
+	$warning =~ s:$:/:;
     }
     else {
-$warning =~ s:^:# :gm;
-$warning =~ s: +$::gm;
+	$warning =~ s:^:# :gm;
+	$warning =~ s: +$::gm;
     }
     $warning;
 } # do_not_edit
@@ -51,7 +56,8 @@ open IN, "embed.fnc" or die $!;
 sub walk_table (&@) {
     my $function = shift;
     my $filename = shift || '-';
-    my $leader = shift || do_not_edit ($filename);
+    my $leader = shift;
+    defined $leader or $leader = do_not_edit ($filename);
     my $trailer = shift;
     my $F;
     local *F;
@@ -59,7 +65,7 @@ sub walk_table (&@) {
 	$F = $filename;
     }
     else {
-	unlink $filename;
+	safer_unlink $filename;
 	open F, ">$filename" or die "Can't open $filename: $!";
 	$F = \*F;
     }
@@ -83,7 +89,9 @@ sub walk_table (&@) {
         print $F @outs; # $function->(@args) is not 5.003
     }
     print $F $trailer if $trailer;
-    close $F unless ref $filename;
+    unless (ref $filename) {
+	close $F or die "Error closing $filename: $!";
+    }
 }
 
 sub munge_c_files () {
@@ -96,7 +104,7 @@ sub munge_c_files () {
 	if (@_ > 1) {
 	    $functions->{$_[2]} = \@_ if $_[@_-1] =~ /\.\.\./;
 	}
-    } '/dev/null';
+    } '/dev/null', '';
     local $^I = '.bak';
     while (<>) {
 #	if (/^#\s*include\s+"perl.h"/) {
@@ -200,8 +208,8 @@ sub write_global_sym {
     $ret;
 }
 
-walk_table(\&write_protos,     "proto.h");
-walk_table(\&write_global_sym, "global.sym");
+walk_table(\&write_protos,     "proto.h", undef);
+walk_table(\&write_global_sym, "global.sym", undef);
 
 # XXX others that may need adding
 #       warnhook
@@ -211,7 +219,7 @@ my @extvars = qw(sv_undef sv_yes sv_no na dowarn
                  curcop compiling
                  tainting tainted stack_base stack_sp sv_arenaroot
 		 no_modify
-                 curstash DBsub DBsingle debstash
+                 curstash DBsub DBsingle DBassertion debstash
                  rsfp
                  stdingv
 		 defgv
@@ -301,14 +309,18 @@ sub multoff ($$) {
     return hide("PL_$pre$sym", "PL_$sym");
 }
 
-unlink 'embed.h';
+safer_unlink 'embed.h';
 open(EM, '> embed.h') or die "Can't create embed.h: $!\n";
 
 print EM do_not_edit ("embed.h"), <<'END';
 
 /* (Doing namespace management portably in C is really gross.) */
 
-/* NO_EMBED is no longer supported. i.e. EMBED is always active. */
+/* By defining PERL_NO_SHORT_NAMES (not done by default) the short forms
+ * (like warn instead of Perl_warn) for the API are not defined.
+ * Not defining the short forms is a good thing for cleaner embedding. */
+
+#ifndef PERL_NO_SHORT_NAMES
 
 /* Hide global symbols */
 
@@ -332,9 +344,16 @@ walk_table {
 		$ret .= hide($func,"Perl_$func");
 	    }
 	}
+         unless ($flags =~ /A/) {
+	    if ($flags =~ /E/) {
+		$ret = "#if defined(PERL_CORE) || defined(PERL_EXT)\n$ret#endif\n";
+	    } else {
+		$ret = "#ifdef PERL_CORE\n$ret#endif\n";
+	    }
+        }
     }
     $ret;
-} \*EM;
+} \*EM, "";
 
 for $sym (sort keys %ppsym) {
     $sym =~ s/^Perl_//;
@@ -385,9 +404,16 @@ walk_table {
 		$ret .= $alist . ")\n";
 	    }
 	}
+         unless ($flags =~ /A/) {
+	    if ($flags =~ /E/) {
+		$ret = "#if defined(PERL_CORE) || defined(PERL_EXT)\n$ret#endif\n";
+	    } else {
+		$ret = "#ifdef PERL_CORE\n$ret#endif\n";
+	    }
+        }
     }
     $ret;
-} \*EM;
+} \*EM, "";
 
 for $sym (sort keys %ppsym) {
     $sym =~ s/^Perl_//;
@@ -406,6 +432,8 @@ print EM <<'END';
 
 #endif	/* PERL_IMPLICIT_CONTEXT */
 
+#endif	/* #ifndef PERL_NO_SHORT_NAMES */
+
 END
 
 print EM <<'END';
@@ -450,7 +478,7 @@ print EM <<'END';
    an extra argument but grab the context pointer using the macro
    dTHX.
  */
-#if defined(PERL_IMPLICIT_CONTEXT)
+#if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_NO_SHORT_NAMES)
 #  define croak				Perl_croak_nocontext
 #  define deb				Perl_deb_nocontext
 #  define die				Perl_die_nocontext
@@ -487,9 +515,9 @@ print EM <<'END';
 
 END
 
-close(EM);
+close(EM) or die "Error closing EM: $!";
 
-unlink 'embedvar.h';
+safer_unlink 'embedvar.h';
 open(EM, '> embedvar.h')
     or die "Can't create embedvar.h: $!\n";
 
@@ -594,10 +622,10 @@ print EM <<'END';
 #endif /* PERL_POLLUTE */
 END
 
-close(EM);
+close(EM) or die "Error closing EM: $!";
 
-unlink 'perlapi.h';
-unlink 'perlapi.c';
+safer_unlink 'perlapi.h';
+safer_unlink 'perlapi.c';
 open(CAPI, '> perlapi.c') or die "Can't create perlapi.c: $!\n";
 open(CAPIH, '> perlapi.h') or die "Can't create perlapi.h: $!\n";
 
@@ -695,7 +723,7 @@ print CAPIH <<'EOT';
 #endif /* __perlapi_h__ */
 
 EOT
-close CAPIH;
+close CAPIH or die "Error closing CAPIH: $!";
 
 print CAPI do_not_edit ("perlapi.c"), <<'EOT';
 
@@ -745,7 +773,7 @@ END_EXTERN_C
 #endif /* MULTIPLICITY */
 EOT
 
-close(CAPI);
+close(CAPI) or die "Error closing CAPI: $!";
 
 # functions that take va_list* for implementing vararg functions
 # NOTE: makedef.pl must be updated if you add symbols to %vfuncs