X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=embed.pl;h=2ccd8b38e667468366afa178e91bbf7fcfc09f2b;hb=c67709088af01a4b494bf630471516b5c60e9408;hp=219fad301d24dd6fa3043fe91e94b6f9c8e0f94e;hpb=08e5223a8528b971b4471b7221166ff3212af428;p=p5sagit%2Fp5-mst-13.2.git diff --git a/embed.pl b/embed.pl index 219fad3..2ccd8b3 100755 --- a/embed.pl +++ b/embed.pl @@ -3,13 +3,80 @@ 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 = <$filename" or die "Can't open $filename: $!"; $F = \*F; } @@ -49,7 +117,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 +132,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"/) { @@ -141,10 +211,8 @@ sub write_protos { 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/; @@ -158,46 +226,17 @@ sub write_global_sym { 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'); -/* - * 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 @@ -207,7 +246,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 @@ -297,26 +336,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 <<'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. */ +/* 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 */ @@ -340,9 +371,16 @@ walk_table { $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_//; @@ -393,9 +431,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_//; @@ -414,6 +459,8 @@ print EM <<'END'; #endif /* PERL_IMPLICIT_CONTEXT */ +#endif /* #ifndef PERL_NO_SHORT_NAMES */ + END print EM <<'END'; @@ -458,7 +505,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 @@ -495,46 +542,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 @@ -550,18 +582,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 @@ -572,11 +592,9 @@ for $sym (sort keys %intrp) { print EM <<'END'; -# endif /* USE_5005THREADS */ - #else /* !MULTIPLICITY */ -/* cases 1 and 4 above */ +/* case 1 above */ END @@ -586,20 +604,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) { @@ -608,7 +612,6 @@ for $sym (sort keys %thread) { print EM <<'END'; -# endif /* USE_5005THREADS */ #endif /* MULTIPLICITY */ #if defined(PERL_GLOBAL_STRUCT) @@ -646,27 +649,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__ @@ -760,22 +750,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" @@ -823,7 +800,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