X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/ef5eb418bf9cb919bb2d82393f4570a790061e2e..265075c0d13cbdf53c9e662decbb83fc34d4e7a4:/sv.c

diff --git a/sv.c b/sv.c
index 65f0e79..4a57a9a 100644
--- a/sv.c
+++ b/sv.c
@@ -182,7 +182,9 @@ Public API:
 #endif
 
 #ifdef DEBUG_LEAKING_SCALARS
-#  define FREE_SV_DEBUG_FILE(sv) Safefree((sv)->sv_debug_file)
+#  define FREE_SV_DEBUG_FILE(sv) STMT_START { \
+	if ((sv)->sv_debug_file) PerlMemShared_free((sv)->sv_debug_file); \
+    } STMT_END
 #  define DEBUG_SV_SERIAL(sv)						    \
     DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) del_SV\n",    \
 	    PTR2UV(sv), (long)(sv)->sv_debug_serial))
@@ -275,7 +277,7 @@ S_new_SV(pTHX_ const char *file, int line, const char *func)
 	    );
     sv->sv_debug_inpad = 0;
     sv->sv_debug_parent = NULL;
-    sv->sv_debug_file = PL_curcop ? savepv(CopFILE(PL_curcop)): NULL;
+    sv->sv_debug_file = PL_curcop ? savesharedpv(CopFILE(PL_curcop)): NULL;
 
     sv->sv_debug_serial = PL_sv_serial++;
 
@@ -365,8 +367,8 @@ S_sv_add_arena(pTHX_ char *const ptr, const U32 size, const U32 flags)
 {
     dVAR;
     SV *const sva = MUTABLE_SV(ptr);
-    register SV* sv;
-    register SV* svend;
+    SV* sv;
+    SV* svend;
 
     PERL_ARGS_ASSERT_SV_ADD_ARENA;
 
@@ -410,8 +412,8 @@ S_visit(pTHX_ SVFUNC_t f, const U32 flags, const U32 mask)
     PERL_ARGS_ASSERT_VISIT;
 
     for (sva = PL_sv_arenaroot; sva; sva = MUTABLE_SV(SvANY(sva))) {
-	register const SV * const svend = &sva[SvREFCNT(sva)];
-	register SV* sv;
+	const SV * const svend = &sva[SvREFCNT(sva)];
+	SV* sv;
 	for (sv = sva + 1; sv < svend; ++sv) {
 	    if (SvTYPE(sv) != (svtype)SVTYPEMASK
 		    && (sv->sv_flags & mask) == flags
@@ -1161,7 +1163,7 @@ Perl_sv_upgrade(pTHX_ register SV *const sv, svtype new_type)
        no longer need to unshare so as to free up the IVX slot for its proper
        purpose. So it's safe to move the early return earlier.  */
 
-    if (new_type != SVt_PV && SvIsCOW(sv)) {
+    if (new_type > SVt_PVMG && SvIsCOW(sv)) {
 	sv_force_normal_flags(sv, 0);
     }
 
@@ -1329,11 +1331,6 @@ Perl_sv_upgrade(pTHX_ register SV *const sv, svtype new_type)
 	}
 	break;
 
-
-    case SVt_REGEXP:
-	/* This ensures that SvTHINKFIRST(sv) is true, and hence that
-	   sv_force_normal_flags(sv) is called.  */
-	SvFAKE_on(sv);
     case SVt_PVIV:
 	/* XXX Is this still needed?  Was it ever needed?   Surely as there is
 	   no route from NV to PVIV, NOK can never be true  */
@@ -1344,6 +1341,7 @@ Perl_sv_upgrade(pTHX_ register SV *const sv, svtype new_type)
     case SVt_PVGV:
     case SVt_PVCV:
     case SVt_PVLV:
+    case SVt_REGEXP:
     case SVt_PVMG:
     case SVt_PVNV:
     case SVt_PV:
@@ -1397,12 +1395,15 @@ Perl_sv_upgrade(pTHX_ register SV *const sv, svtype new_type)
 	    SvOBJECT_on(io);
 	    /* Clear the stashcache because a new IO could overrule a package
 	       name */
+            DEBUG_o(Perl_deb(aTHX_ "sv_upgrade clearing PL_stashcache\n"));
 	    hv_clear(PL_stashcache);
 
 	    SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
 	    IoPAGE_LEN(sv) = 60;
 	}
-	if (old_type < SVt_PV) {
+	if (new_type == SVt_REGEXP)
+	    sv->sv_u.svu_rx = (regexp *)new_body;
+	else if (old_type < SVt_PV) {
 	    /* referant will be NULL unless the old type was SVt_IV emulating
 	       SVt_RV */
 	    sv->sv_u.svu_rv = referant;
@@ -1471,7 +1472,7 @@ Use the C<SvGROW> wrapper instead.
 char *
 Perl_sv_grow(pTHX_ register SV *const sv, register STRLEN newlen)
 {
-    register char *s;
+    char *s;
 
     PERL_ARGS_ASSERT_SV_GROW;
 
@@ -1802,7 +1803,7 @@ ignored.
 I32
 Perl_looks_like_number(pTHX_ SV *const sv)
 {
-    register const char *sbegin;
+    const char *sbegin;
     STRLEN len;
 
     PERL_ARGS_ASSERT_LOOKS_LIKE_NUMBER;
@@ -2066,7 +2067,7 @@ S_sv_2iuv_common(pTHX_ SV *const sv)
 				  SvUVX(sv)));
 	}
     }
-    else if (SvPOKp(sv) && SvLEN(sv)) {
+    else if (SvPOKp(sv)) {
 	UV value;
 	const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
 	/* We want to avoid a possible problem when we cache an IV/ a UV which
@@ -2256,26 +2257,42 @@ IV
 Perl_sv_2iv_flags(pTHX_ register SV *const sv, const I32 flags)
 {
     dVAR;
+
     if (!sv)
 	return 0;
-    if (SvGMAGICAL(sv) || SvVALID(sv)) {
+
+    if (SvGMAGICAL(sv) && (flags & SV_GMAGIC))
+	mg_get(sv);
+
+    if (SvROK(sv)) {
+	if (SvAMAGIC(sv)) {
+	    SV * tmpstr;
+	    if (flags & SV_SKIP_OVERLOAD)
+		return 0;
+	    tmpstr = AMG_CALLunary(sv, numer_amg);
+	    if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
+		return SvIV(tmpstr);
+	    }
+	}
+	return PTR2IV(SvRV(sv));
+    }
+
+    if (SvVALID(sv) || isREGEXP(sv)) {
 	/* FBMs use the space for SvIVX and SvNVX for other purposes, and use
 	   the same flag bit as SVf_IVisUV, so must not let them cache IVs.
 	   In practice they are extremely unlikely to actually get anywhere
 	   accessible by user Perl code - the only way that I'm aware of is when
 	   a constant subroutine which is used as the second argument to index.
+
+	   Regexps have no SvIVX and SvNVX fields.
 	*/
-	if (flags & SV_GMAGIC)
-	    mg_get(sv);
-	if (SvIOKp(sv))
-	    return SvIVX(sv);
-	if (SvNOKp(sv)) {
-	    return I_V(SvNVX(sv));
-	}
-	if (SvPOKp(sv) && SvLEN(sv)) {
+	assert(isREGEXP(sv) || SvPOKp(sv));
+	{
 	    UV value;
+	    const char * const ptr =
+		isREGEXP(sv) ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
 	    const int numtype
-		= grok_number(SvPVX_const(sv), SvCUR(sv), &value);
+		= grok_number(ptr, SvCUR(sv), &value);
 
 	    if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
 		== IS_NUMBER_IN_UV) {
@@ -2292,40 +2309,28 @@ Perl_sv_2iv_flags(pTHX_ register SV *const sv, const I32 flags)
 		if (ckWARN(WARN_NUMERIC))
 		    not_a_number(sv);
 	    }
-	    return I_V(Atof(SvPVX_const(sv)));
-	}
-        if (SvROK(sv)) {
-	    goto return_rok;
-	}
-	assert(SvTYPE(sv) >= SVt_PVMG);
-	/* This falls through to the report_uninit inside S_sv_2iuv_common.  */
-    } else if (SvTHINKFIRST(sv)) {
-	if (SvROK(sv)) {
-	return_rok:
-	    if (SvAMAGIC(sv)) {
-		SV * tmpstr;
-		if (flags & SV_SKIP_OVERLOAD)
-		    return 0;
-		tmpstr = AMG_CALLunary(sv, numer_amg);
-		if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
-		    return SvIV(tmpstr);
-		}
-	    }
-	    return PTR2IV(SvRV(sv));
+	    return I_V(Atof(ptr));
 	}
+    }
+
+    if (SvTHINKFIRST(sv)) {
+#ifdef PERL_OLD_COPY_ON_WRITE
 	if (SvIsCOW(sv)) {
 	    sv_force_normal_flags(sv, 0);
 	}
+#endif
 	if (SvREADONLY(sv) && !SvOK(sv)) {
 	    if (ckWARN(WARN_UNINITIALIZED))
 		report_uninit(sv);
 	    return 0;
 	}
     }
+
     if (!SvIOKp(sv)) {
 	if (S_sv_2iuv_common(aTHX_ sv))
 	    return 0;
     }
+
     DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%"IVdf")\n",
 	PTR2UV(sv),SvIVX(sv)));
     return SvIsUV(sv) ? (IV)SvUVX(sv) : SvIVX(sv);
@@ -2345,21 +2350,37 @@ UV
 Perl_sv_2uv_flags(pTHX_ register SV *const sv, const I32 flags)
 {
     dVAR;
+
     if (!sv)
 	return 0;
-    if (SvGMAGICAL(sv) || SvVALID(sv)) {
+
+    if (SvGMAGICAL(sv) && (flags & SV_GMAGIC))
+	mg_get(sv);
+
+    if (SvROK(sv)) {
+	if (SvAMAGIC(sv)) {
+	    SV *tmpstr;
+	    if (flags & SV_SKIP_OVERLOAD)
+		return 0;
+	    tmpstr = AMG_CALLunary(sv, numer_amg);
+	    if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
+		return SvUV(tmpstr);
+	    }
+	}
+	return PTR2UV(SvRV(sv));
+    }
+
+    if (SvVALID(sv) || isREGEXP(sv)) {
 	/* FBMs use the space for SvIVX and SvNVX for other purposes, and use
-	   the same flag bit as SVf_IVisUV, so must not let them cache IVs.  */
-	if (flags & SV_GMAGIC)
-	    mg_get(sv);
-	if (SvIOKp(sv))
-	    return SvUVX(sv);
-	if (SvNOKp(sv))
-	    return U_V(SvNVX(sv));
-	if (SvPOKp(sv) && SvLEN(sv)) {
+	   the same flag bit as SVf_IVisUV, so must not let them cache IVs.  
+	   Regexps have no SvIVX and SvNVX fields. */
+	assert(isREGEXP(sv) || SvPOKp(sv));
+	{
 	    UV value;
+	    const char * const ptr =
+		isREGEXP(sv) ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);
 	    const int numtype
-		= grok_number(SvPVX_const(sv), SvCUR(sv), &value);
+		= grok_number(ptr, SvCUR(sv), &value);
 
 	    if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
 		== IS_NUMBER_IN_UV) {
@@ -2371,36 +2392,23 @@ Perl_sv_2uv_flags(pTHX_ register SV *const sv, const I32 flags)
 		if (ckWARN(WARN_NUMERIC))
 		    not_a_number(sv);
 	    }
-	    return U_V(Atof(SvPVX_const(sv)));
-	}
-        if (SvROK(sv)) {
-	    goto return_rok;
-	}
-	assert(SvTYPE(sv) >= SVt_PVMG);
-	/* This falls through to the report_uninit inside S_sv_2iuv_common.  */
-    } else if (SvTHINKFIRST(sv)) {
-	if (SvROK(sv)) {
-	return_rok:
-	    if (SvAMAGIC(sv)) {
-		SV *tmpstr;
-		if (flags & SV_SKIP_OVERLOAD)
-		    return 0;
-		tmpstr = AMG_CALLunary(sv, numer_amg);
-		if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
-		    return SvUV(tmpstr);
-		}
-	    }
-	    return PTR2UV(SvRV(sv));
+	    return U_V(Atof(ptr));
 	}
+    }
+
+    if (SvTHINKFIRST(sv)) {
+#ifdef PERL_OLD_COPY_ON_WRITE
 	if (SvIsCOW(sv)) {
 	    sv_force_normal_flags(sv, 0);
 	}
+#endif
 	if (SvREADONLY(sv) && !SvOK(sv)) {
 	    if (ckWARN(WARN_UNINITIALIZED))
 		report_uninit(sv);
 	    return 0;
 	}
     }
+
     if (!SvIOKp(sv)) {
 	if (S_sv_2iuv_common(aTHX_ sv))
 	    return 0;
@@ -2427,18 +2435,22 @@ Perl_sv_2nv_flags(pTHX_ register SV *const sv, const I32 flags)
     dVAR;
     if (!sv)
 	return 0.0;
-    if (SvGMAGICAL(sv) || SvVALID(sv)) {
+    if (SvGMAGICAL(sv) || SvVALID(sv) || isREGEXP(sv)) {
 	/* FBMs use the space for SvIVX and SvNVX for other purposes, and use
-	   the same flag bit as SVf_IVisUV, so must not let them cache NVs.  */
+	   the same flag bit as SVf_IVisUV, so must not let them cache NVs.
+	   Regexps have no SvIVX and SvNVX fields.  */
+	const char *ptr;
 	if (flags & SV_GMAGIC)
 	    mg_get(sv);
 	if (SvNOKp(sv))
 	    return SvNVX(sv);
-	if ((SvPOKp(sv) && SvLEN(sv)) && !SvIOKp(sv)) {
+	if (SvPOKp(sv) && !SvIOKp(sv)) {
+	    ptr = SvPVX_const(sv);
+	  grokpv:
 	    if (!SvIOKp(sv) && ckWARN(WARN_NUMERIC) &&
-		!grok_number(SvPVX_const(sv), SvCUR(sv), NULL))
+		!grok_number(ptr, SvCUR(sv), NULL))
 		not_a_number(sv);
-	    return Atof(SvPVX_const(sv));
+	    return Atof(ptr);
 	}
 	if (SvIOKp(sv)) {
 	    if (SvIsUV(sv))
@@ -2449,6 +2461,10 @@ Perl_sv_2nv_flags(pTHX_ register SV *const sv, const I32 flags)
         if (SvROK(sv)) {
 	    goto return_rok;
 	}
+	if (isREGEXP(sv)) {
+	    ptr = RX_WRAPPED((REGEXP *)sv);
+	    goto grokpv;
+	}
 	assert(SvTYPE(sv) >= SVt_PVMG);
 	/* This falls through to the report_uninit near the end of the
 	   function. */
@@ -2466,9 +2482,11 @@ Perl_sv_2nv_flags(pTHX_ register SV *const sv, const I32 flags)
 	    }
 	    return PTR2NV(SvRV(sv));
 	}
+#ifdef PERL_OLD_COPY_ON_WRITE
 	if (SvIsCOW(sv)) {
 	    sv_force_normal_flags(sv, 0);
 	}
+#endif
 	if (SvREADONLY(sv) && !SvOK(sv)) {
 	    if (ckWARN(WARN_UNINITIALIZED))
 		report_uninit(sv);
@@ -2518,7 +2536,7 @@ Perl_sv_2nv_flags(pTHX_ register SV *const sv, const I32 flags)
 	    SvNOKp_on(sv);
 #endif
     }
-    else if (SvPOKp(sv) && SvLEN(sv)) {
+    else if (SvPOKp(sv)) {
 	UV value;
 	const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
 	if (!SvIOKp(sv) && !numtype && ckWARN(WARN_NUMERIC))
@@ -2715,201 +2733,150 @@ char *
 Perl_sv_2pv_flags(pTHX_ register SV *const sv, STRLEN *const lp, const I32 flags)
 {
     dVAR;
-    register char *s;
+    char *s;
 
     if (!sv) {
 	if (lp)
 	    *lp = 0;
 	return (char *)"";
     }
-    if (SvGMAGICAL(sv)) {
-	if (flags & SV_GMAGIC)
-	    mg_get(sv);
-	if (SvPOKp(sv)) {
-	    if (lp)
-		*lp = SvCUR(sv);
-	    if (flags & SV_MUTABLE_RETURN)
-		return SvPVX_mutable(sv);
-	    if (flags & SV_CONST_RETURN)
-		return (char *)SvPVX_const(sv);
-	    return SvPVX(sv);
-	}
-	if (SvIOKp(sv) || SvNOKp(sv)) {
-	    char tbuf[64];  /* Must fit sprintf/Gconvert of longest IV/NV */
-	    STRLEN len;
-
-	    if (SvIOKp(sv)) {
-		len = SvIsUV(sv)
-		    ? my_snprintf(tbuf, sizeof(tbuf), "%"UVuf, (UV)SvUVX(sv))
-		    : my_snprintf(tbuf, sizeof(tbuf), "%"IVdf, (IV)SvIVX(sv));
-	    } else if(SvNVX(sv) == 0.0) {
-		    tbuf[0] = '0';
-		    tbuf[1] = 0;
-		    len = 1;
-	    } else {
-		Gconvert(SvNVX(sv), NV_DIG, 0, tbuf);
-		len = strlen(tbuf);
-	    }
-	    assert(!SvROK(sv));
-	    {
-		dVAR;
+    if (SvGMAGICAL(sv) && (flags & SV_GMAGIC))
+	mg_get(sv);
+    if (SvROK(sv)) {
+	if (SvAMAGIC(sv)) {
+	    SV *tmpstr;
+	    if (flags & SV_SKIP_OVERLOAD)
+		return NULL;
+	    tmpstr = AMG_CALLunary(sv, string_amg);
+	    TAINT_IF(tmpstr && SvTAINTED(tmpstr));
+	    if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
+		/* Unwrap this:  */
+		/* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr);
+		 */
 
-		SvUPGRADE(sv, SVt_PV);
-		if (lp)
-		    *lp = len;
-		s = SvGROW_mutable(sv, len + 1);
-		SvCUR_set(sv, len);
-		SvPOKp_on(sv);
-		return (char*)memcpy(s, tbuf, len + 1);
-	    }
-	}
-        if (SvROK(sv)) {
-	    goto return_rok;
-	}
-	assert(SvTYPE(sv) >= SVt_PVMG);
-	/* This falls through to the report_uninit near the end of the
-	   function. */
-    } else if (SvTHINKFIRST(sv)) {
-	if (SvROK(sv)) {
-	return_rok:
-            if (SvAMAGIC(sv)) {
-		SV *tmpstr;
-		if (flags & SV_SKIP_OVERLOAD)
-		    return NULL;
-		tmpstr = AMG_CALLunary(sv, string_amg);
-		TAINT_IF(tmpstr && SvTAINTED(tmpstr));
-		if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
-		    /* Unwrap this:  */
-		    /* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr);
-		     */
-
-		    char *pv;
-		    if ((SvFLAGS(tmpstr) & (SVf_POK)) == SVf_POK) {
-			if (flags & SV_CONST_RETURN) {
-			    pv = (char *) SvPVX_const(tmpstr);
-			} else {
-			    pv = (flags & SV_MUTABLE_RETURN)
-				? SvPVX_mutable(tmpstr) : SvPVX(tmpstr);
-			}
-			if (lp)
-			    *lp = SvCUR(tmpstr);
+		char *pv;
+		if ((SvFLAGS(tmpstr) & (SVf_POK)) == SVf_POK) {
+		    if (flags & SV_CONST_RETURN) {
+			pv = (char *) SvPVX_const(tmpstr);
 		    } else {
-			pv = sv_2pv_flags(tmpstr, lp, flags);
+			pv = (flags & SV_MUTABLE_RETURN)
+			    ? SvPVX_mutable(tmpstr) : SvPVX(tmpstr);
 		    }
-		    if (SvUTF8(tmpstr))
-			SvUTF8_on(sv);
-		    else
-			SvUTF8_off(sv);
-		    return pv;
+		    if (lp)
+			*lp = SvCUR(tmpstr);
+		} else {
+		    pv = sv_2pv_flags(tmpstr, lp, flags);
 		}
+		if (SvUTF8(tmpstr))
+		    SvUTF8_on(sv);
+		else
+		    SvUTF8_off(sv);
+		return pv;
 	    }
-	    {
-		STRLEN len;
-		char *retval;
-		char *buffer;
-		SV *const referent = SvRV(sv);
-
-		if (!referent) {
-		    len = 7;
-		    retval = buffer = savepvn("NULLREF", len);
-		} else if (SvTYPE(referent) == SVt_REGEXP && (
-			      !(PL_curcop->cop_hints & HINT_NO_AMAGIC)
-			   || amagic_is_enabled(string_amg)
-			  )) {
-		    REGEXP * const re = (REGEXP *)MUTABLE_PTR(referent);
-		    I32 seen_evals = 0;
-
-		    assert(re);
+	}
+	{
+	    STRLEN len;
+	    char *retval;
+	    char *buffer;
+	    SV *const referent = SvRV(sv);
+
+	    if (!referent) {
+		len = 7;
+		retval = buffer = savepvn("NULLREF", len);
+	    } else if (SvTYPE(referent) == SVt_REGEXP &&
+		       (!(PL_curcop->cop_hints & HINT_NO_AMAGIC) ||
+			amagic_is_enabled(string_amg))) {
+		REGEXP * const re = (REGEXP *)MUTABLE_PTR(referent);
+
+		assert(re);
 			
-		    /* If the regex is UTF-8 we want the containing scalar to
-		       have an UTF-8 flag too */
-		    if (RX_UTF8(re))
-			SvUTF8_on(sv);
-		    else
-			SvUTF8_off(sv);	
-
-		    if ((seen_evals = RX_SEEN_EVALS(re)))
-			PL_reginterp_cnt += seen_evals;
+		/* If the regex is UTF-8 we want the containing scalar to
+		   have an UTF-8 flag too */
+		if (RX_UTF8(re))
+		    SvUTF8_on(sv);
+		else
+		    SvUTF8_off(sv);	
 
-		    if (lp)
-			*lp = RX_WRAPLEN(re);
+		if (lp)
+		    *lp = RX_WRAPLEN(re);
  
-		    return RX_WRAPPED(re);
-		} else {
-		    const char *const typestr = sv_reftype(referent, 0);
-		    const STRLEN typelen = strlen(typestr);
-		    UV addr = PTR2UV(referent);
-		    const char *stashname = NULL;
-		    STRLEN stashnamelen = 0; /* hush, gcc */
-		    const char *buffer_end;
-
-		    if (SvOBJECT(referent)) {
-			const HEK *const name = HvNAME_HEK(SvSTASH(referent));
-
-			if (name) {
-			    stashname = HEK_KEY(name);
-			    stashnamelen = HEK_LEN(name);
-
-			    if (HEK_UTF8(name)) {
-				SvUTF8_on(sv);
-			    } else {
-				SvUTF8_off(sv);
-			    }
+		return RX_WRAPPED(re);
+	    } else {
+		const char *const typestr = sv_reftype(referent, 0);
+		const STRLEN typelen = strlen(typestr);
+		UV addr = PTR2UV(referent);
+		const char *stashname = NULL;
+		STRLEN stashnamelen = 0; /* hush, gcc */
+		const char *buffer_end;
+
+		if (SvOBJECT(referent)) {
+		    const HEK *const name = HvNAME_HEK(SvSTASH(referent));
+
+		    if (name) {
+			stashname = HEK_KEY(name);
+			stashnamelen = HEK_LEN(name);
+
+			if (HEK_UTF8(name)) {
+			    SvUTF8_on(sv);
 			} else {
-			    stashname = "__ANON__";
-			    stashnamelen = 8;
+			    SvUTF8_off(sv);
 			}
-			len = stashnamelen + 1 /* = */ + typelen + 3 /* (0x */
-			    + 2 * sizeof(UV) + 2 /* )\0 */;
 		    } else {
-			len = typelen + 3 /* (0x */
-			    + 2 * sizeof(UV) + 2 /* )\0 */;
+			stashname = "__ANON__";
+			stashnamelen = 8;
 		    }
+		    len = stashnamelen + 1 /* = */ + typelen + 3 /* (0x */
+			+ 2 * sizeof(UV) + 2 /* )\0 */;
+		} else {
+		    len = typelen + 3 /* (0x */
+			+ 2 * sizeof(UV) + 2 /* )\0 */;
+		}
 
-		    Newx(buffer, len, char);
-		    buffer_end = retval = buffer + len;
-
-		    /* Working backwards  */
-		    *--retval = '\0';
-		    *--retval = ')';
-		    do {
-			*--retval = PL_hexdigit[addr & 15];
-		    } while (addr >>= 4);
-		    *--retval = 'x';
-		    *--retval = '0';
-		    *--retval = '(';
-
-		    retval -= typelen;
-		    memcpy(retval, typestr, typelen);
-
-		    if (stashname) {
-			*--retval = '=';
-			retval -= stashnamelen;
-			memcpy(retval, stashname, stashnamelen);
-		    }
-		    /* retval may not necessarily have reached the start of the
-		       buffer here.  */
-		    assert (retval >= buffer);
-
-		    len = buffer_end - retval - 1; /* -1 for that \0  */
+		Newx(buffer, len, char);
+		buffer_end = retval = buffer + len;
+
+		/* Working backwards  */
+		*--retval = '\0';
+		*--retval = ')';
+		do {
+		    *--retval = PL_hexdigit[addr & 15];
+		} while (addr >>= 4);
+		*--retval = 'x';
+		*--retval = '0';
+		*--retval = '(';
+
+		retval -= typelen;
+		memcpy(retval, typestr, typelen);
+
+		if (stashname) {
+		    *--retval = '=';
+		    retval -= stashnamelen;
+		    memcpy(retval, stashname, stashnamelen);
 		}
-		if (lp)
-		    *lp = len;
-		SAVEFREEPV(buffer);
-		return retval;
+		/* retval may not necessarily have reached the start of the
+		   buffer here.  */
+		assert (retval >= buffer);
+
+		len = buffer_end - retval - 1; /* -1 for that \0  */
 	    }
-	}
-	if (SvREADONLY(sv) && !SvOK(sv)) {
 	    if (lp)
-		*lp = 0;
-	    if (flags & SV_UNDEF_RETURNS_NULL)
-		return NULL;
-	    if (ckWARN(WARN_UNINITIALIZED))
-		report_uninit(sv);
-	    return (char *)"";
+		*lp = len;
+	    SAVEFREEPV(buffer);
+	    return retval;
 	}
     }
-    if (SvIOK(sv) || ((SvIOKp(sv) && !SvNOKp(sv)))) {
+
+    if (SvPOKp(sv)) {
+	if (lp)
+	    *lp = SvCUR(sv);
+	if (flags & SV_MUTABLE_RETURN)
+	    return SvPVX_mutable(sv);
+	if (flags & SV_CONST_RETURN)
+	    return (char *)SvPVX_const(sv);
+	return SvPVX(sv);
+    }
+
+    if (SvIOK(sv)) {
 	/* I'm assuming that if both IV and NV are equally valid then
 	   converting the IV is going to be more efficient */
 	const U32 isUIOK = SvIsUV(sv);
@@ -2927,7 +2894,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *const sv, STRLEN *const lp, const I32 flags
 	s += len;
 	*s = '\0';
     }
-    else if (SvNOKp(sv)) {
+    else if (SvNOK(sv)) {
 	if (SvTYPE(sv) < SVt_PVNV)
 	    sv_upgrade(sv, SVt_PVNV);
 	if (SvNVX(sv) == 0.0) {
@@ -2948,32 +2915,36 @@ Perl_sv_2pv_flags(pTHX_ register SV *const sv, STRLEN *const lp, const I32 flags
 	    *--s = '\0';
 #endif
     }
-    else {
-	if (isGV_with_GP(sv)) {
-	    GV *const gv = MUTABLE_GV(sv);
-	    SV *const buffer = sv_newmortal();
-
-	    gv_efullname3(buffer, gv, "*");
+    else if (isGV_with_GP(sv)) {
+	GV *const gv = MUTABLE_GV(sv);
+	SV *const buffer = sv_newmortal();
 
-	    assert(SvPOK(buffer));
-	    if (lp) {
-		    *lp = SvCUR(buffer);
-	    }
-            if ( SvUTF8(buffer) ) SvUTF8_on(sv);
-	    return SvPVX(buffer);
-	}
+	gv_efullname3(buffer, gv, "*");
 
+	assert(SvPOK(buffer));
+	if (SvUTF8(buffer))
+	    SvUTF8_on(sv);
+	if (lp)
+	    *lp = SvCUR(buffer);
+	return SvPVX(buffer);
+    }
+    else if (isREGEXP(sv)) {
+	if (lp) *lp = RX_WRAPLEN((REGEXP *)sv);
+	return RX_WRAPPED((REGEXP *)sv);
+    }
+    else {
 	if (lp)
 	    *lp = 0;
 	if (flags & SV_UNDEF_RETURNS_NULL)
 	    return NULL;
 	if (!PL_localizing && !SvPADTMP(sv) && ckWARN(WARN_UNINITIALIZED))
 	    report_uninit(sv);
-	if (SvTYPE(sv) < SVt_PV)
-	    /* Typically the caller expects that sv_any is not NULL now.  */
+	/* Typically the caller expects that sv_any is not NULL now.  */
+	if (!SvREADONLY(sv) && SvTYPE(sv) < SVt_PV)
 	    sv_upgrade(sv, SVt_PV);
 	return (char *)"";
     }
+
     {
 	const STRLEN len = s - SvPVX_const(sv);
 	if (lp) 
@@ -3001,17 +2972,37 @@ sv_2pv[_flags] but operates directly on an SV instead of just the
 string.  Mostly uses sv_2pv_flags to do its work, except when that
 would lose the UTF-8'ness of the PV.
 
+=for apidoc sv_copypv_nomg
+
+Like sv_copypv, but doesn't invoke get magic first.
+
+=for apidoc sv_copypv_flags
+
+Implementation of sv_copypv and sv_copypv_nomg.  Calls get magic iff flags
+include SV_GMAGIC.
+
 =cut
 */
 
 void
 Perl_sv_copypv(pTHX_ SV *const dsv, register SV *const ssv)
 {
+    PERL_ARGS_ASSERT_SV_COPYPV;
+
+    sv_copypv_flags(dsv, ssv, 0);
+}
+
+void
+Perl_sv_copypv_flags(pTHX_ SV *const dsv, register SV *const ssv, const I32 flags)
+{
     STRLEN len;
-    const char * const s = SvPV_const(ssv,len);
+    const char *s;
 
-    PERL_ARGS_ASSERT_SV_COPYPV;
+    PERL_ARGS_ASSERT_SV_COPYPV_FLAGS;
 
+    if ((flags & SV_GMAGIC) && SvGMAGICAL(ssv))
+	mg_get(ssv);
+    s = SvPV_nomg_const(ssv,len);
     sv_setpvn(dsv,s,len);
     if (SvUTF8(ssv))
 	SvUTF8_on(dsv);
@@ -3036,7 +3027,8 @@ Perl_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *const lp)
 {
     PERL_ARGS_ASSERT_SV_2PVBYTE;
 
-    if ((SvTHINKFIRST(sv) && !SvIsCOW(sv)) || isGV_with_GP(sv)) {
+    if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv))
+     || isGV_with_GP(sv) || SvROK(sv)) {
 	SV *sv2 = sv_newmortal();
 	sv_copypv(sv2,sv);
 	sv = sv2;
@@ -3062,11 +3054,12 @@ Perl_sv_2pvutf8(pTHX_ register SV *sv, STRLEN *const lp)
 {
     PERL_ARGS_ASSERT_SV_2PVUTF8;
 
-    if ((SvTHINKFIRST(sv) && !SvIsCOW(sv)) || isGV_with_GP(sv))
+    if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv))
+     || isGV_with_GP(sv) || SvROK(sv))
 	sv = sv_mortalcopy(sv);
-    sv_utf8_upgrade(sv);
-    if (SvGMAGICAL(sv)) SvFLAGS(sv) &= ~SVf_POK;
-    assert(SvPOKp(sv));
+    else
+        SvGETMAGIC(sv);
+    sv_utf8_upgrade_nomg(sv);
     return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv);
 }
 
@@ -3107,30 +3100,7 @@ Perl_sv_2bool_flags(pTHX_ register SV *const sv, const I32 flags)
 	}
 	return SvRV(sv) != 0;
     }
-    if (SvPOKp(sv)) {
-	register XPV* const Xpvtmp = (XPV*)SvANY(sv);
-	if (Xpvtmp &&
-		(*sv->sv_u.svu_pv > '0' ||
-		Xpvtmp->xpv_cur > 1 ||
-		(Xpvtmp->xpv_cur && *sv->sv_u.svu_pv != '0')))
-	    return 1;
-	else
-	    return 0;
-    }
-    else {
-	if (SvIOKp(sv))
-	    return SvIVX(sv) != 0;
-	else {
-	    if (SvNOKp(sv))
-		return SvNVX(sv) != 0.0;
-	    else {
-		if (isGV_with_GP(sv))
-		    return TRUE;
-		else
-		    return FALSE;
-	    }
-	}
-    }
+    return SvTRUE_common(sv, isGV_with_GP(sv) ? 1 : 0);
 }
 
 /*
@@ -3143,7 +3113,7 @@ Always sets the SvUTF8 flag to avoid future validity checks even
 if the whole string is the same in UTF-8 as not.
 Returns the number of bytes in the converted string
 
-This is not as a general purpose byte encoding to Unicode interface:
+This is not a general purpose byte encoding to Unicode interface:
 use the Encode extension for that.
 
 =for apidoc sv_utf8_upgrade_nomg
@@ -3162,7 +3132,7 @@ Returns the number of bytes in the converted string
 C<sv_utf8_upgrade> and
 C<sv_utf8_upgrade_nomg> are implemented in terms of this function.
 
-This is not as a general purpose byte encoding to Unicode interface:
+This is not a general purpose byte encoding to Unicode interface:
 use the Encode extension for that.
 
 =cut
@@ -3207,7 +3177,7 @@ Perl_sv_utf8_upgrade_flags_grow(pTHX_ register SV *const sv, const I32 flags, ST
 
     if (sv == &PL_sv_undef)
 	return 0;
-    if (!SvPOK(sv)) {
+    if (!SvPOK_nog(sv)) {
 	STRLEN len = 0;
 	if (SvREADONLY(sv) && (SvPOKp(sv) || SvIOKp(sv) || SvNOKp(sv))) {
 	    (void) sv_2pv_flags(sv,&len, flags);
@@ -3465,7 +3435,7 @@ in a byte, this conversion will fail;
 in this case, either returns false or, if C<fail_ok> is not
 true, croaks.
 
-This is not as a general purpose Unicode to byte encoding interface:
+This is not a general purpose Unicode to byte encoding interface:
 use the Encode extension for that.
 
 =cut
@@ -3705,7 +3675,6 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
          /* The stash may have been detached from the symbol table, so
             check its name. */
          && GvSTASH(dstr) && HvENAME(GvSTASH(dstr))
-         && GvAV((const GV *)sstr)
         )
             mro_changes = 2;
         else {
@@ -3740,6 +3709,7 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
 	}
     GvMULTI_on(dstr);
     if(mro_changes == 2) {
+      if (GvAV((const GV *)sstr)) {
 	MAGIC *mg;
 	SV * const sref = (SV *)GvAV((const GV *)dstr);
 	if (SvSMAGICAL(sref) && (mg = mg_find(sref, PERL_MAGIC_isa))) {
@@ -3751,7 +3721,8 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
 	    av_push((AV *)mg->mg_obj, SvREFCNT_inc_simple_NN(dstr));
 	}
 	else sv_magic(sref, dstr, PERL_MAGIC_isa, NULL, 0);
-	mro_isa_changed_in(GvSTASH(dstr));
+      }
+      mro_isa_changed_in(GvSTASH(dstr));
     }
     else if(mro_changes == 3) {
 	HV * const stash = GvHV(dstr);
@@ -3925,6 +3896,14 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
 	    assert(mg);
 	    Perl_magic_clearisa(aTHX_ NULL, mg);
 	}
+        else if (stype == SVt_PVIO) {
+            DEBUG_o(Perl_deb(aTHX_ "glob_assign_ref clearing PL_stashcache\n"));
+            /* It's a cache. It will rebuild itself quite happily.
+               It's a lot of effort to work out exactly which key (or keys)
+               might be invalidated by the creation of the this file handle.
+            */
+            hv_clear(PL_stashcache);
+        }
 	break;
     }
     SvREFCNT_dec(dref);
@@ -3937,9 +3916,9 @@ void
 Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
 {
     dVAR;
-    register U32 sflags;
-    register int dtype;
-    register svtype stype;
+    U32 sflags;
+    int dtype;
+    svtype stype;
 
     PERL_ARGS_ASSERT_SV_SETSV_FLAGS;
 
@@ -3960,12 +3939,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
     stype = SvTYPE(sstr);
     dtype = SvTYPE(dstr);
 
-    if ( SvVOK(dstr) )
-    {
-	/* need to nuke the magic */
-	sv_unmagic(dstr, PERL_MAGIC_vstring);
-    }
-
     /* There's a lot of redundancy below but we're going for speed here */
 
     switch (stype) {
@@ -4033,15 +4006,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
 	}
 	goto undef_sstr;
 
-    case SVt_PVFM:
-#ifdef PERL_OLD_COPY_ON_WRITE
-	if ((SvFLAGS(sstr) & CAN_COW_MASK) == CAN_COW_FLAGS) {
-	    if (dtype < SVt_PVIV)
-		sv_upgrade(dstr, SVt_PVIV);
-	    break;
-	}
-	/* Fall through */
-#endif
     case SVt_PV:
 	if (dtype < SVt_PV)
 	    sv_upgrade(dstr, SVt_PV);
@@ -4066,8 +4030,17 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
 	break;
 
     case SVt_REGEXP:
+      upgregexp:
 	if (dtype < SVt_REGEXP)
+	{
+	    if (dtype >= SVt_PV) {
+		SvPV_free(dstr);
+		SvPV_set(dstr, 0);
+		SvLEN_set(dstr, 0);
+		SvCUR_set(dstr, 0);
+	    }
 	    sv_upgrade(dstr, SVt_REGEXP);
+	}
 	break;
 
 	/* case SVt_BIND: */
@@ -4084,7 +4057,10 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
 		    return;
 	}
 	if (stype == SVt_PVLV)
+	{
+	    if (isREGEXP(sstr)) goto upgregexp;
 	    SvUPGRADE(dstr, SVt_PVNV);
+	}
 	else
 	    SvUPGRADE(dstr, (svtype)stype);
     }
@@ -4094,7 +4070,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
     dtype = SvTYPE(dstr);
     sflags = SvFLAGS(sstr);
 
-    if (dtype == SVt_PVCV || dtype == SVt_PVFM) {
+    if (dtype == SVt_PVCV) {
 	/* Assigning to a subroutine sets the prototype.  */
 	if (SvOK(sstr)) {
 	    STRLEN len;
@@ -4109,7 +4085,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
 	} else {
 	    SvOK_off(dstr);
 	}
-    } else if (dtype == SVt_PVAV || dtype == SVt_PVHV) {
+    }
+    else if (dtype == SVt_PVAV || dtype == SVt_PVHV || dtype == SVt_PVFM) {
 	const char * const type = sv_reftype(dstr,0);
 	if (PL_op)
 	    /* diag_listed_as: Cannot copy to %s */
@@ -4194,7 +4171,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
 	    }
 	}
     }
-    else if (dtype == SVt_REGEXP && stype == SVt_REGEXP) {
+    else if ((dtype == SVt_REGEXP || dtype == SVt_PVLV)
+	  && (stype == SVt_REGEXP || isREGEXP(sstr))) {
 	reg_temp_copy((REGEXP*)dstr, (REGEXP*)sstr);
     }
     else if (sflags & SVp_POK) {
@@ -4237,7 +4215,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
 		in a newer implementation.  */
 	     /* If we are COW and dstr is a suitable target then we drop down
 		into the else and make dest a COW of us.  */
-	     || (SvFLAGS(dstr) & CAN_COW_MASK) != CAN_COW_FLAGS
+	     || (SvFLAGS(dstr) & SVf_BREAK)
 #endif
 	     )
             &&
@@ -4252,7 +4230,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
             && ((flags & SV_COW_SHARED_HASH_KEYS)
 		? (!((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
 		     && (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
-		     && SvTYPE(sstr) >= SVt_PVIV && SvTYPE(sstr) != SVt_PVFM))
+		     && SvTYPE(sstr) >= SVt_PVIV))
 		: 1)
 #endif
             ) {
@@ -4397,7 +4375,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
 {
     STRLEN cur = SvCUR(sstr);
     STRLEN len = SvLEN(sstr);
-    register char *new_pv;
+    char *new_pv;
 
     PERL_ARGS_ASSERT_SV_SETSV_COW;
 
@@ -4413,7 +4391,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
 	if (SvTHINKFIRST(dstr))
 	    sv_force_normal_flags(dstr, SV_COW_DROP_PV);
 	else if (SvPVX_const(dstr))
-	    Safefree(SvPVX_const(dstr));
+	    Safefree(SvPVX_mutable(dstr));
     }
     else
 	new_SV(dstr);
@@ -4476,7 +4454,7 @@ void
 Perl_sv_setpvn(pTHX_ register SV *const sv, register const char *const ptr, register const STRLEN len)
 {
     dVAR;
-    register char *dptr;
+    char *dptr;
 
     PERL_ARGS_ASSERT_SV_SETPVN;
 
@@ -4533,7 +4511,7 @@ void
 Perl_sv_setpv(pTHX_ register SV *const sv, register const char *const ptr)
 {
     dVAR;
-    register STRLEN len;
+    STRLEN len;
 
     PERL_ARGS_ASSERT_SV_SETPV;
 
@@ -4602,6 +4580,7 @@ Perl_sv_sethek(pTHX_ register SV *const sv, const HEK *const hek)
         {
 	    SV_CHECK_THINKFIRST_COW_DROP(sv);
 	    SvUPGRADE(sv, SVt_PV);
+	    Safefree(SvPVX(sv));
 	    SvPV_set(sv,(char *)HEK_KEY(share_hek_hek(hek)));
 	    SvCUR_set(sv, HEK_LEN(hek));
 	    SvLEN_set(sv, 0);
@@ -4742,10 +4721,12 @@ S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, SV *after)
 /*
 =for apidoc sv_force_normal_flags
 
-Undo various types of fakery on an SV: if the PV is a shared string, make
+Undo various types of fakery on an SV, where fakery means
+"more than" a string: if the PV is a shared string, make
 a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
 an xpvmg; if we're a copy-on-write scalar, this is the on-write time when
-we do the copy, and is also used locally.  If C<SV_COW_DROP_PV> is set
+we do the copy, and is also used locally; if this is a
+vstring, drop the vstring magic.  If C<SV_COW_DROP_PV> is set
 then a copy-on-write scalar drops its PV buffer (if any) and becomes
 SvPOK_off rather than making a copy.  (Used where this
 scalar is about to be set to some other value.)  In addition,
@@ -4765,7 +4746,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
 
 #ifdef PERL_OLD_COPY_ON_WRITE
     if (SvREADONLY(sv)) {
-	if (SvFAKE(sv)) {
+	if (SvIsCOW(sv)) {
 	    const char * const pvx = SvPVX_const(sv);
 	    const STRLEN len = SvLEN(sv);
 	    const STRLEN cur = SvCUR(sv);
@@ -4804,7 +4785,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
             }
 	}
 	else if (IN_PERL_RUNTIME)
-	    Perl_croak_no_modify(aTHX);
+	    Perl_croak_no_modify();
     }
 #else
     if (SvREADONLY(sv)) {
@@ -4826,19 +4807,21 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
 	    unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
 	}
 	else if (IN_PERL_RUNTIME)
-	    Perl_croak_no_modify(aTHX);
+	    Perl_croak_no_modify();
     }
 #endif
     if (SvROK(sv))
 	sv_unref_flags(sv, flags);
     else if (SvFAKE(sv) && isGV_with_GP(sv))
 	sv_unglob(sv, flags);
-    else if (SvFAKE(sv) && SvTYPE(sv) == SVt_REGEXP) {
+    else if (SvFAKE(sv) && isREGEXP(sv)) {
 	/* Need to downgrade the REGEXP to a simple(r) scalar. This is analogous
 	   to sv_unglob. We only need it here, so inline it.  */
-	const svtype new_type = SvMAGIC(sv) || SvSTASH(sv) ? SVt_PVMG : SVt_PV;
+	const bool islv = SvTYPE(sv) == SVt_PVLV;
+	const svtype new_type =
+	  islv ? SVt_NULL : SvMAGIC(sv) || SvSTASH(sv) ? SVt_PVMG : SVt_PV;
 	SV *const temp = newSV_type(new_type);
-	void *const temp_p = SvANY(sv);
+	regexp *const temp_p = ReANY((REGEXP *)sv);
 
 	if (new_type == SVt_PVMG) {
 	    SvMAGIC_set(temp, SvMAGIC(sv));
@@ -4846,41 +4829,51 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
 	    SvSTASH_set(temp, SvSTASH(sv));
 	    SvSTASH_set(sv, NULL);
 	}
-	SvCUR_set(temp, SvCUR(sv));
-	/* Remember that SvPVX is in the head, not the body. */
-	if (SvLEN(temp)) {
-	    SvLEN_set(temp, SvLEN(sv));
-	    /* This signals "buffer is owned by someone else" in sv_clear,
-	       which is the least effort way to stop it freeing the buffer.
-	    */
-	    SvLEN_set(sv, SvLEN(sv)+1);
-	} else {
-	    /* Their buffer is already owned by someone else. */
-	    SvPVX(sv) = savepvn(SvPVX(sv), SvCUR(sv));
-	    SvLEN_set(temp, SvCUR(sv)+1);
+	if (!islv) SvCUR_set(temp, SvCUR(sv));
+	/* Remember that SvPVX is in the head, not the body.  But
+	   RX_WRAPPED is in the body. */
+	assert(ReANY((REGEXP *)sv)->mother_re);
+	/* Their buffer is already owned by someone else. */
+	if (flags & SV_COW_DROP_PV) {
+	    /* SvLEN is already 0.  For SVt_REGEXP, we have a brand new
+	       zeroed body.  For SVt_PVLV, it should have been set to 0
+	       before turning into a regexp. */
+	    assert(!SvLEN(islv ? sv : temp));
+	    sv->sv_u.svu_pv = 0;
+	}
+	else {
+	    sv->sv_u.svu_pv = savepvn(RX_WRAPPED((REGEXP *)sv), SvCUR(sv));
+	    SvLEN_set(islv ? sv : temp, SvCUR(sv)+1);
+	    SvPOK_on(sv);
 	}
 
 	/* Now swap the rest of the bodies. */
 
-	SvFLAGS(sv) &= ~(SVf_FAKE|SVTYPEMASK);
-	SvFLAGS(sv) |= new_type;
-	SvANY(sv) = SvANY(temp);
+	SvFAKE_off(sv);
+	if (!islv) {
+	    SvFLAGS(sv) &= ~SVTYPEMASK;
+	    SvFLAGS(sv) |= new_type;
+	    SvANY(sv) = SvANY(temp);
+	}
 
 	SvFLAGS(temp) &= ~(SVTYPEMASK);
 	SvFLAGS(temp) |= SVt_REGEXP|SVf_FAKE;
 	SvANY(temp) = temp_p;
+	temp->sv_u.svu_rx = (regexp *)temp_p;
 
 	SvREFCNT_dec(temp);
     }
+    else if (SvVOK(sv)) sv_unmagic(sv, PERL_MAGIC_vstring);
 }
 
 /*
 =for apidoc sv_chop
 
 Efficient removal of characters from the beginning of the string buffer.
-SvPOK(sv) must be true and the C<ptr> must be a pointer to somewhere inside
-the string buffer.  The C<ptr> becomes the first character of the adjusted
-string.  Uses the "OOK hack".
+SvPOK(sv), or at least SvPOKp(sv), must be true and the C<ptr> must be a
+pointer to somewhere inside the string buffer.  The C<ptr> becomes the first
+character of the adjusted string.  Uses the "OOK hack".  On return, only
+SvPOK(sv) and SvPOKp(sv) among the OK flags will be true.
 
 Beware: after this function returns, C<ptr> and SvPVX_const(sv) may no longer
 refer to the same chunk of data.
@@ -4919,6 +4912,7 @@ Perl_sv_chop(pTHX_ register SV *const sv, register const char *const ptr)
 		   ptr, SvPVX_const(sv), SvPVX_const(sv) + max_delta);
     /* SvPVX(sv) may move in SV_CHECK_THINKFIRST(sv), so don't use ptr any more */
     SV_CHECK_THINKFIRST(sv);
+    SvPOK_only_UTF8(sv);
 
     if (!SvOOK(sv)) {
 	if (!SvLEN(sv)) { /* make copy of shared string */
@@ -5046,18 +5040,19 @@ Perl_sv_catpvn_flags(pTHX_ register SV *const dsv, register const char *sstr, re
 /*
 =for apidoc sv_catsv
 
-Concatenates the string from SV C<ssv> onto the end of the string in
-SV C<dsv>.  Modifies C<dsv> but not C<ssv>.  Handles 'get' magic, but
-not 'set' magic.  See C<sv_catsv_mg>.
+Concatenates the string from SV C<ssv> onto the end of the string in SV
+C<dsv>.  If C<ssv> is null, does nothing; otherwise modifies only C<dsv>.
+Handles 'get' magic on both SVs, but no 'set' magic.  See C<sv_catsv_mg> and
+C<sv_catsv_nomg>.
 
 =for apidoc sv_catsv_flags
 
-Concatenates the string from SV C<ssv> onto the end of the string in
-SV C<dsv>.  Modifies C<dsv> but not C<ssv>.  If C<flags> has C<SV_GMAGIC>
-bit set, will C<mg_get> on the C<ssv>, if appropriate, before
-reading it.  If the C<flags> contain C<SV_SMAGIC>, C<mg_set> will be
-called on the modified SV afterward, if appropriate.  C<sv_catsv>
-and C<sv_catsv_nomg> are implemented in terms of this function.
+Concatenates the string from SV C<ssv> onto the end of the string in SV
+C<dsv>.  If C<ssv> is null, does nothing; otherwise modifies only C<dsv>.
+If C<flags> include C<SV_GMAGIC> bit set, will call C<mg_get> on both SVs if
+appropriate.  If C<flags> include C<SV_SMAGIC>, C<mg_set> will be called on
+the modified SV afterward, if appropriate.  C<sv_catsv>, C<sv_catsv_nomg>,
+and C<sv_catsv_mg> are implemented in terms of this function.
 
 =cut */
 
@@ -5068,18 +5063,18 @@ Perl_sv_catsv_flags(pTHX_ SV *const dsv, register SV *const ssv, const I32 flags
  
     PERL_ARGS_ASSERT_SV_CATSV_FLAGS;
 
-   if (ssv) {
+    if (ssv) {
 	STRLEN slen;
 	const char *spv = SvPV_flags_const(ssv, slen, flags);
 	if (spv) {
-	    if (SvGMAGICAL(dsv) && (flags & SV_GMAGIC))
-		mg_get(dsv);
+            if (flags & SV_GMAGIC)
+                SvGETMAGIC(dsv);
 	    sv_catpvn_flags(dsv, spv, slen,
 			    DO_UTF8(ssv) ? SV_CATUTF8 : SV_CATBYTES);
-	}
+            if (flags & SV_SMAGIC)
+                SvSETMAGIC(dsv);
+        }
     }
-    if (flags & SV_SMAGIC)
-	SvSETMAGIC(dsv);
 }
 
 /*
@@ -5095,7 +5090,7 @@ void
 Perl_sv_catpv(pTHX_ register SV *const sv, register const char *ptr)
 {
     dVAR;
-    register STRLEN len;
+    STRLEN len;
     STRLEN tlen;
     char *junk;
 
@@ -5170,7 +5165,7 @@ SV *
 Perl_newSV(pTHX_ const STRLEN len)
 {
     dVAR;
-    register SV *sv;
+    SV *sv;
 
     new_SV(sv);
     if (len) {
@@ -5267,8 +5262,6 @@ Perl_sv_magicext(pTHX_ SV *const sv, SV *const obj, const int how,
     mg->mg_virtual = (MGVTBL *) vtable;
 
     mg_magical(sv);
-    if (SvGMAGICAL(sv))
-	SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
     return mg;
 }
 
@@ -5327,7 +5320,7 @@ Perl_sv_magic(pTHX_ register SV *const sv, SV *const obj, const int how,
 	    && !PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(how)
 	   )
 	{
-	    Perl_croak_no_modify(aTHX);
+	    Perl_croak_no_modify();
 	}
     }
     if (SvMAGICAL(sv) || (how == PERL_MAGIC_taint && SvTYPE(sv) >= SVt_PVMG)) {
@@ -5335,13 +5328,8 @@ Perl_sv_magic(pTHX_ register SV *const sv, SV *const obj, const int how,
 	    /* sv_magic() refuses to add a magic of the same 'how' as an
 	       existing one
 	     */
-	    if (how == PERL_MAGIC_taint) {
+	    if (how == PERL_MAGIC_taint)
 		mg->mg_len |= 1;
-		/* Any scalar which already had taint magic on which someone
-		   (erroneously?) did SvIOK_on() or similar will now be
-		   incorrectly sporting public "OK" flags.  */
-		SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
-	    }
 	    return;
 	}
     }
@@ -5687,7 +5675,7 @@ Perl_sv_kill_backrefs(pTHX_ SV *const sv, AV *const av)
     if (!av)
 	return;
 
-    /* after multiple passes through Perl_sv_clean_all() for a thinngy
+    /* after multiple passes through Perl_sv_clean_all() for a thingy
      * that has badly leaked, the backref array may have gotten freed,
      * since we only protect it against 1 round of cleanup */
     if (SvIS_FREED(av)) {
@@ -5783,11 +5771,11 @@ void
 Perl_sv_insert_flags(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, const char *const little, const STRLEN littlelen, const U32 flags)
 {
     dVAR;
-    register char *big;
-    register char *mid;
-    register char *midend;
-    register char *bigend;
-    register SSize_t i;		/* better be sizeof(STRLEN) or bad things happen */
+    char *big;
+    char *mid;
+    char *midend;
+    char *bigend;
+    SSize_t i;		/* better be sizeof(STRLEN) or bad things happen */
     STRLEN curlen;
 
     PERL_ARGS_ASSERT_SV_INSERT_FLAGS;
@@ -5963,10 +5951,11 @@ S_anonymise_cv_maybe(pTHX_ GV *gv, CV* cv)
     assert(GvGP(gv));
     assert(!CvANON(cv));
     assert(CvGV(cv) == gv);
+    assert(!CvNAMED(cv));
 
     /* will the CV shortly be freed by gp_free() ? */
     if (GvCV(gv) == cv && GvGP(gv)->gp_refcnt < 2 && SvREFCNT(cv) < 2) {
-	SvANY(cv)->xcv_gv = NULL;
+	SvANY(cv)->xcv_gv_u.xcv_gv = NULL;
 	return;
     }
 
@@ -5980,7 +5969,7 @@ S_anonymise_cv_maybe(pTHX_ GV *gv, CV* cv)
 
     CvANON_on(cv);
     CvCVGV_RC_on(cv);
-    SvANY(cv)->xcv_gv = MUTABLE_GV(SvREFCNT_inc(anongv));
+    SvANY(cv)->xcv_gv_u.xcv_gv = MUTABLE_GV(SvREFCNT_inc(anongv));
 }
 
 
@@ -6007,7 +5996,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
     const struct body_details *sv_type_details;
     SV* iter_sv = NULL;
     SV* next_sv = NULL;
-    register SV *sv = orig_sv;
+    SV *sv = orig_sv;
     STRLEN hash_index;
 
     PERL_ARGS_ASSERT_SV_CLEAR;
@@ -6081,6 +6070,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
 	    goto freescalar;
 	case SVt_REGEXP:
 	    /* FIXME for plugins */
+	  freeregexp:
 	    pregfree2((REGEXP*) sv);
 	    goto freescalar;
 	case SVt_PVCV:
@@ -6103,9 +6093,12 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
 		if (   PL_phase != PERL_PHASE_DESTRUCT
 		    && (name = HvNAME((HV*)sv)))
 		{
-		    if (PL_stashcache)
+		    if (PL_stashcache) {
+                    DEBUG_o(Perl_deb(aTHX_ "sv_clear clearing PL_stashcache for '%"SVf"'\n",
+                                     sv));
 			(void)hv_delete(PL_stashcache, name,
 			    HvNAMEUTF8((HV*)sv) ? -HvNAMELEN_get((HV*)sv) : HvNAMELEN_get((HV*)sv), G_DISCARD);
+                    }
 		    hv_name_set((HV*)sv, NULL, 0, 0);
 		}
 
@@ -6154,6 +6147,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
 	    }
 	    else if (LvTYPE(sv) != 't') /* unless tie: unrefcnted fake SV**  */
 		SvREFCNT_dec(LvTARG(sv));
+	    if (isREGEXP(sv)) goto freeregexp;
 	case SVt_PVGV:
 	    if (isGV_with_GP(sv)) {
 		if(GvCVu((const GV *)sv) && (stash = GvSTASH(MUTABLE_GV(sv)))
@@ -6217,7 +6211,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
 
 		    SvFAKE_off(sv);
 		} else if (SvLEN(sv)) {
-		    Safefree(SvPVX_const(sv));
+		    Safefree(SvPVX_mutable(sv));
 		}
 	    }
 #else
@@ -6289,6 +6283,10 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
 		    iter_sv = (SV*)SvSTASH(sv);
 		    assert(!SvMAGICAL(sv));
 		    hash_index = ((XPVMG*) SvANY(sv))->xmg_u.xmg_hash_index;
+#ifdef DEBUGGING
+		    /* perl -DA does not like rubbish in SvMAGIC. */
+		    SvMAGIC_set(sv, 0);
+#endif
 
 		    /* free any remaining detritus from the hash struct */
 		    Perl_hv_undef_flags(aTHX_ MUTABLE_HV(sv), HV_NAME_SETALL);
@@ -6512,7 +6510,8 @@ Perl_sv_free2(pTHX_ SV *const sv)
 =for apidoc sv_len
 
 Returns the length of the string in the SV.  Handles magic and type
-coercion.  See also C<SvCUR>, which gives raw access to the xpv_cur slot.
+coercion and sets the UTF8 flag appropriately.  See also C<SvCUR>, which
+gives raw access to the xpv_cur slot.
 
 =cut
 */
@@ -6525,10 +6524,7 @@ Perl_sv_len(pTHX_ register SV *const sv)
     if (!sv)
 	return 0;
 
-    if (SvGMAGICAL(sv))
-	len = mg_length(sv);
-    else
-        (void)SvPV_const(sv, len);
+    (void)SvPV_const(sv, len);
     return len;
 }
 
@@ -6556,14 +6552,20 @@ Perl_sv_len_utf8(pTHX_ register SV *const sv)
     if (!sv)
 	return 0;
 
-    if (SvGMAGICAL(sv))
-	return mg_length(sv);
-    else
-    {
-	STRLEN len;
-	const U8 *s = (U8*)SvPV_const(sv, len);
+    SvGETMAGIC(sv);
+    return sv_len_utf8_nomg(sv);
+}
+
+STRLEN
+Perl_sv_len_utf8_nomg(pTHX_ SV * const sv)
+{
+    dVAR;
+    STRLEN len;
+    const U8 *s = (U8*)SvPV_nomg_const(sv, len);
+
+    PERL_ARGS_ASSERT_SV_LEN_UTF8_NOMG;
 
-	if (PL_utf8cache) {
+    if (PL_utf8cache && SvUTF8(sv)) {
 	    STRLEN ulen;
 	    MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL;
 
@@ -6589,9 +6591,8 @@ Perl_sv_len_utf8(pTHX_ register SV *const sv)
 		utf8_mg_len_cache_update(sv, &mg, ulen);
 	    }
 	    return ulen;
-	}
-	return Perl_utf8_length(aTHX_ s, s + len);
     }
+    return SvUTF8(sv) ? Perl_utf8_length(aTHX_ s, s + len) : len;
 }
 
 /* Walk forwards to find the byte corresponding to the passed in UTF-8
@@ -6679,7 +6680,7 @@ S_sv_pos_u2b_cached(pTHX_ SV *const sv, MAGIC **const mgp, const U8 *const start
     if (!uoffset)
 	return 0;
 
-    if (!SvREADONLY(sv)
+    if (!SvREADONLY(sv) && !SvGMAGICAL(sv) && SvPOK(sv)
 	&& PL_utf8cache
 	&& (*mgp || (SvTYPE(sv) >= SVt_PVMG &&
 		     (*mgp = mg_find(sv, PERL_MAGIC_utf8))))) {
@@ -6762,7 +6763,7 @@ S_sv_pos_u2b_cached(pTHX_ SV *const sv, MAGIC **const mgp, const U8 *const start
 	boffset = real_boffset;
     }
 
-    if (PL_utf8cache) {
+    if (PL_utf8cache && !SvGMAGICAL(sv) && SvPOK(sv)) {
 	if (at_end)
 	    utf8_mg_len_cache_update(sv, mgp, uoffset);
 	else
@@ -6874,7 +6875,7 @@ S_utf8_mg_len_cache_update(pTHX_ SV *const sv, MAGIC **const mgp,
 			   const STRLEN ulen)
 {
     PERL_ARGS_ASSERT_UTF8_MG_LEN_CACHE_UPDATE;
-    if (SvREADONLY(sv))
+    if (SvREADONLY(sv) || SvGMAGICAL(sv) || !SvPOK(sv))
 	return;
 
     if (!*mgp && (SvTYPE(sv) < SVt_PVMG ||
@@ -6981,7 +6982,6 @@ S_utf8_mg_pos_cache_update(pTHX_ SV *const sv, MAGIC **const mgp, const STRLEN b
 	   calculation in bytes simply because we always know the byte
 	   length.  squareroot has the same ordering as the positive value,
 	   so don't bother with the actual square root.  */
-	const float existing = THREEWAY_SQUARE(0, cache[3], cache[1], blen);
 	if (byte > cache[1]) {
 	    /* New position is after the existing pair of pairs.  */
 	    const float keep_earlier
@@ -6990,18 +6990,14 @@ S_utf8_mg_pos_cache_update(pTHX_ SV *const sv, MAGIC **const mgp, const STRLEN b
 		= THREEWAY_SQUARE(0, cache[1], byte, blen);
 
 	    if (keep_later < keep_earlier) {
-		if (keep_later < existing) {
-		    cache[2] = cache[0];
-		    cache[3] = cache[1];
-		    cache[0] = utf8;
-		    cache[1] = byte;
-		}
+                cache[2] = cache[0];
+                cache[3] = cache[1];
+                cache[0] = utf8;
+                cache[1] = byte;
 	    }
 	    else {
-		if (keep_earlier < existing) {
-		    cache[0] = utf8;
-		    cache[1] = byte;
-		}
+                cache[0] = utf8;
+                cache[1] = byte;
 	    }
 	}
 	else if (byte > cache[3]) {
@@ -7012,16 +7008,12 @@ S_utf8_mg_pos_cache_update(pTHX_ SV *const sv, MAGIC **const mgp, const STRLEN b
 		= THREEWAY_SQUARE(0, byte, cache[1], blen);
 
 	    if (keep_later < keep_earlier) {
-		if (keep_later < existing) {
-		    cache[2] = utf8;
-		    cache[3] = byte;
-		}
+                cache[2] = utf8;
+                cache[3] = byte;
 	    }
 	    else {
-		if (keep_earlier < existing) {
-		    cache[0] = utf8;
-		    cache[1] = byte;
-		}
+                cache[0] = utf8;
+                cache[1] = byte;
 	    }
 	}
 	else {
@@ -7032,18 +7024,14 @@ S_utf8_mg_pos_cache_update(pTHX_ SV *const sv, MAGIC **const mgp, const STRLEN b
 		= THREEWAY_SQUARE(0, byte, cache[1], blen);
 
 	    if (keep_later < keep_earlier) {
-		if (keep_later < existing) {
-		    cache[2] = utf8;
-		    cache[3] = byte;
-		}
+                cache[2] = utf8;
+                cache[3] = byte;
 	    }
 	    else {
-		if (keep_earlier < existing) {
-		    cache[0] = cache[2];
-		    cache[1] = cache[3];
-		    cache[2] = utf8;
-		    cache[3] = byte;
-		}
+                cache[0] = cache[2];
+                cache[1] = cache[3];
+                cache[2] = utf8;
+                cache[3] = byte;
 	    }
 	}
     }
@@ -7593,7 +7581,10 @@ S_sv_gets_read_record(pTHX_ SV *const sv, PerlIO *const fp, I32 append)
 =for apidoc sv_gets
 
 Get a line from the filehandle and store it into the SV, optionally
-appending to the currently-stored string.
+appending to the currently-stored string. If C<append> is not 0, the
+line is appended to the SV instead of overwriting it. C<append> should
+be set to the byte offset that the appended string should start at
+in the SV (typically, C<SvCUR(sv)> is a suitable choice).
 
 =cut
 */
@@ -7604,9 +7595,9 @@ Perl_sv_gets(pTHX_ register SV *const sv, register PerlIO *const fp, I32 append)
     dVAR;
     const char *rsptr;
     STRLEN rslen;
-    register STDCHAR rslast;
-    register STDCHAR *bp;
-    register I32 cnt;
+    STDCHAR rslast;
+    STDCHAR *bp;
+    I32 cnt;
     I32 i = 0;
     I32 rspara = 0;
 
@@ -7621,8 +7612,6 @@ Perl_sv_gets(pTHX_ register SV *const sv, register PerlIO *const fp, I32 append)
        Swings and roundabouts.  */
     SvUPGRADE(sv, SVt_PV);
 
-    SvSCREAM_off(sv);
-
     if (append) {
 	if (PerlIO_isutf8(fp)) {
 	    if (!SvUTF8(sv)) {
@@ -7715,7 +7704,7 @@ Perl_sv_gets(pTHX_ register SV *const sv, register PerlIO *const fp, I32 append)
      * We're going to steal some values from the stdio struct
      * and put EVERYTHING in the innermost loop into registers.
      */
-    register STDCHAR *ptr;
+    STDCHAR *ptr;
     STRLEN bpx;
     I32 shortbuffered;
 
@@ -7861,7 +7850,7 @@ thats_really_all_folks:
 
 screamer2:
 	if (rslen) {
-            register const STDCHAR * const bpe = buf + sizeof(buf);
+            const STDCHAR * const bpe = buf + sizeof(buf);
 	    bp = buf;
 	    while ((i = PerlIO_getc(fp)) != EOF && (*bp++ = (STDCHAR)i) != rslast && bp < bpe)
 		; /* keep reading */
@@ -7881,9 +7870,9 @@ screamer2:
 	if (cnt < 0)
 	    cnt = 0;  /* we do need to re-set the sv even when cnt <= 0 */
 	if (append)
-	     sv_catpvn(sv, (char *) buf, cnt);
+            sv_catpvn_nomg(sv, (char *) buf, cnt);
 	else
-	     sv_setpvn(sv, (char *) buf, cnt);
+            sv_setpvn(sv, (char *) buf, cnt);   /* "nomg" is implied */
 
 	if (i != EOF &&			/* joy */
 	    (!rslen ||
@@ -7955,7 +7944,7 @@ void
 Perl_sv_inc_nomg(pTHX_ register SV *const sv)
 {
     dVAR;
-    register char *d;
+    char *d;
     int flags;
 
     if (!sv)
@@ -7965,7 +7954,7 @@ Perl_sv_inc_nomg(pTHX_ register SV *const sv)
 	    sv_force_normal_flags(sv, 0);
 	if (SvREADONLY(sv)) {
 	    if (IN_PERL_RUNTIME)
-		Perl_croak_no_modify(aTHX);
+		Perl_croak_no_modify();
 	}
 	if (SvROK(sv)) {
 	    IV i;
@@ -8147,7 +8136,7 @@ Perl_sv_dec_nomg(pTHX_ register SV *const sv)
 	    sv_force_normal_flags(sv, 0);
 	if (SvREADONLY(sv)) {
 	    if (IN_PERL_RUNTIME)
-		Perl_croak_no_modify(aTHX);
+		Perl_croak_no_modify();
 	}
 	if (SvROK(sv)) {
 	    IV i;
@@ -8274,13 +8263,15 @@ statement boundaries.  See also C<sv_newmortal> and C<sv_2mortal>.
  * permanent location. */
 
 SV *
-Perl_sv_mortalcopy(pTHX_ SV *const oldstr)
+Perl_sv_mortalcopy_flags(pTHX_ SV *const oldstr, U32 flags)
 {
     dVAR;
-    register SV *sv;
+    SV *sv;
 
+    if (flags & SV_GMAGIC)
+	SvGETMAGIC(oldstr); /* before new_SV, in case it dies */
     new_SV(sv);
-    sv_setsv(sv,oldstr);
+    sv_setsv_flags(sv,oldstr,flags & ~SV_GMAGIC);
     PUSH_EXTEND_MORTAL__SV_C(sv);
     SvTEMP_on(sv);
     return sv;
@@ -8301,7 +8292,7 @@ SV *
 Perl_sv_newmortal(pTHX)
 {
     dVAR;
-    register SV *sv;
+    SV *sv;
 
     new_SV(sv);
     SvFLAGS(sv) = SVs_TEMP;
@@ -8334,7 +8325,7 @@ SV *
 Perl_newSVpvn_flags(pTHX_ const char *const s, const STRLEN len, const U32 flags)
 {
     dVAR;
-    register SV *sv;
+    SV *sv;
 
     /* All the flags we don't support must be zero.
        And we're new code so I'm going to assert this from the start.  */
@@ -8398,7 +8389,7 @@ SV *
 Perl_newSVpv(pTHX_ const char *const s, const STRLEN len)
 {
     dVAR;
-    register SV *sv;
+    SV *sv;
 
     new_SV(sv);
     sv_setpvn(sv, s, len || s == NULL ? len : strlen(s));
@@ -8422,7 +8413,7 @@ SV *
 Perl_newSVpvn(pTHX_ const char *const buffer, const STRLEN len)
 {
     dVAR;
-    register SV *sv;
+    SV *sv;
 
     new_SV(sv);
     sv_setpvn(sv,buffer,len);
@@ -8520,7 +8511,7 @@ SV *
 Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
 {
     dVAR;
-    register SV *sv;
+    SV *sv;
     bool is_utf8 = FALSE;
     const char *const orig_src = src;
 
@@ -8576,7 +8567,7 @@ SV *
 Perl_newSVpvf_nocontext(const char *const pat, ...)
 {
     dTHX;
-    register SV *sv;
+    SV *sv;
     va_list args;
 
     PERL_ARGS_ASSERT_NEWSVPVF_NOCONTEXT;
@@ -8600,7 +8591,7 @@ C<sprintf>.
 SV *
 Perl_newSVpvf(pTHX_ const char *const pat, ...)
 {
-    register SV *sv;
+    SV *sv;
     va_list args;
 
     PERL_ARGS_ASSERT_NEWSVPVF;
@@ -8617,7 +8608,7 @@ SV *
 Perl_vnewSVpvf(pTHX_ const char *const pat, va_list *const args)
 {
     dVAR;
-    register SV *sv;
+    SV *sv;
 
     PERL_ARGS_ASSERT_VNEWSVPVF;
 
@@ -8639,7 +8630,7 @@ SV *
 Perl_newSVnv(pTHX_ const NV n)
 {
     dVAR;
-    register SV *sv;
+    SV *sv;
 
     new_SV(sv);
     sv_setnv(sv,n);
@@ -8659,7 +8650,7 @@ SV *
 Perl_newSViv(pTHX_ const IV i)
 {
     dVAR;
-    register SV *sv;
+    SV *sv;
 
     new_SV(sv);
     sv_setiv(sv,i);
@@ -8679,7 +8670,7 @@ SV *
 Perl_newSVuv(pTHX_ const UV u)
 {
     dVAR;
-    register SV *sv;
+    SV *sv;
 
     new_SV(sv);
     sv_setuv(sv,u);
@@ -8698,7 +8689,7 @@ is set to 1.
 SV *
 Perl_newSV_type(pTHX_ const svtype type)
 {
-    register SV *sv;
+    SV *sv;
 
     new_SV(sv);
     sv_upgrade(sv, type);
@@ -8718,7 +8709,7 @@ SV *
 Perl_newRV_noinc(pTHX_ SV *const tmpRef)
 {
     dVAR;
-    register SV *sv = newSV_type(SVt_IV);
+    SV *sv = newSV_type(SVt_IV);
 
     PERL_ARGS_ASSERT_NEWRV_NOINC;
 
@@ -8755,7 +8746,7 @@ SV *
 Perl_newSVsv(pTHX_ register SV *const old)
 {
     dVAR;
-    register SV *sv;
+    SV *sv;
 
     if (!old)
 	return NULL;
@@ -8763,11 +8754,12 @@ Perl_newSVsv(pTHX_ register SV *const old)
 	Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string");
 	return NULL;
     }
+    /* Do this here, otherwise we leak the new SV if this croaks. */
+    SvGETMAGIC(old);
     new_SV(sv);
-    /* SV_GMAGIC is the default for sv_setv()
-       SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
+    /* SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
        with SvTEMP_off and SvTEMP_on round a call to sv_setsv.  */
-    sv_setsv_flags(sv, old, SV_GMAGIC | SV_NOSTEAL);
+    sv_setsv_flags(sv, old, SV_NOSTEAL);
     return sv;
 }
 
@@ -8783,15 +8775,22 @@ Note that the perl-level function is vaguely deprecated.
 void
 Perl_sv_reset(pTHX_ register const char *s, HV *const stash)
 {
+    PERL_ARGS_ASSERT_SV_RESET;
+
+    sv_resetpvn(*s ? s : NULL, strlen(s), stash);
+}
+
+void
+Perl_sv_resetpvn(pTHX_ const char *s, STRLEN len, HV * const stash)
+{
     dVAR;
     char todo[PERL_UCHAR_MAX+1];
-
-    PERL_ARGS_ASSERT_SV_RESET;
+    const char *send;
 
     if (!stash)
 	return;
 
-    if (!*s) {		/* reset ?? searches */
+    if (!s) {		/* reset ?? searches */
 	MAGIC * const mg = mg_find((const SV *)stash, PERL_MAGIC_symtab);
 	if (mg) {
 	    const U32 count = mg->mg_len / sizeof(PMOP**);
@@ -8816,7 +8815,8 @@ Perl_sv_reset(pTHX_ register const char *s, HV *const stash)
 	return;
 
     Zero(todo, 256, char);
-    while (*s) {
+    send = s + len;
+    while (s < send) {
 	I32 max;
 	I32 i = (unsigned char)*s;
 	if (s[1] == '-') {
@@ -8832,8 +8832,8 @@ Perl_sv_reset(pTHX_ register const char *s, HV *const stash)
 		 entry;
 		 entry = HeNEXT(entry))
 	    {
-		register GV *gv;
-		register SV *sv;
+		GV *gv;
+		SV *sv;
 
 		if (!todo[(U8)*HeKEY(entry)])
 		    continue;
@@ -9005,20 +9005,10 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **const st, GV **const gvp, const I32 lref)
 	}
 	*st = GvESTASH(gv);
 	if (lref & ~GV_ADDMG && !GvCVu(gv)) {
-	    SV *tmpsv;
-	    ENTER;
-	    tmpsv = newSV(0);
-	    gv_efullname3(tmpsv, gv, NULL);
 	    /* XXX this is probably not what they think they're getting.
 	     * It has the same effect as "sub name;", i.e. just a forward
 	     * declaration! */
-	    newSUB(start_subparse(FALSE, 0),
-		   newSVOP(OP_CONST, 0, tmpsv),
-		   NULL, NULL);
-	    LEAVE;
-	    if (!GvCVu(gv))
-		Perl_croak(aTHX_ "Unable to create sub named \"%"SVf"\"",
-			   SVfARG(SvOK(sv) ? sv : &PL_sv_no));
+	    newSTUB(gv,0);
 	}
 	return GvCVu(gv);
     }
@@ -9040,7 +9030,7 @@ Perl_sv_true(pTHX_ register SV *const sv)
     if (!sv)
 	return 0;
     if (SvPOK(sv)) {
-	register const XPV* const tXpv = (XPV*)SvANY(sv);
+	const XPV* const tXpv = (XPV*)SvANY(sv);
 	if (tXpv &&
 		(tXpv->xpv_cur > 1 ||
 		(tXpv->xpv_cur && *sv->sv_u.svu_pv != '0')))
@@ -9106,12 +9096,15 @@ Perl_sv_pvn_force_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
 	    else
 		Perl_croak(aTHX_ "Can't coerce readonly %s to string", ref);
 	}
-	if ((SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM)
+	if (SvTYPE(sv) > SVt_PVLV
 	    || isGV_with_GP(sv))
 	    /* diag_listed_as: Can't coerce %s to %s in %s */
 	    Perl_croak(aTHX_ "Can't coerce %s to string in %s", sv_reftype(sv,0),
 		OP_DESC(PL_op));
 	s = sv_2pv_flags(sv, &len, flags &~ SV_GMAGIC);
+	if (!s) {
+	  s = (char *)"";
+	}
 	if (lp)
 	    *lp = len;
 
@@ -9131,6 +9124,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
 				  PTR2UV(sv),SvPVX_const(sv)));
 	}
     }
+    (void)SvPOK_only_UTF8(sv);
     return SvPVX_mutable(sv);
 }
 
@@ -9168,8 +9162,8 @@ Perl_sv_pvutf8n_force(pTHX_ SV *const sv, STRLEN *const lp)
 {
     PERL_ARGS_ASSERT_SV_PVUTF8N_FORCE;
 
-    sv_pvn_force(sv,lp);
-    sv_utf8_upgrade(sv);
+    sv_pvn_force(sv,0);
+    sv_utf8_upgrade_nomg(sv);
     *lp = SvCUR(sv);
     return SvPVX(sv);
 }
@@ -9500,10 +9494,8 @@ Perl_sv_bless(pTHX_ SV *const sv, HV *const stash)
         Perl_croak(aTHX_ "Can't bless non-reference value");
     tmpRef = SvRV(sv);
     if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) {
-	if (SvIsCOW(tmpRef))
-	    sv_force_normal_flags(tmpRef, 0);
-	if (SvREADONLY(tmpRef))
-	    Perl_croak_no_modify(aTHX);
+	if (SvREADONLY(tmpRef) && !SvIsCOW(tmpRef))
+	    Perl_croak_no_modify();
 	if (SvOBJECT(tmpRef)) {
 	    if (SvTYPE(tmpRef) != SVt_PVIO)
 		--PL_sv_objcount;
@@ -9956,7 +9948,7 @@ Perl_sv_vsetpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
     PERL_ARGS_ASSERT_SV_VSETPVFN;
 
     sv_setpvs(sv, "");
-    sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, maybe_tainted);
+    sv_vcatpvfn_flags(sv, pat, patlen, args, svargs, svmax, maybe_tainted, 0);
 }
 
 
@@ -10030,18 +10022,21 @@ S_F0convert(NV nv, char *const endbuf, STRLEN *const len)
 /*
 =for apidoc sv_vcatpvfn
 
+=for apidoc sv_vcatpvfn_flags
+
 Processes its arguments like C<vsprintf> and appends the formatted output
 to an SV.  Uses an array of SVs if the C style variable argument list is
 missing (NULL).  When running with taint checks enabled, indicates via
 C<maybe_tainted> if results are untrustworthy (often due to the use of
 locales).
 
+If called as C<sv_vcatpvfn> or flags include C<SV_GMAGIC>, calls get magic.
+
 Usually used via one of its frontends C<sv_vcatpvf> and C<sv_vcatpvf_mg>.
 
 =cut
 */
 
-
 #define VECTORIZE_ARGS	vecsv = va_arg(*args, SV*);\
 			vecstr = (U8*)SvPV_const(vecsv,veclen);\
 			vec_utf8 = DO_UTF8(vecsv);
@@ -10052,6 +10047,16 @@ void
 Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
                  va_list *const args, SV **const svargs, const I32 svmax, bool *const maybe_tainted)
 {
+    PERL_ARGS_ASSERT_SV_VCATPVFN;
+
+    sv_vcatpvfn_flags(sv, pat, patlen, args, svargs, svmax, maybe_tainted, SV_GMAGIC|SV_SMAGIC);
+}
+
+void
+Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
+                       va_list *const args, SV **const svargs, const I32 svmax, bool *const maybe_tainted,
+                       const U32 flags)
+{
     dVAR;
     char *p;
     char *q;
@@ -10070,11 +10075,14 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
     /* large enough for "%#.#f" --chip */
     /* what about long double NVs? --jhi */
 
-    PERL_ARGS_ASSERT_SV_VCATPVFN;
+    PERL_ARGS_ASSERT_SV_VCATPVFN_FLAGS;
     PERL_UNUSED_ARG(maybe_tainted);
 
+    if (flags & SV_GMAGIC)
+        SvGETMAGIC(sv);
+
     /* no matter what, this is a string now */
-    (void)SvPV_force(sv, origlen);
+    (void)SvPV_force_nomg(sv, origlen);
 
     /* special-case "", "%s", and "%-p" (SVf - see below) */
     if (patlen == 0)
@@ -10082,10 +10090,12 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
     if (patlen == 2 && pat[0] == '%' && pat[1] == 's') {
 	if (args) {
 	    const char * const s = va_arg(*args, char*);
-	    sv_catpv(sv, s ? s : nullstr);
+	    sv_catpv_nomg(sv, s ? s : nullstr);
 	}
 	else if (svix < svmax) {
-	    sv_catsv(sv, *svargs);
+	    /* we want get magic on the source but not the target. sv_catsv can't do that, though */
+	    SvGETMAGIC(*svargs);
+	    sv_catsv_nomg(sv, *svargs);
 	}
 	else
 	    S_vcatpvfn_missing_argument(aTHX);
@@ -10094,7 +10104,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
     if (args && patlen == 3 && pat[0] == '%' &&
 		pat[1] == '-' && pat[2] == 'p') {
 	argsv = MUTABLE_SV(va_arg(*args, void*));
-	sv_catsv(sv, argsv);
+	sv_catsv_nomg(sv, argsv);
 	return;
     }
 
@@ -10117,7 +10127,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 		if (digits && digits < sizeof(ebuf) - NV_DIG - 10) {
 		     /* 0, point, slack */
 		    Gconvert(nv, (int)digits, 0, ebuf);
-		    sv_catpv(sv, ebuf);
+		    sv_catpv_nomg(sv, ebuf);
 		    if (*ebuf)	/* May return an empty string for digits==0 */
 			return;
 		}
@@ -10125,7 +10135,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 		STRLEN l;
 
 		if ((p = F0convert(nv, ebuf + sizeof ebuf, &l))) {
-		    sv_catpvn(sv, p, l);
+		    sv_catpvn_nomg(sv, p, l);
 		    return;
 		}
 	    }
@@ -10196,9 +10206,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 	for (q = p; q < patend && *q != '%'; ++q) ;
 	if (q > p) {
 	    if (has_utf8 && !pat_utf8)
-		sv_catpvn_utf8_upgrade(sv, p, q - p, nsv);
+		sv_catpvn_nomg_utf8_upgrade(sv, p, q - p, nsv);
 	    else
-		sv_catpvn(sv, p, q - p);
+		sv_catpvn_nomg(sv, p, q - p);
 	    p = q;
 	}
 	if (q++ >= patend)
@@ -10418,20 +10428,20 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 		 * vectorize happen normally
 		 */
 		if (sv_isobject(vecsv) && sv_derived_from(vecsv, "version")) {
-		    char *version = savesvpv(vecsv);
 		    if ( hv_exists(MUTABLE_HV(SvRV(vecsv)), "alpha", 5 ) ) {
-			Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
+			Perl_ck_warner_d(aTHX_ packWARN(WARN_PRINTF),
 			"vector argument not supported with alpha versions");
-			goto unknown;
+			goto vdblank;
 		    }
 		    vecsv = sv_newmortal();
-		    scan_vstring(version, version + veclen, vecsv);
+		    scan_vstring((char *)vecstr, (char *)vecstr + veclen,
+				 vecsv);
 		    vecstr = (U8*)SvPV_const(vecsv, veclen);
 		    vec_utf8 = DO_UTF8(vecsv);
-		    Safefree(version);
 		}
 	    }
 	    else {
+	      vdblank:
 		vecstr = (U8*)"";
 		veclen = 0;
 	    }
@@ -10442,7 +10452,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 	switch (*q) {
 #ifdef WIN32
 	case 'I':			/* Ix, I32x, and I64x */
-#  ifdef WIN64
+#  ifdef USE_64_BIT_INT
 	    if (q[1] == '6' && q[2] == '4') {
 		q += 3;
 		intsize = 'q';
@@ -10453,7 +10463,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 		q += 3;
 		break;
 	    }
-#  ifdef WIN64
+#  ifdef USE_64_BIT_INT
 	    intsize = 'q';
 #  endif
 	    q++;
@@ -10560,16 +10570,17 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 		if (DO_UTF8(argsv)) {
 		    STRLEN old_precis = precis;
 		    if (has_precis && precis < elen) {
-			STRLEN ulen = sv_len_utf8(argsv);
-			I32 p = precis > ulen ? ulen : precis;
-			sv_pos_u2b(argsv, &p, 0); /* sticks at end */
-			precis = p;
+			STRLEN ulen = sv_or_pv_len_utf8(argsv, eptr, elen);
+			STRLEN p = precis > ulen ? ulen : precis;
+			precis = sv_or_pv_pos_u2b(argsv, eptr, p, 0);
+							/* sticks at end */
 		    }
 		    if (width) { /* fudge width (can't fudge elen) */
 			if (has_precis && precis < elen)
 			    width += precis - old_precis;
 			else
-			    width += elen - sv_len_utf8(argsv);
+			    width +=
+				elen - sv_or_pv_len_utf8(argsv,eptr,elen);
 		    }
 		    is_utf8 = TRUE;
 		}
@@ -11072,7 +11083,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 		    sv_catpvs(msg, "\"%");
 		    for (f = fmtstart; f < fmtend; f++) {
 			if (isPRINT(*f)) {
-			    sv_catpvn(msg, f, 1);
+			    sv_catpvn_nomg(msg, f, 1);
 			} else {
 			    Perl_sv_catpvf(aTHX_ msg,
 					   "\\%03"UVof, (UV)*f & 0xFF);
@@ -11123,13 +11134,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 
 	have = esignlen + zeros + elen;
 	if (have < zeros)
-	    Perl_croak_nocontext("%s", PL_memory_wrap);
+	    croak_memory_wrap();
 
 	need = (have > width ? have : width);
 	gap = need - have;
 
 	if (need >= (((STRLEN)~0) - SvCUR(sv) - dotstrlen - 1))
-	    Perl_croak_nocontext("%s", PL_memory_wrap);
+	    croak_memory_wrap();
 	SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1);
 	p = SvEND(sv);
 	if (esignlen && fill == '0') {
@@ -11274,7 +11285,6 @@ Perl_parser_dup(pTHX_ const yy_parser *const proto, CLONE_PARAMS *const param)
     parser->multi_open	= proto->multi_open;
     parser->multi_start	= proto->multi_start;
     parser->multi_end	= proto->multi_end;
-    parser->pending_ident = proto->pending_ident;
     parser->preambled	= proto->preambled;
     parser->sublex_info	= proto->sublex_info; /* XXX not quite right */
     parser->linestr	= sv_dup_inc(proto->linestr, param);
@@ -11377,7 +11387,7 @@ Perl_dirp_dup(pTHX_ DIR *const dp, CLONE_PARAMS *const param)
 
 #ifdef HAS_FCHDIR
     DIR *pwd;
-    register const Direntry_t *dirent;
+    const Direntry_t *dirent;
     char smallbuf[256];
     char *name = NULL;
     STRLEN len = 0;
@@ -11769,6 +11779,7 @@ Perl_rvpv_dup(pTHX_ SV *const dstr, const SV *const sstr, CLONE_PARAMS *const pa
 {
     PERL_ARGS_ASSERT_RVPV_DUP;
 
+    assert(!isREGEXP(sstr));
     if (SvROK(sstr)) {
 	if (SvWEAKREF(sstr)) {
 	    SvRV_set(dstr, sv_dup(SvRV_const(sstr), param));
@@ -11896,7 +11907,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
     dstr->sv_debug_inpad = sstr->sv_debug_inpad;
     dstr->sv_debug_parent = (SV*)sstr;
     FREE_SV_DEBUG_FILE(dstr);
-    dstr->sv_debug_file = savepv(sstr->sv_debug_file);
+    dstr->sv_debug_file = savesharedpv(sstr->sv_debug_file);
 #endif
 
     ptr_table_store(PL_ptr_table, sstr, dstr);
@@ -11984,6 +11995,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
 
 	    if (sv_type != SVt_PVAV && sv_type != SVt_PVHV
 		&& !isGV_with_GP(dstr)
+		&& !isREGEXP(dstr)
 		&& !(sv_type == SVt_PVIO && !(IoFLAGS(dstr) & IOf_FAKE_DIRP)))
 		Perl_rvpv_dup(aTHX_ dstr, sstr, param);
 
@@ -12012,7 +12024,9 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
 	    case SVt_PVMG:
 		break;
 	    case SVt_REGEXP:
+	      duprex:
 		/* FIXME for plugins */
+		dstr->sv_u.svu_rx = ((REGEXP *)dstr)->sv_any;
 		re_dup_guts((REGEXP*) sstr, (REGEXP*) dstr, param);
 		break;
 	    case SVt_PVLV:
@@ -12023,6 +12037,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
 		    LvTARG(dstr) = MUTABLE_SV(he_dup((HE*)LvTARG(dstr), 0, param));
 		else
 		    LvTARG(dstr) = sv_dup_inc(LvTARG(dstr), param);
+		if (isREGEXP(sstr)) goto duprex;
 	    case SVt_PVGV:
 		/* non-GP case already handled above */
 		if(isGV_with_GP(sstr)) {
@@ -12172,6 +12187,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
                         daux->xhv_mro_meta = saux->xhv_mro_meta
                             ? mro_meta_dup(saux->xhv_mro_meta, param)
                             : 0;
+			daux->xhv_super = NULL;
 
 			/* Record stashes for possible cloning in Perl_clone(). */
 			if (HvNAME(sstr))
@@ -12196,14 +12212,20 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
 		    OP_REFCNT_LOCK;
 		    CvROOT(dstr) = OpREFCNT_inc(CvROOT(dstr));
 		    OP_REFCNT_UNLOCK;
+		    CvSLABBED_off(dstr);
 		} else if (CvCONST(dstr)) {
 		    CvXSUBANY(dstr).any_ptr =
 			sv_dup_inc((const SV *)CvXSUBANY(dstr).any_ptr, param);
 		}
+		assert(!CvSLABBED(dstr));
 		if (CvDYNFILE(dstr)) CvFILE(dstr) = SAVEPV(CvFILE(dstr));
+		if (CvNAMED(dstr))
+		    SvANY((CV *)dstr)->xcv_gv_u.xcv_hek =
+			share_hek_hek(CvNAME_HEK((CV *)sstr));
 		/* don't dup if copying back - CvGV isn't refcounted, so the
 		 * duped GV may never be freed. A bit of a hack! DAPM */
-		SvANY(MUTABLE_CV(dstr))->xcv_gv =
+		else
+		  SvANY(MUTABLE_CV(dstr))->xcv_gv_u.xcv_gv =
 		    CvCVGV_RC(dstr)
 		    ? gv_dup_inc(CvGV(sstr), param)
 		    : (param->flags & CLONEf_JOIN_IN)
@@ -12289,6 +12311,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
 	    Perl_croak(aTHX_ "Cloning substitution context is unimplemented");
 	}
 	else {
+	    ncx->blk_oldcop = (COP*)any_dup(ncx->blk_oldcop, param->proto_perl);
 	    switch (CxTYPE(ncx)) {
 	    case CXt_SUB:
 		ncx->blk_sub.cv		= (ncx->blk_sub.olddepth == 0
@@ -12470,6 +12493,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 	TOPUV(nss,ix) = uv;
 	switch (type) {
 	case SAVEt_CLEARSV:
+	case SAVEt_CLEARPADRANGE:
 	    break;
 	case SAVEt_HELEM:		/* hash element */
 	    sv = (const SV *)POPPTR(ss,ix);
@@ -12684,32 +12708,8 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 
 		new_state->re_state_bostr
 		    = pv_dup(old_state->re_state_bostr);
-		new_state->re_state_reginput
-		    = pv_dup(old_state->re_state_reginput);
 		new_state->re_state_regeol
 		    = pv_dup(old_state->re_state_regeol);
-		new_state->re_state_regoffs
-		    = (regexp_paren_pair*)
-			any_dup(old_state->re_state_regoffs, proto_perl);
-		new_state->re_state_reglastparen
-		    = (U32*) any_dup(old_state->re_state_reglastparen, 
-			      proto_perl);
-		new_state->re_state_reglastcloseparen
-		    = (U32*)any_dup(old_state->re_state_reglastcloseparen,
-			      proto_perl);
-		/* XXX This just has to be broken. The old save_re_context
-		   code did SAVEGENERICPV(PL_reg_start_tmp);
-		   PL_reg_start_tmp is char **.
-		   Look above to what the dup code does for
-		   SAVEt_GENERIC_PVREF
-		   It can never have worked.
-		   So this is merely a faithful copy of the exiting bug:  */
-		new_state->re_state_reg_start_tmp
-		    = (char **) pv_dup((char *)
-				      old_state->re_state_reg_start_tmp);
-		/* I assume that it only ever "worked" because no-one called
-		   (pseudo)fork while the regexp engine had re-entered itself.
-		*/
 #ifdef PERL_OLD_COPY_ON_WRITE
 		new_state->re_state_nrs
 		    = sv_dup(old_state->re_state_nrs, param);
@@ -12940,35 +12940,23 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_hash_seed	= proto_perl->Ihash_seed;
     PL_rehash_seed	= proto_perl->Irehash_seed;
 
-    SvANY(&PL_sv_undef)		= NULL;
-    SvREFCNT(&PL_sv_undef)	= (~(U32)0)/2;
-    SvFLAGS(&PL_sv_undef)	= SVf_READONLY|SVt_NULL;
-    SvREFCNT(&PL_sv_no)		= (~(U32)0)/2;
-    SvFLAGS(&PL_sv_no)		= SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
-				  |SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
-
-    SvANY(&PL_sv_yes)		= new_XPVNV();
-    SvREFCNT(&PL_sv_yes)	= (~(U32)0)/2;
-    SvFLAGS(&PL_sv_yes)		= SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
-				  |SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
-
     /* dbargs array probably holds garbage */
     PL_dbargs		= NULL;
 
     PL_compiling = proto_perl->Icompiling;
 
-#ifdef PERL_DEBUG_READONLY_OPS
-    PL_slabs = NULL;
-    PL_slab_count = 0;
-#endif
-
     /* pseudo environmental stuff */
     PL_origargc		= proto_perl->Iorigargc;
     PL_origargv		= proto_perl->Iorigargv;
 
+#if !NO_TAINT_SUPPORT
     /* Set tainting stuff before PerlIO_debug can possibly get called */
     PL_tainting		= proto_perl->Itainting;
     PL_taint_warn	= proto_perl->Itaint_warn;
+#else
+    PL_tainting         = FALSE;
+    PL_taint_warn	= FALSE;
+#endif
 
     PL_minus_c		= proto_perl->Iminus_c;
 
@@ -13001,7 +12989,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     /* RE engine related */
     Zero(&PL_reg_state, 1, struct re_save_state);
-    PL_reginterp_cnt	= 0;
     PL_regmatch_slab	= NULL;
 
     PL_sub_generation	= proto_perl->Isub_generation;
@@ -13142,7 +13129,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_timesbuf		= proto_perl->Itimesbuf;
 #endif
 
+#if !NO_TAINT_SUPPORT
     PL_tainted		= proto_perl->Itainted;
+#else
+    PL_tainted          = FALSE;
+#endif
     PL_curpm		= proto_perl->Icurpm;	/* XXX No PMOP ref count */
 
     PL_chopset		= proto_perl->Ichopset;	/* XXX never deallocated */
@@ -13186,21 +13177,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_ptr_table = ptr_table_new();
 
     /* initialize these special pointers as early as possible */
+    init_constants();
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_undef, &PL_sv_undef);
-
-    SvANY(&PL_sv_no)		= new_XPVNV();
-    SvPV_set(&PL_sv_no, savepvn(PL_No, 0));
-    SvCUR_set(&PL_sv_no, 0);
-    SvLEN_set(&PL_sv_no, 1);
-    SvIV_set(&PL_sv_no, 0);
-    SvNV_set(&PL_sv_no, 0);
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_no, &PL_sv_no);
-
-    SvPV_set(&PL_sv_yes, savepvn(PL_Yes, 1));
-    SvCUR_set(&PL_sv_yes, 1);
-    SvLEN_set(&PL_sv_yes, 2);
-    SvIV_set(&PL_sv_yes, 1);
-    SvNV_set(&PL_sv_yes, 1);
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
 
     /* create (a non-shared!) shared string table */
@@ -13209,10 +13188,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     hv_ksplit(PL_strtab, HvTOTALKEYS(proto_perl->Istrtab));
     ptr_table_store(PL_ptr_table, proto_perl->Istrtab, PL_strtab);
 
-    /* These two PVs will be free'd special way so must set them same way op.c does */
-    PL_compiling.cop_stashpv = savesharedpv(PL_compiling.cop_stashpv);
-    ptr_table_store(PL_ptr_table, proto_perl->Icompiling.cop_stashpv, PL_compiling.cop_stashpv);
-
+    /* This PV will be free'd special way so must set it same way op.c does */
     PL_compiling.cop_file    = savesharedpv(PL_compiling.cop_file);
     ptr_table_store(PL_ptr_table, proto_perl->Icompiling.cop_file, PL_compiling.cop_file);
 
@@ -13253,7 +13229,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_e_script		= sv_dup_inc(proto_perl->Ie_script, param);
 
     /* magical thingies */
-    PL_formfeed		= sv_dup(proto_perl->Iformfeed, param);
 
     PL_encoding		= sv_dup(proto_perl->Iencoding, param);
 
@@ -13270,6 +13245,15 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_regex_padav = av_dup_inc(proto_perl->Iregex_padav, param);
     PL_regex_pad = AvARRAY(PL_regex_padav);
 
+    PL_stashpadmax	= proto_perl->Istashpadmax;
+    PL_stashpadix	= proto_perl->Istashpadix ;
+    Newx(PL_stashpad, PL_stashpadmax, HV *);
+    {
+	PADOFFSET o = 0;
+	for (; o < PL_stashpadmax; ++o)
+	    PL_stashpad[o] = hv_dup(proto_perl->Istashpad[o], param);
+    }
+
     /* shortcuts to various I/O objects */
     PL_ofsgv            = gv_dup_inc(proto_perl->Iofsgv, param);
     PL_stdingv		= gv_dup(proto_perl->Istdingv, param);
@@ -13445,9 +13429,13 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_VertSpace	= sv_dup_inc(proto_perl->IVertSpace, param);
 
+    PL_NonL1NonFinalFold = sv_dup_inc(proto_perl->INonL1NonFinalFold, param);
+    PL_HasMultiCharFold= sv_dup_inc(proto_perl->IHasMultiCharFold, param);
+
     /* utf8 character class swashes */
     PL_utf8_alnum	= sv_dup_inc(proto_perl->Iutf8_alnum, param);
     PL_utf8_alpha	= sv_dup_inc(proto_perl->Iutf8_alpha, param);
+    PL_utf8_blank	= sv_dup_inc(proto_perl->Iutf8_blank, param);
     PL_utf8_space	= sv_dup_inc(proto_perl->Iutf8_space, param);
     PL_utf8_graph	= sv_dup_inc(proto_perl->Iutf8_graph, param);
     PL_utf8_digit	= sv_dup_inc(proto_perl->Iutf8_digit, param);
@@ -13457,16 +13445,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_utf8_punct	= sv_dup_inc(proto_perl->Iutf8_punct, param);
     PL_utf8_xdigit	= sv_dup_inc(proto_perl->Iutf8_xdigit, param);
     PL_utf8_mark	= sv_dup_inc(proto_perl->Iutf8_mark, param);
-    PL_utf8_X_begin	= sv_dup_inc(proto_perl->Iutf8_X_begin, param);
+    PL_utf8_X_regular_begin	= sv_dup_inc(proto_perl->Iutf8_X_regular_begin, param);
     PL_utf8_X_extend	= sv_dup_inc(proto_perl->Iutf8_X_extend, param);
-    PL_utf8_X_prepend	= sv_dup_inc(proto_perl->Iutf8_X_prepend, param);
-    PL_utf8_X_non_hangul	= sv_dup_inc(proto_perl->Iutf8_X_non_hangul, param);
-    PL_utf8_X_L	= sv_dup_inc(proto_perl->Iutf8_X_L, param);
-    PL_utf8_X_LV	= sv_dup_inc(proto_perl->Iutf8_X_LV, param);
     PL_utf8_X_LVT	= sv_dup_inc(proto_perl->Iutf8_X_LVT, param);
-    PL_utf8_X_T	= sv_dup_inc(proto_perl->Iutf8_X_T, param);
-    PL_utf8_X_V	= sv_dup_inc(proto_perl->Iutf8_X_V, param);
-    PL_utf8_X_LV_LVT_V	= sv_dup_inc(proto_perl->Iutf8_X_LV_LVT_V, param);
     PL_utf8_toupper	= sv_dup_inc(proto_perl->Iutf8_toupper, param);
     PL_utf8_totitle	= sv_dup_inc(proto_perl->Iutf8_totitle, param);
     PL_utf8_tolower	= sv_dup_inc(proto_perl->Iutf8_tolower, param);
@@ -13477,12 +13458,12 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_utf8_idcont	= sv_dup_inc(proto_perl->Iutf8_idcont, param);
     PL_utf8_xidcont	= sv_dup_inc(proto_perl->Iutf8_xidcont, param);
     PL_utf8_foldable	= sv_dup_inc(proto_perl->Iutf8_foldable, param);
-    PL_utf8_quotemeta	= sv_dup_inc(proto_perl->Iutf8_quotemeta, param);
+    PL_utf8_charname_begin = sv_dup_inc(proto_perl->Iutf8_charname_begin, param);
+    PL_utf8_charname_continue = sv_dup_inc(proto_perl->Iutf8_charname_continue, param);
     PL_ASCII		= sv_dup_inc(proto_perl->IASCII, param);
     PL_AboveLatin1	= sv_dup_inc(proto_perl->IAboveLatin1, param);
     PL_Latin1		= sv_dup_inc(proto_perl->ILatin1, param);
 
-
     if (proto_perl->Ipsig_pend) {
 	Newxz(PL_psig_pend, SIG_SIZE, int);
     }
@@ -13723,6 +13704,38 @@ Perl_clone_params_new(PerlInterpreter *const from, PerlInterpreter *const to)
 
 #endif /* USE_ITHREADS */
 
+void
+Perl_init_constants(pTHX)
+{
+    SvREFCNT(&PL_sv_undef)	= (~(U32)0)/2;
+    SvFLAGS(&PL_sv_undef)	= SVf_READONLY|SVt_NULL;
+    SvANY(&PL_sv_undef)		= NULL;
+
+    SvANY(&PL_sv_no)		= new_XPVNV();
+    SvREFCNT(&PL_sv_no)		= (~(U32)0)/2;
+    SvFLAGS(&PL_sv_no)		= SVt_PVNV|SVf_READONLY
+				  |SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
+				  |SVp_POK|SVf_POK;
+
+    SvANY(&PL_sv_yes)		= new_XPVNV();
+    SvREFCNT(&PL_sv_yes)	= (~(U32)0)/2;
+    SvFLAGS(&PL_sv_yes)		= SVt_PVNV|SVf_READONLY
+				  |SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
+				  |SVp_POK|SVf_POK;
+
+    SvPV_set(&PL_sv_no, (char*)PL_No);
+    SvCUR_set(&PL_sv_no, 0);
+    SvLEN_set(&PL_sv_no, 0);
+    SvIV_set(&PL_sv_no, 0);
+    SvNV_set(&PL_sv_no, 0);
+
+    SvPV_set(&PL_sv_yes, (char*)PL_Yes);
+    SvCUR_set(&PL_sv_yes, 1);
+    SvLEN_set(&PL_sv_yes, 0);
+    SvIV_set(&PL_sv_yes, 1);
+    SvNV_set(&PL_sv_yes, 1);
+}
+
 /*
 =head1 Unicode Support
 
@@ -13758,8 +13771,8 @@ Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding)
 	save_re_context();
 	PUSHMARK(sp);
 	EXTEND(SP, 3);
-	XPUSHs(encoding);
-	XPUSHs(sv);
+	PUSHs(encoding);
+	PUSHs(sv);
 /*
   NI-S 2002/07/09
   Passing sv_yes is wrong - it needs to be or'ed set of constants
@@ -13829,12 +13842,12 @@ Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding,
 	save_re_context();
 	PUSHMARK(sp);
 	EXTEND(SP, 6);
-	XPUSHs(encoding);
-	XPUSHs(dsv);
-	XPUSHs(ssv);
+	PUSHs(encoding);
+	PUSHs(dsv);
+	PUSHs(ssv);
 	offsv = newSViv(*offset);
-	mXPUSHs(offsv);
-	mXPUSHp(tstr, tlen);
+	mPUSHs(offsv);
+	mPUSHp(tstr, tlen);
 	PUTBACK;
 	call_method("cat_decode", G_SCALAR);
 	SPAGAIN;
@@ -13867,7 +13880,7 @@ STATIC SV*
 S_find_hash_subscript(pTHX_ const HV *const hv, const SV *const val)
 {
     dVAR;
-    register HE **array;
+    HE **array;
     I32 i;
 
     PERL_ARGS_ASSERT_FIND_HASH_SUBSCRIPT;
@@ -13878,8 +13891,8 @@ S_find_hash_subscript(pTHX_ const HV *const hv, const SV *const val)
 
     array = HvARRAY(hv);
 
-    for (i=HvMAX(hv); i>0; i--) {
-	register HE *entry;
+    for (i=HvMAX(hv); i>=0; i--) {
+	HE *entry;
 	for (entry = array[i]; entry; entry = HeNEXT(entry)) {
 	    if (HeVAL(entry) != val)
 		continue;
@@ -13921,7 +13934,7 @@ S_find_array_subscript(pTHX_ const AV *const av, const SV *const val)
     return -1;
 }
 
-/* S_varname(): return the name of a variable, optionally with a subscript.
+/* varname(): return the name of a variable, optionally with a subscript.
  * If gv is non-zero, use the name of that global, along with gvtype (one
  * of "$", "@", "%"); otherwise use the name of the lexical at pad offset
  * targ.  Depending on the value of the subscript_type flag, return:
@@ -13961,13 +13974,13 @@ Perl_varname(pTHX_ const GV *const gv, const char gvtype, PADOFFSET targ,
 	SV *sv;
 	AV *av;
 
-	assert(!cv || SvTYPE(cv) == SVt_PVCV);
+	assert(!cv || SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM);
 
 	if (!cv || !CvPADLIST(cv))
 	    return NULL;
-	av = MUTABLE_AV((*av_fetch(CvPADLIST(cv), 0, FALSE)));
+	av = *PadlistARRAY(CvPADLIST(cv));
 	sv = *av_fetch(av, targ, FALSE);
-	sv_setsv(name, sv);
+	sv_setsv_flags(name, sv, 0);
     }
 
     if (subscript_type == FUV_SUBSCRIPT_HASH) {
@@ -14031,8 +14044,16 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
     case OP_PADAV:
     case OP_PADHV:
       {
-	const bool pad  = (obase->op_type == OP_PADAV || obase->op_type == OP_PADHV);
-	const bool hash = (obase->op_type == OP_PADHV || obase->op_type == OP_RV2HV);
+	const bool pad  = (    obase->op_type == OP_PADAV
+                            || obase->op_type == OP_PADHV
+                            || obase->op_type == OP_PADRANGE
+                          );
+
+	const bool hash = (    obase->op_type == OP_PADHV
+                            || obase->op_type == OP_RV2HV
+                            || (obase->op_type == OP_PADRANGE
+                                && SvTYPE(PAD_SVl(obase->op_targ)) == SVt_PVHV)
+                          );
 	I32 index = 0;
 	SV *keysv = NULL;
 	int subscript_type = FUV_SUBSCRIPT_WITHIN;
@@ -14238,7 +14259,9 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
 
     case OP_OPEN:
 	o = cUNOPx(obase)->op_first;
-	if (o->op_type == OP_PUSHMARK)
+	if (   o->op_type == OP_PUSHMARK
+	   || (o->op_type == OP_NULL && o->op_targ == OP_PUSHMARK)
+        )
 	    o = o->op_sibling;
 
 	if (!o->op_sibling) {
@@ -14282,7 +14305,10 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
 	match = 1; /* print etc can return undef on defined args */
 	/* skip filehandle as it can't produce 'undef' warning  */
 	o = cUNOPx(obase)->op_first;
-	if ((obase->op_flags & OPf_STACKED) && o->op_type == OP_PUSHMARK)
+	if ((obase->op_flags & OPf_STACKED)
+            &&
+               (   o->op_type == OP_PUSHMARK
+               || (o->op_type == OP_NULL && o->op_targ == OP_PUSHMARK)))
 	    o = o->op_sibling->op_sibling;
 	goto do_op2;
 
@@ -14410,6 +14436,8 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
 	 * left that is not skipped, then we *know* it is responsible for
 	 * the uninitialized value.  If there is more than one op left, we
 	 * have to look for an exact match in the while() loop below.
+         * Note that we skip padrange, because the individual pad ops that
+         * it replaced are still in the tree, so we work on them instead.
 	 */
 	o2 = NULL;
 	for (kid=o; kid; kid = kid->op_sibling) {
@@ -14418,6 +14446,7 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
 		if ( (type == OP_CONST && SvOK(cSVOPx_sv(kid)))
 		  || (type == OP_NULL  && ! (kid->op_flags & OPf_KIDS))
 		  || (type == OP_PUSHMARK)
+		  || (type == OP_PADRANGE)
 		)
 		continue;
 	    }
@@ -14476,8 +14505,8 @@ Perl_report_uninit(pTHX_ const SV *uninit_sv)
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */