X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/f0ab9afb53ef594bb6fb8989153fbfba9762816f..4df7f6afd80e96d28fd18bba9dda8b38b6ed6700:/sv.c

diff --git a/sv.c b/sv.c
index 88dcd96..7b49ce2 100644
--- 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;
-    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;
@@ -349,7 +354,7 @@ Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags)
 #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++;
@@ -462,7 +467,8 @@ do_clean_named_objs(pTHX_ SV *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)));
@@ -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;
-    if (PL_comppad == (AV*)sv) {
-	PL_comppad = NULL;
-	PL_curpad = NULL;
-    }
     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
-  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 */
@@ -553,7 +556,7 @@ struct arena_desc {
 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*) \
@@ -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;
-    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;
 }
@@ -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;
-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
-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.
-       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 },
 
@@ -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)) },
 
-    /* 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)
@@ -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)) },
-    
+
+    /* 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)) },
@@ -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;
+    SV *referant = NULL;
 
     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)
-	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
@@ -1169,9 +1168,18 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
     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:
@@ -1179,8 +1187,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
 	    new_type = SVt_PVNV;
 	}
 	break;
-    case SVt_RV:
-	break;
     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);
     }
+
+    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;
@@ -1224,11 +1235,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
 	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);
@@ -1250,13 +1256,36 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
 	    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.
 	*/
-	if (old_type >= SVt_RV) {
+	if (old_type == SVt_IV) {
+	    assert(!SvROK(sv));
+	} else if (old_type >= SVt_PV) {
 	    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 (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",
@@ -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_upgrade(sv, SVt_IV);
-	break;
     case SVt_NV:
-	sv_upgrade(sv, SVt_PVNV);
+	sv_upgrade(sv, SVt_IV);
 	break;
-    case SVt_RV:
     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_RV:
     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);
 }
 
+/*
+=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.
@@ -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;
+	STRLEN len;
 
 	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 */
-	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)) {
@@ -2766,8 +2818,10 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 	}
 	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
@@ -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)
 {
+    I32 mro_changes = 0; /* 1 = method, 2 = isa */
+
     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
 
+    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);
@@ -3192,6 +3270,8 @@ S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype)
 	    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;
 }
 
@@ -3241,18 +3321,18 @@ S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr) {
     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. */
-		    PL_sub_generation++;
 		}
 	    }
 	    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) &&
@@ -3291,7 +3371,7 @@ S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr) {
 	    }
 	    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)
@@ -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:
-	    case SVt_RV:
 	    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;
 	}
-	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)) {
@@ -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_RV:
 	    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;
 
-    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) {
@@ -3507,7 +3585,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
 	}
 
 	if (dtype >= SVt_PV) {
-	    if (dtype == SVt_PVGV) {
+	    if (dtype == SVt_PVGV && isGV_with_GP(dstr)) {
 		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
-            && !((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.
@@ -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)) {
-	*SvEND(sv) = '\0';
+	ptr[len] = '\0';
     }
     (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
-    /* 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));
-    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;
+    HV *stash;
 
     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.  */
+	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)) {
-	if (PL_defstash) {		/* Still have a symbol table? */
+	if (PL_defstash &&	/* Still have a symbol table? */
+	    SvDESTROYABLE(sv))
+	{
 	    dSP;
 	    HV* stash;
 	    do {	
@@ -5124,6 +5212,10 @@ Perl_sv_clear(pTHX_ register SV *sv)
 	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:
@@ -5136,14 +5228,21 @@ Perl_sv_clear(pTHX_ register SV *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));
-	/* 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:
@@ -5154,7 +5253,6 @@ Perl_sv_clear(pTHX_ register SV *sv)
 	    /* 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))
@@ -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);
+#else
+  #ifdef DEBUG_LEAKING_SCALARS
+	sv_dump(sv);
+  #endif
 #endif
 	}
 	return;
@@ -5350,7 +5452,7 @@ Perl_sv_len_utf8(pTHX_ register SV *sv)
 
 	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;
@@ -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
-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
 */
@@ -7169,7 +7271,7 @@ Perl_newSVuv(pTHX_ UV u)
 /*
 =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
@@ -7198,7 +7300,7 @@ SV *
 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);
@@ -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) {
-	    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;
@@ -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);
-	    *SvEND(sv) = '\0';
+	    SvPVX(sv)[len] = '\0';
 	}
 	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_RV:
 	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;
 
-	sv_upgrade(rv, SVt_RV);
+	sv_upgrade(rv, SVt_IV);
     } 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);
@@ -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)) {
+	if (SvIsCOW(tmpRef))
+	    sv_force_normal_flags(tmpRef, 0);
 	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;
+    HV *stash;
     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)) {
+        if(GvCVu((GV*)sv) && (stash = GvSTASH((GV*)sv)) && HvNAME_get(stash))
+            mro_method_changed_in(stash);
 	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>	
-		%1p	(VDf)	include a v-string (as %vd)
 		%<num>p		reserved for future extensions
 
 	Robin Barker 2005-07-14
+
+		%1p	(VDf)	removed.  RMB 2007-10-19
 */
  	    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*);
-		    eptr = SvPVx_const(argsv, elen);
+		    eptr = SvPV_const(argsv, elen);
 		    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),
@@ -8694,12 +8801,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 			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);
@@ -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;
-	    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) {
@@ -8860,7 +8962,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		}
 	    }
 	    else {
-		eptr = SvPVx_const(argsv, elen);
+		eptr = SvPV_const(argsv, 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 {
-		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;
@@ -9017,7 +9119,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		}
 	    }
 	    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;
@@ -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
-		: SvNVx(argsv);
+		: SvNV(argsv);
 
 	    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) */
@@ -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().
 
-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.
@@ -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_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->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;
@@ -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;
+
+    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;
 }
@@ -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));
 	}
-	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)
@@ -9874,10 +10020,7 @@ Perl_rvpv_dup(pTHX_ SV *dstr, const SV *sstr, CLONE_PARAMS* param)
     }
     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) {
-	    const char * const hvname = HvNAME_get(sstr);
+	    const HEK * const hvname = HvNAME_HEK(sstr);
 	    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)) {
-	SvFLAGS(dstr) &= ~SVTYPEMASK;
-	SvOBJECT_off(dstr);
+	SvFLAGS(dstr) = 0;
 	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));
-	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;
-    case SVt_RV:
-	SvANY(dstr)	= &(dstr->sv_u.svu_rv);
-	Perl_rvpv_dup(aTHX_ dstr, sstr, param);
-	break;
 	/* 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);
-		/* 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
@@ -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;
+
+                        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);
@@ -10369,9 +10516,9 @@ ANY *
 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;
@@ -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_parser = NULL;
     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_parser = NULL;
     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_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;
@@ -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_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_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);
@@ -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_isarev		= hv_dup_inc(proto_perl->Iisarev, param);
 
     /* 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);
-    PL_copline		= proto_perl->Icopline;
 
     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_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);
 
@@ -11169,52 +11317,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     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_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);
 
-    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
@@ -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_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;
@@ -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_uudmap[(U32) 'M']	= 0;	/* reinits on demand */
     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;
     }
 
-    /* thrdvar.h stuff */
+    /* intrpvar.h stuff */
 
     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) {
-	    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 = proto_perl->Tmarkstack_max - proto_perl->Tmarkstack;
+	i = proto_perl->Imarkstack_max - proto_perl->Imarkstack;
 	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_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);
-	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 */
-	PL_curstackinfo		= si_dup(proto_perl->Tcurstackinfo, param);
+	PL_curstackinfo		= si_dup(proto_perl->Icurstackinfo, param);
 
 	/* 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);
-	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_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);
     }
@@ -11386,9 +11490,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 	 * 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,
-		    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);
@@ -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_op		= proto_perl->Top;
+    PL_op		= proto_perl->Iop;
 
     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
-    PL_timesbuf		= proto_perl->Ttimesbuf;
+    PL_timesbuf		= proto_perl->Itimesbuf;
 #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_modcount		= proto_perl->Tmodcount;
+    PL_modcount		= proto_perl->Imodcount;
     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 */
 
@@ -11450,20 +11554,28 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     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_peepp		= proto_perl->Tpeepp;
+    PL_peepp		= proto_perl->Ipeepp;
 
     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;
@@ -11715,8 +11827,7 @@ S_varname(pTHX_ GV *gv, const char gvtype, PADOFFSET targ,
 	}
     }
     else {
-	U32 unused;
-	CV * const cv = find_runcv(&unused);
+	CV * const cv = find_runcv(NULL);
 	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_ENTERSUB:
 	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))