combopatch

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

p4raw-id: //depot/perl@24318

diff --git a/embed.fnc b/embed.fnc
index 2870884..18f7ac4 100644 (file)
--- 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 (file)
--- 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 39b8fd8..b04e24f 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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;