X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=d3a001af4c7070dc193d6298a733bd1d6b67b030;hb=47ec63d06651617a148bb474657949bf1cf43062;hp=b5a9290923269174ec0bc9d937ad33a8014c2a88;hpb=50acdf951a03f778010b5632532ec99bfa7c4f6a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/mg.c b/mg.c
index b5a9290..d3a001a 100644
--- a/mg.c
+++ b/mg.c
@@ -1,7 +1,7 @@
 /*    mg.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005 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.
@@ -52,19 +52,11 @@ tie.
 #  include <sys/pstat.h>
 #endif
 
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+Signal_t Perl_csighandler(int sig, ...);
+#else
 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_ void *p);
-static void unwind_handler_stack(pTHX_ void *p);
 
 #ifdef __Lynx__
 /* Missing protos on LynxOS */
@@ -90,13 +82,13 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv)
 {
     MGS* mgs;
     assert(SvMAGICAL(sv));
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
     /* Turning READONLY off for a copy-on-write scalar is a bad idea.  */
     if (SvIsCOW(sv))
       sv_force_normal(sv);
 #endif
 
-    SAVEDESTRUCTOR_X(restore_magic, INT2PTR(void*, (IV)mgs_ix));
+    SAVEDESTRUCTOR_X(S_restore_magic, INT2PTR(void*, (IV)mgs_ix));
 
     mgs = SSPTR(mgs_ix, MGS*);
     mgs->mgs_sv = sv;
@@ -119,9 +111,9 @@ Turns on the magical status of an SV.  See C<sv_magic>.
 void
 Perl_mg_magical(pTHX_ SV *sv)
 {
-    MAGIC* mg;
+    const MAGIC* mg;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
-	MGVTBL* vtbl = mg->mg_virtual;
+	const MGVTBL* const vtbl = mg->mg_virtual;
 	if (vtbl) {
 	    if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
 		SvGMAGICAL_on(sv);
@@ -144,10 +136,10 @@ Do magic after a value is retrieved from the SV.  See C<sv_magic>.
 int
 Perl_mg_get(pTHX_ SV *sv)
 {
-    int new = 0;
+    const I32 mgs_ix = SSNEW(sizeof(MGS));
+    const bool was_temp = (bool)SvTEMP(sv);
+    int have_new = 0;
     MAGIC *newmg, *head, *cur, *mg;
-    I32 mgs_ix = SSNEW(sizeof(MGS));
-    int was_temp = SvTEMP(sv);
     /* guard against sv having being freed midway by holding a private
        reference. */
 
@@ -168,7 +160,7 @@ Perl_mg_get(pTHX_ SV *sv)
 
     newmg = cur = head = mg = SvMAGIC(sv);
     while (mg) {
-	MGVTBL *vtbl = mg->mg_virtual;
+	const MGVTBL * const vtbl = mg->mg_virtual;
 
 	if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
 	    CALL_FPTR(vtbl->svt_get)(aTHX_ sv, mg);
@@ -185,25 +177,25 @@ Perl_mg_get(pTHX_ SV *sv)
 
 	mg = mg->mg_moremagic;
 
-	if (new) {
+	if (have_new) {
 	    /* Have we finished with the new entries we saw? Start again
 	       where we left off (unless there are more new entries). */
 	    if (mg == head) {
-		new  = 0;
+		have_new = 0;
 		mg   = cur;
 		head = newmg;
 	    }
 	}
 
 	/* Were any new entries added? */
-	if (!new && (newmg = SvMAGIC(sv)) != head) {
-	    new = 1;
+	if (!have_new && (newmg = SvMAGIC(sv)) != head) {
+	    have_new = 1;
 	    cur = mg;
 	    mg  = newmg;
 	}
     }
 
-    restore_magic(aTHX_ INT2PTR(void *, (IV)mgs_ix));
+    restore_magic(INT2PTR(void *, (IV)mgs_ix));
 
     if (SvREFCNT(sv) == 1) {
 	/* We hold the last reference to this SV, which implies that the
@@ -224,15 +216,14 @@ Do magic after a value is assigned to the SV.  See C<sv_magic>.
 int
 Perl_mg_set(pTHX_ SV *sv)
 {
-    I32 mgs_ix;
+    const I32 mgs_ix = SSNEW(sizeof(MGS));
     MAGIC* mg;
     MAGIC* nextmg;
 
-    mgs_ix = SSNEW(sizeof(MGS));
     save_magic(mgs_ix, sv);
 
     for (mg = SvMAGIC(sv); mg; mg = nextmg) {
-	MGVTBL* vtbl = mg->mg_virtual;
+        const MGVTBL* vtbl = mg->mg_virtual;
 	nextmg = mg->mg_moremagic;	/* it may delete itself */
 	if (mg->mg_flags & MGf_GSKIP) {
 	    mg->mg_flags &= ~MGf_GSKIP;	/* setting requires another read */
@@ -242,7 +233,7 @@ Perl_mg_set(pTHX_ SV *sv)
 	    CALL_FPTR(vtbl->svt_set)(aTHX_ sv, mg);
     }
 
-    restore_magic(aTHX_ INT2PTR(void*, (IV)mgs_ix));
+    restore_magic(INT2PTR(void*, (IV)mgs_ix));
     return 0;
 }
 
@@ -261,26 +252,23 @@ Perl_mg_length(pTHX_ SV *sv)
     STRLEN len;
 
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
-	MGVTBL* vtbl = mg->mg_virtual;
+        const MGVTBL * const vtbl = mg->mg_virtual;
 	if (vtbl && vtbl->svt_len) {
-            I32 mgs_ix;
-
-	    mgs_ix = SSNEW(sizeof(MGS));
+            const I32 mgs_ix = SSNEW(sizeof(MGS));
 	    save_magic(mgs_ix, sv);
 	    /* omit MGf_GSKIP -- not changed here */
 	    len = CALL_FPTR(vtbl->svt_len)(aTHX_ sv, mg);
-	    restore_magic(aTHX_ INT2PTR(void*, (IV)mgs_ix));
+	    restore_magic(INT2PTR(void*, (IV)mgs_ix));
 	    return len;
 	}
     }
 
-    if (DO_UTF8(sv))
-    {
-        U8 *s = (U8*)SvPV(sv, len);
+    if (DO_UTF8(sv)) {
+        const U8 *s = (U8*)SvPV_const(sv, len);
         len = Perl_utf8_length(aTHX_ s, s + len);
     }
     else
-        (void)SvPV(sv, len);
+        (void)SvPV_const(sv, len);
     return len;
 }
 
@@ -288,26 +276,23 @@ I32
 Perl_mg_size(pTHX_ SV *sv)
 {
     MAGIC* mg;
-    I32 len;
 
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
-	MGVTBL* vtbl = mg->mg_virtual;
+        const MGVTBL* const vtbl = mg->mg_virtual;
 	if (vtbl && vtbl->svt_len) {
-            I32 mgs_ix;
-
-	    mgs_ix = SSNEW(sizeof(MGS));
+            const I32 mgs_ix = SSNEW(sizeof(MGS));
+            I32 len;
 	    save_magic(mgs_ix, sv);
 	    /* omit MGf_GSKIP -- not changed here */
 	    len = CALL_FPTR(vtbl->svt_len)(aTHX_ sv, mg);
-	    restore_magic(aTHX_ INT2PTR(void*, (IV)mgs_ix));
+	    restore_magic(INT2PTR(void*, (IV)mgs_ix));
 	    return len;
 	}
     }
 
     switch(SvTYPE(sv)) {
 	case SVt_PVAV:
-	    len = AvFILLp((AV *) sv); /* Fallback to non-tied array */
-	    return len;
+	    return AvFILLp((AV *) sv); /* Fallback to non-tied array */
 	case SVt_PVHV:
 	    /* FIXME */
 	default:
@@ -328,21 +313,20 @@ Clear something magical that the SV represents.  See C<sv_magic>.
 int
 Perl_mg_clear(pTHX_ SV *sv)
 {
-    I32 mgs_ix;
+    const I32 mgs_ix = SSNEW(sizeof(MGS));
     MAGIC* mg;
 
-    mgs_ix = SSNEW(sizeof(MGS));
     save_magic(mgs_ix, sv);
 
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
-	MGVTBL* vtbl = mg->mg_virtual;
+        const MGVTBL* const vtbl = mg->mg_virtual;
 	/* omit GSKIP -- never set here */
 
 	if (vtbl && vtbl->svt_clear)
 	    CALL_FPTR(vtbl->svt_clear)(aTHX_ sv, mg);
     }
 
-    restore_magic(aTHX_ INT2PTR(void*, (IV)mgs_ix));
+    restore_magic(INT2PTR(void*, (IV)mgs_ix));
     return 0;
 }
 
@@ -355,14 +339,14 @@ Finds the magic pointer for type matching the SV.  See C<sv_magic>.
 */
 
 MAGIC*
-Perl_mg_find(pTHX_ SV *sv, int type)
+Perl_mg_find(pTHX_ const SV *sv, int type)
 {
-    MAGIC* mg;
-    if (!sv)
-        return 0;
-    for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
-	if (mg->mg_type == type)
-	    return mg;
+    if (sv) {
+        MAGIC *mg;
+        for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+            if (mg->mg_type == type)
+                return mg;
+        }
     }
     return 0;
 }
@@ -381,7 +365,7 @@ Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen)
     int count = 0;
     MAGIC* mg;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
-	MGVTBL* vtbl = mg->mg_virtual;
+        const MGVTBL* const vtbl = mg->mg_virtual;
 	if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy){
 	    count += CALL_FPTR(vtbl->svt_copy)(aTHX_ sv, mg, nsv, key, klen);
 	}
@@ -398,6 +382,68 @@ Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen)
 }
 
 /*
+=for apidoc mg_localize
+
+Copy some of the magic from an existing SV to new localized version of
+that SV. Container magic (eg %ENV, $1, tie) gets copied, value magic
+doesn't (eg taint, pos).
+
+=cut
+*/
+
+void
+Perl_mg_localize(pTHX_ SV *sv, SV *nsv)
+{
+    MAGIC *mg;
+    for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+	const MGVTBL* const vtbl = mg->mg_virtual;
+	switch (mg->mg_type) {
+	/* value magic types: don't copy */
+	case PERL_MAGIC_bm:
+	case PERL_MAGIC_fm:
+	case PERL_MAGIC_regex_global:
+	case PERL_MAGIC_nkeys:
+#ifdef USE_LOCALE_COLLATE
+	case PERL_MAGIC_collxfrm:
+#endif
+	case PERL_MAGIC_qr:
+	case PERL_MAGIC_taint:
+	case PERL_MAGIC_vec:
+	case PERL_MAGIC_vstring:
+	case PERL_MAGIC_utf8:
+	case PERL_MAGIC_substr:
+	case PERL_MAGIC_defelem:
+	case PERL_MAGIC_arylen:
+	case PERL_MAGIC_pos:
+	case PERL_MAGIC_backref:
+	case PERL_MAGIC_arylen_p:
+	case PERL_MAGIC_rhash:
+	case PERL_MAGIC_symtab:
+	    continue;
+	}
+		
+	if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy) {
+	    /* XXX calling the copy method is probably not correct. DAPM */
+	    (void)CALL_FPTR(vtbl->svt_copy)(aTHX_ sv, mg, nsv,
+				    mg->mg_ptr, mg->mg_len);
+	}
+	else {
+	    sv_magicext(nsv, mg->mg_obj, mg->mg_type, vtbl,
+			    mg->mg_ptr, mg->mg_len);
+	}
+	/* container types should remain read-only across localization */
+	SvFLAGS(nsv) |= SvREADONLY(sv);
+    }
+
+    if (SvTYPE(nsv) >= SVt_PVMG && SvMAGIC(nsv)) {
+	SvFLAGS(nsv) |= SvMAGICAL(sv);
+	PL_localizing = 1;
+	SvSETMAGIC(nsv);
+	PL_localizing = 0;
+    }	    
+}
+
+/*
 =for apidoc mg_free
 
 Free any magic storage used by the SV.  See C<sv_magic>.
@@ -411,7 +457,7 @@ Perl_mg_free(pTHX_ SV *sv)
     MAGIC* mg;
     MAGIC* moremagic;
     for (mg = SvMAGIC(sv); mg; mg = moremagic) {
-	MGVTBL* vtbl = mg->mg_virtual;
+        const MGVTBL* const vtbl = mg->mg_virtual;
 	moremagic = mg->mg_moremagic;
 	if (vtbl && vtbl->svt_free)
 	    CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg);
@@ -425,7 +471,7 @@ Perl_mg_free(pTHX_ SV *sv)
 	    SvREFCNT_dec(mg->mg_obj);
 	Safefree(mg);
     }
-    SvMAGIC(sv) = 0;
+    SvMAGIC_set(sv, NULL);
     return 0;
 }
 
@@ -434,7 +480,8 @@ Perl_mg_free(pTHX_ SV *sv)
 U32
 Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
 {
-    register REGEXP *rx;
+    register const REGEXP *rx;
+    PERL_UNUSED_ARG(sv);
 
     if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
 	if (mg->mg_obj)		/* @+ */
@@ -449,27 +496,26 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
 {
-    register I32 paren;
-    register I32 s;
-    register I32 i;
     register REGEXP *rx;
-    I32 t;
 
     if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-	paren = mg->mg_len;
+        register const I32 paren = mg->mg_len;
+        register I32 s;
+        register I32 t;
 	if (paren < 0)
 	    return 0;
 	if (paren <= (I32)rx->nparens &&
 	    (s = rx->startp[paren]) != -1 &&
 	    (t = rx->endp[paren]) != -1)
 	    {
+                register I32 i;
 		if (mg->mg_obj)		/* @+ */
 		    i = t;
 		else			/* @- */
 		    i = s;
 
 		if (i > 0 && RX_MATCH_UTF8(rx)) {
-		    char *b = rx->subbeg;
+		    const char * const b = rx->subbeg;
 		    if (b)
 		        i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i));
 		}
@@ -483,9 +529,9 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_UNUSED_ARG(sv); PERL_UNUSED_ARG(mg);
     Perl_croak(aTHX_ PL_no_modify);
-    /* NOT REACHED */
-    return 0;
+    NORETURN_FUNCTION_END;
 }
 
 U32
@@ -493,7 +539,7 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
 {
     register I32 paren;
     register I32 i;
-    register REGEXP *rx;
+    register const REGEXP *rx;
     I32 s1, t1;
 
     switch (*mg->mg_ptr) {
@@ -510,12 +556,13 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
 		i = t1 - s1;
 	      getlen:
 		if (i > 0 && RX_MATCH_UTF8(rx)) {
-		    char *s    = rx->subbeg + s1;
-		    char *send = rx->subbeg + t1;
+		    const char * const s = rx->subbeg + s1;
+		    const U8 *ep;
+		    STRLEN el;
 
                     i = t1 - s1;
-		    if (is_utf8_string((U8*)s, i))
-			i = Perl_utf8_length(aTHX_ (U8*)s, (U8*)send);
+		    if (is_utf8_string_loclen((U8*)s, i, &ep, &el))
+			i = el;
 		}
 		if (i < 0)
 		    Perl_croak(aTHX_ "panic: magic_len: %"IVdf, (IV)i);
@@ -572,17 +619,24 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
     }
     magic_get(sv,mg);
     if (!SvPOK(sv) && SvNIOK(sv)) {
-	STRLEN n_a;
-	sv_2pv(sv, &n_a);
+	sv_2pv(sv, 0);
     }
     if (SvPOK(sv))
 	return SvCUR(sv);
     return 0;
 }
 
+#define SvRTRIM(sv) STMT_START { \
+    STRLEN len = SvCUR(sv); \
+    while (len > 0 && isSPACE(SvPVX(sv)[len-1])) \
+	--len; \
+    SvCUR_set(sv, len); \
+} STMT_END
+
 int
 Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     register I32 paren;
     register char *s = NULL;
     register I32 i;
@@ -592,8 +646,13 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     case '\001':		/* ^A */
 	sv_setsv(sv, PL_bodytarget);
 	break;
-    case '\003':		/* ^C */
-	sv_setiv(sv, (IV)PL_minus_c);
+    case '\003':		/* ^C, ^CHILD_ERROR_NATIVE */
+	if (*(mg->mg_ptr+1) == '\0') {
+	    sv_setiv(sv, (IV)PL_minus_c);
+	}
+	else if (strEQ(mg->mg_ptr, "\003HILD_ERROR_NATIVE")) {
+	    sv_setiv(sv, (IV)STATUS_NATIVE);
+        }
 	break;
 
     case '\004':		/* ^D */
@@ -619,7 +678,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 		  if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) & 1)
 		       sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length);
 		  else
-		       sv_setpv(sv,"");
+		       sv_setpvn(sv,"",0);
 	     }
 #else
 #ifdef OS2
@@ -645,12 +704,12 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 		       PerlProc_GetOSError(sv, dwErr);
 		  }
 		  else
-		       sv_setpv(sv, "");
+		       sv_setpvn(sv, "", 0);
 		  SetLastError(dwErr);
 	     }
 #else
 	     {
-		 int saveerrno = errno;
+		 const int saveerrno = errno;
 		 sv_setnv(sv, (NV)errno);
 		 sv_setpv(sv, errno ? Strerror(errno) : "");
 		 errno = saveerrno;
@@ -659,6 +718,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 #endif
 #endif
 #endif
+	     SvRTRIM(sv);
 	     SvNOK_on(sv);	/* what a wonderful hack! */
 	 }
 	 else if (strEQ(mg->mg_ptr+1, "NCODING"))
@@ -715,9 +775,11 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 		    ? (PL_taint_warn || PL_unsafe ? -1 : 1)
 		    : 0);
         break;
-    case '\025':		/* $^UNICODE */
+    case '\025':		/* $^UNICODE, $^UTF8LOCALE */
         if (strEQ(mg->mg_ptr, "\025NICODE"))
 	    sv_setuv(sv, (UV) PL_unicode);
+        else if (strEQ(mg->mg_ptr, "\025TF8LOCALE"))
+	    sv_setuv(sv, (UV) PL_utf8locale);
         break;
     case '\027':		/* ^W  & $^WARNING_BITS */
 	if (*(mg->mg_ptr+1) == '\0')
@@ -778,11 +840,11 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 			    MAGIC* mg = SvMAGIC(sv);
 			    MAGIC* mgt;
 			    PL_tainted = 1;
-			    SvMAGIC(sv) = mg->mg_moremagic;
+			    SvMAGIC_set(sv, mg->mg_moremagic);
 			    SvTAINT(sv);
 			    if ((mgt = SvMAGIC(sv))) {
 				mg->mg_moremagic = mgt;
-				SvMAGIC(sv) = mg;
+				SvMAGIC_set(sv, mg);
 			    }
 			} else
 			    SvTAINTED_off(sv);
@@ -829,11 +891,9 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	sv_setsv(sv,&PL_sv_undef);
 	break;
     case '.':
-#ifndef lint
 	if (GvIO(PL_last_in_gv)) {
 	    sv_setiv(sv, (IV)IoLINES(GvIOp(PL_last_in_gv)));
 	}
-#endif
 	break;
     case '?':
 	{
@@ -861,7 +921,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	    s = GvENAME(PL_defoutgv);
 	sv_setpv(sv,s);
 	break;
-#ifndef lint
     case '=':
 	if (GvIOp(PL_defoutgv))
 	    sv_setiv(sv, (IV)IoPAGE_LEN(GvIOp(PL_defoutgv)));
@@ -874,7 +933,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	if (GvIOp(PL_defoutgv))
 	    sv_setiv(sv, (IV)IoPAGE(GvIOp(PL_defoutgv)));
 	break;
-#endif
     case ':':
 	break;
     case '/':
@@ -892,16 +950,13 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	if (PL_ors_sv)
 	    sv_copypv(sv, PL_ors_sv);
 	break;
-    case '#':
-	sv_setpv(sv,PL_ofmt);
-	break;
     case '!':
 #ifdef VMS
 	sv_setnv(sv, (NV)((errno == EVMSERR) ? vaxc$errno : errno));
 	sv_setpv(sv, errno ? Strerror(errno) : "");
 #else
 	{
-	int saveerrno = errno;
+	const int saveerrno = errno;
 	sv_setnv(sv, (NV)errno);
 #ifdef OS2
 	if (errno == errno_isOS2 || errno == errno_isOS2_set)
@@ -912,6 +967,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	errno = saveerrno;
 	}
 #endif
+	SvRTRIM(sv);
 	SvNOK_on(sv);	/* what a wonderful hack! */
 	break;
     case '<':
@@ -923,21 +979,21 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     case '(':
 	sv_setiv(sv, (IV)PL_gid);
 #ifdef HAS_GETGROUPS
-	Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_gid);
+	Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, (long unsigned int)PL_gid);
 #endif
 	goto add_groups;
     case ')':
 	sv_setiv(sv, (IV)PL_egid);
 #ifdef HAS_GETGROUPS
-	Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_egid);
+	Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, (long unsigned int)PL_egid);
 #endif
       add_groups:
 #ifdef HAS_GETGROUPS
 	{
 	    Groups_t gary[NGROUPS];
-	    i = getgroups(NGROUPS,gary);
-	    while (--i >= 0)
-		Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f, gary[i]);
+	    I32 j = getgroups(NGROUPS,gary);
+	    while (--j >= 0)
+		Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f, (long unsigned int)gary[j]);
 	}
 #endif
 	(void)SvIOK_on(sv);	/* what a wonderful hack! */
@@ -953,7 +1009,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_getuvar(pTHX_ SV *sv, MAGIC *mg)
 {
-    struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
+    struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr;
 
     if (uf && uf->uf_val)
 	(*uf->uf_val)(aTHX_ uf->uf_index, sv);
@@ -963,12 +1019,13 @@ Perl_magic_getuvar(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 {
-    register char *s;
-    char *ptr;
+    dVAR;
+    const char *s;
+    const char *ptr;
     STRLEN len, klen;
 
-    s = SvPV(sv,len);
-    ptr = MgPV(mg,klen);
+    s = SvPV_const(sv,len);
+    ptr = MgPV_const(mg,klen);
     my_setenv(ptr, s);
 
 #ifdef DYNAMIC_ENV_FETCH
@@ -977,7 +1034,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
     if (!len) {
 	SV **valp;
 	if ((valp = hv_fetch(GvHVn(PL_envgv), ptr, klen, FALSE)))
-	    s = SvPV(*valp, len);
+	    s = SvPV_const(*valp, len);
     }
 #endif
 
@@ -988,10 +1045,13 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 	MgTAINTEDDIR_off(mg);
 #ifdef VMS
 	if (s && klen == 8 && strEQ(ptr, "DCL$PATH")) {
-	    char pathbuf[256], eltbuf[256], *cp, *elt = s;
+	    char pathbuf[256], eltbuf[256], *cp, *elt;
 	    Stat_t sbuf;
 	    int i = 0, j = 0;
 
+	    strncpy(eltbuf, s, 255);
+	    eltbuf[255] = 0;
+	    elt = eltbuf;
 	    do {          /* DCL$PATH may be a search list */
 		while (1) {   /* as may dev portion of any element */
 		    if ( ((cp = strchr(elt,'[')) || (cp = strchr(elt,'<'))) ) {
@@ -1013,7 +1073,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 	}
 #endif /* VMS */
 	if (s && klen == 4 && strEQ(ptr,"PATH")) {
-	    char *strend = s + len;
+	    const char * const strend = s + len;
 
 	    while (s < strend) {
 		char tmpbuf[256];
@@ -1039,26 +1099,25 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_clearenv(pTHX_ SV *sv, MAGIC *mg)
 {
-    STRLEN n_a;
-    my_setenv(MgPV(mg,n_a),Nullch);
+    PERL_UNUSED_ARG(sv);
+    my_setenv(MgPV_nolen_const(mg),Nullch);
     return 0;
 }
 
 int
 Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg)
 {
-#if defined(VMS)
+#if defined(VMS) || defined(EPOC) || defined(SYMBIAN)
     Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
 #else
     if (PL_localizing) {
 	HE* entry;
-	STRLEN n_a;
 	magic_clear_all_env(sv,mg);
 	hv_iterinit((HV*)sv);
 	while ((entry = hv_iternext((HV*)sv))) {
 	    I32 keylen;
 	    my_setenv(hv_iterkey(entry, &keylen),
-		      SvPV(hv_iterval((HV*)sv, entry), n_a));
+		      SvPV_nolen_const(hv_iterval((HV*)sv, entry)));
 	}
     }
 #endif
@@ -1068,8 +1127,9 @@ Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
 #ifndef PERL_MICRO
-#if defined(VMS) || defined(EPOC)
+#if defined(VMS) || defined(EPOC) || defined(SYMBIAN)
     Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
 #else
 #  if defined(PERL_IMPLICIT_SYS) || defined(WIN32)
@@ -1099,35 +1159,25 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 #   endif /* PERL_IMPLICIT_SYS || WIN32 */
 #endif /* VMS || EPOC */
 #endif /* !PERL_MICRO */
+    PERL_UNUSED_ARG(sv);
+    PERL_UNUSED_ARG(mg);
     return 0;
 }
 
-#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS)||defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
-static int sig_handlers_initted = 0;
-#endif
-#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
-static int sig_ignoring[SIG_SIZE];      /* which signals we are ignoring */
-#endif
-#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
-static int sig_defaulting[SIG_SIZE];
-#endif
-
 #ifndef PERL_MICRO
 #ifdef HAS_SIGPROCMASK
 static void
 restore_sigmask(pTHX_ SV *save_sv)
 {
-    sigset_t *ossetp = (sigset_t *) SvPV_nolen( save_sv );
+    const sigset_t *ossetp = (const sigset_t *) SvPV_nolen_const( save_sv );
     (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
 }
 #endif
 int
 Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
 {
-    I32 i;
-    STRLEN n_a;
     /* Are we fetching a signal entry? */
-    i = whichsig(MgPV(mg,n_a));
+    const I32 i = whichsig(MgPV_nolen_const(mg));
     if (i > 0) {
     	if(PL_psig_ptr[i])
     	    sv_setsv(sv,PL_psig_ptr[i]);
@@ -1135,13 +1185,13 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
     	    Sighandler_t sigstate;
     	    sigstate = rsignal_state(i);
 #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
-    	    if (sig_handlers_initted && sig_ignoring[i]) sigstate = SIG_IGN;
+    	    if (PL_sig_handlers_initted && PL_sig_ignoring[i]) sigstate = SIG_IGN;
 #endif
 #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
-    	    if (sig_handlers_initted && sig_defaulting[i]) sigstate = SIG_DFL;
+    	    if (PL_sig_handlers_initted && PL_sig_defaulting[i]) sigstate = SIG_DFL;
 #endif
     	    /* cache state so we don't fetch it again */
-    	    if(sigstate == SIG_IGN)
+    	    if(sigstate == (Sighandler_t) SIG_IGN)
     	    	sv_setpv(sv,"IGNORE");
     	    else
     	    	sv_setsv(sv,&PL_sv_undef);
@@ -1157,28 +1207,26 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
     /* XXX Some of this code was copied from Perl_magic_setsig. A little
      * refactoring might be in order.
      */
-    register char *s;
-    STRLEN n_a;
-    SV* to_dec;
-    s = MgPV(mg,n_a);
+    dVAR;
+    register const char * const s = MgPV_nolen_const(mg);
+    PERL_UNUSED_ARG(sv);
     if (*s == '_') {
-	SV** svp;
+	SV** svp = 0;
 	if (strEQ(s,"__DIE__"))
 	    svp = &PL_diehook;
 	else if (strEQ(s,"__WARN__"))
 	    svp = &PL_warnhook;
 	else
 	    Perl_croak(aTHX_ "No such hook: %s", s);
-	if (*svp) {
-	    to_dec = *svp;
+	if (svp && *svp) {
+            SV * const to_dec = *svp;
 	    *svp = 0;
     	    SvREFCNT_dec(to_dec);
 	}
     }
     else {
-	I32 i;
 	/* Are we clearing a signal entry? */
-	i = whichsig(s);
+	const I32 i = whichsig(s);
 	if (i > 0) {
 #ifdef HAS_SIGPROCMASK
 	    sigset_t set, save;
@@ -1194,20 +1242,20 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
 #endif
 	    PERL_ASYNC_CHECK();
 #if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
-	    if (!sig_handlers_initted) Perl_csighandler_init();
+	    if (!PL_sig_handlers_initted) Perl_csighandler_init();
 #endif
 #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
-	    sig_defaulting[i] = 1;
+	    PL_sig_defaulting[i] = 1;
 	    (void)rsignal(i, PL_csighandlerp);
 #else
-	    (void)rsignal(i, SIG_DFL);
+	    (void)rsignal(i, (Sighandler_t) SIG_DFL);
 #endif
     	    if(PL_psig_name[i]) {
     		SvREFCNT_dec(PL_psig_name[i]);
     		PL_psig_name[i]=0;
     	    }
     	    if(PL_psig_ptr[i]) {
-		to_dec=PL_psig_ptr[i];
+                SV *to_dec=PL_psig_ptr[i];
     		PL_psig_ptr[i]=0;
 		LEAVE;
     		SvREFCNT_dec(to_dec);
@@ -1219,8 +1267,8 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
     return 0;
 }
 
-void
-Perl_raise_signal(pTHX_ int sig)
+static void
+S_raise_signal(pTHX_ int sig)
 {
     /* Set a flag to say this signal is pending */
     PL_psig_pend[sig]++;
@@ -1229,7 +1277,11 @@ Perl_raise_signal(pTHX_ int sig)
 }
 
 Signal_t
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+Perl_csighandler(int sig, ...)
+#else
 Perl_csighandler(int sig)
+#endif
 {
 #ifdef PERL_GET_SIG_CONTEXT
     dTHXa(PERL_GET_SIG_CONTEXT);
@@ -1238,10 +1290,10 @@ Perl_csighandler(int sig)
 #endif
 #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
     (void) rsignal(sig, PL_csighandlerp);
-    if (sig_ignoring[sig]) return;
+    if (PL_sig_ignoring[sig]) return;
 #endif
 #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
-    if (sig_defaulting[sig])
+    if (PL_sig_defaulting[sig])
 #ifdef KILL_BY_SIGPRC
             exit((Perl_sig_to_vmscondition(sig)&STS$M_COND_ID)|STS$K_SEVERE|STS$M_INHIB_MSG);
 #else
@@ -1253,7 +1305,7 @@ Perl_csighandler(int sig)
 	 * with risk we may be in malloc() etc. */
 	(*PL_sighandlerp)(sig);
    else
-	Perl_raise_signal(aTHX_ sig);
+	S_raise_signal(aTHX_ sig);
 }
 
 #if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
@@ -1261,19 +1313,19 @@ void
 Perl_csighandler_init(void)
 {
     int sig;
-    if (sig_handlers_initted) return;
+    if (PL_sig_handlers_initted) return;
 
     for (sig = 1; sig < SIG_SIZE; sig++) {
 #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
         dTHX;
-        sig_defaulting[sig] = 1;
+        PL_sig_defaulting[sig] = 1;
         (void) rsignal(sig, PL_csighandlerp);
 #endif
 #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
-        sig_ignoring[sig] = 0;
+        PL_sig_ignoring[sig] = 0;
 #endif
     }
-    sig_handlers_initted = 1;
+    PL_sig_handlers_initted = 1;
 }
 #endif
 
@@ -1296,7 +1348,7 @@ Perl_despatch_signals(pTHX)
 int
 Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 {
-    register char *s;
+    dVAR;
     I32 i;
     SV** svp = 0;
     /* Need to be careful with SvREFCNT_dec(), because that can have side
@@ -1310,7 +1362,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
     SV* save_sv;
 #endif
 
-    s = MgPV(mg,len);
+    register const char *s = MgPV_const(mg,len);
     if (*s == '_') {
 	if (strEQ(s,"__DIE__"))
 	    svp = &PL_diehook;
@@ -1326,7 +1378,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
     }
     else {
 	i = whichsig(s);	/* ...no, a brick */
-	if (i < 0) {
+	if (i <= 0) {
 	    if (ckWARN(WARN_SIGNAL))
 		Perl_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s", s);
 	    return 0;
@@ -1343,13 +1395,13 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 #endif
 	PERL_ASYNC_CHECK();
 #if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
-	if (!sig_handlers_initted) Perl_csighandler_init();
+	if (!PL_sig_handlers_initted) Perl_csighandler_init();
 #endif
 #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
-	sig_ignoring[i] = 0;
+	PL_sig_ignoring[i] = 0;
 #endif
 #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
-	sig_defaulting[i] = 0;
+	PL_sig_defaulting[i] = 0;
 #endif
 	SvREFCNT_dec(PL_psig_name[i]);
 	to_dec = PL_psig_ptr[i];
@@ -1375,10 +1427,10 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
     if (strEQ(s,"IGNORE")) {
 	if (i) {
 #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
-	    sig_ignoring[i] = 1;
+	    PL_sig_ignoring[i] = 1;
 	    (void)rsignal(i, PL_csighandlerp);
 #else
-	    (void)rsignal(i, SIG_IGN);
+	    (void)rsignal(i, (Sighandler_t) SIG_IGN);
 #endif
 	}
     }
@@ -1386,11 +1438,11 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 	if (i)
 #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
 	  {
-	    sig_defaulting[i] = 1;
+	    PL_sig_defaulting[i] = 1;
 	    (void)rsignal(i, PL_csighandlerp);
 	  }
 #else
-	    (void)rsignal(i, SIG_DFL);
+	    (void)rsignal(i, (Sighandler_t) SIG_DFL);
 #endif
     }
     else {
@@ -1419,6 +1471,8 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_UNUSED_ARG(sv);
+    PERL_UNUSED_ARG(mg);
     PL_sub_generation++;
     return 0;
 }
@@ -1426,6 +1480,8 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setamagic(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_UNUSED_ARG(sv);
+    PERL_UNUSED_ARG(mg);
     /* HV_badAMAGIC_on(Sv_STASH(sv)); */
     PL_amagic_generation++;
 
@@ -1435,8 +1491,9 @@ Perl_magic_setamagic(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_getnkeys(pTHX_ SV *sv, MAGIC *mg)
 {
-    HV *hv = (HV*)LvTARG(sv);
+    HV * const hv = (HV*)LvTARG(sv);
     I32 i = 0;
+    PERL_UNUSED_ARG(mg);
 
     if (hv) {
          (void) hv_iterinit(hv);
@@ -1455,6 +1512,7 @@ Perl_magic_getnkeys(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setnkeys(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_UNUSED_ARG(mg);
     if (LvTARG(sv)) {
 	hv_ksplit((HV*)LvTARG(sv), SvIV(sv));
     }
@@ -1463,7 +1521,7 @@ Perl_magic_setnkeys(pTHX_ SV *sv, MAGIC *mg)
 
 /* caller is responsible for stack switching/cleanup */
 STATIC int
-S_magic_methcall(pTHX_ SV *sv, MAGIC *mg, char *meth, I32 flags, int n, SV *val)
+S_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags, int n, SV *val)
 {
     dSP;
 
@@ -1490,9 +1548,9 @@ S_magic_methcall(pTHX_ SV *sv, MAGIC *mg, char *meth, I32 flags, int n, SV *val)
 }
 
 STATIC int
-S_magic_methpack(pTHX_ SV *sv, MAGIC *mg, char *meth)
+S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, const char *meth)
 {
-    dSP;
+    dVAR; dSP;
 
     ENTER;
     SAVETMPS;
@@ -1520,7 +1578,7 @@ Perl_magic_getpack(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg)
 {
-    dSP;
+    dVAR; dSP;
     ENTER;
     PUSHSTACKi(PERLSI_MAGIC);
     magic_methcall(sv, mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
@@ -1539,7 +1597,7 @@ Perl_magic_clearpack(pTHX_ SV *sv, MAGIC *mg)
 U32
 Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg)
 {
-    dSP;
+    dVAR; dSP;
     U32 retval = 0;
 
     ENTER;
@@ -1558,7 +1616,7 @@ Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
 {
-    dSP;
+    dVAR; dSP;
 
     ENTER;
     PUSHSTACKi(PERLSI_MAGIC);
@@ -1575,8 +1633,8 @@ Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
 {
-    dSP;
-    const char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
+    dVAR; dSP;
+    const char * const meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
 
     ENTER;
     SAVETMPS;
@@ -1606,20 +1664,20 @@ Perl_magic_existspack(pTHX_ SV *sv, MAGIC *mg)
 SV *
 Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
 {
-    dSP;
+    dVAR; dSP;
     SV *retval = &PL_sv_undef;
-    SV *tied = SvTIED_obj((SV*)hv, mg);
-    HV *pkg = SvSTASH((SV*)SvRV(tied));
+    SV * const tied = SvTIED_obj((SV*)hv, mg);
+    HV * const pkg = SvSTASH((SV*)SvRV(tied));
    
     if (!gv_fetchmethod_autoload(pkg, "SCALAR", FALSE)) {
         SV *key;
-        if (HvEITER(hv))
+        if (HvEITER_get(hv))
             /* we are in an iteration so the hash cannot be empty */
             return &PL_sv_yes;
         /* no xhv_eiter so now use FIRSTKEY */
         key = sv_newmortal();
         magic_nextpack((SV*)hv, mg, key);
-        HvEITER(hv) = NULL;     /* need to reset iterator */
+        HvEITER_set(hv, NULL);     /* need to reset iterator */
         return SvOK(key) ? &PL_sv_yes : &PL_sv_no;
     }
    
@@ -1641,44 +1699,74 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
 int
 Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
 {
-    OP *o;
-    I32 i;
-    GV* gv;
-    SV** svp;
-    STRLEN n_a;
-
-    gv = PL_DBline;
-    i = SvTRUE(sv);
-    svp = av_fetch(GvAV(gv),
-		     atoi(MgPV(mg,n_a)), FALSE);
-    if (svp && SvIOKp(*svp) && (o = INT2PTR(OP*,SvIVX(*svp)))) {
-	/* set or clear breakpoint in the relevant control op */
-	if (i)
-	    o->op_flags |= OPf_SPECIAL;
-	else
-	    o->op_flags &= ~OPf_SPECIAL;
+    GV * const gv = PL_DBline;
+    const I32 i = SvTRUE(sv);
+    SV ** const svp = av_fetch(GvAV(gv),
+		     atoi(MgPV_nolen_const(mg)), FALSE);
+    if (svp && SvIOKp(*svp)) {
+	OP * const o = INT2PTR(OP*,SvIVX(*svp));
+	if (o) {
+	    /* set or clear breakpoint in the relevant control op */
+	    if (i)
+		o->op_flags |= OPf_SPECIAL;
+	    else
+		o->op_flags &= ~OPf_SPECIAL;
+	}
     }
     return 0;
 }
 
 int
-Perl_magic_getarylen(pTHX_ SV *sv, MAGIC *mg)
+Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg)
 {
-    sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + PL_curcop->cop_arybase);
+    const AV * const obj = (AV*)mg->mg_obj;
+    if (obj) {
+	sv_setiv(sv, AvFILL(obj) + PL_curcop->cop_arybase);
+    } else {
+	SvOK_off(sv);
+    }
     return 0;
 }
 
 int
 Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
 {
-    av_fill((AV*)mg->mg_obj, SvIV(sv) - PL_curcop->cop_arybase);
+    AV * const obj = (AV*)mg->mg_obj;
+    if (obj) {
+	av_fill(obj, SvIV(sv) - PL_curcop->cop_arybase);
+    } else {
+	if (ckWARN(WARN_MISC))
+	    Perl_warner(aTHX_ packWARN(WARN_MISC),
+			"Attempt to set length of freed array");
+    }
+    return 0;
+}
+
+int
+Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg)
+{
+    PERL_UNUSED_ARG(sv);
+    /* during global destruction, mg_obj may already have been freed */
+    if (PL_in_clean_all)
+	return 0;
+
+    mg = mg_find (mg->mg_obj, PERL_MAGIC_arylen);
+
+    if (mg) {
+	/* arylen scalar holds a pointer back to the array, but doesn't own a
+	   reference. Hence the we (the array) are about to go away with it
+	   still pointing at us. Clear its pointer, else it would be pointing
+	   at free memory. See the comment in sv_magic about reference loops,
+	   and why it can't own a reference to us.  */
+	mg->mg_obj = 0;
+    }
     return 0;
 }
 
 int
 Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
 {
-    SV* lsv = LvTARG(sv);
+    SV* const lsv = LvTARG(sv);
 
     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
 	mg = mg_find(lsv, PERL_MAGIC_regex_global);
@@ -1697,7 +1785,7 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
 {
-    SV* lsv = LvTARG(sv);
+    SV* const lsv = LvTARG(sv);
     SSize_t pos;
     STRLEN len;
     STRLEN ulen = 0;
@@ -1749,6 +1837,7 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_getglob(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_UNUSED_ARG(mg);
     if (SvFAKE(sv)) {			/* FAKE globs can get coerced */
 	SvFAKE_off(sv);
 	gv_efullname3(sv,((GV*)sv), "*");
@@ -1762,16 +1851,12 @@ Perl_magic_getglob(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
 {
-    register char *s;
     GV* gv;
-    STRLEN n_a;
+    PERL_UNUSED_ARG(mg);
 
     if (!SvOK(sv))
 	return 0;
-    s = SvPV(sv, n_a);
-    if (*s == '*' && s[1])
-	s++;
-    gv = gv_fetchpv(s,TRUE, SVt_PVGV);
+    gv = gv_fetchsv(sv,TRUE, SVt_PVGV);
     if (sv == (SV*)gv)
 	return 0;
     if (GvGP(sv))
@@ -1784,10 +1869,11 @@ int
 Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
 {
     STRLEN len;
-    SV *lsv = LvTARG(sv);
-    char *tmps = SvPV(lsv,len);
+    SV * const lsv = LvTARG(sv);
+    const char * const tmps = SvPV_const(lsv,len);
     I32 offs = LvTARGOFF(sv);
     I32 rem = LvTARGLEN(sv);
+    PERL_UNUSED_ARG(mg);
 
     if (SvUTF8(lsv))
 	sv_pos_u2b(lsv, &offs, &rem);
@@ -1805,10 +1891,11 @@ int
 Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 {
     STRLEN len;
-    char *tmps = SvPV(sv, len);
-    SV *lsv = LvTARG(sv);
+    const char *tmps = SvPV_const(sv, len);
+    SV * const lsv = LvTARG(sv);
     I32 lvoff = LvTARGOFF(sv);
     I32 lvlen = LvTARGLEN(sv);
+    PERL_UNUSED_ARG(mg);
 
     if (DO_UTF8(sv)) {
 	sv_utf8_upgrade(lsv);
@@ -1836,31 +1923,30 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg)
 {
-    TAINT_IF((mg->mg_len & 1) ||
-	     ((mg->mg_len & 2) && mg->mg_obj == sv));	/* kludge */
+    PERL_UNUSED_ARG(sv);
+    TAINT_IF((PL_localizing != 1) && (mg->mg_len & 1));
     return 0;
 }
 
 int
 Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg)
 {
-    if (PL_localizing) {
-	if (PL_localizing == 1)
-	    mg->mg_len <<= 1;
+    PERL_UNUSED_ARG(sv);
+    /* update taint status unless we're restoring at scope exit */
+    if (PL_localizing != 2) {
+	if (PL_tainted)
+	    mg->mg_len |= 1;
 	else
-	    mg->mg_len >>= 1;
+	    mg->mg_len &= ~1;
     }
-    else if (PL_tainted)
-	mg->mg_len |= 1;
-    else
-	mg->mg_len &= ~1;
     return 0;
 }
 
 int
 Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg)
 {
-    SV *lsv = LvTARG(sv);
+    SV * const lsv = LvTARG(sv);
+    PERL_UNUSED_ARG(mg);
 
     if (!lsv) {
 	SvOK_off(sv);
@@ -1874,6 +1960,7 @@ Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setvec(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_UNUSED_ARG(mg);
     do_vecset(sv);	/* XXX slurp this routine */
     return 0;
 }
@@ -1884,13 +1971,13 @@ Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg)
     SV *targ = Nullsv;
     if (LvTARGLEN(sv)) {
 	if (mg->mg_obj) {
-	    SV *ahv = LvTARG(sv);
-            HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, FALSE, 0);
+	    SV * const ahv = LvTARG(sv);
+	    HE * const he = hv_fetch_ent((HV*)ahv, mg->mg_obj, FALSE, 0);
             if (he)
                 targ = HeVAL(he);
 	}
 	else {
-	    AV* av = (AV*)LvTARG(sv);
+	    AV* const av = (AV*)LvTARG(sv);
 	    if ((I32)LvTARGOFF(sv) <= AvFILL(av))
 		targ = AvARRAY(av)[LvTARGOFF(sv)];
 	}
@@ -1913,6 +2000,7 @@ Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setdefelem(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_UNUSED_ARG(mg);
     if (LvTARGLEN(sv))
 	vivify_defelem(sv);
     if (LvTARG(sv)) {
@@ -1931,20 +2019,19 @@ Perl_vivify_defelem(pTHX_ SV *sv)
     if (!LvTARGLEN(sv) || !(mg = mg_find(sv, PERL_MAGIC_defelem)))
 	return;
     if (mg->mg_obj) {
-	SV *ahv = LvTARG(sv);
-	STRLEN n_a;
-        HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, TRUE, 0);
+	SV * const ahv = LvTARG(sv);
+	HE * const he = hv_fetch_ent((HV*)ahv, mg->mg_obj, TRUE, 0);
         if (he)
             value = HeVAL(he);
 	if (!value || value == &PL_sv_undef)
-	    Perl_croak(aTHX_ PL_no_helem, SvPV(mg->mg_obj, n_a));
+	    Perl_croak(aTHX_ PL_no_helem_sv, mg->mg_obj);
     }
     else {
-	AV* av = (AV*)LvTARG(sv);
+	AV* const av = (AV*)LvTARG(sv);
 	if ((I32)LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av))
 	    LvTARG(sv) = Nullsv;	/* array can't be extended */
 	else {
-	    SV** svp = av_fetch(av, LvTARGOFF(sv), TRUE);
+	    SV** const svp = av_fetch(av, LvTARGOFF(sv), TRUE);
 	    if (!svp || (value = *svp) == &PL_sv_undef)
 		Perl_croak(aTHX_ PL_no_aelem, (I32)LvTARGOFF(sv));
 	}
@@ -1961,20 +2048,37 @@ Perl_vivify_defelem(pTHX_ SV *sv)
 int
 Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
 {
-    AV *av = (AV*)mg->mg_obj;
+    AV *const av = (AV*)mg->mg_obj;
     SV **svp = AvARRAY(av);
-    I32 i = AvFILLp(av);
-    while (i >= 0) {
-	if (svp[i]) {
-	    if (!SvWEAKREF(svp[i]))
-		Perl_croak(aTHX_ "panic: magic_killbackrefs");
-	    /* XXX Should we check that it hasn't changed? */
-	    SvRV(svp[i]) = 0;
-	    SvOK_off(svp[i]);
-	    SvWEAKREF_off(svp[i]);
-	    svp[i] = Nullsv;
-	}
-	i--;
+    PERL_UNUSED_ARG(sv);
+
+    if (svp) {
+	SV *const *const last = svp + AvFILLp(av);
+
+	while (svp <= last) {
+	    if (*svp) {
+		SV *const referrer = *svp;
+		if (SvWEAKREF(referrer)) {
+		    /* XXX Should we check that it hasn't changed? */
+		    SvRV_set(referrer, 0);
+		    SvOK_off(referrer);
+		    SvWEAKREF_off(referrer);
+		} else if (SvTYPE(referrer) == SVt_PVGV ||
+			   SvTYPE(referrer) == SVt_PVLV) {
+		    /* You lookin' at me?  */
+		    assert(GvSTASH(referrer));
+		    assert(GvSTASH(referrer) == (HV*)sv);
+		    GvSTASH(referrer) = 0;
+		} else {
+		    Perl_croak(aTHX_
+			       "panic: magic_killbackrefs (flags=%"UVxf")",
+			       (UV)SvFLAGS(referrer));
+		}
+
+		*svp = Nullsv;
+	    }
+	    svp++;
+	}
     }
     SvREFCNT_dec(av); /* remove extra count added by sv_add_backref() */
     return 0;
@@ -1991,6 +2095,7 @@ Perl_magic_setmglob(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setbm(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_UNUSED_ARG(mg);
     sv_unmagic(sv, PERL_MAGIC_bm);
     SvVALID_off(sv);
     return 0;
@@ -1999,6 +2104,7 @@ Perl_magic_setbm(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setfm(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_UNUSED_ARG(mg);
     sv_unmagic(sv, PERL_MAGIC_fm);
     SvCOMPILED_off(sv);
     return 0;
@@ -2007,7 +2113,7 @@ Perl_magic_setfm(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *mg)
 {
-    struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
+    const struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr;
 
     if (uf && uf->uf_set)
 	(*uf->uf_set)(aTHX_ uf->uf_index, sv);
@@ -2017,6 +2123,7 @@ Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_UNUSED_ARG(mg);
     sv_unmagic(sv, PERL_MAGIC_qr);
     return 0;
 }
@@ -2024,7 +2131,9 @@ Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_freeregexp(pTHX_ SV *sv, MAGIC *mg)
 {
-    regexp *re = (regexp *)mg->mg_obj;
+    regexp * const re = (regexp *)mg->mg_obj;
+    PERL_UNUSED_ARG(sv);
+
     ReREFCNT_dec(re);
     return 0;
 }
@@ -2037,6 +2146,7 @@ Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg)
      * RenE<eacute> Descartes said "I think not."
      * and vanished with a faint plop.
      */
+    PERL_UNUSED_ARG(sv);
     if (mg->mg_ptr) {
 	Safefree(mg->mg_ptr);
 	mg->mg_ptr = NULL;
@@ -2050,6 +2160,7 @@ Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_UNUSED_ARG(sv);
     Safefree(mg->mg_ptr);	/* The mg_ptr holds the pos cache. */
     mg->mg_ptr = 0;
     mg->mg_len = -1;		/* The mg_len holds the len cache. */
@@ -2059,7 +2170,7 @@ Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 {
-    register char *s;
+    register const char *s;
     I32 i;
     STRLEN len;
     switch (*mg->mg_ptr) {
@@ -2072,7 +2183,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 
     case '\004':	/* ^D */
 #ifdef DEBUGGING
-	s = SvPV_nolen(sv);
+	s = SvPV_nolen_const(sv);
 	PL_debug = get_debug_opts(&s, 0) | DEBUG_TOP_FLAG;
 	DEBUG_x(dump_all());
 #else
@@ -2118,22 +2229,16 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	PL_hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
 	break;
     case '\011':	/* ^I */ /* NOT \t in EBCDIC */
-	if (PL_inplace)
-	    Safefree(PL_inplace);
-	if (SvOK(sv))
-	    PL_inplace = savepv(SvPV(sv,len));
-	else
-	    PL_inplace = Nullch;
+	Safefree(PL_inplace);
+	PL_inplace = SvOK(sv) ? savesvpv(sv) : Nullch;
 	break;
     case '\017':	/* ^O */
 	if (*(mg->mg_ptr+1) == '\0') {
-	    if (PL_osname) {
-		Safefree(PL_osname);
-		PL_osname = Nullch;
-	    }
+	    Safefree(PL_osname);
+	    PL_osname = Nullch;
 	    if (SvOK(sv)) {
 		TAINT_PROPER("assigning to $^O");
-		PL_osname = savepv(SvPV(sv,len));
+		PL_osname = savesvpv(sv);
 	    }
 	}
 	else if (strEQ(mg->mg_ptr, "\017PEN")) {
@@ -2145,8 +2250,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	break;
     case '\020':	/* ^P */
 	PL_perldb = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
-	if ((PERLDB_SUB || PERLDB_LINE || PERLDB_SUBLINE || PERLDB_ASSERTION)
-		&& !PL_DBsingle)
+	if (PL_perldb && !PL_DBsingle)
 	    init_debugger();
 	break;
     case '\024':	/* ^T */
@@ -2175,7 +2279,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 		    STRLEN len, i;
 		    int accumulate = 0 ;
 		    int any_fatals = 0 ;
-		    char * ptr = (char*)SvPV(sv, len) ;
+		    const char * const ptr = SvPV_const(sv, len) ;
 		    for (i = 0 ; i < len ; ++i) {
 		        accumulate |= ptr[i] ;
 		        any_fatals |= (ptr[i] & 0xAA) ;
@@ -2209,13 +2313,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	break;
     case '^':
 	Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
-	IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
-	IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
+	s = IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
+	IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);
 	break;
     case '~':
 	Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
-	IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
-	IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
+	s = IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
+	IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);
 	break;
     case '=':
 	IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
@@ -2230,7 +2334,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	break;
     case '|':
 	{
-	    IO *io = GvIOp(PL_defoutgv);
+	    IO * const io = GvIOp(PL_defoutgv);
 	    if(!io)
 	      break;
 	    if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) == 0)
@@ -2269,11 +2373,6 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	    PL_ofs_sv = Nullsv;
 	}
 	break;
-    case '#':
-	if (PL_ofmt)
-	    Safefree(PL_ofmt);
-	PL_ofmt = savepv(SvPV(sv,len));
-	break;
     case '[':
 	PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
 	break;
@@ -2290,7 +2389,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	    STATUS_NATIVE_SET((U32)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)));
 	else
 #endif
-	    STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	    STATUS_UNIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 	break;
     case '!':
         {
@@ -2392,7 +2491,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     case ')':
 #ifdef HAS_SETGROUPS
 	{
-	    char *p = SvPV(sv, len);
+	    const char *p = SvPV_const(sv, len);
 	    Groups_t gary[NGROUPS];
 
 	    while (isSPACE(*p))
@@ -2449,7 +2548,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	 * show a string from the process struct and provide
 	 * the setproctitle() routine to manipulate that. */
 	{
-	    s = SvPV(sv, len);
+	    s = SvPV_const(sv, len);
 #   if __FreeBSD_version > 410001
 	    /* The leading "-" removes the "perl: " prefix,
 	     * but not the "(perl) suffix from the ps(1)
@@ -2471,8 +2570,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 #if defined(__hpux) && defined(PSTAT_SETCMD)
 	{
 	     union pstun un;
-	     s = SvPV(sv, len);
-	     un.pst_command = s;
+	     s = SvPV_const(sv, len);
+	     un.pst_command = (char *)s;
 	     pstat(PSTAT_SETCMD, un, len, 0, 0);
 	}
 #endif
@@ -2506,13 +2605,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 }
 
 I32
-Perl_whichsig(pTHX_ char *sig)
+Perl_whichsig(pTHX_ const char *sig)
 {
-    register char **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;
@@ -2524,12 +2623,12 @@ Perl_whichsig(pTHX_ char *sig)
     return -1;
 }
 
-#if !defined(PERL_IMPLICIT_CONTEXT)
-static SV* sig_sv;
-#endif
-
 Signal_t
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+Perl_sighandler(int sig, ...)
+#else
 Perl_sighandler(int sig)
+#endif
 {
 #ifdef PERL_GET_SIG_CONTEXT
     dTHXa(PERL_GET_SIG_CONTEXT);
@@ -2538,12 +2637,12 @@ Perl_sighandler(int sig)
 #endif
     dSP;
     GV *gv = Nullgv;
-    HV *st;
-    SV *sv = Nullsv, *tSv = PL_Sv;
+    SV *sv = Nullsv;
+    SV * const tSv = PL_Sv;
     CV *cv = Nullcv;
     OP *myop = PL_op;
     U32 flags = 0;
-    XPV *tXpv = PL_Xpv;
+    XPV * const tXpv = PL_Xpv;
 
     if (PL_savestack_ix + 15 <= PL_savestack_max)
 	flags |= 1;
@@ -2562,7 +2661,7 @@ Perl_sighandler(int sig)
        infinity, so we fix 4 (in fact 5): */
     if (flags & 1) {
 	PL_savestack_ix += 5;		/* Protect save in progress. */
-	SAVEDESTRUCTOR_X(unwind_handler_stack, (void*)&flags);
+	SAVEDESTRUCTOR_X(S_unwind_handler_stack, (void*)&flags);
     }
     if (flags & 4)
 	PL_markstack_ptr++;		/* Protect mark. */
@@ -2570,8 +2669,10 @@ Perl_sighandler(int sig)
 	PL_scopestack_ix += 1;
     /* sv_2cv is too complicated, try a simpler variant first: */
     if (!SvROK(PL_psig_ptr[sig]) || !(cv = (CV*)SvRV(PL_psig_ptr[sig]))
-	|| SvTYPE(cv) != SVt_PVCV)
+	|| SvTYPE(cv) != SVt_PVCV) {
+	HV *st;
 	cv = sv_2cv(PL_psig_ptr[sig],&st,&gv,TRUE);
+    }
 
     if (!cv || !CvROOT(cv)) {
 	if (ckWARN(WARN_SIGNAL))
@@ -2587,7 +2688,7 @@ Perl_sighandler(int sig)
     	sv = SvREFCNT_inc(PL_psig_name[sig]);
 	flags |= 64;
 #if !defined(PERL_IMPLICIT_CONTEXT)
-	sig_sv = sv;
+	PL_sig_sv = sv;
 #endif
     } else {
 	sv = sv_newmortal();
@@ -2597,6 +2698,38 @@ Perl_sighandler(int sig)
     PUSHSTACKi(PERLSI_SIGNAL);
     PUSHMARK(SP);
     PUSHs(sv);
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+    {
+	 struct sigaction oact;
+
+	 if (sigaction(sig, 0, &oact) == 0 && oact.sa_flags & SA_SIGINFO) {
+	      siginfo_t *sip;
+	      va_list args;
+
+	      va_start(args, sig);
+	      sip = (siginfo_t*)va_arg(args, siginfo_t*);
+	      if (sip) {
+		   HV *sih = newHV();
+		   SV *rv  = newRV_noinc((SV*)sih);
+		   /* The siginfo fields signo, code, errno, pid, uid,
+		    * addr, status, and band are defined by POSIX/SUSv3. */
+		   hv_store(sih, "signo",   5, newSViv(sip->si_signo),  0);
+		   hv_store(sih, "code",    4, newSViv(sip->si_code),   0);
+#if 0 /* XXX TODO: Configure scan for the existence of these, but even that does not help if the SA_SIGINFO is not implemented according to the spec. */
+		   hv_store(sih, "errno",   5, newSViv(sip->si_errno),  0);
+		   hv_store(sih, "status",  6, newSViv(sip->si_status), 0);
+		   hv_store(sih, "uid",     3, newSViv(sip->si_uid),    0);
+		   hv_store(sih, "pid",     3, newSViv(sip->si_pid),    0);
+		   hv_store(sih, "addr",    4, newSVuv(PTR2UV(sip->si_addr)),   0);
+		   hv_store(sih, "band",    4, newSViv(sip->si_band),   0);
+#endif
+		   EXTEND(SP, 2);
+		   PUSHs((SV*)rv);
+		   PUSHs(newSVpv((void*)sip, sizeof(*sip)));
+	      }
+	 }
+    }
+#endif
     PUTBACK;
 
     call_sv((SV*)cv, G_DISCARD|G_EVAL);
@@ -2619,7 +2752,7 @@ Perl_sighandler(int sig)
 	(void)rsignal(sig, PL_csighandlerp);
 #endif
 #endif /* !PERL_MICRO */
-	Perl_die(aTHX_ Nullformat);
+	Perl_die(aTHX_ Nullch);
     }
 cleanup:
     if (flags & 1)
@@ -2639,17 +2772,17 @@ cleanup:
 
 
 static void
-restore_magic(pTHX_ void *p)
+S_restore_magic(pTHX_ const void *p)
 {
-    MGS* mgs = SSPTR(PTR2IV(p), MGS*);
-    SV* sv = mgs->mgs_sv;
+    MGS* const mgs = SSPTR(PTR2IV(p), MGS*);
+    SV* const sv = mgs->mgs_sv;
 
     if (!sv)
         return;
 
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
     {
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
 	/* While magic was saved (and off) sv_setsv may well have seen
 	   this SV as a prime candidate for COW.  */
 	if (SvIsCOW(sv))
@@ -2660,8 +2793,16 @@ restore_magic(pTHX_ void *p)
 	    SvFLAGS(sv) |= mgs->mgs_flags;
 	else
 	    mg_magical(sv);
-	if (SvGMAGICAL(sv))
-	    SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
+	if (SvGMAGICAL(sv)) {
+	    /* downgrade public flags to private,
+	       and discard any other private flags */
+
+	    U32 public = SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK);
+	    if (public) {
+		SvFLAGS(sv) &= ~( public | SVp_IOK|SVp_NOK|SVp_POK );
+		SvFLAGS(sv) |= ( public << PRIVSHIFT );
+	    }
+	}
     }
 
     mgs->mgs_sv = NULL;  /* mark the MGS structure as restored */
@@ -2687,17 +2828,26 @@ restore_magic(pTHX_ void *p)
 }
 
 static void
-unwind_handler_stack(pTHX_ void *p)
+S_unwind_handler_stack(pTHX_ const void *p)
 {
-    U32 flags = *(U32*)p;
+    dVAR;
+    const U32 flags = *(const U32*)p;
 
     if (flags & 1)
 	PL_savestack_ix -= 5; /* Unprotect save in progress. */
     /* cxstack_ix-- Not needed, die already unwound it. */
 #if !defined(PERL_IMPLICIT_CONTEXT)
     if (flags & 64)
-	SvREFCNT_dec(sig_sv);
+	SvREFCNT_dec(PL_sig_sv);
 #endif
 }
 
-
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */