This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Eliminate SVt_RV, and use SVt_IV to store plain references.
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index 88dcd96..7b49ce2 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -246,8 +246,13 @@ S_new_SV(pTHX)
     SvREFCNT(sv) = 1;
     SvFLAGS(sv) = 0;
     sv->sv_debug_optype = PL_op ? PL_op->op_type : 0;
     SvREFCNT(sv) = 1;
     SvFLAGS(sv) = 0;
     sv->sv_debug_optype = PL_op ? PL_op->op_type : 0;
-    sv->sv_debug_line = (U16) ((PL_copline == NOLINE) ?
-        (PL_curcop ? CopLINE(PL_curcop) : 0) : PL_copline);
+    sv->sv_debug_line = (U16) (PL_parser
+           ?  PL_parser->copline == NOLINE
+               ?  PL_curcop
+                   ? CopLINE(PL_curcop)
+                   : 0
+               : PL_parser->copline
+           : 0);
     sv->sv_debug_inpad = 0;
     sv->sv_debug_cloned = 0;
     sv->sv_debug_file = PL_curcop ? savepv(CopFILE(PL_curcop)): NULL;
     sv->sv_debug_inpad = 0;
     sv->sv_debug_cloned = 0;
     sv->sv_debug_file = PL_curcop ? savepv(CopFILE(PL_curcop)): NULL;
@@ -349,7 +354,7 @@ Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags)
 #ifdef DEBUGGING
        SvREFCNT(sv) = 0;
 #endif
 #ifdef DEBUGGING
        SvREFCNT(sv) = 0;
 #endif
-       /* Must always set typemask because it's awlays checked in on cleanup
+       /* Must always set typemask because it's always checked in on cleanup
           when the arenas are walked looking for objects.  */
        SvFLAGS(sv) = SVTYPEMASK;
        sv++;
           when the arenas are walked looking for objects.  */
        SvFLAGS(sv) = SVTYPEMASK;
        sv++;
@@ -462,7 +467,8 @@ do_clean_named_objs(pTHX_ SV *sv)
             SvOBJECT(GvSV(sv))) ||
             (GvAV(sv) && SvOBJECT(GvAV(sv))) ||
             (GvHV(sv) && SvOBJECT(GvHV(sv))) ||
             SvOBJECT(GvSV(sv))) ||
             (GvAV(sv) && SvOBJECT(GvAV(sv))) ||
             (GvHV(sv) && SvOBJECT(GvHV(sv))) ||
-            (GvIO(sv) && SvOBJECT(GvIO(sv))) ||
+            /* In certain rare cases GvIOp(sv) can be NULL, which would make SvOBJECT(GvIO(sv)) dereference NULL. */
+            (GvIO(sv) ? (SvFLAGS(GvIOp(sv)) & SVs_OBJECT) : 0) ||
             (GvCV(sv) && SvOBJECT(GvCV(sv))) )
        {
            DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv)));
             (GvCV(sv) && SvOBJECT(GvCV(sv))) )
        {
            DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv)));
@@ -502,10 +508,6 @@ do_clean_all(pTHX_ SV *sv)
     dVAR;
     DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) ));
     SvFLAGS(sv) |= SVf_BREAK;
     dVAR;
     DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) ));
     SvFLAGS(sv) |= SVf_BREAK;
-    if (PL_comppad == (AV*)sv) {
-       PL_comppad = NULL;
-       PL_curpad = NULL;
-    }
     SvREFCNT_dec(sv);
 }
 
     SvREFCNT_dec(sv);
 }
 
@@ -542,7 +544,8 @@ Perl_sv_clean_all(pTHX)
   memory in the last arena-set (1/2 on average).  In trade, we get
   back the 1st slot in each arena (ie 1.7% of a CV-arena, less for
   smaller types).  The recovery of the wasted space allows use of
   memory in the last arena-set (1/2 on average).  In trade, we get
   back the 1st slot in each arena (ie 1.7% of a CV-arena, less for
   smaller types).  The recovery of the wasted space allows use of
-  small arenas for large, rare body types,
+  small arenas for large, rare body types, by changing array* fields
+  in body_details_by_type[] below.
 */
 struct arena_desc {
     char       *arena;         /* the raw storage, allocated aligned */
 */
 struct arena_desc {
     char       *arena;         /* the raw storage, allocated aligned */
@@ -553,7 +556,7 @@ struct arena_desc {
 struct arena_set;
 
 /* Get the maximum number of elements in set[] such that struct arena_set
 struct arena_set;
 
 /* Get the maximum number of elements in set[] such that struct arena_set
-   will fit within PERL_ARENA_SIZE, which is probabably just under 4K, and
+   will fit within PERL_ARENA_SIZE, which is probably just under 4K, and
    therefore likely to be 1 aligned memory page.  */
 
 #define ARENAS_PER_SET  ((PERL_ARENA_SIZE - sizeof(struct arena_set*) \
    therefore likely to be 1 aligned memory page.  */
 
 #define ARENAS_PER_SET  ((PERL_ARENA_SIZE - sizeof(struct arena_set*) \
@@ -690,8 +693,8 @@ Perl_get_arena(pTHX_ size_t arena_size, U32 misc)
     Newx(adesc->arena, arena_size, char);
     adesc->size = arena_size;
     adesc->misc = misc;
     Newx(adesc->arena, arena_size, char);
     adesc->size = arena_size;
     adesc->misc = misc;
-    DEBUG_m(PerlIO_printf(Perl_debug_log, "arena %d added: %p size %d\n", 
-                         curr, (void*)adesc->arena, arena_size));
+    DEBUG_m(PerlIO_printf(Perl_debug_log, "arena %d added: %p size %"UVuf"\n", 
+                         curr, (void*)adesc->arena, (UV)arena_size));
 
     return adesc->arena;
 }
 
     return adesc->arena;
 }
@@ -784,16 +787,16 @@ are used for this, except for arena_size.
 For the sv-types that have no bodies, arenas are not used, so those
 PL_body_roots[sv_type] are unused, and can be overloaded.  In
 something of a special case, SVt_NULL is borrowed for HE arenas;
 For the sv-types that have no bodies, arenas are not used, so those
 PL_body_roots[sv_type] are unused, and can be overloaded.  In
 something of a special case, SVt_NULL is borrowed for HE arenas;
-PL_body_roots[SVt_NULL] is filled by S_more_he, but the
+PL_body_roots[HE_SVSLOT=SVt_NULL] is filled by S_more_he, but the
 bodies_by_type[SVt_NULL] slot is not used, as the table is not
 bodies_by_type[SVt_NULL] slot is not used, as the table is not
-available in hv.c,
+available in hv.c.
 
 
-PTEs also use arenas, but are never seen in Perl_sv_upgrade.
-Nonetheless, they get their own slot in bodies_by_type[SVt_NULL], so
-they can just use the same allocation semantics.  At first, PTEs were
-also overloaded to a non-body sv-type, but this yielded hard-to-find
-malloc bugs, so was simplified by claiming a new slot.  This choice
-has no consequence at this time.
+PTEs also use arenas, but are never seen in Perl_sv_upgrade. Nonetheless,
+they get their own slot in bodies_by_type[PTE_SVSLOT =SVt_IV], so they can
+just use the same allocation semantics.  At first, PTEs were also
+overloaded to a non-body sv-type, but this yielded hard-to-find malloc
+bugs, so was simplified by claiming a new slot.  This choice has no
+consequence at this time.
 
 */
 
 
 */
 
@@ -873,7 +876,7 @@ static const struct body_details bodies_by_type[] = {
       FALSE, NONV, NOARENA, FIT_ARENA(0, sizeof(HE)) },
 
     /* The bind placeholder pretends to be an RV for now.
       FALSE, NONV, NOARENA, FIT_ARENA(0, sizeof(HE)) },
 
     /* The bind placeholder pretends to be an RV for now.
-       Also it's marked as "can't upgrade" top stop anyone using it before it's
+       Also it's marked as "can't upgrade" to stop anyone using it before it's
        implemented.  */
     { 0, 0, 0, SVt_BIND, TRUE, NONV, NOARENA, 0 },
 
        implemented.  */
     { 0, 0, 0, SVt_BIND, TRUE, NONV, NOARENA, 0 },
 
@@ -891,9 +894,6 @@ static const struct body_details bodies_by_type[] = {
     { sizeof(NV), sizeof(NV), 0, SVt_NV, FALSE, HADNV, HASARENA,
       FIT_ARENA(0, sizeof(NV)) },
 
     { sizeof(NV), sizeof(NV), 0, SVt_NV, FALSE, HADNV, HASARENA,
       FIT_ARENA(0, sizeof(NV)) },
 
-    /* RVs are in the head now.  */
-    { 0, 0, 0, SVt_RV, FALSE, NONV, NOARENA, 0 },
-
     /* 8 bytes on most ILP32 with IEEE doubles */
     { sizeof(xpv_allocated),
       copy_length(XPV, xpv_len)
     /* 8 bytes on most ILP32 with IEEE doubles */
     { sizeof(xpv_allocated),
       copy_length(XPV, xpv_len)
@@ -915,7 +915,10 @@ static const struct body_details bodies_by_type[] = {
     /* 28 */
     { sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, SVt_PVMG, FALSE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
     /* 28 */
     { sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, SVt_PVMG, FALSE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
-    
+
+    /* There are plans for this  */
+    { 0, 0, 0, SVt_ORANGE, FALSE, NONV, NOARENA, 0 },
+
     /* 48 */
     { sizeof(XPVGV), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVGV)) },
     /* 48 */
     { sizeof(XPVGV), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVGV)) },
@@ -1112,6 +1115,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
     const struct body_details *new_type_details;
     const struct body_details *const old_type_details
        = bodies_by_type + old_type;
     const struct body_details *new_type_details;
     const struct body_details *const old_type_details
        = bodies_by_type + old_type;
+    SV *referant = NULL;
 
     if (new_type != SVt_PV && SvIsCOW(sv)) {
        sv_force_normal_flags(sv, 0);
 
     if (new_type != SVt_PV && SvIsCOW(sv)) {
        sv_force_normal_flags(sv, 0);
@@ -1120,11 +1124,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
     if (old_type == new_type)
        return;
 
     if (old_type == new_type)
        return;
 
-    if (old_type > new_type)
-       Perl_croak(aTHX_ "sv_upgrade from type %d down to type %d",
-               (int)old_type, (int)new_type);
-
-
     old_body = SvANY(sv);
 
     /* Copying structures onto other structures that have been neatly zeroed
     old_body = SvANY(sv);
 
     /* Copying structures onto other structures that have been neatly zeroed
@@ -1169,9 +1168,18 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
     case SVt_NULL:
        break;
     case SVt_IV:
     case SVt_NULL:
        break;
     case SVt_IV:
-       if (new_type < SVt_PVIV) {
-           new_type = (new_type == SVt_NV)
-               ? SVt_PVNV : SVt_PVIV;
+       if (SvROK(sv)) {
+           referant = SvRV(sv);
+           if (new_type < SVt_PVIV) {
+               new_type = SVt_PVIV;
+               /* FIXME to check SvROK(sv) ? SVt_PV : and fake up
+                  old_body_details */
+           }
+       } else {
+           if (new_type < SVt_PVIV) {
+               new_type = (new_type == SVt_NV)
+                   ? SVt_PVNV : SVt_PVIV;
+           }
        }
        break;
     case SVt_NV:
        }
        break;
     case SVt_NV:
@@ -1179,8 +1187,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
            new_type = SVt_PVNV;
        }
        break;
            new_type = SVt_PVNV;
        }
        break;
-    case SVt_RV:
-       break;
     case SVt_PV:
        assert(new_type > SVt_PV);
        assert(SVt_IV < SVt_PV);
     case SVt_PV:
        assert(new_type > SVt_PV);
        assert(SVt_IV < SVt_PV);
@@ -1205,6 +1211,11 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
            Perl_croak(aTHX_ "Can't upgrade %s (%" UVuf ") to %" UVuf,
                       sv_reftype(sv, 0), (UV) old_type, (UV) new_type);
     }
            Perl_croak(aTHX_ "Can't upgrade %s (%" UVuf ") to %" UVuf,
                       sv_reftype(sv, 0), (UV) old_type, (UV) new_type);
     }
+
+    if (old_type > new_type)
+       Perl_croak(aTHX_ "sv_upgrade from type %d down to type %d",
+               (int)old_type, (int)new_type);
+
     new_type_details = bodies_by_type + new_type;
 
     SvFLAGS(sv) &= ~SVTYPEMASK;
     new_type_details = bodies_by_type + new_type;
 
     SvFLAGS(sv) &= ~SVTYPEMASK;
@@ -1224,11 +1235,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
        SvANY(sv) = new_XNV();
        SvNV_set(sv, 0);
        return;
        SvANY(sv) = new_XNV();
        SvNV_set(sv, 0);
        return;
-    case SVt_RV:
-       assert(old_type == SVt_NULL);
-       SvANY(sv) = &sv->sv_u.svu_rv;
-       SvRV_set(sv, 0);
-       return;
     case SVt_PVHV:
     case SVt_PVAV:
        assert(new_type_details->body_size);
     case SVt_PVHV:
     case SVt_PVAV:
        assert(new_type_details->body_size);
@@ -1250,13 +1256,36 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
            AvMAX(sv)   = -1;
            AvFILLp(sv) = -1;
            AvREAL_only(sv);
            AvMAX(sv)   = -1;
            AvFILLp(sv) = -1;
            AvREAL_only(sv);
+           if (old_type_details->body_size) {
+               AvALLOC(sv) = 0;
+           } else {
+               /* It will have been zeroed when the new body was allocated.
+                  Lets not write to it, in case it confuses a write-back
+                  cache.  */
+           }
+       } else {
+           assert(!SvOK(sv));
+           SvOK_off(sv);
+#ifndef NODEFAULT_SHAREKEYS
+           HvSHAREKEYS_on(sv);         /* key-sharing on by default */
+#endif
+           HvMAX(sv) = 7; /* (start with 8 buckets) */
+           if (old_type_details->body_size) {
+               HvFILL(sv) = 0;
+           } else {
+               /* It will have been zeroed when the new body was allocated.
+                  Lets not write to it, in case it confuses a write-back
+                  cache.  */
+           }
        }
 
        /* SVt_NULL isn't the only thing upgraded to AV or HV.
           The target created by newSVrv also is, and it can have magic.
           However, it never has SvPVX set.
        */
        }
 
        /* SVt_NULL isn't the only thing upgraded to AV or HV.
           The target created by newSVrv also is, and it can have magic.
           However, it never has SvPVX set.
        */
-       if (old_type >= SVt_RV) {
+       if (old_type == SVt_IV) {
+           assert(!SvROK(sv));
+       } else if (old_type >= SVt_PV) {
            assert(SvPVX_const(sv) == 0);
        }
 
            assert(SvPVX_const(sv) == 0);
        }
 
@@ -1327,8 +1356,11 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
 
        if (new_type == SVt_PVIO)
            IoPAGE_LEN(sv) = 60;
 
        if (new_type == SVt_PVIO)
            IoPAGE_LEN(sv) = 60;
-       if (old_type < SVt_RV)
-           SvPV_set(sv, NULL);
+       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;
+       }
        break;
     default:
        Perl_croak(aTHX_ "panic: sv_upgrade to unknown type %lu",
        break;
     default:
        Perl_croak(aTHX_ "panic: sv_upgrade to unknown type %lu",
@@ -1461,12 +1493,9 @@ Perl_sv_setiv(pTHX_ register SV *sv, IV i)
     SV_CHECK_THINKFIRST_COW_DROP(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
     SV_CHECK_THINKFIRST_COW_DROP(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
-       sv_upgrade(sv, SVt_IV);
-       break;
     case SVt_NV:
     case SVt_NV:
-       sv_upgrade(sv, SVt_PVNV);
+       sv_upgrade(sv, SVt_IV);
        break;
        break;
-    case SVt_RV:
     case SVt_PV:
        sv_upgrade(sv, SVt_PVIV);
        break;
     case SVt_PV:
        sv_upgrade(sv, SVt_PVIV);
        break;
@@ -1564,7 +1593,6 @@ Perl_sv_setnv(pTHX_ register SV *sv, NV num)
     case SVt_IV:
        sv_upgrade(sv, SVt_NV);
        break;
     case SVt_IV:
        sv_upgrade(sv, SVt_NV);
        break;
-    case SVt_RV:
     case SVt_PV:
     case SVt_PVIV:
        sv_upgrade(sv, SVt_PVNV);
     case SVt_PV:
     case SVt_PVIV:
        sv_upgrade(sv, SVt_PVNV);
@@ -2499,6 +2527,29 @@ Perl_sv_2nv(pTHX_ register SV *sv)
     return SvNVX(sv);
 }
 
     return SvNVX(sv);
 }
 
+/*
+=for apidoc sv_2num
+
+Return an SV with the numeric value of the source SV, doing any necessary
+reference or overload conversion.  You must use the C<SvNUM(sv)> macro to
+access this function.
+
+=cut
+*/
+
+SV *
+Perl_sv_2num(pTHX_ register SV *sv)
+{
+    if (!SvROK(sv))
+       return sv;
+    if (SvAMAGIC(sv)) {
+       SV * const tmpsv = AMG_CALLun(sv,numer);
+       if (tmpsv && (!SvROK(tmpsv) || (SvRV(tmpsv) != SvRV(sv))))
+           return sv_2num(tmpsv);
+    }
+    return sv_2mortal(newSVuv(PTR2UV(SvRV(sv))));
+}
+
 /* uiv_2buf(): private routine for use by sv_2pv_flags(): print an IV or
  * UV as a string towards the end of buf, and return pointers to start and
  * end of it.
 /* uiv_2buf(): private routine for use by sv_2pv_flags(): print an IV or
  * UV as a string towards the end of buf, and return pointers to start and
  * end of it.
@@ -2738,15 +2789,16 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
        const U32 isUIOK = SvIsUV(sv);
        char buf[TYPE_CHARS(UV)];
        char *ebuf, *ptr;
        const U32 isUIOK = SvIsUV(sv);
        char buf[TYPE_CHARS(UV)];
        char *ebuf, *ptr;
+       STRLEN len;
 
        if (SvTYPE(sv) < SVt_PVIV)
            sv_upgrade(sv, SVt_PVIV);
        ptr = uiv_2buf(buf, SvIVX(sv), SvUVX(sv), isUIOK, &ebuf);
 
        if (SvTYPE(sv) < SVt_PVIV)
            sv_upgrade(sv, SVt_PVIV);
        ptr = uiv_2buf(buf, SvIVX(sv), SvUVX(sv), isUIOK, &ebuf);
+       len = ebuf - ptr;
        /* inlined from sv_setpvn */
        /* inlined from sv_setpvn */
-       SvGROW_mutable(sv, (STRLEN)(ebuf - ptr + 1));
-       Move(ptr,SvPVX_mutable(sv),ebuf - ptr,char);
-       SvCUR_set(sv, ebuf - ptr);
-       s = SvEND(sv);
+       s = SvGROW_mutable(sv, len + 1);
+       Move(ptr, s, len, char);
+       s += len;
        *s = '\0';
     }
     else if (SvNOKp(sv)) {
        *s = '\0';
     }
     else if (SvNOKp(sv)) {
@@ -2766,8 +2818,10 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
        }
        errno = olderrno;
 #ifdef FIXNEGATIVEZERO
        }
        errno = olderrno;
 #ifdef FIXNEGATIVEZERO
-        if (*s == '-' && s[1] == '0' && !s[2])
-           my_strlcpy(s, "0", SvLEN(s));
+        if (*s == '-' && s[1] == '0' && !s[2]) {
+           s[0] = '0';
+           s[1] = 0;
+       }
 #endif
        while (*s) s++;
 #ifdef hcx
 #endif
        while (*s) s++;
 #ifdef hcx
@@ -3149,6 +3203,8 @@ copy-ish functions and macros use this underneath.
 static void
 S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype)
 {
 static void
 S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype)
 {
+    I32 mro_changes = 0; /* 1 = method, 2 = isa */
+
     if (dtype != SVt_PVGV) {
        const char * const name = GvNAME(sstr);
        const STRLEN len = GvNAMELEN(sstr);
     if (dtype != SVt_PVGV) {
        const char * const name = GvNAME(sstr);
        const STRLEN len = GvNAMELEN(sstr);
@@ -3178,6 +3234,28 @@ S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype)
     }
 #endif
 
     }
 #endif
 
+    if(GvGP((GV*)sstr)) {
+        /* If source has method cache entry, clear it */
+        if(GvCVGEN(sstr)) {
+            SvREFCNT_dec(GvCV(sstr));
+            GvCV(sstr) = NULL;
+            GvCVGEN(sstr) = 0;
+        }
+        /* If source has a real method, then a method is
+           going to change */
+        else if(GvCV((GV*)sstr)) {
+            mro_changes = 1;
+        }
+    }
+
+    /* If dest already had a real method, that's a change as well */
+    if(!mro_changes && GvGP((GV*)dstr) && GvCVu((GV*)dstr)) {
+        mro_changes = 1;
+    }
+
+    if(strEQ(GvNAME((GV*)dstr),"ISA"))
+        mro_changes = 2;
+
     gp_free((GV*)dstr);
     isGV_with_GP_off(dstr);
     (void)SvOK_off(dstr);
     gp_free((GV*)dstr);
     isGV_with_GP_off(dstr);
     (void)SvOK_off(dstr);
@@ -3192,6 +3270,8 @@ S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype)
            GvIMPORTED_on(dstr);
        }
     GvMULTI_on(dstr);
            GvIMPORTED_on(dstr);
        }
     GvMULTI_on(dstr);
+    if(mro_changes == 2) mro_isa_changed_in(GvSTASH(dstr));
+    else if(mro_changes) mro_method_changed_in(GvSTASH(dstr));
     return;
 }
 
     return;
 }
 
@@ -3241,18 +3321,18 @@ S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr) {
     common:
        if (intro) {
            if (stype == SVt_PVCV) {
     common:
        if (intro) {
            if (stype == SVt_PVCV) {
-               if (GvCVGEN(dstr) && GvCV(dstr) != (CV*)sref) {
+               /*if (GvCVGEN(dstr) && (GvCV(dstr) != (CV*)sref || GvCVGEN(dstr))) {*/
+               if (GvCVGEN(dstr)) {
                    SvREFCNT_dec(GvCV(dstr));
                    GvCV(dstr) = NULL;
                    GvCVGEN(dstr) = 0; /* Switch off cacheness. */
                    SvREFCNT_dec(GvCV(dstr));
                    GvCV(dstr) = NULL;
                    GvCVGEN(dstr) = 0; /* Switch off cacheness. */
-                   PL_sub_generation++;
                }
            }
            SAVEGENERICSV(*location);
        }
        else
            dref = *location;
                }
            }
            SAVEGENERICSV(*location);
        }
        else
            dref = *location;
-       if (stype == SVt_PVCV && *location != sref) {
+       if (stype == SVt_PVCV && (*location != sref || GvCVGEN(dstr))) {
            CV* const cv = (CV*)*location;
            if (cv) {
                if (!GvCVGEN((GV*)dstr) &&
            CV* const cv = (CV*)*location;
            if (cv) {
                if (!GvCVGEN((GV*)dstr) &&
@@ -3291,7 +3371,7 @@ S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr) {
            }
            GvCVGEN(dstr) = 0; /* Switch off cacheness. */
            GvASSUMECV_on(dstr);
            }
            GvCVGEN(dstr) = 0; /* Switch off cacheness. */
            GvASSUMECV_on(dstr);
-           PL_sub_generation++;
+           if(GvSTASH(dstr)) mro_method_changed_in(GvSTASH(dstr)); /* sub foo { 1 } sub bar { 2 } *bar = \&foo */
        }
        *location = sref;
        if (import_flag && !(GvFLAGS(dstr) & import_flag)
        }
        *location = sref;
        if (import_flag && !(GvFLAGS(dstr) & import_flag)
@@ -3356,7 +3436,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                sv_upgrade(dstr, SVt_IV);
                break;
            case SVt_NV:
                sv_upgrade(dstr, SVt_IV);
                break;
            case SVt_NV:
-           case SVt_RV:
            case SVt_PV:
                sv_upgrade(dstr, SVt_PVIV);
                break;
            case SVt_PV:
                sv_upgrade(dstr, SVt_PVIV);
                break;
@@ -3374,7 +3453,11 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            assert(!SvTAINTED(sstr));
            return;
        }
            assert(!SvTAINTED(sstr));
            return;
        }
-       goto undef_sstr;
+       if (!SvROK(sstr))
+           goto undef_sstr;
+       if (dtype < SVt_PV && dtype != SVt_IV)
+           sv_upgrade(dstr, SVt_IV);
+       break;
 
     case SVt_NV:
        if (SvNOK(sstr)) {
 
     case SVt_NV:
        if (SvNOK(sstr)) {
@@ -3383,7 +3466,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            case SVt_IV:
                sv_upgrade(dstr, SVt_NV);
                break;
            case SVt_IV:
                sv_upgrade(dstr, SVt_NV);
                break;
-           case SVt_RV:
            case SVt_PV:
            case SVt_PVIV:
                sv_upgrade(dstr, SVt_PVNV);
            case SVt_PV:
            case SVt_PVIV:
                sv_upgrade(dstr, SVt_PVNV);
@@ -3402,10 +3484,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
        }
        goto undef_sstr;
 
        }
        goto undef_sstr;
 
-    case SVt_RV:
-       if (dtype < SVt_RV)
-           sv_upgrade(dstr, SVt_RV);
-       break;
     case SVt_PVFM:
 #ifdef PERL_OLD_COPY_ON_WRITE
        if ((SvFLAGS(sstr) & CAN_COW_MASK) == CAN_COW_FLAGS) {
     case SVt_PVFM:
 #ifdef PERL_OLD_COPY_ON_WRITE
        if ((SvFLAGS(sstr) & CAN_COW_MASK) == CAN_COW_FLAGS) {
@@ -3507,7 +3585,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
        }
 
        if (dtype >= SVt_PV) {
        }
 
        if (dtype >= SVt_PV) {
-           if (dtype == SVt_PVGV) {
+           if (dtype == SVt_PVGV && isGV_with_GP(dstr)) {
                glob_assign_ref(dstr, sstr);
                return;
            }
                glob_assign_ref(dstr, sstr);
                return;
            }
@@ -3594,9 +3672,11 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                                /* and won't be needed again, potentially */
              !(PL_op && PL_op->op_type == OP_AASSIGN))
 #ifdef PERL_OLD_COPY_ON_WRITE
                                /* and won't be needed again, potentially */
              !(PL_op && PL_op->op_type == OP_AASSIGN))
 #ifdef PERL_OLD_COPY_ON_WRITE
-            && !((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
-                && (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
-                 && SvTYPE(sstr) >= SVt_PVIV)
+            && ((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))
+               : 1)
 #endif
             ) {
             /* Failed the swipe test, and it's not a shared hash key either.
 #endif
             ) {
             /* Failed the swipe test, and it's not a shared hash key either.
@@ -3976,7 +4056,7 @@ Perl_sv_usepvn_flags(pTHX_ SV *sv, char *ptr, STRLEN len, U32 flags)
     SvCUR_set(sv, len);
     SvLEN_set(sv, allocate);
     if (!(flags & SV_HAS_TRAILING_NUL)) {
     SvCUR_set(sv, len);
     SvLEN_set(sv, allocate);
     if (!(flags & SV_HAS_TRAILING_NUL)) {
-       *SvEND(sv) = '\0';
+       ptr[len] = '\0';
     }
     (void)SvPOK_only_UTF8(sv);         /* validate pointer */
     SvTAINT(sv);
     }
     (void)SvPOK_only_UTF8(sv);         /* validate pointer */
     SvTAINT(sv);
@@ -4970,13 +5050,9 @@ Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv)
 #else
     StructCopy(nsv,sv,SV);
 #endif
 #else
     StructCopy(nsv,sv,SV);
 #endif
-    /* Currently could join these into one piece of pointer arithmetic, but
-       it would be unclear.  */
-    if(SvTYPE(sv) == SVt_IV)
+    if(SvTYPE(sv) == SVt_IV) {
        SvANY(sv)
            = (XPVIV*)((char*)&(sv->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
        SvANY(sv)
            = (XPVIV*)((char*)&(sv->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
-    else if (SvTYPE(sv) == SVt_RV) {
-       SvANY(sv) = &sv->sv_u.svu_rv;
     }
        
 
     }
        
 
@@ -5029,6 +5105,7 @@ Perl_sv_clear(pTHX_ register SV *sv)
     const U32 type = SvTYPE(sv);
     const struct body_details *const sv_type_details
        = bodies_by_type + type;
     const U32 type = SvTYPE(sv);
     const struct body_details *const sv_type_details
        = bodies_by_type + type;
+    HV *stash;
 
     assert(sv);
     assert(SvREFCNT(sv) == 0);
 
     assert(sv);
     assert(SvREFCNT(sv) == 0);
@@ -5037,11 +5114,22 @@ Perl_sv_clear(pTHX_ register SV *sv)
        /* See the comment in sv.h about the collusion between this early
           return and the overloading of the NULL and IV slots in the size
           table.  */
        /* See the comment in sv.h about the collusion between this early
           return and the overloading of the NULL and IV slots in the size
           table.  */
+       if (SvROK(sv)) {
+           SV * const target = SvRV(sv);
+           if (SvWEAKREF(sv))
+               sv_del_backref(target, sv);
+           else
+               SvREFCNT_dec(target);
+       }
+       SvFLAGS(sv) &= SVf_BREAK;
+       SvFLAGS(sv) |= SVTYPEMASK;
        return;
     }
 
     if (SvOBJECT(sv)) {
        return;
     }
 
     if (SvOBJECT(sv)) {
-       if (PL_defstash) {              /* Still have a symbol table? */
+       if (PL_defstash &&      /* Still have a symbol table? */
+           SvDESTROYABLE(sv))
+       {
            dSP;
            HV* stash;
            do {        
            dSP;
            HV* stash;
            do {        
@@ -5124,6 +5212,10 @@ Perl_sv_clear(pTHX_ register SV *sv)
        hv_undef((HV*)sv);
        break;
     case SVt_PVAV:
        hv_undef((HV*)sv);
        break;
     case SVt_PVAV:
+       if (PL_comppad == (AV*)sv) {
+           PL_comppad = NULL;
+           PL_curpad = NULL;
+       }
        av_undef((AV*)sv);
        break;
     case SVt_PVLV:
        av_undef((AV*)sv);
        break;
     case SVt_PVLV:
@@ -5136,14 +5228,21 @@ Perl_sv_clear(pTHX_ register SV *sv)
            SvREFCNT_dec(LvTARG(sv));
     case SVt_PVGV:
        if (isGV_with_GP(sv)) {
            SvREFCNT_dec(LvTARG(sv));
     case SVt_PVGV:
        if (isGV_with_GP(sv)) {
+            if(GvCVu((GV*)sv) && (stash = GvSTASH((GV*)sv)) && HvNAME_get(stash))
+                mro_method_changed_in(stash);
            gp_free((GV*)sv);
            if (GvNAME_HEK(sv))
                unshare_hek(GvNAME_HEK(sv));
            gp_free((GV*)sv);
            if (GvNAME_HEK(sv))
                unshare_hek(GvNAME_HEK(sv));
-       /* If we're in a stash, we don't own a reference to it. However it does
-          have a back reference to us, which needs to be cleared.  */
-       if (!SvVALID(sv) && GvSTASH(sv))
-               sv_del_backref((SV*)GvSTASH(sv), sv);
-       }
+           /* If we're in a stash, we don't own a reference to it. However it does
+              have a back reference to us, which needs to be cleared.  */
+           if (!SvVALID(sv) && (stash = GvSTASH(sv)))
+                   sv_del_backref((SV*)stash, sv);
+       }
+       /* FIXME. There are probably more unreferenced pointers to SVs in the
+          interpreter struct that we should check and tidy in a similar
+          fashion to this:  */
+       if ((GV*)sv == PL_last_in_gv)
+           PL_last_in_gv = NULL;
     case SVt_PVMG:
     case SVt_PVNV:
     case SVt_PVIV:
     case SVt_PVMG:
     case SVt_PVNV:
     case SVt_PVIV:
@@ -5154,7 +5253,6 @@ Perl_sv_clear(pTHX_ register SV *sv)
            /* Don't even bother with turning off the OOK flag.  */
        }
     case SVt_PV:
            /* Don't even bother with turning off the OOK flag.  */
        }
     case SVt_PV:
-    case SVt_RV:
        if (SvROK(sv)) {
            SV * const target = SvRV(sv);
            if (SvWEAKREF(sv))
        if (SvROK(sv)) {
            SV * const target = SvRV(sv);
            if (SvWEAKREF(sv))
@@ -5261,6 +5359,10 @@ Perl_sv_free(pTHX_ SV *sv)
                         pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE);
 #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
            Perl_dump_sv_child(aTHX_ sv);
                         pTHX__FORMAT, PTR2UV(sv) pTHX__VALUE);
 #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
            Perl_dump_sv_child(aTHX_ sv);
+#else
+  #ifdef DEBUG_LEAKING_SCALARS
+       sv_dump(sv);
+  #endif
 #endif
        }
        return;
 #endif
        }
        return;
@@ -5350,7 +5452,7 @@ Perl_sv_len_utf8(pTHX_ register SV *sv)
 
        if (PL_utf8cache) {
            STRLEN ulen;
 
        if (PL_utf8cache) {
            STRLEN ulen;
-           MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : 0;
+           MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL;
 
            if (mg && mg->mg_len != -1) {
                ulen = mg->mg_len;
 
            if (mg && mg->mg_len != -1) {
                ulen = mg->mg_len;
@@ -7012,11 +7114,11 @@ Perl_newSVhek(pTHX_ const HEK *hek)
 
 Creates a new SV with its SvPVX_const pointing to a shared string in the string
 table. If the string does not already exist in the table, it is created
 
 Creates a new SV with its SvPVX_const pointing to a shared string in the string
 table. If the string does not already exist in the table, it is created
-first.  Turns on READONLY and FAKE.  The string's hash is stored in the UV
-slot of the SV; if the C<hash> parameter is non-zero, that value is used;
-otherwise the hash is computed.  The idea here is that as the string table
-is used for shared hash keys these strings will have SvPVX_const == HeKEY and
-hash lookup will avoid string compare.
+first.  Turns on READONLY and FAKE. If the C<hash> parameter is non-zero, that
+value is used; otherwise the hash is computed. The string's hash can be later
+be retrieved from the SV with the C<SvSHARED_HASH()> macro. The idea here is
+that as the string table is used for shared hash keys these strings will have
+SvPVX_const == HeKEY and hash lookup will avoid string compare.
 
 =cut
 */
 
 =cut
 */
@@ -7169,7 +7271,7 @@ Perl_newSVuv(pTHX_ UV u)
 /*
 =for apidoc newSV_type
 
 /*
 =for apidoc newSV_type
 
-Creates a new SV, of the type specificied.  The reference count for the new SV
+Creates a new SV, of the type specified.  The reference count for the new SV
 is set to 1.
 
 =cut
 is set to 1.
 
 =cut
@@ -7198,7 +7300,7 @@ SV *
 Perl_newRV_noinc(pTHX_ SV *tmpRef)
 {
     dVAR;
 Perl_newRV_noinc(pTHX_ SV *tmpRef)
 {
     dVAR;
-    register SV *sv = newSV_type(SVt_RV);
+    register SV *sv = newSV_type(SVt_IV);
     SvTEMP_off(tmpRef);
     SvRV_set(sv, tmpRef);
     SvROK_on(sv);
     SvTEMP_off(tmpRef);
     SvRV_set(sv, tmpRef);
     SvROK_on(sv);
@@ -7267,10 +7369,17 @@ Perl_sv_reset(pTHX_ register const char *s, HV *stash)
     if (!*s) {         /* reset ?? searches */
        MAGIC * const mg = mg_find((SV *)stash, PERL_MAGIC_symtab);
        if (mg) {
     if (!*s) {         /* reset ?? searches */
        MAGIC * const mg = mg_find((SV *)stash, PERL_MAGIC_symtab);
        if (mg) {
-           PMOP *pm = (PMOP *) mg->mg_obj;
-           while (pm) {
-               pm->op_pmdynflags &= ~PMdf_USED;
-               pm = pm->op_pmnext;
+           const U32 count = mg->mg_len / sizeof(PMOP**);
+           PMOP **pmp = (PMOP**) mg->mg_ptr;
+           PMOP *const *const end = pmp + count;
+
+           while (pmp < end) {
+#ifdef USE_ITHREADS
+                SvREADONLY_off(PL_regex_pad[(*pmp)->op_pmoffset]);
+#else
+               (*pmp)->op_pmflags &= ~PMf_USED;
+#endif
+               ++pmp;
            }
        }
        return;
            }
        }
        return;
@@ -7567,7 +7676,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags)
            SvGROW(sv, len + 1);
            Move(s,SvPVX(sv),len,char);
            SvCUR_set(sv, len);
            SvGROW(sv, len + 1);
            Move(s,SvPVX(sv),len,char);
            SvCUR_set(sv, len);
-           *SvEND(sv) = '\0';
+           SvPVX(sv)[len] = '\0';
        }
        if (!SvPOK(sv)) {
            SvPOK_on(sv);               /* validate pointer */
        }
        if (!SvPOK(sv)) {
            SvPOK_on(sv);               /* validate pointer */
@@ -7635,7 +7744,6 @@ Perl_sv_reftype(pTHX_ const SV *sv, int ob)
        case SVt_NULL:
        case SVt_IV:
        case SVt_NV:
        case SVt_NULL:
        case SVt_IV:
        case SVt_NV:
-       case SVt_RV:
        case SVt_PV:
        case SVt_PVIV:
        case SVt_PVNV:
        case SVt_PV:
        case SVt_PVIV:
        case SVt_PVNV:
@@ -7746,12 +7854,12 @@ Perl_newSVrv(pTHX_ SV *rv, const char *classname)
        SvFLAGS(rv) = 0;
        SvREFCNT(rv) = refcnt;
 
        SvFLAGS(rv) = 0;
        SvREFCNT(rv) = refcnt;
 
-       sv_upgrade(rv, SVt_RV);
+       sv_upgrade(rv, SVt_IV);
     } else if (SvROK(rv)) {
        SvREFCNT_dec(SvRV(rv));
     } else if (SvROK(rv)) {
        SvREFCNT_dec(SvRV(rv));
-    } else if (SvTYPE(rv) < SVt_RV)
-       sv_upgrade(rv, SVt_RV);
-    else if (SvTYPE(rv) > SVt_RV) {
+    } else if (SvTYPE(rv) < SVt_PV && SvTYPE(rv) != SVt_IV)
+       sv_upgrade(rv, SVt_IV);
+    else if (SvTYPE(rv) >= SVt_PV) {
        SvPV_free(rv);
        SvCUR_set(rv, 0);
        SvLEN_set(rv, 0);
        SvPV_free(rv);
        SvCUR_set(rv, 0);
        SvLEN_set(rv, 0);
@@ -7897,6 +8005,8 @@ Perl_sv_bless(pTHX_ SV *sv, HV *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(aTHX_ PL_no_modify);
        if (SvOBJECT(tmpRef)) {
        if (SvREADONLY(tmpRef))
            Perl_croak(aTHX_ PL_no_modify);
        if (SvOBJECT(tmpRef)) {
@@ -7933,6 +8043,7 @@ S_sv_unglob(pTHX_ SV *sv)
 {
     dVAR;
     void *xpvmg;
 {
     dVAR;
     void *xpvmg;
+    HV *stash;
     SV * const temp = sv_newmortal();
 
     assert(SvTYPE(sv) == SVt_PVGV);
     SV * const temp = sv_newmortal();
 
     assert(SvTYPE(sv) == SVt_PVGV);
@@ -7940,6 +8051,8 @@ S_sv_unglob(pTHX_ SV *sv)
     gv_efullname3(temp, (GV *) sv, "*");
 
     if (GvGP(sv)) {
     gv_efullname3(temp, (GV *) sv, "*");
 
     if (GvGP(sv)) {
+        if(GvCVu((GV*)sv) && (stash = GvSTASH((GV*)sv)) && HvNAME_get(stash))
+            mro_method_changed_in(stash);
        gp_free((GV*)sv);
     }
     if (GvSTASH(sv)) {
        gp_free((GV*)sv);
     }
     if (GvSTASH(sv)) {
@@ -8544,10 +8657,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                %p              include pointer address (standard)      
                %-p     (SVf)   include an SV (previously %_)
                %-<num>p        include an SV with precision <num>      
                %p              include pointer address (standard)      
                %-p     (SVf)   include an SV (previously %_)
                %-<num>p        include an SV with precision <num>      
-               %1p     (VDf)   include a v-string (as %vd)
                %<num>p         reserved for future extensions
 
        Robin Barker 2005-07-14
                %<num>p         reserved for future extensions
 
        Robin Barker 2005-07-14
+
+               %1p     (VDf)   removed.  RMB 2007-10-19
 */
            char* r = q; 
            bool sv = FALSE;    
 */
            char* r = q; 
            bool sv = FALSE;    
@@ -8562,18 +8676,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                        has_precis = TRUE;
                    }
                    argsv = (SV*)va_arg(*args, void*);
                        has_precis = TRUE;
                    }
                    argsv = (SV*)va_arg(*args, void*);
-                   eptr = SvPVx_const(argsv, elen);
+                   eptr = SvPV_const(argsv, elen);
                    if (DO_UTF8(argsv))
                        is_utf8 = TRUE;
                    goto string;
                }
                    if (DO_UTF8(argsv))
                        is_utf8 = TRUE;
                    goto string;
                }
-#if vdNUMBER
-               else if (n == vdNUMBER) {       /* VDf */
-                   vectorize = TRUE;
-                   VECTORIZE_ARGS
-                   goto format_vd;
-               }
-#endif
                else if (n) {
                    if (ckWARN_d(WARN_INTERNAL))
                        Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
                else if (n) {
                    if (ckWARN_d(WARN_INTERNAL))
                        Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
@@ -8694,12 +8801,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                        goto unknown;
                    }
                    vecsv = sv_newmortal();
                        goto unknown;
                    }
                    vecsv = sv_newmortal();
-                   /* scan_vstring is expected to be called during
-                    * tokenization, so we need to fake up the end
-                    * of the buffer for it
-                    */
-                   PL_bufend = version + veclen;
-                   scan_vstring(version, vecsv);
+                   scan_vstring(version, version + veclen, vecsv);
                    vecstr = (U8*)SvPV_const(vecsv, veclen);
                    vec_utf8 = DO_UTF8(vecsv);
                    Safefree(version);
                    vecstr = (U8*)SvPV_const(vecsv, veclen);
                    vec_utf8 = DO_UTF8(vecsv);
                    Safefree(version);
@@ -8826,7 +8928,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        case 'c':
            if (vectorize)
                goto unknown;
        case 'c':
            if (vectorize)
                goto unknown;
-           uv = (args) ? va_arg(*args, int) : SvIVx(argsv);
+           uv = (args) ? va_arg(*args, int) : SvIV(argsv);
            if ((uv > 255 ||
                 (!UNI_IS_INVARIANT(uv) && SvUTF8(sv)))
                && !IN_BYTES) {
            if ((uv > 255 ||
                 (!UNI_IS_INVARIANT(uv) && SvUTF8(sv)))
                && !IN_BYTES) {
@@ -8860,7 +8962,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                }
            }
            else {
                }
            }
            else {
-               eptr = SvPVx_const(argsv, elen);
+               eptr = SvPV_const(argsv, elen);
                if (DO_UTF8(argsv)) {
                    I32 old_precis = precis;
                    if (has_precis && precis < elen) {
                if (DO_UTF8(argsv)) {
                    I32 old_precis = precis;
                    if (has_precis && precis < elen) {
@@ -8932,7 +9034,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                }
            }
            else {
                }
            }
            else {
-               IV tiv = SvIVx(argsv); /* work around GCC bug #13488 */
+               IV tiv = SvIV(argsv); /* work around GCC bug #13488 */
                switch (intsize) {
                case 'h':       iv = (short)tiv; break;
                case 'l':       iv = (long)tiv; break;
                switch (intsize) {
                case 'h':       iv = (short)tiv; break;
                case 'l':       iv = (long)tiv; break;
@@ -9017,7 +9119,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                }
            }
            else {
                }
            }
            else {
-               UV tuv = SvUVx(argsv); /* work around GCC bug #13488 */
+               UV tuv = SvUV(argsv); /* work around GCC bug #13488 */
                switch (intsize) {
                case 'h':       uv = (unsigned short)tuv; break;
                case 'l':       uv = (unsigned long)tuv; break;
                switch (intsize) {
                case 'h':       uv = (unsigned short)tuv; break;
                case 'l':       uv = (unsigned long)tuv; break;
@@ -9139,10 +9241,12 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 #else
                    va_arg(*args, double)
 #endif
 #else
                    va_arg(*args, double)
 #endif
-               : SvNVx(argsv);
+               : SvNV(argsv);
 
            need = 0;
 
            need = 0;
-           if (c != 'e' && c != 'E') {
+           /* nv * 0 will be NaN for NaN, +Inf and -Inf, and 0 for anything
+              else. frexp() has some unspecified behaviour for those three */
+           if (c != 'e' && c != 'E' && (nv * 0) == 0) {
                i = PERL_INT_MIN;
                /* FIXME: if HAS_LONG_DOUBLE but not USE_LONG_DOUBLE this
                   will cast our (long double) to (double) */
                i = PERL_INT_MIN;
                /* FIXME: if HAS_LONG_DOUBLE but not USE_LONG_DOUBLE this
                   will cast our (long double) to (double) */
@@ -9443,7 +9547,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 All the macros and functions in this section are for the private use of
 the main function, perl_clone().
 
 All the macros and functions in this section are for the private use of
 the main function, perl_clone().
 
-The foo_dup() functions make an exact copy of an existing foo thinngy.
+The foo_dup() functions make an exact copy of an existing foo thingy.
 During the course of a cloning, a hash table is used to map old addresses
 to new addresses. The table is created and manipulated with the
 ptr_table_* functions.
 During the course of a cloning, a hash table is used to map old addresses
 to new addresses. The table is created and manipulated with the
 ptr_table_* functions.
@@ -9529,9 +9633,47 @@ Perl_parser_dup(pTHX_ const yy_parser *proto, CLONE_PARAMS* param)
     parser->multi_close        = proto->multi_close;
     parser->multi_open = proto->multi_open;
     parser->multi_start        = proto->multi_start;
     parser->multi_close        = proto->multi_close;
     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->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->expect     = proto->expect;
+    parser->copline    = proto->copline;
+    parser->last_lop_op        = proto->last_lop_op;
+    parser->lex_state  = proto->lex_state;
+    parser->rsfp       = fp_dup(proto->rsfp, '<', param);
+    /* rsfp_filters entries have fake IoDIRP() */
+    parser->rsfp_filters= av_dup_inc(proto->rsfp_filters, param);
+    parser->in_my      = proto->in_my;
+    parser->in_my_stash        = hv_dup(proto->in_my_stash, param);
+    parser->error_count        = proto->error_count;
+
+
+    parser->linestr    = sv_dup_inc(proto->linestr, param);
+
+    {
+       char * const ols = SvPVX(proto->linestr);
+       char * const ls  = SvPVX(parser->linestr);
+
+       parser->bufptr      = ls + (proto->bufptr >= ols ?
+                                   proto->bufptr -  ols : 0);
+       parser->oldbufptr   = ls + (proto->oldbufptr >= ols ?
+                                   proto->oldbufptr -  ols : 0);
+       parser->oldoldbufptr= ls + (proto->oldoldbufptr >= ols ?
+                                   proto->oldoldbufptr -  ols : 0);
+       parser->linestart   = ls + (proto->linestart >= ols ?
+                                   proto->linestart -  ols : 0);
+       parser->last_uni    = ls + (proto->last_uni >= ols ?
+                                   proto->last_uni -  ols : 0);
+       parser->last_lop    = ls + (proto->last_lop >= ols ?
+                                   proto->last_lop -  ols : 0);
+
+       parser->bufend      = ls + SvCUR(parser->linestr);
+    }
+
+    Copy(proto->tokenbuf, parser->tokenbuf, 256, char);
+
 
 #ifdef PERL_MAD
     parser->endwhite   = proto->endwhite;
 
 #ifdef PERL_MAD
     parser->endwhite   = proto->endwhite;
@@ -9546,6 +9688,13 @@ Perl_parser_dup(pTHX_ const yy_parser *proto, CLONE_PARAMS* param)
     parser->thisstuff  = proto->thisstuff;
     parser->thistoken  = proto->thistoken;
     parser->thiswhite  = proto->thiswhite;
     parser->thisstuff  = proto->thisstuff;
     parser->thistoken  = proto->thistoken;
     parser->thiswhite  = proto->thiswhite;
+
+    Copy(proto->nexttoke, parser->nexttoke, 5, NEXTTOKE);
+    parser->curforce   = proto->curforce;
+#else
+    Copy(proto->nextval, parser->nextval, 5, YYSTYPE);
+    Copy(proto->nexttype, parser->nexttype, 5, I32);
+    parser->nexttoke   = proto->nexttoke;
 #endif
     return parser;
 }
 #endif
     return parser;
 }
@@ -9652,9 +9801,6 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS* param)
               1.  */
            nmg->mg_obj = SvREFCNT_inc(av_dup_inc((AV*) mg->mg_obj, param));
        }
               1.  */
            nmg->mg_obj = SvREFCNT_inc(av_dup_inc((AV*) mg->mg_obj, param));
        }
-       else if (mg->mg_type == PERL_MAGIC_symtab) {
-           nmg->mg_obj = mg->mg_obj;
-       }
        else {
            nmg->mg_obj = (mg->mg_flags & MGf_REFCOUNTED)
                              ? sv_dup_inc(mg->mg_obj, param)
        else {
            nmg->mg_obj = (mg->mg_flags & MGf_REFCOUNTED)
                              ? sv_dup_inc(mg->mg_obj, param)
@@ -9874,10 +10020,7 @@ Perl_rvpv_dup(pTHX_ SV *dstr, const SV *sstr, CLONE_PARAMS* param)
     }
     else {
        /* Copy the NULL */
     }
     else {
        /* Copy the NULL */
-       if (SvTYPE(dstr) == SVt_RV)
-           SvRV_set(dstr, NULL);
-       else
-           SvPV_set(dstr, NULL);
+       SvPV_set(dstr, NULL);
     }
 }
 
     }
 }
 
@@ -9900,10 +10043,10 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
         /** We are joining here so we don't want do clone
            something that is bad **/
        if (SvTYPE(sstr) == SVt_PVHV) {
         /** We are joining here so we don't want do clone
            something that is bad **/
        if (SvTYPE(sstr) == SVt_PVHV) {
-           const char * const hvname = HvNAME_get(sstr);
+           const HEK * const hvname = HvNAME_HEK(sstr);
            if (hvname)
                /** don't clone stashes if they already exist **/
            if (hvname)
                /** don't clone stashes if they already exist **/
-               return (SV*)gv_stashpv(hvname,0);
+               return (SV*)gv_stashpvn(HEK_KEY(hvname), HEK_LEN(hvname), 0);
         }
     }
 
         }
     }
 
@@ -9933,8 +10076,7 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
 
     /* don't clone objects whose class has asked us not to */
     if (SvOBJECT(sstr) && ! (SvFLAGS(SvSTASH(sstr)) & SVphv_CLONEABLE)) {
 
     /* don't clone objects whose class has asked us not to */
     if (SvOBJECT(sstr) && ! (SvFLAGS(SvSTASH(sstr)) & SVphv_CLONEABLE)) {
-       SvFLAGS(dstr) &= ~SVTYPEMASK;
-       SvOBJECT_off(dstr);
+       SvFLAGS(dstr) = 0;
        return dstr;
     }
 
        return dstr;
     }
 
@@ -9944,16 +10086,16 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
        break;
     case SVt_IV:
        SvANY(dstr)     = (XPVIV*)((char*)&(dstr->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
        break;
     case SVt_IV:
        SvANY(dstr)     = (XPVIV*)((char*)&(dstr->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
-       SvIV_set(dstr, SvIVX(sstr));
+       if(SvROK(sstr)) {
+           Perl_rvpv_dup(aTHX_ dstr, sstr, param);
+       } else {
+           SvIV_set(dstr, SvIVX(sstr));
+       }
        break;
     case SVt_NV:
        SvANY(dstr)     = new_XNV();
        SvNV_set(dstr, SvNVX(sstr));
        break;
        break;
     case SVt_NV:
        SvANY(dstr)     = new_XNV();
        SvNV_set(dstr, SvNVX(sstr));
        break;
-    case SVt_RV:
-       SvANY(dstr)     = &(dstr->sv_u.svu_rv);
-       Perl_rvpv_dup(aTHX_ dstr, sstr, param);
-       break;
        /* case SVt_BIND: */
     default:
        {
        /* case SVt_BIND: */
     default:
        {
@@ -10061,7 +10203,7 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
                    IoOFP(dstr) = IoIFP(dstr);
                else
                    IoOFP(dstr) = fp_dup(IoOFP(dstr), IoTYPE(dstr), param);
                    IoOFP(dstr) = IoIFP(dstr);
                else
                    IoOFP(dstr) = fp_dup(IoOFP(dstr), IoTYPE(dstr), param);
-               /* PL_rsfp_filters entries have fake IoDIRP() */
+               /* PL_parser->rsfp_filters entries have fake IoDIRP() */
                if(IoFLAGS(dstr) & IOf_FAKE_DIRP) {
                    /* I have no idea why fake dirp (rsfps)
                       should be treated differently but otherwise
                if(IoFLAGS(dstr) & IOf_FAKE_DIRP) {
                    /* I have no idea why fake dirp (rsfps)
                       should be treated differently but otherwise
@@ -10149,6 +10291,11 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
                                ? (AV*) SvREFCNT_inc(
                                        sv_dup((SV*)saux->xhv_backreferences, param))
                                : 0;
                                ? (AV*) SvREFCNT_inc(
                                        sv_dup((SV*)saux->xhv_backreferences, param))
                                : 0;
+
+                        daux->xhv_mro_meta = saux->xhv_mro_meta
+                            ? mro_meta_dup(saux->xhv_mro_meta, param)
+                            : 0;
+
                        /* Record stashes for possible cloning in Perl_clone(). */
                        if (hvname)
                            av_push(param->stashes, dstr);
                        /* Record stashes for possible cloning in Perl_clone(). */
                        if (hvname)
                            av_push(param->stashes, dstr);
@@ -10369,9 +10516,9 @@ ANY *
 Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 {
     dVAR;
 Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 {
     dVAR;
-    ANY * const ss     = proto_perl->Tsavestack;
-    const I32 max      = proto_perl->Tsavestack_max;
-    I32 ix             = proto_perl->Tsavestack_ix;
+    ANY * const ss     = proto_perl->Isavestack;
+    const I32 max      = proto_perl->Isavestack_max;
+    I32 ix             = proto_perl->Isavestack_ix;
     ANY *nss;
     SV *sv;
     GV *gv;
     ANY *nss;
     SV *sv;
     GV *gv;
@@ -10807,6 +10954,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_savestack_ix = 0;
     PL_savestack_max = -1;
     PL_sig_pending = 0;
     PL_savestack_ix = 0;
     PL_savestack_max = -1;
     PL_sig_pending = 0;
+    PL_parser = NULL;
     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
 #  else        /* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);
     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
 #  else        /* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);
@@ -10841,6 +10989,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_savestack_ix = 0;
     PL_savestack_max = -1;
     PL_sig_pending = 0;
     PL_savestack_ix = 0;
     PL_savestack_max = -1;
     PL_sig_pending = 0;
+    PL_parser = NULL;
     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
 #    else      /* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);
     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
 #    else      /* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);
@@ -10927,7 +11076,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
        PL_compiling.cop_hints_hash->refcounted_he_refcnt++;
        HINTS_REFCNT_UNLOCK;
     }
        PL_compiling.cop_hints_hash->refcounted_he_refcnt++;
        HINTS_REFCNT_UNLOCK;
     }
-    PL_curcop          = (COP*)any_dup(proto_perl->Tcurcop, proto_perl);
+    PL_curcop          = (COP*)any_dup(proto_perl->Icurcop, proto_perl);
+#ifdef PERL_DEBUG_READONLY_OPS
+    PL_slabs = NULL;
+    PL_slab_count = 0;
+#endif
 
     /* pseudo environmental stuff */
     PL_origargc                = proto_perl->Iorigargc;
 
     /* pseudo environmental stuff */
     PL_origargc                = proto_perl->Iorigargc;
@@ -11042,13 +11195,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_DBsingle                = sv_dup(proto_perl->IDBsingle, param);
     PL_DBtrace         = sv_dup(proto_perl->IDBtrace, param);
     PL_DBsignal                = sv_dup(proto_perl->IDBsignal, param);
     PL_DBsingle                = sv_dup(proto_perl->IDBsingle, param);
     PL_DBtrace         = sv_dup(proto_perl->IDBtrace, param);
     PL_DBsignal                = sv_dup(proto_perl->IDBsignal, param);
-    PL_DBassertion      = sv_dup(proto_perl->IDBassertion, param);
-    PL_lineary         = av_dup(proto_perl->Ilineary, param);
     PL_dbargs          = av_dup(proto_perl->Idbargs, param);
 
     /* symbol tables */
     PL_dbargs          = av_dup(proto_perl->Idbargs, param);
 
     /* symbol tables */
-    PL_defstash                = hv_dup_inc(proto_perl->Tdefstash, param);
-    PL_curstash                = hv_dup(proto_perl->Tcurstash, param);
+    PL_defstash                = hv_dup_inc(proto_perl->Idefstash, param);
+    PL_curstash                = hv_dup(proto_perl->Icurstash, param);
     PL_debstash                = hv_dup(proto_perl->Idebstash, param);
     PL_globalstash     = hv_dup(proto_perl->Iglobalstash, param);
     PL_curstname       = sv_dup_inc(proto_perl->Icurstname, param);
     PL_debstash                = hv_dup(proto_perl->Idebstash, param);
     PL_globalstash     = hv_dup(proto_perl->Iglobalstash, param);
     PL_curstname       = sv_dup_inc(proto_perl->Icurstname, param);
@@ -11063,6 +11214,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_initav          = av_dup_inc(proto_perl->Iinitav, param);
 
     PL_sub_generation  = proto_perl->Isub_generation;
     PL_initav          = av_dup_inc(proto_perl->Iinitav, param);
 
     PL_sub_generation  = proto_perl->Isub_generation;
+    PL_isarev          = hv_dup_inc(proto_perl->Iisarev, param);
 
     /* funky return mechanisms */
     PL_forkprocess     = proto_perl->Iforkprocess;
 
     /* funky return mechanisms */
     PL_forkprocess     = proto_perl->Iforkprocess;
@@ -11089,7 +11241,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     /* runtime control stuff */
     PL_curcopdb                = (COP*)any_dup(proto_perl->Icurcopdb, proto_perl);
 
     /* runtime control stuff */
     PL_curcopdb                = (COP*)any_dup(proto_perl->Icurcopdb, proto_perl);
-    PL_copline         = proto_perl->Icopline;
 
     PL_filemode                = proto_perl->Ifilemode;
     PL_lastfd          = proto_perl->Ilastfd;
 
     PL_filemode                = proto_perl->Ifilemode;
     PL_lastfd          = proto_perl->Ilastfd;
@@ -11133,9 +11284,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_custom_op_descs  = hv_dup_inc(proto_perl->Icustom_op_descs,param);
 
     PL_profiledata     = NULL;
     PL_custom_op_descs  = hv_dup_inc(proto_perl->Icustom_op_descs,param);
 
     PL_profiledata     = NULL;
-    PL_rsfp            = fp_dup(proto_perl->Irsfp, '<', param);
-    /* PL_rsfp_filters entries have fake IoDIRP() */
-    PL_rsfp_filters    = av_dup_inc(proto_perl->Irsfp_filters, param);
 
     PL_compcv                  = cv_dup(proto_perl->Icompcv, param);
 
 
     PL_compcv                  = cv_dup(proto_perl->Icompcv, param);
 
@@ -11169,52 +11317,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_runops          = proto_perl->Irunops;
 
 
     PL_runops          = proto_perl->Irunops;
 
-    Copy(proto_perl->Itokenbuf, PL_tokenbuf, 256, char);
-
-#ifdef CSH
-    PL_cshlen          = proto_perl->Icshlen;
-    PL_cshname         = proto_perl->Icshname; /* XXX never deallocated */
-#endif
-
     PL_parser          = parser_dup(proto_perl->Iparser, param);
 
     PL_parser          = parser_dup(proto_perl->Iparser, param);
 
-    PL_lex_state       = proto_perl->Ilex_state;
-
-#ifdef PERL_MAD
-    Copy(proto_perl->Inexttoke, PL_nexttoke, 5, NEXTTOKE);
-    PL_curforce                = proto_perl->Icurforce;
-#else
-    Copy(proto_perl->Inextval, PL_nextval, 5, YYSTYPE);
-    Copy(proto_perl->Inexttype, PL_nexttype, 5,        I32);
-    PL_nexttoke                = proto_perl->Inexttoke;
-#endif
-
-    PL_linestr         = sv_dup_inc(proto_perl->Ilinestr, param);
-    i = proto_perl->Ibufptr - SvPVX_const(proto_perl->Ilinestr);
-    PL_bufptr          = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-    i = proto_perl->Ioldbufptr - SvPVX_const(proto_perl->Ilinestr);
-    PL_oldbufptr       = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-    i = proto_perl->Ioldoldbufptr - SvPVX_const(proto_perl->Ilinestr);
-    PL_oldoldbufptr    = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-    i = proto_perl->Ilinestart - SvPVX_const(proto_perl->Ilinestr);
-    PL_linestart       = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-    PL_bufend          = SvPVX(PL_linestr) + SvCUR(PL_linestr);
-
-    PL_expect          = proto_perl->Iexpect;
-
-    PL_multi_end       = proto_perl->Imulti_end;
-
-    PL_error_count     = proto_perl->Ierror_count;
     PL_subline         = proto_perl->Isubline;
     PL_subname         = sv_dup_inc(proto_perl->Isubname, param);
 
     PL_subline         = proto_perl->Isubline;
     PL_subname         = sv_dup_inc(proto_perl->Isubname, param);
 
-    i = proto_perl->Ilast_uni - SvPVX_const(proto_perl->Ilinestr);
-    PL_last_uni                = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-    i = proto_perl->Ilast_lop - SvPVX_const(proto_perl->Ilinestr);
-    PL_last_lop                = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
-    PL_last_lop_op     = proto_perl->Ilast_lop_op;
-    PL_in_my           = proto_perl->Iin_my;
-    PL_in_my_stash     = hv_dup(proto_perl->Iin_my_stash, param);
 #ifdef FCRYPT
     PL_cryptseen       = proto_perl->Icryptseen;
 #endif
 #ifdef FCRYPT
     PL_cryptseen       = proto_perl->Icryptseen;
 #endif
@@ -11286,9 +11393,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_lockhook                = proto_perl->Ilockhook;
     PL_unlockhook      = proto_perl->Iunlockhook;
     PL_threadhook      = proto_perl->Ithreadhook;
     PL_lockhook                = proto_perl->Ilockhook;
     PL_unlockhook      = proto_perl->Iunlockhook;
     PL_threadhook      = proto_perl->Ithreadhook;
-
-    PL_runops_std      = proto_perl->Irunops_std;
-    PL_runops_dbg      = proto_perl->Irunops_dbg;
+    PL_destroyhook     = proto_perl->Idestroyhook;
 
 #ifdef THREADS_HAVE_PIDS
     PL_ppid            = proto_perl->Ippid;
 
 #ifdef THREADS_HAVE_PIDS
     PL_ppid            = proto_perl->Ippid;
@@ -11303,7 +11408,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_glob_index      = proto_perl->Iglob_index;
     PL_srand_called    = proto_perl->Isrand_called;
 
     PL_glob_index      = proto_perl->Iglob_index;
     PL_srand_called    = proto_perl->Isrand_called;
-    PL_uudmap[(U32) 'M']       = 0;    /* reinits on demand */
     PL_bitcount                = NULL; /* reinits on demand */
 
     if (proto_perl->Ipsig_pend) {
     PL_bitcount                = NULL; /* reinits on demand */
 
     if (proto_perl->Ipsig_pend) {
@@ -11326,54 +11430,54 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
        PL_psig_name    = (SV**)NULL;
     }
 
        PL_psig_name    = (SV**)NULL;
     }
 
-    /* thrdvar.h stuff */
+    /* intrpvar.h stuff */
 
     if (flags & CLONEf_COPY_STACKS) {
        /* next allocation will be PL_tmps_stack[PL_tmps_ix+1] */
 
     if (flags & CLONEf_COPY_STACKS) {
        /* next allocation will be PL_tmps_stack[PL_tmps_ix+1] */
-       PL_tmps_ix              = proto_perl->Ttmps_ix;
-       PL_tmps_max             = proto_perl->Ttmps_max;
-       PL_tmps_floor           = proto_perl->Ttmps_floor;
+       PL_tmps_ix              = proto_perl->Itmps_ix;
+       PL_tmps_max             = proto_perl->Itmps_max;
+       PL_tmps_floor           = proto_perl->Itmps_floor;
        Newxz(PL_tmps_stack, PL_tmps_max, SV*);
        i = 0;
        while (i <= PL_tmps_ix) {
        Newxz(PL_tmps_stack, PL_tmps_max, SV*);
        i = 0;
        while (i <= PL_tmps_ix) {
-           PL_tmps_stack[i]    = sv_dup_inc(proto_perl->Ttmps_stack[i], param);
+           PL_tmps_stack[i]    = sv_dup_inc(proto_perl->Itmps_stack[i], param);
            ++i;
        }
 
        /* next PUSHMARK() sets *(PL_markstack_ptr+1) */
            ++i;
        }
 
        /* next PUSHMARK() sets *(PL_markstack_ptr+1) */
-       i = proto_perl->Tmarkstack_max - proto_perl->Tmarkstack;
+       i = proto_perl->Imarkstack_max - proto_perl->Imarkstack;
        Newxz(PL_markstack, i, I32);
        Newxz(PL_markstack, i, I32);
-       PL_markstack_max        = PL_markstack + (proto_perl->Tmarkstack_max
-                                                 - proto_perl->Tmarkstack);
-       PL_markstack_ptr        = PL_markstack + (proto_perl->Tmarkstack_ptr
-                                                 - proto_perl->Tmarkstack);
-       Copy(proto_perl->Tmarkstack, PL_markstack,
+       PL_markstack_max        = PL_markstack + (proto_perl->Imarkstack_max
+                                                 - proto_perl->Imarkstack);
+       PL_markstack_ptr        = PL_markstack + (proto_perl->Imarkstack_ptr
+                                                 - proto_perl->Imarkstack);
+       Copy(proto_perl->Imarkstack, PL_markstack,
             PL_markstack_ptr - PL_markstack + 1, I32);
 
        /* next push_scope()/ENTER sets PL_scopestack[PL_scopestack_ix]
         * NOTE: unlike the others! */
             PL_markstack_ptr - PL_markstack + 1, I32);
 
        /* next push_scope()/ENTER sets PL_scopestack[PL_scopestack_ix]
         * NOTE: unlike the others! */
-       PL_scopestack_ix        = proto_perl->Tscopestack_ix;
-       PL_scopestack_max       = proto_perl->Tscopestack_max;
+       PL_scopestack_ix        = proto_perl->Iscopestack_ix;
+       PL_scopestack_max       = proto_perl->Iscopestack_max;
        Newxz(PL_scopestack, PL_scopestack_max, I32);
        Newxz(PL_scopestack, PL_scopestack_max, I32);
-       Copy(proto_perl->Tscopestack, PL_scopestack, PL_scopestack_ix, I32);
+       Copy(proto_perl->Iscopestack, PL_scopestack, PL_scopestack_ix, I32);
 
        /* NOTE: si_dup() looks at PL_markstack */
 
        /* NOTE: si_dup() looks at PL_markstack */
-       PL_curstackinfo         = si_dup(proto_perl->Tcurstackinfo, param);
+       PL_curstackinfo         = si_dup(proto_perl->Icurstackinfo, param);
 
        /* PL_curstack          = PL_curstackinfo->si_stack; */
 
        /* PL_curstack          = PL_curstackinfo->si_stack; */
-       PL_curstack             = av_dup(proto_perl->Tcurstack, param);
-       PL_mainstack            = av_dup(proto_perl->Tmainstack, param);
+       PL_curstack             = av_dup(proto_perl->Icurstack, param);
+       PL_mainstack            = av_dup(proto_perl->Imainstack, param);
 
        /* next PUSHs() etc. set *(PL_stack_sp+1) */
        PL_stack_base           = AvARRAY(PL_curstack);
 
        /* next PUSHs() etc. set *(PL_stack_sp+1) */
        PL_stack_base           = AvARRAY(PL_curstack);
-       PL_stack_sp             = PL_stack_base + (proto_perl->Tstack_sp
-                                                  - proto_perl->Tstack_base);
+       PL_stack_sp             = PL_stack_base + (proto_perl->Istack_sp
+                                                  - proto_perl->Istack_base);
        PL_stack_max            = PL_stack_base + AvMAX(PL_curstack);
 
        /* next SSPUSHFOO() sets PL_savestack[PL_savestack_ix]
         * NOTE: unlike the others! */
        PL_stack_max            = PL_stack_base + AvMAX(PL_curstack);
 
        /* next SSPUSHFOO() sets PL_savestack[PL_savestack_ix]
         * NOTE: unlike the others! */
-       PL_savestack_ix         = proto_perl->Tsavestack_ix;
-       PL_savestack_max        = proto_perl->Tsavestack_max;
+       PL_savestack_ix         = proto_perl->Isavestack_ix;
+       PL_savestack_max        = proto_perl->Isavestack_max;
        /*Newxz(PL_savestack, PL_savestack_max, ANY);*/
        PL_savestack            = ss_dup(proto_perl, param);
     }
        /*Newxz(PL_savestack, PL_savestack_max, ANY);*/
        PL_savestack            = ss_dup(proto_perl, param);
     }
@@ -11386,9 +11490,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
         * non-refcount means (eg a temp in @_); otherwise they will be
         * orphaned
         */
         * non-refcount means (eg a temp in @_); otherwise they will be
         * orphaned
         */
-       for (i = 0; i<= proto_perl->Ttmps_ix; i++) {
+       for (i = 0; i<= proto_perl->Itmps_ix; i++) {
            SV * const nsv = (SV*)ptr_table_fetch(PL_ptr_table,
            SV * const nsv = (SV*)ptr_table_fetch(PL_ptr_table,
-                   proto_perl->Ttmps_stack[i]);
+                   proto_perl->Itmps_stack[i]);
            if (nsv && !SvREFCNT(nsv)) {
                EXTEND_MORTAL(1);
                PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple(nsv);
            if (nsv && !SvREFCNT(nsv)) {
                EXTEND_MORTAL(1);
                PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple(nsv);
@@ -11396,50 +11500,50 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
        }
     }
 
        }
     }
 
-    PL_start_env       = proto_perl->Tstart_env;       /* XXXXXX */
+    PL_start_env       = proto_perl->Istart_env;       /* XXXXXX */
     PL_top_env         = &PL_start_env;
 
     PL_top_env         = &PL_start_env;
 
-    PL_op              = proto_perl->Top;
+    PL_op              = proto_perl->Iop;
 
     PL_Sv              = NULL;
     PL_Xpv             = (XPV*)NULL;
 
     PL_Sv              = NULL;
     PL_Xpv             = (XPV*)NULL;
-    PL_na              = proto_perl->Tna;
+    my_perl->Ina       = proto_perl->Ina;
 
 
-    PL_statbuf         = proto_perl->Tstatbuf;
-    PL_statcache       = proto_perl->Tstatcache;
-    PL_statgv          = gv_dup(proto_perl->Tstatgv, param);
-    PL_statname                = sv_dup_inc(proto_perl->Tstatname, param);
+    PL_statbuf         = proto_perl->Istatbuf;
+    PL_statcache       = proto_perl->Istatcache;
+    PL_statgv          = gv_dup(proto_perl->Istatgv, param);
+    PL_statname                = sv_dup_inc(proto_perl->Istatname, param);
 #ifdef HAS_TIMES
 #ifdef HAS_TIMES
-    PL_timesbuf                = proto_perl->Ttimesbuf;
+    PL_timesbuf                = proto_perl->Itimesbuf;
 #endif
 
 #endif
 
-    PL_tainted         = proto_perl->Ttainted;
-    PL_curpm           = proto_perl->Tcurpm;   /* XXX No PMOP ref count */
-    PL_rs              = sv_dup_inc(proto_perl->Trs, param);
-    PL_last_in_gv      = gv_dup(proto_perl->Tlast_in_gv, param);
-    PL_ofs_sv          = sv_dup_inc(proto_perl->Tofs_sv, param);
-    PL_defoutgv                = gv_dup_inc(proto_perl->Tdefoutgv, param);
-    PL_chopset         = proto_perl->Tchopset; /* XXX never deallocated */
-    PL_toptarget       = sv_dup_inc(proto_perl->Ttoptarget, param);
-    PL_bodytarget      = sv_dup_inc(proto_perl->Tbodytarget, param);
-    PL_formtarget      = sv_dup(proto_perl->Tformtarget, param);
-
-    PL_restartop       = proto_perl->Trestartop;
-    PL_in_eval         = proto_perl->Tin_eval;
-    PL_delaymagic      = proto_perl->Tdelaymagic;
-    PL_dirty           = proto_perl->Tdirty;
-    PL_localizing      = proto_perl->Tlocalizing;
-
-    PL_errors          = sv_dup_inc(proto_perl->Terrors, param);
+    PL_tainted         = proto_perl->Itainted;
+    PL_curpm           = proto_perl->Icurpm;   /* XXX No PMOP ref count */
+    PL_rs              = sv_dup_inc(proto_perl->Irs, param);
+    PL_last_in_gv      = gv_dup(proto_perl->Ilast_in_gv, param);
+    PL_ofs_sv          = sv_dup_inc(proto_perl->Iofs_sv, param);
+    PL_defoutgv                = gv_dup_inc(proto_perl->Idefoutgv, param);
+    PL_chopset         = proto_perl->Ichopset; /* XXX never deallocated */
+    PL_toptarget       = sv_dup_inc(proto_perl->Itoptarget, param);
+    PL_bodytarget      = sv_dup_inc(proto_perl->Ibodytarget, param);
+    PL_formtarget      = sv_dup(proto_perl->Iformtarget, param);
+
+    PL_restartop       = proto_perl->Irestartop;
+    PL_in_eval         = proto_perl->Iin_eval;
+    PL_delaymagic      = proto_perl->Idelaymagic;
+    PL_dirty           = proto_perl->Idirty;
+    PL_localizing      = proto_perl->Ilocalizing;
+
+    PL_errors          = sv_dup_inc(proto_perl->Ierrors, param);
     PL_hv_fetch_ent_mh = NULL;
     PL_hv_fetch_ent_mh = NULL;
-    PL_modcount                = proto_perl->Tmodcount;
+    PL_modcount                = proto_perl->Imodcount;
     PL_lastgotoprobe   = NULL;
     PL_lastgotoprobe   = NULL;
-    PL_dumpindent      = proto_perl->Tdumpindent;
+    PL_dumpindent      = proto_perl->Idumpindent;
 
 
-    PL_sortcop         = (OP*)any_dup(proto_perl->Tsortcop, proto_perl);
-    PL_sortstash       = hv_dup(proto_perl->Tsortstash, param);
-    PL_firstgv         = gv_dup(proto_perl->Tfirstgv, param);
-    PL_secondgv                = gv_dup(proto_perl->Tsecondgv, param);
+    PL_sortcop         = (OP*)any_dup(proto_perl->Isortcop, proto_perl);
+    PL_sortstash       = hv_dup(proto_perl->Isortstash, param);
+    PL_firstgv         = gv_dup(proto_perl->Ifirstgv, param);
+    PL_secondgv                = gv_dup(proto_perl->Isecondgv, param);
     PL_efloatbuf       = NULL;         /* reinits on demand */
     PL_efloatsize      = 0;                    /* reinits on demand */
 
     PL_efloatbuf       = NULL;         /* reinits on demand */
     PL_efloatsize      = 0;                    /* reinits on demand */
 
@@ -11450,20 +11554,28 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_maxscream       = -1;                   /* reinits on demand */
     PL_lastscream      = NULL;
 
     PL_maxscream       = -1;                   /* reinits on demand */
     PL_lastscream      = NULL;
 
-    PL_watchaddr       = NULL;
-    PL_watchok         = NULL;
 
 
-    PL_regdummy                = proto_perl->Tregdummy;
+    PL_regdummy                = proto_perl->Iregdummy;
     PL_colorset                = 0;            /* reinits PL_colors[] */
     /*PL_colors[6]     = {0,0,0,0,0,0};*/
 
 
 
     /* Pluggable optimizer */
     PL_colorset                = 0;            /* reinits PL_colors[] */
     /*PL_colors[6]     = {0,0,0,0,0,0};*/
 
 
 
     /* Pluggable optimizer */
-    PL_peepp           = proto_perl->Tpeepp;
+    PL_peepp           = proto_perl->Ipeepp;
 
     PL_stashcache       = newHV();
 
 
     PL_stashcache       = newHV();
 
+    PL_watchaddr       = (char **) ptr_table_fetch(PL_ptr_table,
+                                           proto_perl->Iwatchaddr);
+    PL_watchok         = PL_watchaddr ? * PL_watchaddr : NULL;
+    if (PL_debug && PL_watchaddr) {
+       PerlIO_printf(Perl_debug_log,
+         "WATCHING: %"UVxf" cloned as %"UVxf" with value %"UVxf"\n",
+         PTR2UV(proto_perl->Iwatchaddr), PTR2UV(PL_watchaddr),
+         PTR2UV(PL_watchok));
+    }
+
     if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
         ptr_table_free(PL_ptr_table);
         PL_ptr_table = NULL;
     if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
         ptr_table_free(PL_ptr_table);
         PL_ptr_table = NULL;
@@ -11715,8 +11827,7 @@ S_varname(pTHX_ GV *gv, const char gvtype, PADOFFSET targ,
        }
     }
     else {
        }
     }
     else {
-       U32 unused;
-       CV * const cv = find_runcv(&unused);
+       CV * const cv = find_runcv(NULL);
        SV *sv;
        AV *av;
 
        SV *sv;
        AV *av;
 
@@ -12006,10 +12117,23 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
 
     case OP_RV2SV:
     case OP_CUSTOM:
 
     case OP_RV2SV:
     case OP_CUSTOM:
-    case OP_ENTERSUB:
        match = 1; /* XS or custom code could trigger random warnings */
        goto do_op;
 
        match = 1; /* XS or custom code could trigger random warnings */
        goto do_op;
 
+    case OP_ENTERSUB:
+    case OP_GOTO:
+       /* XXX tmp hack: these two may call an XS sub, and currently
+         XS subs don't have a SUB entry on the context stack, so CV and
+         pad determination goes wrong, and BAD things happen. So, just
+         don't try to determine the value under those circumstances.
+         Need a better fix at dome point. DAPM 11/2007 */
+       break;
+
+    case OP_POS:
+       /* def-ness of rval pos() is independent of the def-ness of its arg */
+       if ( !(obase->op_flags & OPf_MOD))
+           break;
+
     case OP_SCHOMP:
     case OP_CHOMP:
        if (SvROK(PL_rs) && uninit_sv == SvRV(PL_rs))
     case OP_SCHOMP:
     case OP_CHOMP:
        if (SvROK(PL_rs) && uninit_sv == SvRV(PL_rs))
Unnamed repository; edit this file 'description' to name the repository.