X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=46b2d7500089adafbbc28bd40c98e248597481b7;hb=16816334e212c70aca1836b4031924af481891ad;hp=bf9ecee8cbec6ce9f70f567be59ca3b3129f0770;hpb=1990e48c66466d2315d6307ae43a02140969e8dc;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/mg.c b/mg.c
index bf9ecee..46b2d75 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.
@@ -20,10 +20,10 @@
 "magical" properties.  When any Perl code tries to read from, or assign to,
 an SV marked as magical, it calls the 'get' or 'set' function associated
 with that SV's magic. A get is called prior to reading an SV, in order to
-give it a chance to update its interval value (get on $. writes the line
+give it a chance to update its internal value (get on $. writes the line
 number of the last read filehandle into to the SV's IV slot), while
 set is called after an SV has been written to, in order to allow it to make
-use of it's changed value (set on $/ copies the SV's new value to the
+use of its changed value (set on $/ copies the SV's new value to the
 PL_rs global variable).
 
 Magic is implemented as a linked list of MAGIC structures attached to the
@@ -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,30 +177,30 @@ 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
 	   SV was deleted as a side effect of the routines we called.  */
-	(void)SvOK_off(sv);
+	SvOK_off(sv);
     }
     return 0;
 }
@@ -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"))
@@ -695,7 +755,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     case '\023':		/* ^S */
         if (*(mg->mg_ptr+1) == '\0') {
 	    if (PL_lex_state != LEX_NOTPARSING)
-		(void)SvOK_off(sv);
+		SvOK_off(sv);
 	    else if (PL_in_eval)
  		sv_setiv(sv, PL_in_eval & ~(EVAL_INREQUIRE));
 	    else
@@ -715,19 +775,26 @@ 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')
 	    sv_setiv(sv, (IV)((PL_dowarn & G_WARN_ON) ? TRUE : FALSE));
 	else if (strEQ(mg->mg_ptr+1, "ARNING_BITS")) {
-	    if (PL_compiling.cop_warnings == pWARN_NONE ||
-	        PL_compiling.cop_warnings == pWARN_STD)
-	    {
+	    if (PL_compiling.cop_warnings == pWARN_NONE) {
 	        sv_setpvn(sv, WARN_NONEstring, WARNsize) ;
-            }
+	    }
+	    else if (PL_compiling.cop_warnings == pWARN_STD) {
+		sv_setpvn(
+		    sv, 
+		    (PL_dowarn & G_WARN_ON) ? WARN_ALLstring : WARN_NONEstring,
+		    WARNsize
+		);
+	    }
             else if (PL_compiling.cop_warnings == pWARN_ALL) {
 		/* Get the bit mask for $warnings::Bits{all}, because
 		 * it could have been extended by warnings::register */
@@ -778,11 +845,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 +896,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 +926,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 +938,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 +955,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 +972,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 +984,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 +1014,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 +1024,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 +1039,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 +1050,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 +1078,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 +1104,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 +1132,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)
@@ -1082,6 +1147,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 #      endif
     {
 #      ifndef PERL_USE_SAFE_PUTENV
+    if (!PL_use_safe_putenv) {
     I32 i;
 
     if (environ == PL_origenviron)
@@ -1089,6 +1155,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
     else
 	for (i = 0; environ[i]; i++)
 	    safesysfree(environ[i]);
+    }
 #      endif /* PERL_USE_SAFE_PUTENV */
 
     environ[0] = Nullch;
@@ -1097,35 +1164,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]);
@@ -1133,13 +1190,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);
@@ -1155,28 +1212,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;
@@ -1192,20 +1247,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);
@@ -1217,8 +1272,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]++;
@@ -1227,7 +1282,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);
@@ -1236,10 +1295,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
@@ -1251,7 +1310,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)
@@ -1259,19 +1318,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
 
@@ -1294,7 +1353,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
@@ -1308,7 +1367,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;
@@ -1324,7 +1383,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;
@@ -1341,13 +1400,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];
@@ -1373,10 +1432,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
 	}
     }
@@ -1384,11 +1443,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 {
@@ -1417,6 +1476,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;
 }
@@ -1424,6 +1485,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++;
 
@@ -1433,8 +1496,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);
@@ -1453,6 +1517,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));
     }
@@ -1461,7 +1526,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;
 
@@ -1488,9 +1553,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;
@@ -1518,7 +1583,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);
@@ -1537,7 +1602,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;
@@ -1556,7 +1621,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);
@@ -1573,8 +1638,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;
@@ -1604,20 +1669,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;
     }
    
@@ -1639,44 +1704,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);
@@ -1688,14 +1783,14 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
 	    return 0;
 	}
     }
-    (void)SvOK_off(sv);
+    SvOK_off(sv);
     return 0;
 }
 
 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;
@@ -1747,6 +1842,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), "*");
@@ -1760,16 +1856,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))
@@ -1782,10 +1874,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);
@@ -1803,10 +1896,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);
@@ -1834,34 +1928,33 @@ 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) {
-	(void)SvOK_off(sv);
+	SvOK_off(sv);
 	return 0;
     }
 
@@ -1872,6 +1965,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;
 }
@@ -1882,13 +1976,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)];
 	}
@@ -1911,6 +2005,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)) {
@@ -1929,20 +2024,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));
 	}
@@ -1959,20 +2053,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;
-	    (void)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;
@@ -1989,6 +2100,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;
@@ -1997,6 +2109,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;
@@ -2005,7 +2118,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);
@@ -2015,6 +2128,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;
 }
@@ -2022,7 +2136,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;
 }
@@ -2035,6 +2151,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;
@@ -2048,6 +2165,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. */
@@ -2057,7 +2175,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) {
@@ -2070,8 +2188,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 
     case '\004':	/* ^D */
 #ifdef DEBUGGING
-	s = SvPV_nolen(sv);
-	PL_debug = get_debug_opts(&s) | DEBUG_TOP_FLAG;
+	s = SvPV_nolen_const(sv);
+	PL_debug = get_debug_opts(&s, 0) | DEBUG_TOP_FLAG;
 	DEBUG_x(dump_all());
 #else
 	PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | DEBUG_TOP_FLAG;
@@ -2116,22 +2234,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")) {
@@ -2143,8 +2255,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 */
@@ -2173,7 +2284,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) ;
@@ -2207,13 +2318,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));
@@ -2228,7 +2339,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)
@@ -2267,11 +2378,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;
@@ -2288,7 +2394,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 '!':
         {
@@ -2390,7 +2496,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))
@@ -2447,7 +2553,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)
@@ -2469,8 +2575,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
@@ -2504,13 +2610,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;
@@ -2522,12 +2628,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);
@@ -2536,12 +2642,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;
@@ -2560,7 +2666,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. */
@@ -2568,8 +2674,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))
@@ -2585,7 +2693,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();
@@ -2595,6 +2703,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);
@@ -2617,7 +2757,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)
@@ -2637,17 +2777,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))
@@ -2658,8 +2798,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 */
@@ -2685,17 +2833,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:
+ */