combopatch

Message-ID: <426BFA57.9060105@iki.fi>

p4raw-id: //depot/perl@24318

10 files changed, 91 insertions, 76 deletions

diff --git a/embed.fnc b/embed.fnc
index 2870884af9..18f7ac481a 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 107541c451..28b7b3d67f 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 (<VARS>) {
 	# 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 39b8fd823a..b04e24faa4 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 3bb3a8eef5..ff87fd7838 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 e0b1a94016..617ca51666 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 2ddd0acf64..35af2dcad6 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 67d80f0412..58e3bb2a07 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 c3ccf1d0ee..ea83b9b216 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 d35227fae4..aeb0595441 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 0bff7e7504..9d8a0c1113 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;