X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/79dec0f47660bf63141eb6171dd4c2d4053422af..fc786e8b942a45b310ddfa1a762229c42b1bce9f:/mg.c

diff --git a/mg.c b/mg.c
index f3e6720..2e3bf46 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, 2005 by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 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.
@@ -40,14 +40,17 @@ tie.
 #include "perl.h"
 
 #if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
-#  ifndef NGROUPS
-#    define NGROUPS 32
-#  endif
 #  ifdef I_GRP
 #    include <grp.h>
 #  endif
 #endif
 
+#if defined(HAS_SETGROUPS)
+#  ifndef NGROUPS
+#    define NGROUPS 32
+#  endif
+#endif
+
 #ifdef __hpux
 #  include <sys/pstat.h>
 #endif
@@ -80,13 +83,13 @@ struct magic_state {
 STATIC void
 S_save_magic(pTHX_ I32 mgs_ix, SV *sv)
 {
+    dVAR;
     MGS* mgs;
     assert(SvMAGICAL(sv));
-#ifdef PERL_OLD_COPY_ON_WRITE
-    /* Turning READONLY off for a copy-on-write scalar is a bad idea.  */
+    /* Turning READONLY off for a copy-on-write scalar (including shared
+       hash keys) is a bad idea.  */
     if (SvIsCOW(sv))
-      sv_force_normal(sv);
-#endif
+      sv_force_normal_flags(sv, 0);
 
     SAVEDESTRUCTOR_X(S_restore_magic, INT2PTR(void*, (IV)mgs_ix));
 
@@ -97,7 +100,7 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv)
 
     SvMAGICAL_off(sv);
     SvREADONLY_off(sv);
-    SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+    SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
 }
 
 /*
@@ -112,6 +115,7 @@ void
 Perl_mg_magical(pTHX_ SV *sv)
 {
     const MAGIC* mg;
+    PERL_UNUSED_CONTEXT;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
 	const MGVTBL* const vtbl = mg->mg_virtual;
 	if (vtbl) {
@@ -136,6 +140,7 @@ Do magic after a value is retrieved from the SV.  See C<sv_magic>.
 int
 Perl_mg_get(pTHX_ SV *sv)
 {
+    dVAR;
     const I32 mgs_ix = SSNEW(sizeof(MGS));
     const bool was_temp = (bool)SvTEMP(sv);
     int have_new = 0;
@@ -147,7 +152,7 @@ Perl_mg_get(pTHX_ SV *sv)
        cause the SV's buffer to get stolen (and maybe other stuff).
        So restore it.
     */
-    sv_2mortal(SvREFCNT_inc(sv));
+    sv_2mortal(SvREFCNT_inc_simple_NN(sv));
     if (!was_temp) {
 	SvTEMP_off(sv);
     }
@@ -216,6 +221,7 @@ Do magic after a value is assigned to the SV.  See C<sv_magic>.
 int
 Perl_mg_set(pTHX_ SV *sv)
 {
+    dVAR;
     const I32 mgs_ix = SSNEW(sizeof(MGS));
     MAGIC* mg;
     MAGIC* nextmg;
@@ -248,6 +254,7 @@ Report on the SV's length.  See C<sv_magic>.
 U32
 Perl_mg_length(pTHX_ SV *sv)
 {
+    dVAR;
     MAGIC* mg;
     STRLEN len;
 
@@ -265,7 +272,7 @@ Perl_mg_length(pTHX_ SV *sv)
 
     if (DO_UTF8(sv)) {
         const U8 *s = (U8*)SvPV_const(sv, len);
-        len = Perl_utf8_length(aTHX_ s, s + len);
+	len = utf8_length(s, s + len);
     }
     else
         (void)SvPV_const(sv, len);
@@ -341,6 +348,7 @@ Finds the magic pointer for type matching the SV.  See C<sv_magic>.
 MAGIC*
 Perl_mg_find(pTHX_ const SV *sv, int type)
 {
+    PERL_UNUSED_CONTEXT;
     if (sv) {
         MAGIC *mg;
         for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
@@ -348,7 +356,7 @@ Perl_mg_find(pTHX_ const SV *sv, int type)
                 return mg;
         }
     }
-    return 0;
+    return NULL;
 }
 
 /*
@@ -369,13 +377,18 @@ Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen)
 	if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy){
 	    count += CALL_FPTR(vtbl->svt_copy)(aTHX_ sv, mg, nsv, key, klen);
 	}
-	else if (isUPPER(mg->mg_type)) {
-	    sv_magic(nsv,
-		     mg->mg_type == PERL_MAGIC_tied ? SvTIED_obj(sv, mg) :
-		     (mg->mg_type == PERL_MAGIC_regdata && mg->mg_obj)
-							? sv : mg->mg_obj,
-		     toLOWER(mg->mg_type), key, klen);
-	    count++;
+	else {
+	    const char type = mg->mg_type;
+	    if (isUPPER(type) && type != PERL_MAGIC_uvar) {
+		sv_magic(nsv,
+		     (type == PERL_MAGIC_tied)
+			? SvTIED_obj(sv, mg)
+			: (type == PERL_MAGIC_regdata && mg->mg_obj)
+			    ? sv
+			    : mg->mg_obj,
+		     toLOWER(type), key, klen);
+		count++;
+	    }
 	}
     }
     return count;
@@ -394,9 +407,10 @@ doesn't (eg taint, pos).
 void
 Perl_mg_localize(pTHX_ SV *sv, SV *nsv)
 {
+    dVAR;
     MAGIC *mg;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
-	const MGVTBL* const vtbl = mg->mg_virtual;
+	MGVTBL* const vtbl = mg->mg_virtual;
 	switch (mg->mg_type) {
 	/* value magic types: don't copy */
 	case PERL_MAGIC_bm:
@@ -422,15 +436,12 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv)
 	    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 {
+	if ((mg->mg_flags & MGf_LOCAL) && vtbl->svt_local)
+	    (void)CALL_FPTR(vtbl->svt_local)(aTHX_ nsv, mg);
+	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);
     }
@@ -480,14 +491,16 @@ Perl_mg_free(pTHX_ SV *sv)
 U32
 Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
 {
-    register const REGEXP *rx;
+    dVAR;
     PERL_UNUSED_ARG(sv);
 
-    if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-	if (mg->mg_obj)		/* @+ */
-	    return rx->nparens;
-	else			/* @- */
-	    return rx->lastparen;
+    if (PL_curpm) {
+	register const REGEXP * const rx = PM_GETRE(PL_curpm);
+	if (rx) {
+	    return mg->mg_obj
+		? rx->nparens       /* @+ */
+		: rx->lastparen;    /* @- */
+	}
     }
 
     return (U32)-1;
@@ -496,32 +509,34 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
 {
-    register REGEXP *rx;
-
-    if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-        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;
+    dVAR;
+    if (PL_curpm) {
+	register const REGEXP * const rx = PM_GETRE(PL_curpm);
+	if (rx) {
+	    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)) {
+			const char * const b = rx->subbeg;
+			if (b)
+			    i = utf8_length((U8*)b, (U8*)(b+i));
+		    }
 
-		if (i > 0 && RX_MATCH_UTF8(rx)) {
-		    const char * const b = rx->subbeg;
-		    if (b)
-		        i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i));
+		    sv_setiv(sv, i);
 		}
-
-		sv_setiv(sv, i);
-	    }
+	}
     }
     return 0;
 }
@@ -529,7 +544,8 @@ 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_UNUSED_ARG(sv);
+    PERL_UNUSED_ARG(mg);
     Perl_croak(aTHX_ PL_no_modify);
     NORETURN_FUNCTION_END;
 }
@@ -537,6 +553,7 @@ Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
 U32
 Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     register I32 paren;
     register I32 i;
     register const REGEXP *rx;
@@ -627,10 +644,14 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
 }
 
 #define SvRTRIM(sv) STMT_START { \
-    STRLEN len = SvCUR(sv); \
-    while (len > 0 && isSPACE(SvPVX(sv)[len-1])) \
-	--len; \
-    SvCUR_set(sv, len); \
+    if (SvPOK(sv)) { \
+        STRLEN len = SvCUR(sv); \
+        char * const p = SvPVX(sv); \
+	while (len > 0 && isSPACE(p[len-1])) \
+	   --len; \
+	SvCUR_set(sv, len); \
+	p[len] = '\0'; \
+    } \
 } STMT_END
 
 int
@@ -641,16 +662,18 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     register char *s = NULL;
     register I32 i;
     register REGEXP *rx;
+    const char * const remaining = mg->mg_ptr + 1;
+    const char nextchar = *remaining;
 
     switch (*mg->mg_ptr) {
     case '\001':		/* ^A */
 	sv_setsv(sv, PL_bodytarget);
 	break;
     case '\003':		/* ^C, ^CHILD_ERROR_NATIVE */
-	if (*(mg->mg_ptr+1) == '\0') {
+	if (nextchar == '\0') {
 	    sv_setiv(sv, (IV)PL_minus_c);
 	}
-	else if (strEQ(mg->mg_ptr, "\003HILD_ERROR_NATIVE")) {
+	else if (strEQ(remaining, "HILD_ERROR_NATIVE")) {
 	    sv_setiv(sv, (IV)STATUS_NATIVE);
         }
 	break;
@@ -659,16 +682,15 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	sv_setiv(sv, (IV)(PL_debug & DEBUG_MASK));
 	break;
     case '\005':  /* ^E */
-	 if (*(mg->mg_ptr+1) == '\0') {
-#ifdef MACOS_TRADITIONAL
+	 if (nextchar == '\0') {
+#if defined(MACOS_TRADITIONAL)
 	     {
 		  char msg[256];
 
 		  sv_setnv(sv,(double)gMacPerl_OSErr);
 		  sv_setpv(sv, gMacPerl_OSErr ? GetSysErrText(gMacPerl_OSErr, msg) : "");
 	     }
-#else
-#ifdef VMS
+#elif defined(VMS)
 	     {
 #	          include <descrip.h>
 #	          include <starlet.h>
@@ -680,27 +702,24 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 		  else
 		       sv_setpvn(sv,"",0);
 	     }
-#else
-#ifdef OS2
+#elif defined(OS2)
 	     if (!(_emx_env & 0x200)) {	/* Under DOS */
 		  sv_setnv(sv, (NV)errno);
 		  sv_setpv(sv, errno ? Strerror(errno) : "");
 	     } else {
 		  if (errno != errno_isOS2) {
-		       int tmp = _syserrno();
+		       const int tmp = _syserrno();
 		       if (tmp)	/* 2nd call to _syserrno() makes it 0 */
 			    Perl_rc = tmp;
 		  }
 		  sv_setnv(sv, (NV)Perl_rc);
 		  sv_setpv(sv, os2error(Perl_rc));
 	     }
-#else
-#ifdef WIN32
+#elif defined(WIN32)
 	     {
-		  DWORD dwErr = GetLastError();
+		  const DWORD dwErr = GetLastError();
 		  sv_setnv(sv, (NV)dwErr);
-		  if (dwErr)
-		  {
+		  if (dwErr) {
 		       PerlProc_GetOSError(sv, dwErr);
 		  }
 		  else
@@ -715,13 +734,10 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 		 errno = saveerrno;
 	     }
 #endif
-#endif
-#endif
-#endif
 	     SvRTRIM(sv);
 	     SvNOK_on(sv);	/* what a wonderful hack! */
 	 }
-	 else if (strEQ(mg->mg_ptr+1, "NCODING"))
+	 else if (strEQ(remaining, "NCODING"))
 	      sv_setsv(sv, PL_encoding);
 	 break;
     case '\006':		/* ^F */
@@ -737,15 +753,18 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	    sv_setsv(sv, &PL_sv_undef);
 	break;
     case '\017':		/* ^O & ^OPEN */
-	if (*(mg->mg_ptr+1) == '\0') {
+	if (nextchar == '\0') {
 	    sv_setpv(sv, PL_osname);
 	    SvTAINTED_off(sv);
 	}
-	else if (strEQ(mg->mg_ptr, "\017PEN")) {
-	    if (!PL_compiling.cop_io)
+	else if (strEQ(remaining, "PEN")) {
+	    if (!(CopHINTS_get(&PL_compiling) & HINT_LEXICAL_IO))
 		sv_setsv(sv, &PL_sv_undef);
             else {
-	        sv_setsv(sv, PL_compiling.cop_io);
+	        sv_setsv(sv,
+			 Perl_refcounted_he_fetch(aTHX_
+						  PL_compiling.cop_hints_hash,
+						  0, "open", 4, 0, 0));
 	    }
 	}
 	break;
@@ -753,7 +772,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	sv_setiv(sv, (IV)PL_perldb);
 	break;
     case '\023':		/* ^S */
-        if (*(mg->mg_ptr+1) == '\0') {
+	if (nextchar == '\0') {
 	    if (PL_lex_state != LEX_NOTPARSING)
 		SvOK_off(sv);
 	    else if (PL_in_eval)
@@ -763,47 +782,56 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	}
 	break;
     case '\024':		/* ^T */
-        if (*(mg->mg_ptr+1) == '\0') {
+	if (nextchar == '\0') {
 #ifdef BIG_TIME
             sv_setnv(sv, PL_basetime);
 #else
             sv_setiv(sv, (IV)PL_basetime);
 #endif
         }
-        else if (strEQ(mg->mg_ptr, "\024AINT"))
+	else if (strEQ(remaining, "AINT"))
             sv_setiv(sv, PL_tainting
 		    ? (PL_taint_warn || PL_unsafe ? -1 : 1)
 		    : 0);
         break;
-    case '\025':		/* $^UNICODE, $^UTF8LOCALE */
-        if (strEQ(mg->mg_ptr, "\025NICODE"))
+    case '\025':		/* $^UNICODE, $^UTF8LOCALE, $^UTF8CACHE */
+	if (strEQ(remaining, "NICODE"))
 	    sv_setuv(sv, (UV) PL_unicode);
-        else if (strEQ(mg->mg_ptr, "\025TF8LOCALE"))
+	else if (strEQ(remaining, "TF8LOCALE"))
 	    sv_setuv(sv, (UV) PL_utf8locale);
+	else if (strEQ(remaining, "TF8CACHE"))
+	    sv_setiv(sv, (IV) PL_utf8cache);
         break;
     case '\027':		/* ^W  & $^WARNING_BITS */
-	if (*(mg->mg_ptr+1) == '\0')
+	if (nextchar == '\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)
-	    {
+	else if (strEQ(remaining, "ARNING_BITS")) {
+	    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 */
-		SV **bits_all;
-		HV *bits=get_hv("warnings::Bits", FALSE);
-		if (bits && (bits_all=hv_fetch(bits, "all", 3, FALSE))) {
-		    sv_setsv(sv, *bits_all);
+		HV * const bits=get_hv("warnings::Bits", FALSE);
+		if (bits) {
+		    SV ** const bits_all = hv_fetchs(bits, "all", FALSE);
+		    if (bits_all)
+			sv_setsv(sv, *bits_all);
 		}
 	        else {
 		    sv_setpvn(sv, WARN_ALLstring, WARNsize) ;
 		}
 	    }
             else {
-	        sv_setsv(sv, PL_compiling.cop_warnings);
+	        sv_setpvn(sv, (char *) (PL_compiling.cop_warnings + 1),
+			  *PL_compiling.cop_warnings);
 	    }
 	    SvPOK_only(sv);
 	}
@@ -825,19 +853,21 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	    {
 		i = t1 - s1;
 		s = rx->subbeg + s1;
-		if (!rx->subbeg)
-		    break;
+		assert(rx->subbeg);
 
 	      getrx:
 		if (i >= 0) {
+		    const int oldtainted = PL_tainted;
+		    TAINT_NOT;
 		    sv_setpvn(sv, s, i);
+		    PL_tainted = oldtainted;
 		    if (RX_MATCH_UTF8(rx) && is_utf8_string((U8*)s, i))
 			SvUTF8_on(sv);
 		    else
 			SvUTF8_off(sv);
 		    if (PL_tainting) {
 			if (RX_MATCH_TAINTED(rx)) {
-			    MAGIC* mg = SvMAGIC(sv);
+			    MAGIC* const mg = SvMAGIC(sv);
 			    MAGIC* mgt;
 			    PL_tainted = 1;
 			    SvMAGIC_set(sv, mg->mg_moremagic);
@@ -938,7 +968,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     case '/':
 	break;
     case '[':
-	WITH_THR(sv_setiv(sv, (IV)PL_curcop->cop_arybase));
+	sv_setiv(sv, (IV)CopARYBASE_get(PL_curcop));
 	break;
     case '|':
 	if (GvIOp(PL_defoutgv))
@@ -978,25 +1008,22 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	break;
     case '(':
 	sv_setiv(sv, (IV)PL_gid);
-#ifdef HAS_GETGROUPS
-	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, (long unsigned int)PL_egid);
-#endif
       add_groups:
 #ifdef HAS_GETGROUPS
 	{
-	    Groups_t gary[NGROUPS];
-	    I32 j = getgroups(NGROUPS,gary);
-	    while (--j >= 0)
-		Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f, (long unsigned int)gary[j]);
+	    Groups_t *gary = NULL;
+	    I32 i, num_groups = getgroups(0, gary);
+            Newx(gary, num_groups, Groups_t);
+            num_groups = getgroups(num_groups, gary);
+	    for (i = 0; i < num_groups; i++)
+		Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]);
+            Safefree(gary);
 	}
-#endif
 	(void)SvIOK_on(sv);	/* what a wonderful hack! */
+#endif
 	break;
 #ifndef MACOS_TRADITIONAL
     case '0':
@@ -1020,21 +1047,18 @@ int
 Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
-    const char *s;
-    const char *ptr;
-    STRLEN len, klen;
-
-    s = SvPV_const(sv,len);
-    ptr = MgPV_const(mg,klen);
+    STRLEN len = 0, klen;
+    const char *s = SvOK(sv) ? SvPV_const(sv,len) : "";
+    const char * const ptr = MgPV_const(mg,klen);
     my_setenv(ptr, s);
 
 #ifdef DYNAMIC_ENV_FETCH
      /* We just undefd an environment var.  Is a replacement */
      /* waiting in the wings? */
     if (!len) {
-	SV **valp;
-	if ((valp = hv_fetch(GvHVn(PL_envgv), ptr, klen, FALSE)))
-	    s = SvPV_const(*valp, len);
+	SV ** const valp = hv_fetch(GvHVn(PL_envgv), ptr, klen, FALSE);
+	if (valp)
+	    s = SvOK(*valp) ? SvPV_const(*valp, len) : "";
     }
 #endif
 
@@ -1045,10 +1069,12 @@ 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;
 
+	    my_strlcpy(eltbuf, s, sizeof(eltbuf));
+	    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,'<'))) ) {
@@ -1058,7 +1084,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 			    return 0;
 			}
 		    }
-		    if ((cp = strchr(elt, ':')) != Nullch)
+		    if ((cp = strchr(elt, ':')) != NULL)
 			*cp = '\0';
 		    if (my_trnlnm(elt, eltbuf, j++))
 			elt = eltbuf;
@@ -1076,11 +1102,20 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 		char tmpbuf[256];
 		Stat_t st;
 		I32 i;
+#ifdef VMS  /* Hmm.  How do we get $Config{path_sep} from C? */
+		const char path_sep = '|';
+#else
+		const char path_sep = ':';
+#endif
 		s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf,
-			     s, strend, ':', &i);
+			     s, strend, path_sep, &i);
 		s++;
-		if (i >= sizeof tmpbuf   /* too long -- assume the worst */
-		      || *tmpbuf != '/'
+		if (i >= (I32)sizeof tmpbuf   /* too long -- assume the worst */
+#ifdef VMS
+		      || !strchr(tmpbuf, ':') /* no colon thus no device name -- assume relative path */
+#else
+		      || *tmpbuf != '/'       /* no starting slash -- assume relative path */
+#endif
 		      || (PerlLIO_stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) ) {
 		    MgTAINTEDDIR_on(mg);
 		    return 0;
@@ -1097,19 +1132,21 @@ int
 Perl_magic_clearenv(pTHX_ SV *sv, MAGIC *mg)
 {
     PERL_UNUSED_ARG(sv);
-    my_setenv(MgPV_nolen_const(mg),Nullch);
+    my_setenv(MgPV_nolen_const(mg),NULL);
     return 0;
 }
 
 int
 Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg)
 {
-#if defined(VMS) || defined(EPOC) || defined(SYMBIAN)
+    dVAR;
+    PERL_UNUSED_ARG(mg);
+#if defined(VMS)
     Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
 #else
     if (PL_localizing) {
 	HE* entry;
-	magic_clear_all_env(sv,mg);
+	my_clearenv();
 	hv_iterinit((HV*)sv);
 	while ((entry = hv_iternext((HV*)sv))) {
 	    I32 keylen;
@@ -1125,39 +1162,13 @@ int
 Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
-#ifndef PERL_MICRO
-#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)
-    PerlEnv_clearenv();
-#  else
-#    ifdef USE_ENVIRON_ARRAY
-#      if defined(USE_ITHREADS)
-    /* only the parent thread can clobber the process environment */
-    if (PL_curinterp == aTHX)
-#      endif
-    {
-#      ifndef PERL_USE_SAFE_PUTENV
-    if (!PL_use_safe_putenv) {
-    I32 i;
-
-    if (environ == PL_origenviron)
-	environ = (char**)safesysmalloc(sizeof(char*));
-    else
-	for (i = 0; environ[i]; i++)
-	    safesysfree(environ[i]);
-    }
-#      endif /* PERL_USE_SAFE_PUTENV */
-
-    environ[0] = Nullch;
-    }
-#    endif /* USE_ENVIRON_ARRAY */
-#   endif /* PERL_IMPLICIT_SYS || WIN32 */
-#endif /* VMS || EPOC */
-#endif /* !PERL_MICRO */
     PERL_UNUSED_ARG(sv);
     PERL_UNUSED_ARG(mg);
+#if defined(VMS)
+    Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
+#else
+    my_clearenv();
+#endif
     return 0;
 }
 
@@ -1166,33 +1177,35 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 static void
 restore_sigmask(pTHX_ SV *save_sv)
 {
-    const sigset_t *ossetp = (const sigset_t *) SvPV_nolen_const( save_sv );
-    (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
+    const sigset_t * const ossetp = (const sigset_t *) SvPV_nolen_const( save_sv );
+    (void)sigprocmask(SIG_SETMASK, ossetp, NULL);
 }
 #endif
 int
 Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     /* Are we fetching a signal entry? */
     const I32 i = whichsig(MgPV_nolen_const(mg));
     if (i > 0) {
     	if(PL_psig_ptr[i])
     	    sv_setsv(sv,PL_psig_ptr[i]);
     	else {
-    	    Sighandler_t sigstate;
-    	    sigstate = rsignal_state(i);
+	    Sighandler_t sigstate = rsignal_state(i);
 #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
-    	    if (PL_sig_handlers_initted && PL_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 (PL_sig_handlers_initted && PL_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 == (Sighandler_t) SIG_IGN)
     	    	sv_setpv(sv,"IGNORE");
     	    else
     	    	sv_setsv(sv,&PL_sv_undef);
-    	    PL_psig_ptr[i] = SvREFCNT_inc(sv);
+	    PL_psig_ptr[i] = SvREFCNT_inc_simple_NN(sv);
     	    SvTEMP_off(sv);
     	}
     }
@@ -1208,17 +1221,15 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
     register const char * const s = MgPV_nolen_const(mg);
     PERL_UNUSED_ARG(sv);
     if (*s == '_') {
-	SV** svp = 0;
+	SV** svp = NULL;
 	if (strEQ(s,"__DIE__"))
 	    svp = &PL_diehook;
-	else if (strEQ(s,"__WARN__"))
+	else if (strEQ(s,"__WARN__") && PL_warnhook != PERL_WARNHOOK_FATAL)
 	    svp = &PL_warnhook;
-	else
-	    Perl_croak(aTHX_ "No such hook: %s", s);
 	if (svp && *svp) {
-            SV * const to_dec = *svp;
-	    *svp = 0;
-    	    SvREFCNT_dec(to_dec);
+	    SV *const to_dec = *svp;
+	    *svp = NULL;
+	    SvREFCNT_dec(to_dec);
 	}
     }
     else {
@@ -1252,7 +1263,7 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
     		PL_psig_name[i]=0;
     	    }
     	    if(PL_psig_ptr[i]) {
-                SV *to_dec=PL_psig_ptr[i];
+		SV * const to_dec=PL_psig_ptr[i];
     		PL_psig_ptr[i]=0;
 		LEAVE;
     		SvREFCNT_dec(to_dec);
@@ -1267,6 +1278,7 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
 static void
 S_raise_signal(pTHX_ int sig)
 {
+    dVAR;
     /* Set a flag to say this signal is pending */
     PL_psig_pend[sig]++;
     /* And one to say _a_ signal is pending */
@@ -1329,6 +1341,7 @@ Perl_csighandler_init(void)
 void
 Perl_despatch_signals(pTHX)
 {
+    dVAR;
     int sig;
     PL_sig_pending = 0;
     for (sig = 1; sig < SIG_SIZE; sig++) {
@@ -1347,12 +1360,12 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     I32 i;
-    SV** svp = 0;
+    SV** svp = NULL;
     /* Need to be careful with SvREFCNT_dec(), because that can have side
      * effects (due to closures). We must make sure that the new disposition
      * is in place before it is called.
      */
-    SV* to_dec = 0;
+    SV* to_dec = NULL;
     STRLEN len;
 #ifdef HAS_SIGPROCMASK
     sigset_t set, save;
@@ -1369,8 +1382,9 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 	    Perl_croak(aTHX_ "No such hook: %s", s);
 	i = 0;
 	if (*svp) {
-	    to_dec = *svp;
-	    *svp = 0;
+	    if (*svp != PERL_WARNHOOK_FATAL)
+		to_dec = *svp;
+	    *svp = NULL;
 	}
     }
     else {
@@ -1402,7 +1416,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 #endif
 	SvREFCNT_dec(PL_psig_name[i]);
 	to_dec = PL_psig_ptr[i];
-	PL_psig_ptr[i] = SvREFCNT_inc(sv);
+	PL_psig_ptr[i] = SvREFCNT_inc_simple_NN(sv);
 	SvTEMP_off(sv); /* Make sure it doesn't go away on us */
 	PL_psig_name[i] = newSVpvn(s, len);
 	SvREADONLY_on(PL_psig_name[i]);
@@ -1415,7 +1429,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 #endif
 	}
 	else
-	    *svp = SvREFCNT_inc(sv);
+	    *svp = SvREFCNT_inc_simple_NN(sv);
 	if(to_dec)
 	    SvREFCNT_dec(to_dec);
 	return 0;
@@ -1449,11 +1463,11 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 	 * tell whether HINT_STRICT_REFS is in force or not.
 	 */
 	if (!strchr(s,':') && !strchr(s,'\''))
-	    sv_insert(sv, 0, 0, "main::", 6);
+	    Perl_sv_insert(aTHX_ sv, 0, 0, STR_WITH_LEN("main::"));
 	if (i)
 	    (void)rsignal(i, PL_csighandlerp);
 	else
-	    *svp = SvREFCNT_inc(sv);
+	    *svp = SvREFCNT_inc_simple_NN(sv);
     }
 #ifdef HAS_SIGPROCMASK
     if(i)
@@ -1468,6 +1482,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     PERL_UNUSED_ARG(sv);
     PERL_UNUSED_ARG(mg);
     PL_sub_generation++;
@@ -1477,6 +1492,7 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setamagic(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     PERL_UNUSED_ARG(sv);
     PERL_UNUSED_ARG(mg);
     /* HV_badAMAGIC_on(Sv_STASH(sv)); */
@@ -1520,6 +1536,7 @@ Perl_magic_setnkeys(pTHX_ SV *sv, MAGIC *mg)
 STATIC int
 S_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags, int n, SV *val)
 {
+    dVAR;
     dSP;
 
     PUSHMARK(SP);
@@ -1653,7 +1670,7 @@ Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
 }
 
 int
-Perl_magic_existspack(pTHX_ SV *sv, MAGIC *mg)
+Perl_magic_existspack(pTHX_ SV *sv, const MAGIC *mg)
 {
     return magic_methpack(sv,mg,"EXISTS");
 }
@@ -1662,7 +1679,7 @@ SV *
 Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
 {
     dVAR; dSP;
-    SV *retval = &PL_sv_undef;
+    SV *retval;
     SV * const tied = SvTIED_obj((SV*)hv, mg);
     HV * const pkg = SvSTASH((SV*)SvRV(tied));
    
@@ -1688,6 +1705,8 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
 
     if (call_method("SCALAR", G_SCALAR))
         retval = *PL_stack_sp--; 
+    else
+	retval = &PL_sv_undef;
     POPSTACK;
     LEAVE;
     return retval;
@@ -1696,6 +1715,7 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
 int
 Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     GV * const gv = PL_DBline;
     const I32 i = SvTRUE(sv);
     SV ** const svp = av_fetch(GvAV(gv),
@@ -1716,9 +1736,10 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg)
 {
+    dVAR;
     const AV * const obj = (AV*)mg->mg_obj;
     if (obj) {
-	sv_setiv(sv, AvFILL(obj) + PL_curcop->cop_arybase);
+	sv_setiv(sv, AvFILL(obj) + CopARYBASE_get(PL_curcop));
     } else {
 	SvOK_off(sv);
     }
@@ -1728,9 +1749,10 @@ Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg)
 int
 Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     AV * const obj = (AV*)mg->mg_obj;
     if (obj) {
-	av_fill(obj, SvIV(sv) - PL_curcop->cop_arybase);
+	av_fill(obj, SvIV(sv) - CopARYBASE_get(PL_curcop));
     } else {
 	if (ckWARN(WARN_MISC))
 	    Perl_warner(aTHX_ packWARN(WARN_MISC),
@@ -1742,6 +1764,7 @@ Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     PERL_UNUSED_ARG(sv);
     /* during global destruction, mg_obj may already have been freed */
     if (PL_in_clean_all)
@@ -1763,15 +1786,17 @@ Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     SV* const lsv = LvTARG(sv);
+    PERL_UNUSED_ARG(mg);
 
     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
-	mg = mg_find(lsv, PERL_MAGIC_regex_global);
-	if (mg && mg->mg_len >= 0) {
-	    I32 i = mg->mg_len;
+	MAGIC * const found = mg_find(lsv, PERL_MAGIC_regex_global);
+	if (found && found->mg_len >= 0) {
+	    I32 i = found->mg_len;
 	    if (DO_UTF8(lsv))
 		sv_pos_b2u(lsv, &i);
-	    sv_setiv(sv, i + PL_curcop->cop_arybase);
+	    sv_setiv(sv, i + CopARYBASE_get(PL_curcop));
 	    return 0;
 	}
     }
@@ -1782,28 +1807,36 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     SV* const lsv = LvTARG(sv);
     SSize_t pos;
     STRLEN len;
     STRLEN ulen = 0;
+    MAGIC *found;
 
-    mg = 0;
+    PERL_UNUSED_ARG(mg);
 
     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv))
-	mg = mg_find(lsv, PERL_MAGIC_regex_global);
-    if (!mg) {
+	found = mg_find(lsv, PERL_MAGIC_regex_global);
+    else
+	found = NULL;
+    if (!found) {
 	if (!SvOK(sv))
 	    return 0;
-	sv_magic(lsv, (SV*)0, PERL_MAGIC_regex_global, Nullch, 0);
-	mg = mg_find(lsv, PERL_MAGIC_regex_global);
+#ifdef PERL_OLD_COPY_ON_WRITE
+    if (SvIsCOW(lsv))
+        sv_force_normal_flags(lsv, 0);
+#endif
+	found = sv_magicext(lsv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
+			 NULL, 0);
     }
     else if (!SvOK(sv)) {
-	mg->mg_len = -1;
+	found->mg_len = -1;
 	return 0;
     }
     len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
 
-    pos = SvIV(sv) - PL_curcop->cop_arybase;
+    pos = SvIV(sv) - CopARYBASE_get(PL_curcop);
 
     if (DO_UTF8(lsv)) {
 	ulen = sv_len_utf8(lsv);
@@ -1825,23 +1858,9 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
 	pos = p;
     }
 
-    mg->mg_len = pos;
-    mg->mg_flags &= ~MGf_MINMATCH;
-
-    return 0;
-}
+    found->mg_len = pos;
+    found->mg_flags &= ~MGf_MINMATCH;
 
-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), "*");
-	SvFAKE_on(sv);
-    }
-    else
-	gv_efullname3(sv,((GV*)sv), "*");	/* a gv value, be nice */
     return 0;
 }
 
@@ -1853,7 +1872,13 @@ Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
 
     if (!SvOK(sv))
 	return 0;
-    gv = gv_fetchsv(sv,TRUE, SVt_PVGV);
+    if (SvFLAGS(sv) & SVp_SCREAM
+	&& (SvTYPE(sv) == SVt_PVGV || SvTYPE(sv) == SVt_PVGV)) {
+	/* We're actually already a typeglob, so don't need the stuff below.
+	 */
+	return 0;
+    }
+    gv =  gv_fetchsv(sv, GV_ADD, SVt_PVGV);
     if (sv == (SV*)gv)
 	return 0;
     if (GvGP(sv))
@@ -1887,8 +1912,9 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     STRLEN len;
-    const char *tmps = SvPV_const(sv, len);
+    const char * const tmps = SvPV_const(sv, len);
     SV * const lsv = LvTARG(sv);
     I32 lvoff = LvTARGOFF(sv);
     I32 lvlen = LvTARGLEN(sv);
@@ -1902,11 +1928,12 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 	SvUTF8_on(lsv);
     }
     else if (lsv && SvUTF8(lsv)) {
+	const char *utf8;
 	sv_pos_u2b(lsv, &lvoff, &lvlen);
 	LvTARGLEN(sv) = len;
-	tmps = (char*)bytes_to_utf8((U8*)tmps, &len);
-	sv_insert(lsv, lvoff, lvlen, tmps, len);
-	Safefree(tmps);
+	utf8 = (char*)bytes_to_utf8((U8*)tmps, &len);
+	sv_insert(lsv, lvoff, lvlen, utf8, len);
+	Safefree(utf8);
     }
     else {
 	sv_insert(lsv, lvoff, lvlen, tmps, len);
@@ -1920,6 +1947,7 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     PERL_UNUSED_ARG(sv);
     TAINT_IF((PL_localizing != 1) && (mg->mg_len & 1));
     return 0;
@@ -1928,6 +1956,7 @@ Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     PERL_UNUSED_ARG(sv);
     /* update taint status unless we're restoring at scope exit */
     if (PL_localizing != 2) {
@@ -1945,12 +1974,11 @@ Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg)
     SV * const lsv = LvTARG(sv);
     PERL_UNUSED_ARG(mg);
 
-    if (!lsv) {
+    if (lsv)
+	sv_setuv(sv, do_vecget(lsv, LvTARGOFF(sv), LvTARGLEN(sv)));
+    else
 	SvOK_off(sv);
-	return 0;
-    }
 
-    sv_setuv(sv, do_vecget(lsv, LvTARGOFF(sv), LvTARGLEN(sv)));
     return 0;
 }
 
@@ -1965,7 +1993,8 @@ Perl_magic_setvec(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg)
 {
-    SV *targ = Nullsv;
+    dVAR;
+    SV *targ = NULL;
     if (LvTARGLEN(sv)) {
 	if (mg->mg_obj) {
 	    SV * const ahv = LvTARG(sv);
@@ -1978,13 +2007,13 @@ Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg)
 	    if ((I32)LvTARGOFF(sv) <= AvFILL(av))
 		targ = AvARRAY(av)[LvTARGOFF(sv)];
 	}
-	if (targ && targ != &PL_sv_undef) {
+	if (targ && (targ != &PL_sv_undef)) {
 	    /* somebody else defined it for us */
 	    SvREFCNT_dec(LvTARG(sv));
-	    LvTARG(sv) = SvREFCNT_inc(targ);
+	    LvTARG(sv) = SvREFCNT_inc_simple_NN(targ);
 	    LvTARGLEN(sv) = 0;
 	    SvREFCNT_dec(mg->mg_obj);
-	    mg->mg_obj = Nullsv;
+	    mg->mg_obj = NULL;
 	    mg->mg_flags &= ~MGf_REFCOUNTED;
 	}
     }
@@ -2010,8 +2039,9 @@ Perl_magic_setdefelem(pTHX_ SV *sv, MAGIC *mg)
 void
 Perl_vivify_defelem(pTHX_ SV *sv)
 {
+    dVAR;
     MAGIC *mg;
-    SV *value = Nullsv;
+    SV *value = NULL;
 
     if (!LvTARGLEN(sv) || !(mg = mg_find(sv, PERL_MAGIC_defelem)))
 	return;
@@ -2026,64 +2056,32 @@ Perl_vivify_defelem(pTHX_ SV *sv)
     else {
 	AV* const av = (AV*)LvTARG(sv);
 	if ((I32)LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av))
-	    LvTARG(sv) = Nullsv;	/* array can't be extended */
+	    LvTARG(sv) = NULL;	/* array can't be extended */
 	else {
-	    SV** const svp = av_fetch(av, LvTARGOFF(sv), TRUE);
+	    SV* const * const svp = av_fetch(av, LvTARGOFF(sv), TRUE);
 	    if (!svp || (value = *svp) == &PL_sv_undef)
 		Perl_croak(aTHX_ PL_no_aelem, (I32)LvTARGOFF(sv));
 	}
     }
-    (void)SvREFCNT_inc(value);
+    SvREFCNT_inc_simple_void(value);
     SvREFCNT_dec(LvTARG(sv));
     LvTARG(sv) = value;
     LvTARGLEN(sv) = 0;
     SvREFCNT_dec(mg->mg_obj);
-    mg->mg_obj = Nullsv;
+    mg->mg_obj = NULL;
     mg->mg_flags &= ~MGf_REFCOUNTED;
 }
 
 int
 Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
 {
-    AV *const av = (AV*)mg->mg_obj;
-    SV **svp = AvARRAY(av);
-    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")",
-			       SvFLAGS(referrer));
-		}
-
-		*svp = Nullsv;
-	    }
-	    svp++;
-	}
-    }
-    SvREFCNT_dec(av); /* remove extra count added by sv_add_backref() */
-    return 0;
+    return Perl_sv_kill_backrefs(aTHX_ sv, (AV*)mg->mg_obj);
 }
 
 int
 Perl_magic_setmglob(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_UNUSED_CONTEXT;
     mg->mg_len = -1;
     SvSCREAM_off(sv);
     return 0;
@@ -2128,6 +2126,7 @@ Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_freeregexp(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     regexp * const re = (regexp *)mg->mg_obj;
     PERL_UNUSED_ARG(sv);
 
@@ -2143,6 +2142,7 @@ Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg)
      * RenE<eacute> Descartes said "I think not."
      * and vanished with a faint plop.
      */
+    PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(sv);
     if (mg->mg_ptr) {
 	Safefree(mg->mg_ptr);
@@ -2157,9 +2157,10 @@ Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(sv);
     Safefree(mg->mg_ptr);	/* The mg_ptr holds the pos cache. */
-    mg->mg_ptr = 0;
+    mg->mg_ptr = NULL;
     mg->mg_len = -1;		/* The mg_len holds the len cache. */
     return 0;
 }
@@ -2167,6 +2168,7 @@ Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     register const char *s;
     I32 i;
     STRLEN len;
@@ -2175,7 +2177,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	sv_setsv(PL_bodytarget, sv);
 	break;
     case '\003':	/* ^C */
-	PL_minus_c = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	PL_minus_c = (bool)SvIV(sv);
 	break;
 
     case '\004':	/* ^D */
@@ -2184,25 +2186,25 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	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;
+	PL_debug = (SvIV(sv)) | DEBUG_TOP_FLAG;
 #endif
 	break;
     case '\005':  /* ^E */
 	if (*(mg->mg_ptr+1) == '\0') {
 #ifdef MACOS_TRADITIONAL
-	    gMacPerl_OSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	    gMacPerl_OSErr = SvIV(sv);
 #else
 #  ifdef VMS
-	    set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	    set_vaxc_errno(SvIV(sv));
 #  else
 #    ifdef WIN32
 	    SetLastError( SvIV(sv) );
 #    else
 #      ifdef OS2
-	    os2_setsyserrno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	    os2_setsyserrno(SvIV(sv));
 #      else
 	    /* will anyone ever use this? */
-	    SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
+	    SETERRNO(SvIV(sv), 4);
 #      endif
 #    endif
 #  endif
@@ -2215,38 +2217,39 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 		PL_encoding = newSVsv(sv);
 	    }
 	    else {
-		PL_encoding = Nullsv;
+		PL_encoding = NULL;
 	    }
 	}
 	break;
     case '\006':	/* ^F */
-	PL_maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	PL_maxsysfd = SvIV(sv);
 	break;
     case '\010':	/* ^H */
-	PL_hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	PL_hints = SvIV(sv);
 	break;
     case '\011':	/* ^I */ /* NOT \t in EBCDIC */
 	Safefree(PL_inplace);
-	PL_inplace = SvOK(sv) ? savesvpv(sv) : Nullch;
+	PL_inplace = SvOK(sv) ? savesvpv(sv) : NULL;
 	break;
     case '\017':	/* ^O */
 	if (*(mg->mg_ptr+1) == '\0') {
 	    Safefree(PL_osname);
-	    PL_osname = Nullch;
+	    PL_osname = NULL;
 	    if (SvOK(sv)) {
 		TAINT_PROPER("assigning to $^O");
 		PL_osname = savesvpv(sv);
 	    }
 	}
 	else if (strEQ(mg->mg_ptr, "\017PEN")) {
-	    if (!PL_compiling.cop_io)
-		PL_compiling.cop_io = newSVsv(sv);
-	    else
-		sv_setsv(PL_compiling.cop_io,sv);
+	    PL_compiling.cop_hints |= HINT_LEXICAL_IO;
+	    PL_hints |= HINT_LOCALIZE_HH | HINT_LEXICAL_IO;
+	    PL_compiling.cop_hints_hash
+		= Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints_hash,
+					 sv_2mortal(newSVpvs("open")), sv);
 	}
 	break;
     case '\020':	/* ^P */
-	PL_perldb = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	PL_perldb = SvIV(sv);
 	if (PL_perldb && !PL_DBsingle)
 	    init_debugger();
 	break;
@@ -2254,13 +2257,18 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 #ifdef BIG_TIME
 	PL_basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv));
 #else
-	PL_basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	PL_basetime = (Time_t)SvIV(sv);
 #endif
 	break;
+    case '\025':	/* ^UTF8CACHE */
+	 if (strEQ(mg->mg_ptr+1, "TF8CACHE")) {
+	     PL_utf8cache = (signed char) sv_2iv(sv);
+	 }
+	 break;
     case '\027':	/* ^W & $^WARNING_BITS */
 	if (*(mg->mg_ptr+1) == '\0') {
 	    if ( ! (PL_dowarn & G_WARN_ALL_MASK)) {
-	        i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	        i = SvIV(sv);
 	        PL_dowarn = (PL_dowarn & ~G_WARN_ON)
 		    		| (i ? G_WARN_ON : G_WARN_OFF) ;
 	    }
@@ -2283,15 +2291,20 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 		    }
 		    if (!accumulate)
 	                PL_compiling.cop_warnings = pWARN_NONE;
-		    else if (isWARN_on(sv, WARN_ALL) && !any_fatals) {
+		    /* Yuck. I can't see how to abstract this:  */
+		    else if (isWARN_on(((STRLEN *)SvPV_nolen_const(sv)) - 1,
+				       WARN_ALL) && !any_fatals) {
 	                PL_compiling.cop_warnings = pWARN_ALL;
 	                PL_dowarn |= G_WARN_ONCE ;
 	            }
                     else {
-	                if (specialWARN(PL_compiling.cop_warnings))
-		            PL_compiling.cop_warnings = newSVsv(sv) ;
-	                else
-	                    sv_setsv(PL_compiling.cop_warnings, sv);
+			STRLEN len;
+			const char *const p = SvPV_const(sv, len);
+
+			PL_compiling.cop_warnings
+			    = Perl_new_warnings_bitfield(aTHX_ PL_compiling.cop_warnings,
+							 p, len);
+
 	                if (isWARN_on(PL_compiling.cop_warnings, WARN_ONCE))
 	                    PL_dowarn |= G_WARN_ONCE ;
 	            }
@@ -2311,30 +2324,30 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     case '^':
 	Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
 	s = IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
-	IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);
+	IoTOP_GV(GvIOp(PL_defoutgv)) =  gv_fetchsv(sv, GV_ADD, SVt_PVIO);
 	break;
     case '~':
 	Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
 	s = IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
-	IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);
+	IoFMT_GV(GvIOp(PL_defoutgv)) =  gv_fetchsv(sv, GV_ADD, SVt_PVIO);
 	break;
     case '=':
-	IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIV(sv));
 	break;
     case '-':
-	IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIV(sv));
 	if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L)
 	    IoLINES_LEFT(GvIOp(PL_defoutgv)) = 0L;
 	break;
     case '%':
-	IoPAGE(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	IoPAGE(GvIOp(PL_defoutgv)) = (SvIV(sv));
 	break;
     case '|':
 	{
 	    IO * const io = GvIOp(PL_defoutgv);
 	    if(!io)
 	      break;
-	    if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) == 0)
+	    if ((SvIV(sv)) == 0)
 		IoFLAGS(io) &= ~IOf_FLUSH;
 	    else {
 		if (!(IoFLAGS(io) & IOf_FLUSH)) {
@@ -2357,7 +2370,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	    PL_ors_sv = newSVsv(sv);
 	}
 	else {
-	    PL_ors_sv = Nullsv;
+	    PL_ors_sv = NULL;
 	}
 	break;
     case ',':
@@ -2367,11 +2380,11 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	    PL_ofs_sv = newSVsv(sv);
 	}
 	else {
-	    PL_ofs_sv = Nullsv;
+	    PL_ofs_sv = NULL;
 	}
 	break;
     case '[':
-	PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	CopARYBASE_set(&PL_compiling, SvIV(sv));
 	break;
     case '?':
 #ifdef COMPLEX_STATUS
@@ -2383,10 +2396,10 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 #endif
 #ifdef VMSISH_STATUS
 	if (VMSISH_STATUS)
-	    STATUS_NATIVE_SET((U32)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)));
+	    STATUS_NATIVE_CHILD_SET((U32)SvIV(sv));
 	else
 #endif
-	    STATUS_UNIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	    STATUS_UNIX_EXIT_SET(SvIV(sv));
 	break;
     case '!':
         {
@@ -2400,7 +2413,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	}
 	break;
     case '<':
-	PL_uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	PL_uid = SvIV(sv);
 	if (PL_delaymagic) {
 	    PL_delaymagic |= DM_RUID;
 	    break;				/* don't do magic till later */
@@ -2432,7 +2445,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
 	break;
     case '>':
-	PL_euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	PL_euid = SvIV(sv);
 	if (PL_delaymagic) {
 	    PL_delaymagic |= DM_EUID;
 	    break;				/* don't do magic till later */
@@ -2459,7 +2472,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
 	break;
     case '(':
-	PL_gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	PL_gid = SvIV(sv);
 	if (PL_delaymagic) {
 	    PL_delaymagic |= DM_RGID;
 	    break;				/* don't do magic till later */
@@ -2489,25 +2502,30 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 #ifdef HAS_SETGROUPS
 	{
 	    const char *p = SvPV_const(sv, len);
-	    Groups_t gary[NGROUPS];
-
-	    while (isSPACE(*p))
-		++p;
-	    PL_egid = Atol(p);
-	    for (i = 0; i < NGROUPS; ++i) {
-		while (*p && !isSPACE(*p))
-		    ++p;
-		while (isSPACE(*p))
-		    ++p;
-		if (!*p)
-		    break;
-		gary[i] = Atol(p);
-	    }
-	    if (i)
-		(void)setgroups(i, gary);
+            Groups_t *gary = NULL;
+
+            while (isSPACE(*p))
+                ++p;
+            PL_egid = Atol(p);
+            for (i = 0; i < NGROUPS; ++i) {
+                while (*p && !isSPACE(*p))
+                    ++p;
+                while (isSPACE(*p))
+                    ++p;
+                if (!*p)
+                    break;
+                if(!gary)
+                    Newx(gary, i + 1, Groups_t);
+                else
+                    Renew(gary, i + 1, Groups_t);
+                gary[i] = Atol(p);
+            }
+            if (i)
+                (void)setgroups(i, gary);
+	    Safefree(gary);
 	}
 #else  /* HAS_SETGROUPS */
-	PL_egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	PL_egid = SvIV(sv);
 #endif /* HAS_SETGROUPS */
 	if (PL_delaymagic) {
 	    PL_delaymagic |= DM_EGID;
@@ -2544,7 +2562,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	/* The BSDs don't show the argv[] in ps(1) output, they
 	 * show a string from the process struct and provide
 	 * the setproctitle() routine to manipulate that. */
-	{
+	if (PL_origalen != 1) {
 	    s = SvPV_const(sv, len);
 #   if __FreeBSD_version > 410001
 	    /* The leading "-" removes the "perl: " prefix,
@@ -2565,35 +2583,37 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	}
 #endif
 #if defined(__hpux) && defined(PSTAT_SETCMD)
-	{
+	if (PL_origalen != 1) {
 	     union pstun un;
 	     s = SvPV_const(sv, len);
 	     un.pst_command = (char *)s;
 	     pstat(PSTAT_SETCMD, un, len, 0, 0);
 	}
 #endif
-	/* PL_origalen is set in perl_parse(). */
-	s = SvPV_force(sv,len);
-	if (len >= (STRLEN)PL_origalen-1) {
-	    /* Longer than original, will be truncated. We assume that
-             * PL_origalen bytes are available. */
-	    Copy(s, PL_origargv[0], PL_origalen-1, char);
+	if (PL_origalen > 1) {
+	    /* PL_origalen is set in perl_parse(). */
+	    s = SvPV_force(sv,len);
+	    if (len >= (STRLEN)PL_origalen-1) {
+		/* Longer than original, will be truncated. We assume that
+		 * PL_origalen bytes are available. */
+		Copy(s, PL_origargv[0], PL_origalen-1, char);
+	    }
+	    else {
+		/* Shorter than original, will be padded. */
+		Copy(s, PL_origargv[0], len, char);
+		PL_origargv[0][len] = 0;
+		memset(PL_origargv[0] + len + 1,
+		       /* Is the space counterintuitive?  Yes.
+			* (You were expecting \0?)  
+			* Does it work?  Seems to.  (In Linux 2.4.20 at least.)
+			* --jhi */
+		       (int)' ',
+		       PL_origalen - len - 1);
+	    }
+	    PL_origargv[0][PL_origalen-1] = 0;
+	    for (i = 1; i < PL_origargc; i++)
+		PL_origargv[i] = 0;
 	}
-	else {
-	    /* Shorter than original, will be padded. */
-	    Copy(s, PL_origargv[0], len, char);
-	    PL_origargv[0][len] = 0;
-	    memset(PL_origargv[0] + len + 1,
-		   /* Is the space counterintuitive?  Yes.
-		    * (You were expecting \0?)  
-		    * Does it work?  Seems to.  (In Linux 2.4.20 at least.)
-		    * --jhi */
-		   (int)' ',
-		   PL_origalen - len - 1);
-	}
-	PL_origargv[0][PL_origalen-1] = 0;
-	for (i = 1; i < PL_origargc; i++)
-	    PL_origargv[i] = 0;
 	UNLOCK_DOLLARZERO_MUTEX;
 	break;
 #endif
@@ -2605,6 +2625,7 @@ I32
 Perl_whichsig(pTHX_ const char *sig)
 {
     register char* const* sigv;
+    PERL_UNUSED_CONTEXT;
 
     for (sigv = (char* const*)PL_sig_name; *sigv; sigv++)
 	if (strEQ(sig,*sigv))
@@ -2633,10 +2654,10 @@ Perl_sighandler(int sig)
     dTHX;
 #endif
     dSP;
-    GV *gv = Nullgv;
-    SV *sv = Nullsv;
+    GV *gv = NULL;
+    SV *sv = NULL;
     SV * const tSv = PL_Sv;
-    CV *cv = Nullcv;
+    CV *cv = NULL;
     OP *myop = PL_op;
     U32 flags = 0;
     XPV * const tXpv = PL_Xpv;
@@ -2668,7 +2689,7 @@ Perl_sighandler(int sig)
     if (!SvROK(PL_psig_ptr[sig]) || !(cv = (CV*)SvRV(PL_psig_ptr[sig]))
 	|| SvTYPE(cv) != SVt_PVCV) {
 	HV *st;
-	cv = sv_2cv(PL_psig_ptr[sig],&st,&gv,TRUE);
+	cv = sv_2cv(PL_psig_ptr[sig], &st, &gv, GV_ADD);
     }
 
     if (!cv || !CvROOT(cv)) {
@@ -2682,7 +2703,7 @@ Perl_sighandler(int sig)
     }
 
     if(PL_psig_name[sig]) {
-    	sv = SvREFCNT_inc(PL_psig_name[sig]);
+	sv = SvREFCNT_inc_NN(PL_psig_name[sig]);
 	flags |= 64;
 #if !defined(PERL_IMPLICIT_CONTEXT)
 	PL_sig_sv = sv;
@@ -2712,8 +2733,8 @@ Perl_sighandler(int sig)
 		    * 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);
-		   hv_store(sih, "errno",   5, newSViv(sip->si_errno),  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);
@@ -2722,8 +2743,10 @@ Perl_sighandler(int sig)
 #endif
 		   EXTEND(SP, 2);
 		   PUSHs((SV*)rv);
-		   PUSHs(newSVpv((void*)sip, sizeof(*sip)));
+		   PUSHs(newSVpv((char *)sip, sizeof(*sip)));
 	      }
+
+              va_end(args);
 	 }
     }
 #endif
@@ -2749,7 +2772,7 @@ Perl_sighandler(int sig)
 	(void)rsignal(sig, PL_csighandlerp);
 #endif
 #endif /* !PERL_MICRO */
-	DieNull;
+	Perl_die(aTHX_ NULL);
     }
 cleanup:
     if (flags & 1)
@@ -2771,6 +2794,7 @@ cleanup:
 static void
 S_restore_magic(pTHX_ const void *p)
 {
+    dVAR;
     MGS* const mgs = SSPTR(PTR2IV(p), MGS*);
     SV* const sv = mgs->mgs_sv;
 
@@ -2783,15 +2807,23 @@ S_restore_magic(pTHX_ const void *p)
 	/* While magic was saved (and off) sv_setsv may well have seen
 	   this SV as a prime candidate for COW.  */
 	if (SvIsCOW(sv))
-	    sv_force_normal(sv);
+	    sv_force_normal_flags(sv, 0);
 #endif
 
 	if (mgs->mgs_flags)
 	    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 */
+
+	    const U32 pubflags = SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK);
+	    if (pubflags) {
+		SvFLAGS(sv) &= ~( pubflags | (SVp_IOK|SVp_NOK|SVp_POK) );
+		SvFLAGS(sv) |= ( pubflags << PRIVSHIFT );
+	    }
+	}
     }
 
     mgs->mgs_sv = NULL;  /* mark the MGS structure as restored */
@@ -2824,7 +2856,6 @@ S_unwind_handler_stack(pTHX_ const void *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(PL_sig_sv);
@@ -2832,6 +2863,62 @@ S_unwind_handler_stack(pTHX_ const void *p)
 }
 
 /*
+=for apidoc magic_sethint
+
+Triggered by a store to %^H, records the key/value pair to
+C<PL_compiling.cop_hints_hash>.  It is assumed that hints aren't storing
+anything that would need a deep copy.  Maybe we should warn if we find a
+reference.
+
+=cut
+*/
+int
+Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg)
+{
+    dVAR;
+    assert(mg->mg_len == HEf_SVKEY);
+
+    /* mg->mg_obj isn't being used.  If needed, it would be possible to store
+       an alternative leaf in there, with PL_compiling.cop_hints being used if
+       it's NULL. If needed for threads, the alternative could lock a mutex,
+       or take other more complex action.  */
+
+    /* Something changed in %^H, so it will need to be restored on scope exit.
+       Doing this here saves a lot of doing it manually in perl code (and
+       forgetting to do it, and consequent subtle errors.  */
+    PL_hints |= HINT_LOCALIZE_HH;
+    PL_compiling.cop_hints_hash
+	= Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints_hash,
+				 (SV *)mg->mg_ptr, sv);
+    return 0;
+}
+
+/*
+=for apidoc magic_sethint
+
+Triggered by a delete from %^H, records the key to
+C<PL_compiling.cop_hints_hash>.
+
+=cut
+*/
+int
+Perl_magic_clearhint(pTHX_ SV *sv, MAGIC *mg)
+{
+    dVAR;
+    PERL_UNUSED_ARG(sv);
+
+    assert(mg->mg_len == HEf_SVKEY);
+
+    PERL_UNUSED_ARG(sv);
+
+    PL_hints |= HINT_LOCALIZE_HH;
+    PL_compiling.cop_hints_hash
+	= Perl_refcounted_he_new(aTHX_ PL_compiling.cop_hints_hash,
+				 (SV *)mg->mg_ptr, &PL_sv_placeholder);
+    return 0;
+}
+
+/*
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4