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_lib.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 $years;
+
+ if ($file eq 'embed.h') {
+ $years = '1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004';
+ } elsif ($file eq 'embedvar.h') {
+ $years = '1999, 2000, 2001, 2002, 2003, 2004';
+ } elsif ($file eq 'global.sym') {
+ $years = '1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004';
+ } elsif ($file eq 'perlapi.c') {
+ $years = '1999, 2000, 2001';
+ } elsif ($file eq 'perlapi.h') {
+ $years = '1999, 2000, 2001, 2002, 2003, 2004';
+ } elsif ($file eq 'proto.h') {
+ $years = '1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004';
+ }
+
+ $years =~ s/1999,/1999,\n / if length $years > 40;
+
+ my $warning = <<EOW;
+
+ $file
+
+ Copyright (C) $years, by Larry Wall and others
+
+ 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
+
+ $warning .= <<EOW if $file eq 'perlapi.c';
+
+Up to the threshold of the door there mounted a flight of twenty-seven
+broad stairs, hewn by some unknown art of the same black stone. This
+was the only entrance to the tower.
+
+
+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
my $function = shift;
my $filename = shift || '-';
my $leader = shift;
+ defined $leader or $leader = do_not_edit ($filename);
my $trailer = shift;
my $F;
local *F;
$F = $filename;
}
else {
- unlink $filename;
+ safer_unlink $filename;
open F, ">$filename" or die "Can't open $filename: $!";
$F = \*F;
}
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 () {
if (@_ > 1) {
$functions->{$_[2]} = \@_ if $_[@_-1] =~ /\.\.\./;
}
- } '/dev/null';
+ } '/dev/null', '';
local $^I = '.bak';
while (<>) {
# if (/^#\s*include\s+"perl.h"/) {
if( $flags =~ /f/ ) {
my $prefix = $flags =~ /n/ ? '' : 'pTHX_';
my $args = scalar @args;
- $ret .= "\n#ifdef CHECK_FORMAT\n";
- $ret .= sprintf " __attribute__((format(printf,%s%d,%s%d)))",
+ $ret .= sprintf "\n\t__attribute__format__(__printf__,%s%d,%s%d)",
$prefix, $args - 1, $prefix, $args;
- $ret .= "\n#endif\n";
}
$ret .= ";";
$ret .= ' */' if $flags =~ /m/;
my $ret = "";
if (@_ > 1) {
my ($flags,$retval,$func,@args) = @_;
- if ($flags =~ /A/ && $flags !~ /[xm]/) { # public API, so export
- $func = "Perl_$func" if $flags =~ /p/;
+ if ($flags =~ /[AX]/ && $flags !~ /[xm]/
+ || $flags =~ /b/) { # public API, so export
+ $func = "Perl_$func" if $flags =~ /[pbX]/;
$ret = "$func\n";
}
}
$ret;
}
-
-walk_table(\&write_protos, 'proto.h', <<'EOT');
-/*
- * !!!!!!! 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');
-#
-# !!!!!!! 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
curcop compiling
tainting tainted stack_base stack_sp sv_arenaroot
no_modify
- curstash DBsub DBsingle debstash
+ curstash DBsub DBsingle DBassertion debstash
rsfp
stdingv
defgv
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';
-/* !!!!!!! 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
+/* 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 */
$ret .= hide($func,"Perl_$func");
}
}
+ if ($ret ne '' && $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_//;
$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_//;
#endif /* PERL_IMPLICIT_CONTEXT */
+#endif /* #ifndef PERL_NO_SHORT_NAMES */
+
END
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
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
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';
-/* !!!!!!! 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
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
print EM <<'END';
-# endif /* USE_5005THREADS */
-
#else /* !MULTIPLICITY */
-/* cases 1 and 4 above */
+/* case 1 above */
END
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) {
print EM <<'END';
-# endif /* USE_5005THREADS */
#endif /* MULTIPLICITY */
#if defined(PERL_GLOBAL_STRUCT)
#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';
-/* !!!!!!! 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__
#endif /* __perlapi_h__ */
EOT
-close CAPIH;
+close CAPIH or die "Error closing CAPIH: $!";
-print CAPI <<'EOT';
-/* !!!!!!! 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"
#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
https://perl5.git.perl.org / perl5.git / blobdiff