This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [jhi@iki.fi: enums are not nums]
[perl5.git] / embed.pl
index 073cdf3..bec3ca1 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -3,13 +3,52 @@
 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 at the __END__.
+# See database of global and static function prototypes in embed.fnc
 # This is used to generate prototype headers under various configurations,
 # export symbols lists for different platforms, and macros to provide an
 # implicit interpreter context argument.
 #
 
+sub do_not_edit ($)
+{
+    my $file = shift;
+    my $warning = <<EOW;
+
+   $file
+
+   Copyright (c) 1997-2002, Larry Wall
+
+   You may distribute under the terms of either the GNU General Public
+   License or the Artistic License, as specified in the README file.
+
+!!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
+This file is built by embed.pl from data in embed.fnc, embed.pl,
+pp.sym, intrpvar.h, perlvars.h and thrdvar.h.
+Any changes made here will be lost!
+
+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:$:/:;
+    }
+    else {
+       $warning =~ s:^:# :gm;
+       $warning =~ s: +$::gm;
+    }
+    $warning;
+} # do_not_edit
+
 open IN, "embed.fnc" or die $!;
 
 # walk table providing an array of components in each line to
@@ -18,6 +57,7 @@ sub walk_table (&@) {
     my $function = shift;
     my $filename = shift || '-';
     my $leader = shift;
+    defined $leader or $leader = do_not_edit ($filename);
     my $trailer = shift;
     my $F;
     local *F;
@@ -25,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;
     }
@@ -49,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 () {
@@ -62,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"/) {
@@ -166,38 +208,8 @@ sub write_global_sym {
     $ret;
 }
 
-
-walk_table(\&write_protos, 'proto.h', <<'EOT');
-/*
- *    proto.h
- *
- *    Copyright (c) 1997-2002, Larry Wall
- *
- *    You may distribute under the terms of either the GNU General Public
- *    License or the Artistic License, as specified in the README file.
- *
- * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
- * This file is autogenerated from data in embed.pl.  Edit that file
- * and run 'make regen_headers' to effect changes.
- */
-
-EOT
-
-walk_table(\&write_global_sym, 'global.sym', <<'EOT');
-#
-#    global.sym
-#
-#    Copyright (c) 1997-2002, Larry Wall
-#
-#    You may distribute under the terms of either the GNU General Public
-#    License or the Artistic License, as specified in the README file.
-#
-# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
-# This file is autogenerated from data in embed.pl.  Edit that file
-# and run 'make regen_headers' to effect changes.
-#
-
-EOT
+walk_table(\&write_protos,     "proto.h", undef);
+walk_table(\&write_global_sym, "global.sym", undef);
 
 # XXX others that may need adding
 #       warnhook
@@ -297,63 +309,15 @@ 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 <<'END';
-/*
- *    embed.h
- *
- *    Copyright (c) 1997-2002, Larry Wall
- *
- *    You may distribute under the terms of either the GNU General Public
- *    License or the Artistic License, as specified in the README file.
- *
- *  !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
- *  This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
- *  perlvars.h and thrdvar.h.  Any changes made here will be lost!
- */
+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. */
 
-/* provide binary compatible (but inconsistent) names */
-#if defined(PERL_BINCOMPAT_5005)
-#  define  Perl_call_atexit            perl_atexit
-#  define  Perl_eval_sv                        perl_eval_sv
-#  define  Perl_eval_pv                        perl_eval_pv
-#  define  Perl_call_argv              perl_call_argv
-#  define  Perl_call_method            perl_call_method
-#  define  Perl_call_pv                        perl_call_pv
-#  define  Perl_call_sv                        perl_call_sv
-#  define  Perl_get_av                 perl_get_av
-#  define  Perl_get_cv                 perl_get_cv
-#  define  Perl_get_hv                 perl_get_hv
-#  define  Perl_get_sv                 perl_get_sv
-#  define  Perl_init_i18nl10n          perl_init_i18nl10n
-#  define  Perl_init_i18nl14n          perl_init_i18nl14n
-#  define  Perl_new_collate            perl_new_collate
-#  define  Perl_new_ctype              perl_new_ctype
-#  define  Perl_new_numeric            perl_new_numeric
-#  define  Perl_require_pv             perl_require_pv
-#  define  Perl_safesyscalloc          Perl_safecalloc
-#  define  Perl_safesysfree            Perl_safefree
-#  define  Perl_safesysmalloc          Perl_safemalloc
-#  define  Perl_safesysrealloc         Perl_saferealloc
-#  define  Perl_set_numeric_local      perl_set_numeric_local
-#  define  Perl_set_numeric_standard   perl_set_numeric_standard
-/* malloc() pollution was the default in earlier versions, so enable
- * it for bincompat; but not for systems that used to do prevent that,
- * or when they ask for {HIDE,EMBED}MYMALLOC */
-#  if !defined(EMBEDMYMALLOC) && !defined(HIDEMYMALLOC)
-#    if !defined(NeXT) && !defined(__NeXT) && !defined(__MACHTEN__) && \
-        !defined(__QNX__)
-#      define  PERL_POLLUTE_MALLOC
-#    endif
-#  endif
-#endif
-
 /* Hide global symbols */
 
 #if !defined(PERL_IMPLICIT_CONTEXT)
@@ -378,7 +342,7 @@ walk_table {
        }
     }
     $ret;
-} \*EM;
+} \*EM, "";
 
 for $sym (sort keys %ppsym) {
     $sym =~ s/^Perl_//;
@@ -431,7 +395,7 @@ walk_table {
        }
     }
     $ret;
-} \*EM;
+} \*EM, "";
 
 for $sym (sort keys %ppsym) {
     $sym =~ s/^Perl_//;
@@ -463,7 +427,7 @@ print EM <<'END';
 #  define sv_setptrref(rv,ptr)         sv_setref_iv(rv,Nullch,PTR2IV(ptr))
 #endif
 
-#if !defined(PERL_CORE) && !defined(PERL_NOCOMPAT) && !defined(PERL_BINCOMPAT_5005)
+#if !defined(PERL_CORE) && !defined(PERL_NOCOMPAT)
 
 /* Compatibility for various misnamed functions.  All functions
    in the API that begin with "perl_" (not "Perl_") take an explicit
@@ -531,46 +495,31 @@ 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";
 
-print EM <<'END';
-/*
- *    embedvar.h
- *
- *    Copyright (c) 1997-2002, Larry Wall
- *
- *    You may distribute under the terms of either the GNU General Public
- *    License or the Artistic License, as specified in the README file.
- *
- *
- * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
- *  This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
- *  perlvars.h and thrdvar.h.  Any changes made here will be lost!
- */
+print EM do_not_edit ("embedvar.h"), <<'END';
 
 /* (Doing namespace management portably in C is really gross.) */
 
 /*
-   The following combinations of MULTIPLICITY, USE_5005THREADS
-   and PERL_IMPLICIT_CONTEXT are supported:
+   The following combinations of MULTIPLICITY and PERL_IMPLICIT_CONTEXT
+   are supported:
      1) none
      2) MULTIPLICITY   # supported for compatibility
      3) MULTIPLICITY && PERL_IMPLICIT_CONTEXT
-     4) USE_5005THREADS && PERL_IMPLICIT_CONTEXT
-     5) MULTIPLICITY && USE_5005THREADS && PERL_IMPLICIT_CONTEXT
 
    All other combinations of these flags are errors.
 
-   #3, #4, #5, and #6 are supported directly, while #2 is a special
+   only #3 is supported directly, while #2 is a special
    case of #3 (supported by redefining vTHX appropriately).
 */
 
 #if defined(MULTIPLICITY)
-/* cases 2, 3 and 5 above */
+/* cases 2 and 3 above */
 
 #  if defined(PERL_IMPLICIT_CONTEXT)
 #    define vTHX       aTHX
@@ -586,18 +535,6 @@ for $sym (sort keys %thread) {
 
 print EM <<'END';
 
-#  if defined(USE_5005THREADS)
-/* case 5 above */
-
-END
-
-for $sym (sort keys %intrp) {
-    print EM multon($sym,'I','PERL_GET_INTERP->');
-}
-
-print EM <<'END';
-
-#  else                /* !USE_5005THREADS */
 /* cases 2 and 3 above */
 
 END
@@ -608,11 +545,9 @@ for $sym (sort keys %intrp) {
 
 print EM <<'END';
 
-#  endif       /* USE_5005THREADS */
-
 #else  /* !MULTIPLICITY */
 
-/* cases 1 and 4 above */
+/* case 1 above */
 
 END
 
@@ -622,20 +557,6 @@ for $sym (sort keys %intrp) {
 
 print EM <<'END';
 
-#  if defined(USE_5005THREADS)
-/* case 4 above */
-
-END
-
-for $sym (sort keys %thread) {
-    print EM multon($sym,'T','aTHX->');
-}
-
-print EM <<'END';
-
-#  else        /* !USE_5005THREADS */
-/* case 1 above */
-
 END
 
 for $sym (sort keys %thread) {
@@ -644,7 +565,6 @@ for $sym (sort keys %thread) {
 
 print EM <<'END';
 
-#  endif       /* USE_5005THREADS */
 #endif /* MULTIPLICITY */
 
 #if defined(PERL_GLOBAL_STRUCT)
@@ -682,27 +602,14 @@ 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";
 
-print CAPIH <<'EOT';
-/*
- *    perlapi.h
- *
- *    Copyright (c) 1997-2002, Larry Wall
- *
- *    You may distribute under the terms of either the GNU General Public
- *    License or the Artistic License, as specified in the README file.
- *
- *
- * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
- *  This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
- *  perlvars.h and thrdvar.h.  Any changes made here will be lost!
- */
+print CAPIH do_not_edit ("perlapi.h"), <<'EOT';
 
 /* declare accessor functions for Perl variables */
 #ifndef __perlapi_h__
@@ -796,22 +703,9 @@ print CAPIH <<'EOT';
 #endif /* __perlapi_h__ */
 
 EOT
-close CAPIH;
+close CAPIH or die "Error closing CAPIH: $!";
 
-print CAPI <<'EOT';
-/*
- *    perlapi.c
- *
- *    Copyright (c) 1997-2002, Larry Wall
- *
- *    You may distribute under the terms of either the GNU General Public
- *    License or the Artistic License, as specified in the README file.
- *
- *
- * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
- *  This file is built by embed.pl from data in embed.pl, pp.sym, intrpvar.h,
- *  perlvars.h and thrdvar.h.  Any changes made here will be lost!
- */
+print CAPI do_not_edit ("perlapi.c"), <<'EOT';
 
 #include "EXTERN.h"
 #include "perl.h"
@@ -859,7 +753,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