From: Jarkko Hietaniemi Date: Sun, 24 Apr 2005 22:58:15 +0000 (+0300) Subject: combopatch X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=aadb217dbe1b43fbd45cb1644a86dd26d09068d0;hp=f464ba52b9670216e4d7f1e806fdbca7fb072215;p=p5sagit%2Fp5-mst-13.2.git combopatch Message-ID: <426BFA57.9060105@iki.fi> p4raw-id: //depot/perl@24318 --- diff --git a/embed.fnc b/embed.fnc index 2870884..18f7ac4 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1371,7 +1371,7 @@ pd |void |do_dump_pad |I32 level|PerlIO *file \ pd |void |pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv pd |void |pad_push |PADLIST *padlist|int depth -p |HV* |pad_compname_type|PADOFFSET po +p |HV* |pad_compname_type|const PADOFFSET po #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) sd |PADOFFSET|pad_findlex |const char *name|const CV* cv|U32 seq|int warn \ diff --git a/makedef.pl b/makedef.pl index 107541c..28b7b3d 100644 --- a/makedef.pl +++ b/makedef.pl @@ -63,13 +63,13 @@ if ($PLATFORM eq 'aix') { elsif ($PLATFORM =~ /^win(?:32|ce)$/ || $PLATFORM eq 'netware') { $CCTYPE = "MSVC" unless defined $CCTYPE; foreach ($thrdvar_h, $intrpvar_h, $perlvars_h, $global_sym, - $pp_sym, $globvar_sym, $perlio_sym) { + $pp_sym, $globvar_sym, $perlio_sym) { s!^!..\\!; } } elsif ($PLATFORM eq 'MacOS') { foreach ($thrdvar_h, $intrpvar_h, $perlvars_h, $global_sym, - $pp_sym, $globvar_sym, $perlio_sym) { + $pp_sym, $globvar_sym, $perlio_sym) { s!^!::!; } } @@ -81,6 +81,9 @@ unless ($PLATFORM eq 'win32' || $PLATFORM eq 'wince' || $PLATFORM eq 'MacOS' || $_ = $1; $define{$1} = 1 while /-D(\w+)/g; } + if (/^(d_(?:mmap|sigaction))='(.+)'$/) { + $define{$1} = $2; + } if ($PLATFORM eq 'os2') { $CONFIG_ARGS = $1 if /^config_args='(.+)'$/; $ARCHNAME = $1 if /^archname='(.+)'$/; @@ -233,6 +236,7 @@ if ($PLATFORM eq 'win32') { PL_timesbuf main Perl_ErrorNo + Perl_GetVars Perl_do_exec3 Perl_do_ipcctl Perl_do_ipcget @@ -309,6 +313,7 @@ if ($PLATFORM eq 'wince') { win32_spawnvp main Perl_ErrorNo + Perl_GetVars Perl_do_exec3 Perl_do_ipcctl Perl_do_ipcget @@ -347,6 +352,7 @@ elsif ($PLATFORM eq 'aix') { skip_symbols([qw( Perl_dump_fds Perl_ErrorNo + Perl_GetVars Perl_my_bcopy Perl_my_bzero Perl_my_chsize @@ -447,6 +453,7 @@ elsif ($PLATFORM eq 'os2') { } elsif ($PLATFORM eq 'MacOS') { skip_symbols [qw( + Perl_GetVars PL_cryptseen PL_cshlen PL_cshname @@ -488,6 +495,7 @@ elsif ($PLATFORM eq 'netware') { PL_timesbuf main Perl_ErrorNo + Perl_GetVars Perl_do_exec3 Perl_do_ipcctl Perl_do_ipcget @@ -569,6 +577,7 @@ if ($define{'PERL_IMPLICIT_SYS'}) { Perl_getenv_len Perl_my_popen Perl_my_pclose + PL_sig_sv )]; } else { @@ -629,27 +638,9 @@ else { )]; } -if ($define{'PERL_MALLOC_WRAP'}) { - emit_symbols [qw( - PL_memory_wrap - )]; -} - -unless ($define{'HAS_MMAP'}) { - skip_symbols [qw( - PL_mmap_page_size - )]; -} - -unless ($define{'HAS_TIMES'} || $define{'PERL_NEED_TIMESBASE'}) { +unless ($define{'PERL_MALLOC_WRAP'}) { skip_symbols [qw( - PL_timesbase - )]; -} - -unless ($define{'PERL_NEED_APPCTX'}) { - skip_symbols [qw( - PL_appctx + PL_memory_wrap )]; } @@ -747,12 +738,6 @@ unless ($define{'PERL_IMPLICIT_CONTEXT'}) { )]; } -if ($define{'PERL_IMPLICIT_CONTEXT'}) { - skip_symbols [qw( - PL_sig_sv - )]; -} - unless ($define{'PERL_IMPLICIT_SYS'}) { skip_symbols [qw( perl_alloc_using @@ -764,40 +749,51 @@ unless ($define{'FAKE_THREADS'}) { skip_symbols [qw(PL_curthr)]; } -unless ($define{'FAKE_DEFAULT_SIGNAL_HANDLERS'}) { +unless ($define{'PL_OP_SLAB_ALLOC'}) { skip_symbols [qw( - PL_sig_defaulting - )]; + PL_OpPtr + PL_OpSlab + PL_OpSpace + Perl_Slab_Alloc + Perl_Slab_Free + )]; +} + +unless ($define{'THREADS_HAVE_PIDS'}) { + skip_symbols [qw(PL_ppid)]; } -unless ($define{'FAKE_PERSISTENT_SIGNAL_HANDLERS'}) { +unless ($define{'PERL_NEED_APPCTX'}) { skip_symbols [qw( - PL_sig_ignoring + PL_appctx )]; } -unless ($define{'FAKE_DEFAULT_SIGNAL_HANDLERS'} || - $define{'FAKE_PERSISTENT_SIGNAL_HANDLERS'}) -{ +unless ($define{'PERL_NEED_TIMESBASE'}) { skip_symbols [qw( - PL_sig_handlers_initted + PL_timesbase )]; } -unless ($define{'PL_OP_SLAB_ALLOC'}) { +unless ($define{'d_mmap'}) { skip_symbols [qw( - PL_OpPtr - PL_OpSlab - PL_OpSpace - Perl_Slab_Alloc - Perl_Slab_Free - )]; + PL_mmap_page_size + )]; } -unless ($define{'THREADS_HAVE_PIDS'}) { - skip_symbols [qw(PL_ppid)]; +if ($define{'d_sigaction'}) { + skip_symbols [qw( + PL_sig_trapped + )]; } +if ($^O ne 'vms') { + # VMS does its own thing for these symbols. + skip_symbols [qw(PL_sig_handlers_initted + PL_sig_ignoring + PL_sig_defaulting)]; +} + sub readvar { my $file = shift; my $proc = shift || sub { "PL_$_[2]" }; @@ -805,26 +801,21 @@ sub readvar { my @syms; while () { # All symbols have a Perl_ prefix because that's what embed.h - # sticks in front of them. + # sticks in front of them. The A?I?S?C? is strictly speaking + # wrong. push(@syms, &$proc($1,$2,$3)) if (/\bPERLVAR(A?I?S?C?)\(([IGT])(\w+)/); } close(VARS); return \@syms; } -unless ($define{'PERL_GLOBAL_STRUCT'}) { - skip_symbols [qw( - Perl_GetVars - Perl_free_global_struct - Perl_init_global_struct - )]; -} - if ($define{'PERL_GLOBAL_STRUCT'}) { my $global = readvar($perlvars_h); skip_symbols $global; emit_symbol('Perl_GetVars'); emit_symbols [qw(PL_Vars PL_VarsPtr)] unless $CCTYPE eq 'GCC'; +} else { + skip_symbols [qw(Perl_init_global_struct Perl_free_global_struct)]; } # functions from *.sym files @@ -999,7 +990,7 @@ if ($define{'USE_PERLIO'}) { } else { # -Uuseperlio # Skip the PerlIO layer symbols - although - # nothing should have exported them any way + # nothing should have exported them anyway. skip_symbols \@layer_syms; skip_symbols [qw(PL_def_layerlist PL_known_layers PL_perlio)]; diff --git a/mg.c b/mg.c index 39b8fd8..b04e24f 100644 --- a/mg.c +++ b/mg.c @@ -54,15 +54,6 @@ tie. Signal_t Perl_csighandler(int sig); -/* if you only have signal() and it resets on each signal, FAKE_PERSISTENT_SIGNAL_HANDLERS fixes */ -#if !defined(HAS_SIGACTION) && defined(VMS) -# define FAKE_PERSISTENT_SIGNAL_HANDLERS -#endif -/* if we're doing kill() with sys$sigprc on VMS, FAKE_DEFAULT_SIGNAL_HANDLERS */ -#if defined(KILL_BY_SIGPRC) -# define FAKE_DEFAULT_SIGNAL_HANDLERS -#endif - static void restore_magic(pTHX_ const void *p); static void unwind_handler_stack(pTHX_ const void *p); @@ -2519,11 +2510,11 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) I32 Perl_whichsig(pTHX_ const char *sig) { - register const char * const *sigv; + register char* const* sigv; - for (sigv = PL_sig_name; *sigv; sigv++) + for (sigv = (char* const*)PL_sig_name; *sigv; sigv++) if (strEQ(sig,*sigv)) - return PL_sig_num[sigv - PL_sig_name]; + return PL_sig_num[sigv - (char* const*)PL_sig_name]; #ifdef SIGCLD if (strEQ(sig,"CHLD")) return SIGCLD; diff --git a/perl.c b/perl.c index 3bb3a8e..ff87fd7 100644 --- a/perl.c +++ b/perl.c @@ -2533,7 +2533,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp) for (; isALNUM(**s); (*s)++) ; } else if (givehelp) { - const char **p = usage_msgd; + char **p = (char **)usage_msgd; while (*p) PerlIO_printf(PerlIO_stdout(), "%s\n", *p++); } # ifdef EBCDIC diff --git a/perl.h b/perl.h index e0b1a94..617ca51 100644 --- a/perl.h +++ b/perl.h @@ -3764,6 +3764,16 @@ typedef struct exitlistentry { void *ptr; } PerlExitListEntry; +/* if you only have signal() and it resets on each signal, FAKE_PERSISTENT_SIGNAL_HANDLERS fixes */ +/* These have to be before perlvars.h */ +#if !defined(HAS_SIGACTION) && defined(VMS) +# define FAKE_PERSISTENT_SIGNAL_HANDLERS +#endif +/* if we're doing kill() with sys$sigprc on VMS, FAKE_DEFAULT_SIGNAL_HANDLERS */ +#if defined(KILL_BY_SIGPRC) +# define FAKE_DEFAULT_SIGNAL_HANDLERS +#endif + #ifdef PERL_GLOBAL_STRUCT struct perl_vars { # include "perlvars.h" diff --git a/perlvars.h b/perlvars.h index 2ddd0ac..35af2dc 100644 --- a/perlvars.h +++ b/perlvars.h @@ -90,7 +90,7 @@ PERLVARI(Gsig_handlers_initted, int, 0) PERLVARA(Gsig_ignoring, SIG_SIZE, int) /* which signals we are ignoring */ #endif #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS -PERLVAR(Gsig_defaulting, SIG_SIZE, int) +PERLVARA(Gsig_defaulting, SIG_SIZE, int) #endif #ifndef PERL_IMPLICIT_CONTEXT diff --git a/pp_pack.c b/pp_pack.c index 67d80f0..58e3bb2 100644 --- a/pp_pack.c +++ b/pp_pack.c @@ -2351,7 +2351,21 @@ S_div128(pTHX_ SV *pnum, bool *done) return (m); } - +#define TEMPSYM_INIT(symptr, p, e) \ + STMT_START { \ + (symptr)->patptr = p; \ + (symptr)->patend = e; \ + (symptr)->grpbeg = NULL; \ + (symptr)->grpend = NULL; \ + (symptr)->grpend = NULL; \ + (symptr)->code = 0; \ + (symptr)->length = 0; \ + (symptr)->howlen = 0; \ + (symptr)->level = 0; \ + (symptr)->flags = FLAG_PACK; \ + (symptr)->strbeg = 0; \ + (symptr)->previous = NULL; \ + } STMT_END /* =for apidoc pack_cat @@ -2365,10 +2379,12 @@ flags are not used. This call should not be used; use packlist instead. void Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags) { - tempsym_t sym = { pat, patend, NULL, NULL, 0, 0, 0, 0, FLAG_PACK, 0, NULL }; + tempsym_t sym; (void)next_in_list; (void)flags; + TEMPSYM_INIT(&sym, pat, patend); + (void)pack_rec( cat, &sym, beglist, endlist ); } @@ -2385,7 +2401,9 @@ void Perl_packlist(pTHX_ SV *cat, char *pat, register char *patend, register SV **beglist, SV **endlist ) { STRLEN no_len; - tempsym_t sym = { pat, patend, NULL, NULL, 0, 0, 0, 0, FLAG_PACK, 0, NULL }; + tempsym_t sym; + + TEMPSYM_INIT(&sym, pat, patend); /* We're going to do changes through SvPVX(cat). Make sure it's valid. Also make sure any UTF8 flag is loaded */ diff --git a/proto.h b/proto.h index c3ccf1d..ea83b9b 100644 --- a/proto.h +++ b/proto.h @@ -1314,7 +1314,7 @@ PERL_CALLCONV void Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padl PERL_CALLCONV void Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv); PERL_CALLCONV void Perl_pad_push(pTHX_ PADLIST *padlist, int depth); -PERL_CALLCONV HV* Perl_pad_compname_type(pTHX_ PADOFFSET po); +PERL_CALLCONV HV* Perl_pad_compname_type(pTHX_ const PADOFFSET po); #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) STATIC PADOFFSET S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, SV** out_capture, SV** out_name_sv, int *out_flags); diff --git a/toke.c b/toke.c index d35227f..aeb0595 100644 --- a/toke.c +++ b/toke.c @@ -281,7 +281,7 @@ S_tokereport(pTHX_ const char* s, I32 rv) struct debug_tokens *p; SV* report = newSVpvn("<== ", 4); - for (p = debug_tokens; p->token; p++) { + for (p = (struct debug_tokens *)debug_tokens; p->token; p++) { if (p->token == (int)rv) { name = p->name; type = p->type; diff --git a/util.c b/util.c index 0bff7e7..9d8a0c1 100644 --- a/util.c +++ b/util.c @@ -4723,6 +4723,11 @@ Perl_init_global_struct(pTHX) # else plvarsp = PL_VarsPtr; # endif /* PERL_GLOBAL_STRUCT_PRIVATE */ +# undef PERLVAR +# undef PERLVARA +# undef PERLVARI +# undef PERLVARIC +# undef PERLVARISC # define PERLVAR(var,type) /**/ # define PERLVARA(var,n,type) /**/ # define PERLVARI(var,type,init) plvarsp->var = init;