sv.c: obsolete comment

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index fcd76a9..5447ac6 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -133,10 +133,12 @@ called by visit() for each SV]):
                        dump all remaining SVs (debugging aid)
 
     sv_clean_objs() / do_clean_objs(),do_clean_named_objs(),
                        dump all remaining SVs (debugging aid)
 
     sv_clean_objs() / do_clean_objs(),do_clean_named_objs(),

-                     do_clean_named_io_objs()
+                     do_clean_named_io_objs(),do_curse()

                        Attempt to free all objects pointed to by RVs,
                        Attempt to free all objects pointed to by RVs,

-                       and try to do the same for all objects indirectly
-                       referenced by typeglobs too.  Called once from
+                       try to do the same for all objects indir-
+                       ectly referenced by typeglobs too, and
+                       then do a final sweep, cursing any
+                       objects that remain.  Called once from

                        perl_destruct(), prior to calling sv_clean_all()
                        below.
 
                        perl_destruct(), prior to calling sv_clean_all()
                        below.
 


@@ -182,7 +184,9 @@ Public API:
 #endif
 
 #ifdef DEBUG_LEAKING_SCALARS
 #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))
 #  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 +279,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_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++;
 
 
     sv->sv_debug_serial = PL_sv_serial++;
 


@@ -365,8 +369,8 @@ S_sv_add_arena(pTHX_ char *const ptr, const U32 size, const U32 flags)
 {
     dVAR;
     SV *const sva = MUTABLE_SV(ptr);
 {
     dVAR;
     SV *const sva = MUTABLE_SV(ptr);

-    register SV* sv;
-    register SV* svend;
+    SV* sv;
+    SV* svend;

 
     PERL_ARGS_ASSERT_SV_ADD_ARENA;
 
 
     PERL_ARGS_ASSERT_SV_ADD_ARENA;
 


@@ -410,8 +414,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))) {
     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
        for (sv = sva + 1; sv < svend; ++sv) {
            if (SvTYPE(sv) != (svtype)SVTYPEMASK
                    && (sv->sv_flags & mask) == flags


@@ -479,8 +483,6 @@ do_clean_objs(pTHX_ SV *const ref)
            }
        }
     }
            }
        }
     }

-
-    /* XXX Might want to check arrays, etc. */

 }
 
 
 }
 
 


@@ -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.  */
 
        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);
     }
 
        sv_force_normal_flags(sv, 0);
     }
 


@@ -1329,11 +1331,6 @@ Perl_sv_upgrade(pTHX_ register SV *const sv, svtype new_type)
        }
        break;
 
        }
        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  */
     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_PVGV:
     case SVt_PVCV:
     case SVt_PVLV:

+    case SVt_REGEXP:

     case SVt_PVMG:
     case SVt_PVNV:
     case SVt_PV:
     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 */
            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;
        }
            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;
            /* 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)
 {
 char *
 Perl_sv_grow(pTHX_ register SV *const sv, register STRLEN newlen)
 {

-    register char *s;
+    char *s;

 
     PERL_ARGS_ASSERT_SV_GROW;
 
 
     PERL_ARGS_ASSERT_SV_GROW;
 


@@ -1802,7 +1803,7 @@ ignored.
 I32
 Perl_looks_like_number(pTHX_ SV *const sv)
 {
 I32
 Perl_looks_like_number(pTHX_ SV *const sv)
 {

-    register const char *sbegin;
+    const char *sbegin;

     STRLEN len;
 
     PERL_ARGS_ASSERT_LOOKS_LIKE_NUMBER;
     STRLEN len;
 
     PERL_ARGS_ASSERT_LOOKS_LIKE_NUMBER;


@@ -2066,7 +2067,7 @@ S_sv_2iuv_common(pTHX_ SV *const sv)
                                  SvUVX(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
        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;
 Perl_sv_2iv_flags(pTHX_ register SV *const sv, const I32 flags)
 {
     dVAR;

+

     if (!sv)
        return 0;
     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.
        /* 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;
            UV value;

+           const char * const ptr =
+               isREGEXP(sv) ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);

            const int numtype
            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) {
 
            if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
                == IS_NUMBER_IN_UV) {


@@ -2292,68 +2309,34 @@ Perl_sv_2iv_flags(pTHX_ register SV *const sv, const I32 flags)
                if (ckWARN(WARN_NUMERIC))
                    not_a_number(sv);
            }
                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);
        }
        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 (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;
     }
     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);
 }
 
 /*
     DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%"IVdf")\n",
        PTR2UV(sv),SvIVX(sv)));
     return SvIsUV(sv) ? (IV)SvUVX(sv) : SvIVX(sv);
 }
 
 /*

-=for apidoc sv_gmagical_2iv_please
-
-Used internally by C<SvIV_please_nomg>, this function sets the C<SvIVX>
-slot if C<sv_2iv> would have made the scalar C<SvIOK> had it not been
-magical.  In that case it returns true.
-
-=cut
-*/
-
-bool
-Perl_sv_gmagical_2iv_please(pTHX_ register SV *sv)
-{
-    bool has_int;
-    PERL_ARGS_ASSERT_SV_GMAGICAL_2IV_PLEASE;
-    assert(SvGMAGICAL(sv) && !SvIOKp(sv) && (SvNOKp(sv) || SvPOKp(sv)));
-    if (S_sv_2iuv_common(aTHX_ sv)) { SvNIOK_off(sv); return 0; }
-    has_int = !!SvIOK(sv);
-    SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK);
-    return has_int;
-}
-
-/*

 =for apidoc sv_2uv_flags
 
 Return the unsigned integer value of an SV, doing any necessary string
 =for apidoc sv_2uv_flags
 
 Return the unsigned integer value of an SV, doing any necessary string


@@ -2367,21 +2350,37 @@ UV
 Perl_sv_2uv_flags(pTHX_ register SV *const sv, const I32 flags)
 {
     dVAR;
 Perl_sv_2uv_flags(pTHX_ register SV *const sv, const I32 flags)
 {
     dVAR;

+

     if (!sv)
        return 0;
     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
        /* 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;
            UV value;

+           const char * const ptr =
+               isREGEXP(sv) ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv);

            const int numtype
            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) {
 
            if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
                == IS_NUMBER_IN_UV) {


@@ -2393,36 +2392,23 @@ Perl_sv_2uv_flags(pTHX_ register SV *const sv, const I32 flags)
                if (ckWARN(WARN_NUMERIC))
                    not_a_number(sv);
            }
                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);
        }
        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 (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;
     if (!SvIOKp(sv)) {
        if (S_sv_2iuv_common(aTHX_ sv))
            return 0;


@@ -2449,18 +2435,22 @@ Perl_sv_2nv_flags(pTHX_ register SV *const sv, const I32 flags)
     dVAR;
     if (!sv)
        return 0.0;
     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
        /* 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 (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) &&
            if (!SvIOKp(sv) && ckWARN(WARN_NUMERIC) &&

-               !grok_number(SvPVX_const(sv), SvCUR(sv), NULL))
+               !grok_number(ptr, SvCUR(sv), NULL))

                not_a_number(sv);
                not_a_number(sv);

-           return Atof(SvPVX_const(sv));
+           return Atof(ptr);

        }
        if (SvIOKp(sv)) {
            if (SvIsUV(sv))
        }
        if (SvIOKp(sv)) {
            if (SvIsUV(sv))


@@ -2471,6 +2461,10 @@ Perl_sv_2nv_flags(pTHX_ register SV *const sv, const I32 flags)
         if (SvROK(sv)) {
            goto return_rok;
        }
         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. */
        assert(SvTYPE(sv) >= SVt_PVMG);
        /* This falls through to the report_uninit near the end of the
           function. */


@@ -2488,9 +2482,11 @@ Perl_sv_2nv_flags(pTHX_ register SV *const sv, const I32 flags)
            }
            return PTR2NV(SvRV(sv));
        }
            }
            return PTR2NV(SvRV(sv));
        }

+#ifdef PERL_OLD_COPY_ON_WRITE

        if (SvIsCOW(sv)) {
            sv_force_normal_flags(sv, 0);
        }
        if (SvIsCOW(sv)) {
            sv_force_normal_flags(sv, 0);
        }

+#endif

        if (SvREADONLY(sv) && !SvOK(sv)) {
            if (ckWARN(WARN_UNINITIALIZED))
                report_uninit(sv);
        if (SvREADONLY(sv) && !SvOK(sv)) {
            if (ckWARN(WARN_UNINITIALIZED))
                report_uninit(sv);


@@ -2540,7 +2536,7 @@ Perl_sv_2nv_flags(pTHX_ register SV *const sv, const I32 flags)
            SvNOKp_on(sv);
 #endif
     }
            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))
        UV value;
        const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
        if (!SvIOKp(sv) && !numtype && ckWARN(WARN_NUMERIC))


@@ -2737,201 +2733,150 @@ char *
 Perl_sv_2pv_flags(pTHX_ register SV *const sv, STRLEN *const lp, const I32 flags)
 {
     dVAR;
 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 (!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 {
                    } 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 {
                        } else {

-                           stashname = "__ANON__";
-                           stashnamelen = 8;
+                           SvUTF8_off(sv);

                        }
                        }

-                       len = stashnamelen + 1 /* = */ + typelen + 3 /* (0x */
-                           + 2 * sizeof(UV) + 2 /* )\0 */;

                    } else {
                    } 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)
            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);
        /* 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);


@@ -2949,7 +2894,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *const sv, STRLEN *const lp, const I32 flags
        s += len;
        *s = '\0';
     }
        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) {
        if (SvTYPE(sv) < SVt_PVNV)
            sv_upgrade(sv, SVt_PVNV);
        if (SvNVX(sv) == 0.0) {


@@ -2970,32 +2915,36 @@ Perl_sv_2pv_flags(pTHX_ register SV *const sv, STRLEN *const lp, const I32 flags
            *--s = '\0';
 #endif
     }
            *--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 (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 *)"";
     }
            sv_upgrade(sv, SVt_PV);
        return (char *)"";
     }

+

     {
        const STRLEN len = s - SvPVX_const(sv);
        if (lp) 
     {
        const STRLEN len = s - SvPVX_const(sv);
        if (lp) 


@@ -3023,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.
 
 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)
 {
 =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;
     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);
     sv_setpvn(dsv,s,len);
     if (SvUTF8(ssv))
        SvUTF8_on(dsv);


@@ -3058,7 +3027,8 @@ Perl_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *const lp)
 {
     PERL_ARGS_ASSERT_SV_2PVBYTE;
 
 {
     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;
        SV *sv2 = sv_newmortal();
        sv_copypv(sv2,sv);
        sv = sv2;


@@ -3084,11 +3054,12 @@ Perl_sv_2pvutf8(pTHX_ register SV *sv, STRLEN *const lp)
 {
     PERL_ARGS_ASSERT_SV_2PVUTF8;
 
 {
     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 = 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);
 }
 
     return lp ? SvPV_nomg(sv,*lp) : SvPV_nomg_nolen(sv);
 }
 


@@ -3129,30 +3100,7 @@ Perl_sv_2bool_flags(pTHX_ register SV *const sv, const I32 flags)
        }
        return SvRV(sv) != 0;
     }
        }
        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);

 }
 
 /*
 }
 
 /*


@@ -3165,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
 
 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
 use the Encode extension for that.
 
 =for apidoc sv_utf8_upgrade_nomg


@@ -3184,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.
 
 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
 use the Encode extension for that.
 
 =cut


@@ -3229,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 (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);
        STRLEN len = 0;
        if (SvREADONLY(sv) && (SvPOKp(sv) || SvIOKp(sv) || SvNOKp(sv))) {
            (void) sv_2pv_flags(sv,&len, flags);


@@ -3487,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.
 
 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
 use the Encode extension for that.
 
 =cut


@@ -3727,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))
          /* 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 {
         )
             mro_changes = 2;
         else {


@@ -3762,6 +3709,7 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
        }
     GvMULTI_on(dstr);
     if(mro_changes == 2) {
        }
     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))) {
        MAGIC *mg;
        SV * const sref = (SV *)GvAV((const GV *)dstr);
        if (SvSMAGICAL(sref) && (mg = mg_find(sref, PERL_MAGIC_isa))) {


@@ -3773,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);
            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);
     }
     else if(mro_changes == 3) {
        HV * const stash = GvHV(dstr);


@@ -3947,6 +3896,14 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
            assert(mg);
            Perl_magic_clearisa(aTHX_ NULL, mg);
        }
            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);
        break;
     }
     SvREFCNT_dec(dref);


@@ -3959,9 +3916,9 @@ void
 Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
 {
     dVAR;
 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;
 
 
     PERL_ARGS_ASSERT_SV_SETSV_FLAGS;
 


@@ -3982,12 +3939,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
     stype = SvTYPE(sstr);
     dtype = SvTYPE(dstr);
 
     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) {
     /* There's a lot of redundancy below but we're going for speed here */
 
     switch (stype) {


@@ -4055,15 +4006,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
        }
        goto undef_sstr;
 
        }
        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);
     case SVt_PV:
        if (dtype < SVt_PV)
            sv_upgrade(dstr, SVt_PV);


@@ -4088,8 +4030,17 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
        break;
 
     case SVt_REGEXP:
        break;
 
     case SVt_REGEXP:

+      upgregexp:

        if (dtype < SVt_REGEXP)
        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);
            sv_upgrade(dstr, SVt_REGEXP);

+       }

        break;
 
        /* case SVt_BIND: */
        break;
 
        /* case SVt_BIND: */


@@ -4106,7 +4057,10 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
                    return;
        }
        if (stype == SVt_PVLV)
                    return;
        }
        if (stype == SVt_PVLV)

+       {
+           if (isREGEXP(sstr)) goto upgregexp;

            SvUPGRADE(dstr, SVt_PVNV);
            SvUPGRADE(dstr, SVt_PVNV);

+       }

        else
            SvUPGRADE(dstr, (svtype)stype);
     }
        else
            SvUPGRADE(dstr, (svtype)stype);
     }


@@ -4116,7 +4070,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
     dtype = SvTYPE(dstr);
     sflags = SvFLAGS(sstr);
 
     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;
        /* Assigning to a subroutine sets the prototype.  */
        if (SvOK(sstr)) {
            STRLEN len;


@@ -4131,7 +4085,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
        } else {
            SvOK_off(dstr);
        }
        } 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 */
        const char * const type = sv_reftype(dstr,0);
        if (PL_op)
            /* diag_listed_as: Cannot copy to %s */


@@ -4216,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) {
        reg_temp_copy((REGEXP*)dstr, (REGEXP*)sstr);
     }
     else if (sflags & SVp_POK) {


@@ -4243,7 +4199,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
               shared hash keys then we don't do the COW setup, even if the
               source scalar is a shared hash key scalar.  */
             (((flags & SV_COW_SHARED_HASH_KEYS)
               shared hash keys then we don't do the COW setup, even if the
               source scalar is a shared hash key scalar.  */
             (((flags & SV_COW_SHARED_HASH_KEYS)

-              ? (sflags & (SVf_FAKE|SVf_READONLY)) != (SVf_FAKE|SVf_READONLY)
+              ? !(sflags & SVf_IsCOW)

               : 1 /* If making a COW copy is forbidden then the behaviour we
                       desire is as if the source SV isn't actually already
                       COW, even if it is.  So we act as if the source flags
               : 1 /* If making a COW copy is forbidden then the behaviour we
                       desire is as if the source SV isn't actually already
                       COW, even if it is.  So we act as if the source flags


@@ -4259,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.  */
                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
             )
             &&
 #endif
             )
             &&


@@ -4274,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
             && ((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
             ) {
                : 1)
 #endif
             ) {


@@ -4297,10 +4253,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
             }
 #ifdef PERL_OLD_COPY_ON_WRITE
             if (!isSwipe) {
             }
 #ifdef PERL_OLD_COPY_ON_WRITE
             if (!isSwipe) {

-                if ((sflags & (SVf_FAKE | SVf_READONLY))
-                    != (SVf_FAKE | SVf_READONLY)) {
-                    SvREADONLY_on(sstr);
-                    SvFAKE_on(sstr);
+                if (!(sflags & SVf_IsCOW)) {
+                    SvIsCOW_on(sstr);

                     /* Make the source SV into a loop of 1.
                        (about to become 2) */
                     SV_COW_NEXT_SV_SET(sstr, sstr);
                     /* Make the source SV into a loop of 1.
                        (about to become 2) */
                     SV_COW_NEXT_SV_SET(sstr, sstr);


@@ -4337,8 +4291,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
                }
                 SvLEN_set(dstr, len);
                 SvCUR_set(dstr, cur);
                }
                 SvLEN_set(dstr, len);
                 SvCUR_set(dstr, cur);

-                SvREADONLY_on(dstr);
-                SvFAKE_on(dstr);
+                SvIsCOW_on(dstr);

             }
             else
                 {      /* Passes the swipe test.  */
             }
             else
                 {      /* Passes the swipe test.  */


@@ -4419,7 +4372,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
 {
     STRLEN cur = SvCUR(sstr);
     STRLEN len = SvLEN(sstr);
 {
     STRLEN cur = SvCUR(sstr);
     STRLEN len = SvLEN(sstr);

-    register char *new_pv;
+    char *new_pv;

 
     PERL_ARGS_ASSERT_SV_SETSV_COW;
 
 
     PERL_ARGS_ASSERT_SV_SETSV_COW;
 


@@ -4435,7 +4388,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))
        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);
     }
     else
        new_SV(dstr);


@@ -4461,8 +4414,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
     } else {
        assert ((SvFLAGS(sstr) & CAN_COW_MASK) == CAN_COW_FLAGS);
        SvUPGRADE(sstr, SVt_PVIV);
     } else {
        assert ((SvFLAGS(sstr) & CAN_COW_MASK) == CAN_COW_FLAGS);
        SvUPGRADE(sstr, SVt_PVIV);

-       SvREADONLY_on(sstr);
-       SvFAKE_on(sstr);
+       SvIsCOW_on(sstr);

        DEBUG_C(PerlIO_printf(Perl_debug_log,
                              "Fast copy on write: Converting sstr to COW\n"));
        SV_COW_NEXT_SV_SET(dstr, sstr);
        DEBUG_C(PerlIO_printf(Perl_debug_log,
                              "Fast copy on write: Converting sstr to COW\n"));
        SV_COW_NEXT_SV_SET(dstr, sstr);


@@ -4472,7 +4424,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
 
   common_exit:
     SvPV_set(dstr, new_pv);
 
   common_exit:
     SvPV_set(dstr, new_pv);

-    SvFLAGS(dstr) = (SVt_PVIV|SVf_POK|SVp_POK|SVf_FAKE|SVf_READONLY);
+    SvFLAGS(dstr) = (SVt_PVIV|SVf_POK|SVp_POK|SVf_IsCOW);

     if (SvUTF8(sstr))
        SvUTF8_on(dstr);
     SvLEN_set(dstr, len);
     if (SvUTF8(sstr))
        SvUTF8_on(dstr);
     SvLEN_set(dstr, len);


@@ -4498,7 +4450,7 @@ void
 Perl_sv_setpvn(pTHX_ register SV *const sv, register const char *const ptr, register const STRLEN len)
 {
     dVAR;
 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;
 
 
     PERL_ARGS_ASSERT_SV_SETPVN;
 


@@ -4555,7 +4507,7 @@ void
 Perl_sv_setpv(pTHX_ register SV *const sv, register const char *const ptr)
 {
     dVAR;
 Perl_sv_setpv(pTHX_ register SV *const sv, register const char *const ptr)
 {
     dVAR;

-    register STRLEN len;
+    STRLEN len;

 
     PERL_ARGS_ASSERT_SV_SETPV;
 
 
     PERL_ARGS_ASSERT_SV_SETPV;
 


@@ -4614,7 +4566,7 @@ Perl_sv_sethek(pTHX_ register SV *const sv, const HEK *const hek)
            sv_usepvn_flags(sv, as_utf8, utf8_len, SV_HAS_TRAILING_NUL);
            SvUTF8_on(sv);
             return;
            sv_usepvn_flags(sv, as_utf8, utf8_len, SV_HAS_TRAILING_NUL);
            SvUTF8_on(sv);
             return;

-       } else if (flags & (HVhek_REHASH|HVhek_UNSHARED)) {
+        } else if (flags & HVhek_UNSHARED) {

            sv_setpvn(sv, HEK_KEY(hek), HEK_LEN(hek));
            if (HEK_UTF8(hek))
                SvUTF8_on(sv);
            sv_setpvn(sv, HEK_KEY(hek), HEK_LEN(hek));
            if (HEK_UTF8(hek))
                SvUTF8_on(sv);


@@ -4624,11 +4576,11 @@ Perl_sv_sethek(pTHX_ register SV *const sv, const HEK *const hek)
         {
            SV_CHECK_THINKFIRST_COW_DROP(sv);
            SvUPGRADE(sv, SVt_PV);
         {
            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);
            SvPV_set(sv,(char *)HEK_KEY(share_hek_hek(hek)));
            SvCUR_set(sv, HEK_LEN(hek));
            SvLEN_set(sv, 0);

-           SvREADONLY_on(sv);
-           SvFAKE_on(sv);
+           SvIsCOW_on(sv);

            SvPOK_on(sv);
            if (HEK_UTF8(hek))
                SvUTF8_on(sv);
            SvPOK_on(sv);
            if (HEK_UTF8(hek))
                SvUTF8_on(sv);


@@ -4742,8 +4694,7 @@ S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, SV *after)
             /* The SV we point to points back to us (there were only two of us
                in the loop.)
                Hence other SV is no longer copy on write either.  */
             /* The SV we point to points back to us (there were only two of us
                in the loop.)
                Hence other SV is no longer copy on write either.  */

-            SvFAKE_off(after);
-            SvREADONLY_off(after);
+            SvIsCOW_off(after);

         } else {
             /* We need to follow the pointers around the loop.  */
             SV *next;
         } else {
             /* We need to follow the pointers around the loop.  */
             SV *next;


@@ -4764,10 +4715,12 @@ S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, SV *after)
 /*
 =for apidoc sv_force_normal_flags
 
 /*
 =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
 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,
 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,


@@ -4787,7 +4740,11 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
 
 #ifdef PERL_OLD_COPY_ON_WRITE
     if (SvREADONLY(sv)) {
 
 #ifdef PERL_OLD_COPY_ON_WRITE
     if (SvREADONLY(sv)) {

-       if (SvFAKE(sv)) {
+       if (IN_PERL_RUNTIME)
+           Perl_croak_no_modify(aTHX);
+    }
+    else
+       if (SvIsCOW(sv)) {

            const char * const pvx = SvPVX_const(sv);
            const STRLEN len = SvLEN(sv);
            const STRLEN cur = SvCUR(sv);
            const char * const pvx = SvPVX_const(sv);
            const STRLEN len = SvLEN(sv);
            const STRLEN cur = SvCUR(sv);


@@ -4802,8 +4759,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
                               (long) flags);
                 sv_dump(sv);
             }
                               (long) flags);
                 sv_dump(sv);
             }

-            SvFAKE_off(sv);
-            SvREADONLY_off(sv);
+            SvIsCOW_off(sv);

             /* This SV doesn't own the buffer, so need to Newx() a new one:  */
             SvPV_set(sv, NULL);
             SvLEN_set(sv, 0);
             /* This SV doesn't own the buffer, so need to Newx() a new one:  */
             SvPV_set(sv, NULL);
             SvLEN_set(sv, 0);


@@ -4825,16 +4781,16 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
                 sv_dump(sv);
             }
        }
                 sv_dump(sv);
             }
        }

-       else if (IN_PERL_RUNTIME)
-           Perl_croak_no_modify(aTHX);
-    }

 #else
     if (SvREADONLY(sv)) {
 #else
     if (SvREADONLY(sv)) {

+       if (IN_PERL_RUNTIME)
+           Perl_croak_no_modify();
+    }
+    else

        if (SvIsCOW(sv)) {
            const char * const pvx = SvPVX_const(sv);
            const STRLEN len = SvCUR(sv);
        if (SvIsCOW(sv)) {
            const char * const pvx = SvPVX_const(sv);
            const STRLEN len = SvCUR(sv);

-           SvFAKE_off(sv);
-           SvREADONLY_off(sv);
+           SvIsCOW_off(sv);

            SvPV_set(sv, NULL);
            SvLEN_set(sv, 0);
            if (flags & SV_COW_DROP_PV) {
            SvPV_set(sv, NULL);
            SvLEN_set(sv, 0);
            if (flags & SV_COW_DROP_PV) {


@@ -4847,20 +4803,19 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
            }
            unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
        }
            }
            unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
        }

-       else if (IN_PERL_RUNTIME)
-           Perl_croak_no_modify(aTHX);
-    }

 #endif
     if (SvROK(sv))
        sv_unref_flags(sv, flags);
     else if (SvFAKE(sv) && isGV_with_GP(sv))
        sv_unglob(sv, flags);
 #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.  */
        /* 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);
        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));
 
        if (new_type == SVt_PVMG) {
            SvMAGIC_set(temp, SvMAGIC(sv));


@@ -4868,41 +4823,51 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
            SvSTASH_set(temp, SvSTASH(sv));
            SvSTASH_set(sv, NULL);
        }
            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. */
 
        }
 
        /* 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;
 
        SvFLAGS(temp) &= ~(SVTYPEMASK);
        SvFLAGS(temp) |= SVt_REGEXP|SVf_FAKE;
        SvANY(temp) = temp_p;

+       temp->sv_u.svu_rx = (regexp *)temp_p;

 
        SvREFCNT_dec(temp);
     }
 
        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.
 }
 
 /*
 =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.
 
 Beware: after this function returns, C<ptr> and SvPVX_const(sv) may no longer
 refer to the same chunk of data.


@@ -4941,6 +4906,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);
                   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 */
 
     if (!SvOOK(sv)) {
        if (!SvLEN(sv)) { /* make copy of shared string */


@@ -5068,18 +5034,19 @@ Perl_sv_catpvn_flags(pTHX_ register SV *const dsv, register const char *sstr, re
 /*
 =for apidoc sv_catsv
 
 /*
 =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
 
 
 =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 */
 
 
 =cut */
 


@@ -5090,18 +5057,18 @@ Perl_sv_catsv_flags(pTHX_ SV *const dsv, register SV *const ssv, const I32 flags
  
     PERL_ARGS_ASSERT_SV_CATSV_FLAGS;
 
  
     PERL_ARGS_ASSERT_SV_CATSV_FLAGS;
 

-   if (ssv) {
+    if (ssv) {

        STRLEN slen;
        const char *spv = SvPV_flags_const(ssv, slen, flags);
        if (spv) {
        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);
            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);

 }
 
 /*
 }
 
 /*


@@ -5117,7 +5084,7 @@ void
 Perl_sv_catpv(pTHX_ register SV *const sv, register const char *ptr)
 {
     dVAR;
 Perl_sv_catpv(pTHX_ register SV *const sv, register const char *ptr)
 {
     dVAR;

-    register STRLEN len;
+    STRLEN len;

     STRLEN tlen;
     char *junk;
 
     STRLEN tlen;
     char *junk;
 


@@ -5192,7 +5159,7 @@ SV *
 Perl_newSV(pTHX_ const STRLEN len)
 {
     dVAR;
 Perl_newSV(pTHX_ const STRLEN len)
 {
     dVAR;

-    register SV *sv;
+    SV *sv;

 
     new_SV(sv);
     if (len) {
 
     new_SV(sv);
     if (len) {


@@ -5289,8 +5256,6 @@ Perl_sv_magicext(pTHX_ SV *const sv, SV *const obj, const int how,
     mg->mg_virtual = (MGVTBL *) vtable;
 
     mg_magical(sv);
     mg->mg_virtual = (MGVTBL *) vtable;
 
     mg_magical(sv);

-    if (SvGMAGICAL(sv))
-       SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);

     return mg;
 }
 
     return mg;
 }
 


@@ -5349,7 +5314,7 @@ Perl_sv_magic(pTHX_ register SV *const sv, SV *const obj, const int how,
            && !PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(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)) {
        }
     }
     if (SvMAGICAL(sv) || (how == PERL_MAGIC_taint && SvTYPE(sv) >= SVt_PVMG)) {


@@ -5357,13 +5322,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
             */
            /* 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;
                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;
        }
     }
            return;
        }
     }


@@ -5709,7 +5669,7 @@ Perl_sv_kill_backrefs(pTHX_ SV *const sv, AV *const av)
     if (!av)
        return;
 
     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)) {
      * 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)) {


@@ -5805,11 +5765,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;
 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;
     STRLEN curlen;
 
     PERL_ARGS_ASSERT_SV_INSERT_FLAGS;


@@ -5985,10 +5945,11 @@ S_anonymise_cv_maybe(pTHX_ GV *gv, CV* cv)
     assert(GvGP(gv));
     assert(!CvANON(cv));
     assert(CvGV(cv) == gv);
     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) {
 
     /* 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;
     }
 
        return;
     }
 


@@ -6002,7 +5963,7 @@ S_anonymise_cv_maybe(pTHX_ GV *gv, CV* cv)
 
     CvANON_on(cv);
     CvCVGV_RC_on(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));

 }
 
 
 }
 
 


@@ -6029,7 +5990,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
     const struct body_details *sv_type_details;
     SV* iter_sv = NULL;
     SV* next_sv = NULL;
     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;
     STRLEN hash_index;
 
     PERL_ARGS_ASSERT_SV_CLEAR;


@@ -6103,6 +6064,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
            goto freescalar;
        case SVt_REGEXP:
            /* FIXME for plugins */
            goto freescalar;
        case SVt_REGEXP:
            /* FIXME for plugins */

+         freeregexp:

            pregfree2((REGEXP*) sv);
            goto freescalar;
        case SVt_PVCV:
            pregfree2((REGEXP*) sv);
            goto freescalar;
        case SVt_PVCV:


@@ -6125,9 +6087,12 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
                if (   PL_phase != PERL_PHASE_DESTRUCT
                    && (name = HvNAME((HV*)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);
                        (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);
                }
 
                    hv_name_set((HV*)sv, NULL, 0, 0);
                }
 


@@ -6176,6 +6141,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
            }
            else if (LvTYPE(sv) != 't') /* unless tie: unrefcnted fake SV**  */
                SvREFCNT_dec(LvTARG(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)))
        case SVt_PVGV:
            if (isGV_with_GP(sv)) {
                if(GvCVu((const GV *)sv) && (stash = GvSTASH(MUTABLE_GV(sv)))


@@ -6237,9 +6203,8 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
                        unshare_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv)));
                    }
 
                        unshare_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv)));
                    }
 

-                   SvFAKE_off(sv);

                } else if (SvLEN(sv)) {
                } else if (SvLEN(sv)) {

-                   Safefree(SvPVX_const(sv));
+                   Safefree(SvPVX_mutable(sv));

                }
            }
 #else
                }
            }
 #else


@@ -6249,7 +6214,6 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
                Safefree(SvPVX_mutable(sv));
            else if (SvPVX_const(sv) && SvIsCOW(sv)) {
                unshare_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv)));
                Safefree(SvPVX_mutable(sv));
            else if (SvPVX_const(sv) && SvIsCOW(sv)) {
                unshare_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv)));

-               SvFAKE_off(sv);

            }
 #endif
            break;
            }
 #endif
            break;


@@ -6311,6 +6275,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;
                    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);
 
                    /* free any remaining detritus from the hash struct */
                    Perl_hv_undef_flags(aTHX_ MUTABLE_HV(sv), HV_NAME_SETALL);


@@ -6364,9 +6332,17 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) {
        dSP;
        HV* stash;
        do {
        dSP;
        HV* stash;
        do {

-           CV* destructor;
-           stash = SvSTASH(sv);
-           destructor = StashHANDLER(stash,DESTROY);
+         if ((stash = SvSTASH(sv)) && HvNAME(stash)) {
+           CV* destructor = NULL;
+           if (!SvOBJECT(stash)) destructor = (CV *)SvSTASH(stash);
+           if (!destructor) {
+               GV * const gv =
+                   gv_fetchmeth_autoload(stash, "DESTROY", 7, 0);
+               if (gv && (destructor = GvCV(gv))) {
+                   if (!SvOBJECT(stash))
+                       SvSTASH(stash) = (HV *)destructor;
+               }
+           }

            if (destructor
                /* A constant subroutine can have no side effects, so
                   don't bother calling it.  */
            if (destructor
                /* A constant subroutine can have no side effects, so
                   don't bother calling it.  */


@@ -6406,6 +6382,7 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) {
                }
                SvREFCNT_dec(tmpref);
            }
                }
                SvREFCNT_dec(tmpref);
            }

+         }

        } while (SvOBJECT(sv) && SvSTASH(sv) != stash);
 
 
        } while (SvOBJECT(sv) && SvSTASH(sv) != stash);
 
 


@@ -6534,7 +6511,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
 =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
 */
 
 =cut
 */


@@ -6547,10 +6525,7 @@ Perl_sv_len(pTHX_ register SV *const sv)
     if (!sv)
        return 0;
 
     if (!sv)
        return 0;
 

-    if (SvGMAGICAL(sv))
-       len = mg_length(sv);
-    else
-        (void)SvPV_const(sv, len);
+    (void)SvPV_const(sv, len);

     return len;
 }
 
     return len;
 }
 


@@ -6578,14 +6553,20 @@ Perl_sv_len_utf8(pTHX_ register SV *const sv)
     if (!sv)
        return 0;
 
     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);
+}

 
 

-       if (PL_utf8cache) {
+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 && SvUTF8(sv)) {

            STRLEN ulen;
            MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL;
 
            STRLEN ulen;
            MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL;
 


@@ -6611,9 +6592,8 @@ Perl_sv_len_utf8(pTHX_ register SV *const sv)
                utf8_mg_len_cache_update(sv, &mg, ulen);
            }
            return ulen;
                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
 }
 
 /* Walk forwards to find the byte corresponding to the passed in UTF-8


@@ -6701,7 +6681,7 @@ S_sv_pos_u2b_cached(pTHX_ SV *const sv, MAGIC **const mgp, const U8 *const start
     if (!uoffset)
        return 0;
 
     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))))) {
        && PL_utf8cache
        && (*mgp || (SvTYPE(sv) >= SVt_PVMG &&
                     (*mgp = mg_find(sv, PERL_MAGIC_utf8))))) {


@@ -6784,7 +6764,7 @@ S_sv_pos_u2b_cached(pTHX_ SV *const sv, MAGIC **const mgp, const U8 *const start
        boffset = real_boffset;
     }
 
        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
        if (at_end)
            utf8_mg_len_cache_update(sv, mgp, uoffset);
        else


@@ -6896,7 +6876,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;
                           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 ||
        return;
 
     if (!*mgp && (SvTYPE(sv) < SVt_PVMG ||


@@ -7003,7 +6983,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.  */
           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
        if (byte > cache[1]) {
            /* New position is after the existing pair of pairs.  */
            const float keep_earlier


@@ -7012,18 +6991,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) {
                = 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 {
            }
            else {

-               if (keep_earlier < existing) {
-                   cache[0] = utf8;
-                   cache[1] = byte;
-               }
+                cache[0] = utf8;
+                cache[1] = byte;

            }
        }
        else if (byte > cache[3]) {
            }
        }
        else if (byte > cache[3]) {


@@ -7034,16 +7009,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) {
                = 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 {
            }
            else {

-               if (keep_earlier < existing) {
-                   cache[0] = utf8;
-                   cache[1] = byte;
-               }
+                cache[0] = utf8;
+                cache[1] = byte;

            }
        }
        else {
            }
        }
        else {


@@ -7054,18 +7025,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) {
                = 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 {
            }
            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;

            }
        }
     }
            }
        }
     }


@@ -7615,7 +7582,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
 =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
 */
 
 =cut
 */


@@ -7626,9 +7596,9 @@ Perl_sv_gets(pTHX_ register SV *const sv, register PerlIO *const fp, I32 append)
     dVAR;
     const char *rsptr;
     STRLEN rslen;
     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;
 
     I32 i = 0;
     I32 rspara = 0;
 


@@ -7735,7 +7705,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.
      */
      * 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;
 
     STRLEN bpx;
     I32 shortbuffered;
 


@@ -7881,7 +7851,7 @@ thats_really_all_folks:
 
 screamer2:
        if (rslen) {
 
 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 */
            bp = buf;
            while ((i = PerlIO_getc(fp)) != EOF && (*bp++ = (STDCHAR)i) != rslast && bp < bpe)
                ; /* keep reading */


@@ -7901,9 +7871,9 @@ screamer2:
        if (cnt < 0)
            cnt = 0;  /* we do need to re-set the sv even when cnt <= 0 */
        if (append)
        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
        else

-            sv_setpvn(sv, (char *) buf, cnt);
+            sv_setpvn(sv, (char *) buf, cnt);   /* "nomg" is implied */

 
        if (i != EOF &&                 /* joy */
            (!rslen ||
 
        if (i != EOF &&                 /* joy */
            (!rslen ||


@@ -7975,7 +7945,7 @@ void
 Perl_sv_inc_nomg(pTHX_ register SV *const sv)
 {
     dVAR;
 Perl_sv_inc_nomg(pTHX_ register SV *const sv)
 {
     dVAR;

-    register char *d;
+    char *d;

     int flags;
 
     if (!sv)
     int flags;
 
     if (!sv)


@@ -7985,7 +7955,7 @@ Perl_sv_inc_nomg(pTHX_ register SV *const sv)
            sv_force_normal_flags(sv, 0);
        if (SvREADONLY(sv)) {
            if (IN_PERL_RUNTIME)
            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;
        }
        if (SvROK(sv)) {
            IV i;


@@ -8167,7 +8137,7 @@ Perl_sv_dec_nomg(pTHX_ register SV *const sv)
            sv_force_normal_flags(sv, 0);
        if (SvREADONLY(sv)) {
            if (IN_PERL_RUNTIME)
            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;
        }
        if (SvROK(sv)) {
            IV i;


@@ -8294,13 +8264,15 @@ statement boundaries.  See also C<sv_newmortal> and C<sv_2mortal>.
  * permanent location. */
 
 SV *
  * permanent location. */
 
 SV *

-Perl_sv_mortalcopy(pTHX_ SV *const oldstr)
+Perl_sv_mortalcopy_flags(pTHX_ SV *const oldstr, U32 flags)

 {
     dVAR;
 {
     dVAR;

-    register SV *sv;
+    SV *sv;

 
 

+    if (flags & SV_GMAGIC)
+       SvGETMAGIC(oldstr); /* before new_SV, in case it dies */

     new_SV(sv);
     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;
     PUSH_EXTEND_MORTAL__SV_C(sv);
     SvTEMP_on(sv);
     return sv;


@@ -8321,7 +8293,7 @@ SV *
 Perl_sv_newmortal(pTHX)
 {
     dVAR;
 Perl_sv_newmortal(pTHX)
 {
     dVAR;

-    register SV *sv;
+    SV *sv;

 
     new_SV(sv);
     SvFLAGS(sv) = SVs_TEMP;
 
     new_SV(sv);
     SvFLAGS(sv) = SVs_TEMP;


@@ -8354,7 +8326,7 @@ SV *
 Perl_newSVpvn_flags(pTHX_ const char *const s, const STRLEN len, const U32 flags)
 {
     dVAR;
 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.  */
 
     /* 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.  */


@@ -8418,7 +8390,7 @@ SV *
 Perl_newSVpv(pTHX_ const char *const s, const STRLEN len)
 {
     dVAR;
 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));
 
     new_SV(sv);
     sv_setpvn(sv, s, len || s == NULL ? len : strlen(s));


@@ -8442,7 +8414,7 @@ SV *
 Perl_newSVpvn(pTHX_ const char *const buffer, const STRLEN len)
 {
     dVAR;
 Perl_newSVpvn(pTHX_ const char *const buffer, const STRLEN len)
 {
     dVAR;

-    register SV *sv;
+    SV *sv;

 
     new_SV(sv);
     sv_setpvn(sv,buffer,len);
 
     new_SV(sv);
     sv_setpvn(sv,buffer,len);


@@ -8485,13 +8457,8 @@ Perl_newSVhek(pTHX_ const HEK *const hek)
            sv_usepvn_flags(sv, as_utf8, utf8_len, SV_HAS_TRAILING_NUL);
            SvUTF8_on (sv);
            return sv;
            sv_usepvn_flags(sv, as_utf8, utf8_len, SV_HAS_TRAILING_NUL);
            SvUTF8_on (sv);
            return sv;

-       } else if (flags & (HVhek_REHASH|HVhek_UNSHARED)) {
-           /* We don't have a pointer to the hv, so we have to replicate the
-              flag into every HEK. This hv is using custom a hasing
-              algorithm. Hence we can't return a shared string scalar, as
-              that would contain the (wrong) hash value, and might get passed
-              into an hv routine with a regular hash.
-              Similarly, a hash that isn't using shared hash keys has to have
+        } else if (flags & HVhek_UNSHARED) {
+            /* A hash that isn't using shared hash keys has to have

               the flag in every key so that we know not to try to call
               share_hek_hek on it.  */
 
               the flag in every key so that we know not to try to call
               share_hek_hek on it.  */
 


@@ -8511,8 +8478,7 @@ Perl_newSVhek(pTHX_ const HEK *const hek)
            SvPV_set(sv, (char *)HEK_KEY(share_hek_hek(hek)));
            SvCUR_set(sv, HEK_LEN(hek));
            SvLEN_set(sv, 0);
            SvPV_set(sv, (char *)HEK_KEY(share_hek_hek(hek)));
            SvCUR_set(sv, HEK_LEN(hek));
            SvLEN_set(sv, 0);

-           SvREADONLY_on(sv);
-           SvFAKE_on(sv);
+           SvIsCOW_on(sv);

            SvPOK_on(sv);
            if (HEK_UTF8(hek))
                SvUTF8_on(sv);
            SvPOK_on(sv);
            if (HEK_UTF8(hek))
                SvUTF8_on(sv);


@@ -8540,7 +8506,7 @@ SV *
 Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
 {
     dVAR;
 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;
 
     bool is_utf8 = FALSE;
     const char *const orig_src = src;
 


@@ -8560,8 +8526,7 @@ Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
     SvPV_set(sv, sharepvn(src, is_utf8?-len:len, hash));
     SvCUR_set(sv, len);
     SvLEN_set(sv, 0);
     SvPV_set(sv, sharepvn(src, is_utf8?-len:len, hash));
     SvCUR_set(sv, len);
     SvLEN_set(sv, 0);

-    SvREADONLY_on(sv);
-    SvFAKE_on(sv);
+    SvIsCOW_on(sv);

     SvPOK_on(sv);
     if (is_utf8)
         SvUTF8_on(sv);
     SvPOK_on(sv);
     if (is_utf8)
         SvUTF8_on(sv);


@@ -8596,7 +8561,7 @@ SV *
 Perl_newSVpvf_nocontext(const char *const pat, ...)
 {
     dTHX;
 Perl_newSVpvf_nocontext(const char *const pat, ...)
 {
     dTHX;

-    register SV *sv;
+    SV *sv;

     va_list args;
 
     PERL_ARGS_ASSERT_NEWSVPVF_NOCONTEXT;
     va_list args;
 
     PERL_ARGS_ASSERT_NEWSVPVF_NOCONTEXT;


@@ -8620,7 +8585,7 @@ C<sprintf>.
 SV *
 Perl_newSVpvf(pTHX_ const char *const pat, ...)
 {
 SV *
 Perl_newSVpvf(pTHX_ const char *const pat, ...)
 {

-    register SV *sv;
+    SV *sv;

     va_list args;
 
     PERL_ARGS_ASSERT_NEWSVPVF;
     va_list args;
 
     PERL_ARGS_ASSERT_NEWSVPVF;


@@ -8637,7 +8602,7 @@ SV *
 Perl_vnewSVpvf(pTHX_ const char *const pat, va_list *const args)
 {
     dVAR;
 Perl_vnewSVpvf(pTHX_ const char *const pat, va_list *const args)
 {
     dVAR;

-    register SV *sv;
+    SV *sv;

 
     PERL_ARGS_ASSERT_VNEWSVPVF;
 
 
     PERL_ARGS_ASSERT_VNEWSVPVF;
 


@@ -8659,7 +8624,7 @@ SV *
 Perl_newSVnv(pTHX_ const NV n)
 {
     dVAR;
 Perl_newSVnv(pTHX_ const NV n)
 {
     dVAR;

-    register SV *sv;
+    SV *sv;

 
     new_SV(sv);
     sv_setnv(sv,n);
 
     new_SV(sv);
     sv_setnv(sv,n);


@@ -8679,7 +8644,7 @@ SV *
 Perl_newSViv(pTHX_ const IV i)
 {
     dVAR;
 Perl_newSViv(pTHX_ const IV i)
 {
     dVAR;

-    register SV *sv;
+    SV *sv;

 
     new_SV(sv);
     sv_setiv(sv,i);
 
     new_SV(sv);
     sv_setiv(sv,i);


@@ -8699,7 +8664,7 @@ SV *
 Perl_newSVuv(pTHX_ const UV u)
 {
     dVAR;
 Perl_newSVuv(pTHX_ const UV u)
 {
     dVAR;

-    register SV *sv;
+    SV *sv;

 
     new_SV(sv);
     sv_setuv(sv,u);
 
     new_SV(sv);
     sv_setuv(sv,u);


@@ -8718,7 +8683,7 @@ is set to 1.
 SV *
 Perl_newSV_type(pTHX_ const svtype type)
 {
 SV *
 Perl_newSV_type(pTHX_ const svtype type)
 {

-    register SV *sv;
+    SV *sv;

 
     new_SV(sv);
     sv_upgrade(sv, type);
 
     new_SV(sv);
     sv_upgrade(sv, type);


@@ -8738,7 +8703,7 @@ SV *
 Perl_newRV_noinc(pTHX_ SV *const tmpRef)
 {
     dVAR;
 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;
 
 
     PERL_ARGS_ASSERT_NEWRV_NOINC;
 


@@ -8775,7 +8740,7 @@ SV *
 Perl_newSVsv(pTHX_ register SV *const old)
 {
     dVAR;
 Perl_newSVsv(pTHX_ register SV *const old)
 {
     dVAR;

-    register SV *sv;
+    SV *sv;

 
     if (!old)
        return NULL;
 
     if (!old)
        return NULL;


@@ -8783,11 +8748,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;
     }
        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);
     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.  */
        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;
 }
 
     return sv;
 }
 


@@ -8803,15 +8769,22 @@ Note that the perl-level function is vaguely deprecated.
 void
 Perl_sv_reset(pTHX_ register const char *s, HV *const stash)
 {
 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];
     dVAR;
     char todo[PERL_UCHAR_MAX+1];

-
-    PERL_ARGS_ASSERT_SV_RESET;
+    const char *send;

 
     if (!stash)
        return;
 
 
     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**);
        MAGIC * const mg = mg_find((const SV *)stash, PERL_MAGIC_symtab);
        if (mg) {
            const U32 count = mg->mg_len / sizeof(PMOP**);


@@ -8836,7 +8809,8 @@ Perl_sv_reset(pTHX_ register const char *s, HV *const stash)
        return;
 
     Zero(todo, 256, char);
        return;
 
     Zero(todo, 256, char);

-    while (*s) {
+    send = s + len;
+    while (s < send) {

        I32 max;
        I32 i = (unsigned char)*s;
        if (s[1] == '-') {
        I32 max;
        I32 i = (unsigned char)*s;
        if (s[1] == '-') {


@@ -8852,8 +8826,8 @@ Perl_sv_reset(pTHX_ register const char *s, HV *const stash)
                 entry;
                 entry = HeNEXT(entry))
            {
                 entry;
                 entry = HeNEXT(entry))
            {

-               register GV *gv;
-               register SV *sv;
+               GV *gv;
+               SV *sv;

 
                if (!todo[(U8)*HeKEY(entry)])
                    continue;
 
                if (!todo[(U8)*HeKEY(entry)])
                    continue;


@@ -9025,20 +8999,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)) {
        }
        *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! */
            /* 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);
     }
        }
        return GvCVu(gv);
     }


@@ -9060,7 +9024,7 @@ Perl_sv_true(pTHX_ register SV *const sv)
     if (!sv)
        return 0;
     if (SvPOK(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')))
        if (tXpv &&
                (tXpv->xpv_cur > 1 ||
                (tXpv->xpv_cur && *sv->sv_u.svu_pv != '0')))


@@ -9126,7 +9090,7 @@ 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);
        }
            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),
            || 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),


@@ -9154,6 +9118,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
                                  PTR2UV(sv),SvPVX_const(sv)));
        }
     }
                                  PTR2UV(sv),SvPVX_const(sv)));
        }
     }

+    (void)SvPOK_only_UTF8(sv);

     return SvPVX_mutable(sv);
 }
 
     return SvPVX_mutable(sv);
 }
 


@@ -9191,8 +9156,8 @@ Perl_sv_pvutf8n_force(pTHX_ SV *const sv, STRLEN *const lp)
 {
     PERL_ARGS_ASSERT_SV_PVUTF8N_FORCE;
 
 {
     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);
 }
     *lp = SvCUR(sv);
     return SvPVX(sv);
 }


@@ -9523,10 +9488,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)) {
         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;
        if (SvOBJECT(tmpRef)) {
            if (SvTYPE(tmpRef) != SVt_PVIO)
                --PL_sv_objcount;


@@ -9979,7 +9942,7 @@ Perl_sv_vsetpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
     PERL_ARGS_ASSERT_SV_VSETPVFN;
 
     sv_setpvs(sv, "");
     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);

 }
 
 
 }
 
 


@@ -10053,18 +10016,21 @@ S_F0convert(NV nv, char *const endbuf, STRLEN *const len)
 /*
 =for apidoc sv_vcatpvfn
 
 /*
 =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).
 
 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
 */
 
 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);
 #define VECTORIZE_ARGS vecsv = va_arg(*args, SV*);\
                        vecstr = (U8*)SvPV_const(vecsv,veclen);\
                        vec_utf8 = DO_UTF8(vecsv);


@@ -10075,6 +10041,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_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;
     dVAR;
     char *p;
     char *q;


@@ -10093,11 +10069,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 */
 
     /* 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);
 
     PERL_UNUSED_ARG(maybe_tainted);
 

+    if (flags & SV_GMAGIC)
+        SvGETMAGIC(sv);
+

     /* no matter what, this is a string now */
     /* 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)
 
     /* special-case "", "%s", and "%-p" (SVf - see below) */
     if (patlen == 0)


@@ -10105,10 +10084,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*);
     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) {
        }
        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);
        }
        else
            S_vcatpvfn_missing_argument(aTHX);


@@ -10117,7 +10098,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*));
     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;
     }
 
        return;
     }
 


@@ -10140,7 +10121,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);
                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;
                }
                    if (*ebuf)  /* May return an empty string for digits==0 */
                        return;
                }


@@ -10148,7 +10129,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))) {
                STRLEN l;
 
                if ((p = F0convert(nv, ebuf + sizeof ebuf, &l))) {

-                   sv_catpvn(sv, p, l);
+                   sv_catpvn_nomg(sv, p, l);

                    return;
                }
            }
                    return;
                }
            }


@@ -10219,9 +10200,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)
        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
            else

-               sv_catpvn(sv, p, q - p);
+               sv_catpvn_nomg(sv, p, q - p);

            p = q;
        }
        if (q++ >= patend)
            p = q;
        }
        if (q++ >= patend)


@@ -10441,20 +10422,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")) {
                 * 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 ) ) {
                    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");
                        "vector argument not supported with alpha versions");

-                       goto unknown;
+                       goto vdblank;

                    }
                    vecsv = sv_newmortal();
                    }
                    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);
                    vecstr = (U8*)SvPV_const(vecsv, veclen);
                    vec_utf8 = DO_UTF8(vecsv);

-                   Safefree(version);

                }
            }
            else {
                }
            }
            else {

+             vdblank:

                vecstr = (U8*)"";
                veclen = 0;
            }
                vecstr = (U8*)"";
                veclen = 0;
            }


@@ -10465,7 +10446,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 */
        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';
            if (q[1] == '6' && q[2] == '4') {
                q += 3;
                intsize = 'q';


@@ -10476,7 +10457,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
                q += 3;
                break;
            }
                q += 3;
                break;
            }

-#  ifdef WIN64
+#  ifdef USE_64_BIT_INT

            intsize = 'q';
 #  endif
            q++;
            intsize = 'q';
 #  endif
            q++;


@@ -10583,16 +10564,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) {
                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
                    }
                    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;
                }
                    }
                    is_utf8 = TRUE;
                }


@@ -11095,7 +11077,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_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);
                        } else {
                            Perl_sv_catpvf(aTHX_ msg,
                                           "\\%03"UVof, (UV)*f & 0xFF);


@@ -11146,13 +11128,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 
        have = esignlen + zeros + elen;
        if (have < zeros)
 
        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))
 
        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') {
        SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1);
        p = SvEND(sv);
        if (esignlen && fill == '0') {


@@ -11297,7 +11279,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->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);
     parser->preambled  = proto->preambled;
     parser->sublex_info        = proto->sublex_info; /* XXX not quite right */
     parser->linestr    = sv_dup_inc(proto->linestr, param);


@@ -11400,7 +11381,7 @@ Perl_dirp_dup(pTHX_ DIR *const dp, CLONE_PARAMS *const param)
 
 #ifdef HAS_FCHDIR
     DIR *pwd;
 
 #ifdef HAS_FCHDIR
     DIR *pwd;

-    register const Direntry_t *dirent;
+    const Direntry_t *dirent;

     char smallbuf[256];
     char *name = NULL;
     STRLEN len = 0;
     char smallbuf[256];
     char *name = NULL;
     STRLEN len = 0;


@@ -11792,6 +11773,7 @@ Perl_rvpv_dup(pTHX_ SV *const dstr, const SV *const sstr, CLONE_PARAMS *const pa
 {
     PERL_ARGS_ASSERT_RVPV_DUP;
 
 {
     PERL_ARGS_ASSERT_RVPV_DUP;
 

+    assert(!isREGEXP(sstr));

     if (SvROK(sstr)) {
        if (SvWEAKREF(sstr)) {
            SvRV_set(dstr, sv_dup(SvRV_const(sstr), param));
     if (SvROK(sstr)) {
        if (SvWEAKREF(sstr)) {
            SvRV_set(dstr, sv_dup(SvRV_const(sstr), param));


@@ -11809,19 +11791,16 @@ Perl_rvpv_dup(pTHX_ SV *const dstr, const SV *const sstr, CLONE_PARAMS *const pa
        if (SvLEN(sstr)) {
            /* Normal PV - clone whole allocated space */
            SvPV_set(dstr, SAVEPVN(SvPVX_const(sstr), SvLEN(sstr)-1));
        if (SvLEN(sstr)) {
            /* Normal PV - clone whole allocated space */
            SvPV_set(dstr, SAVEPVN(SvPVX_const(sstr), SvLEN(sstr)-1));

-           if (SvREADONLY(sstr) && SvFAKE(sstr)) {
-               /* Not that normal - actually sstr is copy on write.
-                  But we are a true, independent SV, so:  */
-               SvREADONLY_off(dstr);
-               SvFAKE_off(dstr);
-           }
+           /* sstr may not be that normal, but actually copy on write.
+              But we are a true, independent SV, so:  */
+           SvIsCOW_off(dstr);

        }
        else {
            /* Special case - not normally malloced for some reason */
            if (isGV_with_GP(sstr)) {
                /* Don't need to do anything here.  */
            }
        }
        else {
            /* Special case - not normally malloced for some reason */
            if (isGV_with_GP(sstr)) {
                /* Don't need to do anything here.  */
            }

-           else if ((SvREADONLY(sstr) && SvFAKE(sstr))) {
+           else if ((SvIsCOW(sstr))) {

                /* A "shared" PV - clone it as "shared" PV */
                SvPV_set(dstr,
                         HEK_KEY(hek_dup(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr)),
                /* A "shared" PV - clone it as "shared" PV */
                SvPV_set(dstr,
                         HEK_KEY(hek_dup(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr)),


@@ -11919,7 +11898,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_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);
 #endif
 
     ptr_table_store(PL_ptr_table, sstr, dstr);


@@ -12007,6 +11986,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)
 
            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);
 
                && !(sv_type == SVt_PVIO && !(IoFLAGS(dstr) & IOf_FAKE_DIRP)))
                Perl_rvpv_dup(aTHX_ dstr, sstr, param);
 


@@ -12035,7 +12015,9 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
            case SVt_PVMG:
                break;
            case SVt_REGEXP:
            case SVt_PVMG:
                break;
            case SVt_REGEXP:

+             duprex:

                /* FIXME for plugins */
                /* FIXME for plugins */

+               dstr->sv_u.svu_rx = ((REGEXP *)dstr)->sv_any;

                re_dup_guts((REGEXP*) sstr, (REGEXP*) dstr, param);
                break;
            case SVt_PVLV:
                re_dup_guts((REGEXP*) sstr, (REGEXP*) dstr, param);
                break;
            case SVt_PVLV:


@@ -12046,6 +12028,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);
                    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)) {
            case SVt_PVGV:
                /* non-GP case already handled above */
                if(isGV_with_GP(sstr)) {


@@ -12195,6 +12178,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_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))
 
                        /* Record stashes for possible cloning in Perl_clone(). */
                        if (HvNAME(sstr))


@@ -12219,14 +12203,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;
                    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);
                }
                } 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 (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 */
                /* 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)
                    CvCVGV_RC(dstr)
                    ? gv_dup_inc(CvGV(sstr), param)
                    : (param->flags & CLONEf_JOIN_IN)


@@ -12494,6 +12484,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
        TOPUV(nss,ix) = uv;
        switch (type) {
        case SAVEt_CLEARSV:
        TOPUV(nss,ix) = uv;
        switch (type) {
        case SAVEt_CLEARSV:

+       case SAVEt_CLEARPADRANGE:

            break;
        case SAVEt_HELEM:               /* hash element */
            sv = (const SV *)POPPTR(ss,ix);
            break;
        case SAVEt_HELEM:               /* hash element */
            sv = (const SV *)POPPTR(ss,ix);


@@ -12708,32 +12699,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_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_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);
 #ifdef PERL_OLD_COPY_ON_WRITE
                new_state->re_state_nrs
                    = sv_dup(old_state->re_state_nrs, param);


@@ -12940,6 +12907,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_Proc            = ipP;
 #endif         /* PERL_IMPLICIT_SYS */
 
     PL_Proc            = ipP;
 #endif         /* PERL_IMPLICIT_SYS */
 

+

     param->flags = flags;
     /* Nothing in the core code uses this, but we make it available to
        extensions (using mg_dup).  */
     param->flags = flags;
     /* Nothing in the core code uses this, but we make it available to
        extensions (using mg_dup).  */


@@ -12949,6 +12917,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     param->new_perl = my_perl;
     param->unreferenced = NULL;
 
     param->new_perl = my_perl;
     param->unreferenced = NULL;
 

+

     INIT_TRACK_MEMPOOL(my_perl->Imemory_debug_header, my_perl);
 
     PL_body_arenas = NULL;
     INIT_TRACK_MEMPOOL(my_perl->Imemory_debug_header, my_perl);
 
     PL_body_arenas = NULL;


@@ -12961,38 +12930,23 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_debug           = proto_perl->Idebug;
 
 
     PL_debug           = proto_perl->Idebug;
 

-    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;
 
     /* 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;
 
     /* 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;
     /* 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;
 
 
     PL_minus_c         = proto_perl->Iminus_c;
 


@@ -13025,7 +12979,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     /* RE engine related */
     Zero(&PL_reg_state, 1, struct re_save_state);
 
     /* 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;
     PL_regmatch_slab   = NULL;
 
     PL_sub_generation  = proto_perl->Isub_generation;


@@ -13166,7 +13119,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_timesbuf                = proto_perl->Itimesbuf;
 #endif
 
     PL_timesbuf                = proto_perl->Itimesbuf;
 #endif
 

+#if !NO_TAINT_SUPPORT

     PL_tainted         = proto_perl->Itainted;
     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 */
     PL_curpm           = proto_perl->Icurpm;   /* XXX No PMOP ref count */
 
     PL_chopset         = proto_perl->Ichopset; /* XXX never deallocated */


@@ -13210,21 +13167,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_ptr_table = ptr_table_new();
 
     /* initialize these special pointers as early as possible */
     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);
     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);
     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 */
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
 
     /* create (a non-shared!) shared string table */


@@ -13274,7 +13219,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_e_script                = sv_dup_inc(proto_perl->Ie_script, param);
 
     /* magical thingies */
     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);
 
 
     PL_encoding                = sv_dup(proto_perl->Iencoding, param);
 


@@ -13475,9 +13419,13 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_VertSpace       = sv_dup_inc(proto_perl->IVertSpace, param);
 
 
     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);
     /* 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);
     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);


@@ -13487,16 +13435,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_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_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_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);
     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);


@@ -13507,12 +13448,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_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);
 
     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);
     }
     if (proto_perl->Ipsig_pend) {
        Newxz(PL_psig_pend, SIG_SIZE, int);
     }


@@ -13555,6 +13496,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
        Newxz(PL_scopestack_name, PL_scopestack_max, const char *);
        Copy(proto_perl->Iscopestack_name, PL_scopestack_name, PL_scopestack_ix, const char *);
 #endif
        Newxz(PL_scopestack_name, PL_scopestack_max, const char *);
        Copy(proto_perl->Iscopestack_name, PL_scopestack_name, PL_scopestack_ix, const char *);
 #endif

+        /* reset stack AV to correct length before its duped via
+         * PL_curstackinfo */
+        AvFILLp(proto_perl->Icurstack) =
+                            proto_perl->Istack_sp - proto_perl->Istack_base;
+

        /* NOTE: si_dup() looks at PL_markstack */
        PL_curstackinfo         = si_dup(proto_perl->Icurstackinfo, param);
 
        /* NOTE: si_dup() looks at PL_markstack */
        PL_curstackinfo         = si_dup(proto_perl->Icurstackinfo, param);
 


@@ -13753,6 +13699,38 @@ Perl_clone_params_new(PerlInterpreter *const from, PerlInterpreter *const to)
 
 #endif /* USE_ITHREADS */
 
 
 #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
 
 /*
 =head1 Unicode Support
 


@@ -13788,8 +13766,8 @@ Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding)
        save_re_context();
        PUSHMARK(sp);
        EXTEND(SP, 3);
        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
 /*
   NI-S 2002/07/09
   Passing sv_yes is wrong - it needs to be or'ed set of constants


@@ -13859,12 +13837,12 @@ Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding,
        save_re_context();
        PUSHMARK(sp);
        EXTEND(SP, 6);
        save_re_context();
        PUSHMARK(sp);
        EXTEND(SP, 6);

-       XPUSHs(encoding);
-       XPUSHs(dsv);
-       XPUSHs(ssv);
+       PUSHs(encoding);
+       PUSHs(dsv);
+       PUSHs(ssv);

        offsv = newSViv(*offset);
        offsv = newSViv(*offset);

-       mXPUSHs(offsv);
-       mXPUSHp(tstr, tlen);
+       mPUSHs(offsv);
+       mPUSHp(tstr, tlen);

        PUTBACK;
        call_method("cat_decode", G_SCALAR);
        SPAGAIN;
        PUTBACK;
        call_method("cat_decode", G_SCALAR);
        SPAGAIN;


@@ -13897,7 +13875,7 @@ STATIC SV*
 S_find_hash_subscript(pTHX_ const HV *const hv, const SV *const val)
 {
     dVAR;
 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;
     I32 i;
 
     PERL_ARGS_ASSERT_FIND_HASH_SUBSCRIPT;


@@ -13908,8 +13886,8 @@ S_find_hash_subscript(pTHX_ const HV *const hv, const SV *const val)
 
     array = HvARRAY(hv);
 
 
     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;
        for (entry = array[i]; entry; entry = HeNEXT(entry)) {
            if (HeVAL(entry) != val)
                continue;


@@ -13951,7 +13929,7 @@ S_find_array_subscript(pTHX_ const AV *const av, const SV *const val)
     return -1;
 }
 
     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:
  * 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:


@@ -13991,13 +13969,13 @@ Perl_varname(pTHX_ const GV *const gv, const char gvtype, PADOFFSET targ,
        SV *sv;
        AV *av;
 
        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;
 
        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 = *av_fetch(av, targ, FALSE);

-       sv_setsv(name, sv);
+       sv_setsv_flags(name, sv, 0);

     }
 
     if (subscript_type == FUV_SUBSCRIPT_HASH) {
     }
 
     if (subscript_type == FUV_SUBSCRIPT_HASH) {


@@ -14061,8 +14039,16 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
     case OP_PADAV:
     case OP_PADHV:
       {
     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;
        I32 index = 0;
        SV *keysv = NULL;
        int subscript_type = FUV_SUBSCRIPT_WITHIN;


@@ -14268,7 +14254,9 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
 
     case OP_OPEN:
        o = cUNOPx(obase)->op_first;
 
     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) {
            o = o->op_sibling;
 
        if (!o->op_sibling) {


@@ -14312,7 +14300,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;
        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;
 
            o = o->op_sibling->op_sibling;
        goto do_op2;
 


@@ -14440,6 +14431,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.
         * 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) {
         */
        o2 = NULL;
        for (kid=o; kid; kid = kid->op_sibling) {


@@ -14448,6 +14441,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)
                if ( (type == OP_CONST && SvOK(cSVOPx_sv(kid)))
                  || (type == OP_NULL  && ! (kid->op_flags & OPf_KIDS))
                  || (type == OP_PUSHMARK)

+                 || (type == OP_PADRANGE)

                )
                continue;
            }
                )
                continue;
            }