X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=2d6d84d8c16f17b2d0719435a40809a9663072f2;hb=2522aa67345a7f37d0050d70f341ab3a0b6165b0;hp=174f893aca7858685dd0caca5ad71b1569400260;hpb=8b4f5e176a26235e99161210aebb1bc0073474cd;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index 174f893..2d6d84d 100644
--- a/sv.c
+++ b/sv.c
@@ -537,6 +537,10 @@ Perl_sv_free_arenas(pTHX)
 	(void**) &PL_xpvgv_arenaroot,
 	(void**) &PL_xpvlv_arenaroot,
 	(void**) &PL_xpvbm_arenaroot,
+	(void**) &PL_he_arenaroot,
+#if defined(USE_ITHREADS)
+	(void**) &PL_pte_arenaroot,
+#endif
 	(void**) 0
     };
     void **roots[] = {
@@ -551,6 +555,10 @@ Perl_sv_free_arenas(pTHX)
 	(void**) &PL_xpvgv_root,
 	(void**) &PL_xpvlv_root,
 	(void**) &PL_xpvbm_root,
+	(void**) &PL_he_root,
+#if defined(USE_ITHREADS)
+	(void**) &PL_pte_root,
+#endif
 	(void**) 0
     };
 
@@ -579,30 +587,6 @@ Perl_sv_free_arenas(pTHX)
 	*roots[i] = 0;
     }
 
-    {
-	HE *he;
-	HE *he_next;
-	for (he = PL_he_arenaroot; he; he = he_next) {
-	    he_next = HeNEXT(he);
-	    Safefree(he);
-	}
-    }
-    PL_he_arenaroot = 0;
-    PL_he_root = 0;
-
-#if defined(USE_ITHREADS)
-    {
-	struct ptr_tbl_ent *pte;
-	struct ptr_tbl_ent *pte_next;
-	for (pte = PL_pte_arenaroot; pte; pte = pte_next) {
-	    pte_next = pte->next;
-	    Safefree(pte);
-	}
-    }
-    PL_pte_arenaroot = 0;
-    PL_pte_root = 0;
-#endif
-
     if (PL_nice_chunk)
 	Safefree(PL_nice_chunk);
     PL_nice_chunk = Nullch;
@@ -1122,27 +1106,25 @@ S_more_bodies (pTHX_ void **arena_root, void **root, size_t size)
 /* grab a new thing from the free list, allocating more if necessary */
 
 STATIC void *
-S_new_body(pTHX_ void **arena_root, void **root, size_t size, size_t offset)
+S_new_body(pTHX_ void **arena_root, void **root, size_t size)
 {
     void *xpv;
     LOCK_SV_MUTEX;
     xpv = *root ? *root : S_more_bodies(aTHX_ arena_root, root, size);
     *root = *(void**)xpv;
     UNLOCK_SV_MUTEX;
-    return (void*)((char*)xpv - offset);
+    return xpv;
 }
 
 /* return a thing to the free list */
 
-STATIC void
-S_del_body(pTHX_ void *thing, void **root, size_t offset)
-{
-    void **real_thing = (void**)((char *)thing + offset);
-    LOCK_SV_MUTEX;
-    *real_thing = *root;
-    *root = (void*)real_thing;
-    UNLOCK_SV_MUTEX;
-}
+#define del_body(thing, root)			\
+    STMT_START {				\
+	LOCK_SV_MUTEX;				\
+	*(void **)thing = *root;		\
+	*root = (void*)thing;			\
+	UNLOCK_SV_MUTEX;			\
+    } STMT_END
 
 /* Conventionally we simply malloc() a big block of memory, then divide it
    up into lots of the thing that we're allocating.
@@ -1157,8 +1139,10 @@ S_del_body(pTHX_ void *thing, void **root, size_t offset)
 #define new_body(TYPE,lctype)						\
     S_new_body(aTHX_ (void**)&PL_ ## lctype ## _arenaroot,		\
 		 (void**)&PL_ ## lctype ## _root,			\
-		 sizeof(TYPE),						\
-		 0)
+		 sizeof(TYPE))
+
+#define del_body_type(p,TYPE,lctype)			\
+    del_body((void*)p, (void**)&PL_ ## lctype ## _root)
 
 /* But for some types, we cheat. The type starts with some members that are
    never accessed. So we allocate the substructure, starting at the first used
@@ -1181,20 +1165,17 @@ S_del_body(pTHX_ void *thing, void **root, size_t offset)
    no longer allocated.  */
 
 #define new_body_allocated(TYPE,lctype,member)				\
-    S_new_body(aTHX_ (void**)&PL_ ## lctype ## _arenaroot,		\
-	       (void**)&PL_ ## lctype ## _root,				\
-	       sizeof(lctype ## _allocated),				\
-	       STRUCT_OFFSET(TYPE, member)				\
-	       - STRUCT_OFFSET(lctype ## _allocated, member))
+    (void*)((char*)S_new_body(aTHX_ (void**)&PL_ ## lctype ## _arenaroot, \
+			      (void**)&PL_ ## lctype ## _root,		\
+			      sizeof(lctype ## _allocated)) -		\
+			      STRUCT_OFFSET(TYPE, member)		\
+	    + STRUCT_OFFSET(lctype ## _allocated, member))
 
 
-#define del_body(p,TYPE,lctype)						\
-    S_del_body(aTHX_ (void*)p, (void**)&PL_ ## lctype ## _root, 0)
-
 #define del_body_allocated(p,TYPE,lctype,member)			\
-    S_del_body(aTHX_ (void*)p, (void**)&PL_ ## lctype ## _root,		\
-	       STRUCT_OFFSET(TYPE, member)				\
-	       - STRUCT_OFFSET(lctype ## _allocated, member))
+    del_body((void*)((char*)p + STRUCT_OFFSET(TYPE, member)		\
+		     - STRUCT_OFFSET(lctype ## _allocated, member)),	\
+	     (void**)&PL_ ## lctype ## _root)
 
 #define my_safemalloc(s)	(void*)safemalloc(s)
 #define my_safefree(p)	safefree((char*)p)
@@ -1237,7 +1218,7 @@ S_del_body(pTHX_ void *thing, void **root, size_t offset)
 #else /* !PURIFY */
 
 #define new_XNV()	new_body(NV, xnv)
-#define del_XNV(p)	del_body(p, NV, xnv)
+#define del_XNV(p)	del_body_type(p, NV, xnv)
 
 #define new_XPV()	new_body_allocated(XPV, xpv, xpv_cur)
 #define del_XPV(p)	del_body_allocated(p, XPV, xpv, xpv_cur)
@@ -1246,10 +1227,10 @@ S_del_body(pTHX_ void *thing, void **root, size_t offset)
 #define del_XPVIV(p)	del_body_allocated(p, XPVIV, xpviv, xpv_cur)
 
 #define new_XPVNV()	new_body(XPVNV, xpvnv)
-#define del_XPVNV(p)	del_body(p, XPVNV, xpvnv)
+#define del_XPVNV(p)	del_body_type(p, XPVNV, xpvnv)
 
 #define new_XPVCV()	new_body(XPVCV, xpvcv)
-#define del_XPVCV(p)	del_body(p, XPVCV, xpvcv)
+#define del_XPVCV(p)	del_body_type(p, XPVCV, xpvcv)
 
 #define new_XPVAV()	new_body_allocated(XPVAV, xpvav, xav_fill)
 #define del_XPVAV(p)	del_body_allocated(p, XPVAV, xpvav, xav_fill)
@@ -1258,16 +1239,16 @@ S_del_body(pTHX_ void *thing, void **root, size_t offset)
 #define del_XPVHV(p)	del_body_allocated(p, XPVHV, xpvhv, xhv_fill)
 
 #define new_XPVMG()	new_body(XPVMG, xpvmg)
-#define del_XPVMG(p)	del_body(p, XPVMG, xpvmg)
+#define del_XPVMG(p)	del_body_type(p, XPVMG, xpvmg)
 
 #define new_XPVGV()	new_body(XPVGV, xpvgv)
-#define del_XPVGV(p)	del_body(p, XPVGV, xpvgv)
+#define del_XPVGV(p)	del_body_type(p, XPVGV, xpvgv)
 
 #define new_XPVLV()	new_body(XPVLV, xpvlv)
-#define del_XPVLV(p)	del_body(p, XPVLV, xpvlv)
+#define del_XPVLV(p)	del_body_type(p, XPVLV, xpvlv)
 
 #define new_XPVBM()	new_body(XPVBM, xpvbm)
-#define del_XPVBM(p)	del_body(p, XPVBM, xpvbm)
+#define del_XPVBM(p)	del_body_type(p, XPVBM, xpvbm)
 
 #endif /* PURIFY */
 
@@ -1294,7 +1275,11 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
     size_t	old_body_offset;
     size_t	old_body_length;	/* Well, the length to copy.  */
     void*	old_body;
+#ifndef NV_ZERO_IS_ALLBITS_ZERO
+    /* If NV 0.0 is store as all bits 0 then Zero() already creates a correct
+       0.0 for us.  */
     bool	zero_nv = TRUE;
+#endif
     void*	new_body;
     size_t	new_body_length;
     size_t	new_body_offset;
@@ -1371,8 +1356,9 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
     case SVt_NV:
 	old_body_arena = (void **) &PL_xnv_root;
 	old_body_length = sizeof(NV);
+#ifndef NV_ZERO_IS_ALLBITS_ZERO
 	zero_nv = FALSE;
-
+#endif
 	if (mt < SVt_PVNV)
 	    mt = SVt_PVNV;
 	break;
@@ -1402,7 +1388,9 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 	old_body_arena = (void **) &PL_xpvnv_root;
 	old_body_length = STRUCT_OFFSET(XPVNV, xiv_u)
 	    + sizeof (((XPVNV*)SvANY(sv))->xiv_u);
+#ifndef NV_ZERO_IS_ALLBITS_ZERO
 	zero_nv = FALSE;
+#endif
 	break;
     case SVt_PVMG:
 	/* Because the XPVMG of PL_mess_sv isn't allocated from the arena,
@@ -1416,7 +1404,9 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 	old_body_arena = (void **) &PL_xpvmg_root;
 	old_body_length = STRUCT_OFFSET(XPVMG, xmg_stash)
 	    + sizeof (((XPVMG*)SvANY(sv))->xmg_stash);
+#ifndef NV_ZERO_IS_ALLBITS_ZERO
 	zero_nv = FALSE;
+#endif
 	break;
     default:
 	Perl_croak(aTHX_ "Can't upgrade that kind of scalar");
@@ -1539,41 +1529,43 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 	new_body_arenaroot = (void **) &PL_xpv_arenaroot;
     new_body_no_NV:
 	/* PV and PVIV don't have an NV slot.  */
+#ifndef NV_ZERO_IS_ALLBITS_ZERO
 	zero_nv = FALSE;
+#endif
 
-	{
-	new_body:
-	    assert(new_body_length);
+    new_body:
+	assert(new_body_length);
 #ifndef PURIFY
-	    new_body = S_new_body(aTHX_ new_body_arenaroot, new_body_arena,
-				  new_body_length, new_body_offset);
+	/* This points to the start of the allocated area.  */
+	new_body = S_new_body(aTHX_ new_body_arenaroot, new_body_arena,
+			      new_body_length);
 #else
-	    /* We always allocated the full length item with PURIFY */
-	    new_body_length += new_body_offset;
-	    new_body_offset = 0;
-	    new_body = my_safemalloc(new_body_length);
+	/* We always allocated the full length item with PURIFY */
+	new_body_length += new_body_offset;
+	new_body_offset = 0;
+	new_body = my_safemalloc(new_body_length);
 
 #endif
-	zero:
-	    Zero(((char *)new_body) + new_body_offset, new_body_length, char);
-	    SvANY(sv) = new_body;
-
-	    if (old_body_length) {
-		Copy((char *)old_body + old_body_offset,
-		     (char *)new_body + old_body_offset,
-		     old_body_length, char);
-	    }
-
-	    /* FIXME - add a Configure test to determine if NV 0.0 is actually
-	       all bits zero. If it is, we can skip this initialisation.  */
-	    if (zero_nv)
-		SvNV_set(sv, 0);
+    zero:
+	Zero(new_body, new_body_length, char);
+	new_body = ((char *)new_body) - new_body_offset;
+	SvANY(sv) = new_body;
 
-	    if (mt == SVt_PVIO)
-		IoPAGE_LEN(sv)	= 60;
-	    if (old_type < SVt_RV)
-		SvPV_set(sv, 0);
+	if (old_body_length) {
+	    Copy((char *)old_body + old_body_offset,
+		 (char *)new_body + old_body_offset,
+		 old_body_length, char);
 	}
+
+#ifndef NV_ZERO_IS_ALLBITS_ZERO
+	if (zero_nv)
+	    SvNV_set(sv, 0);
+#endif
+
+	if (mt == SVt_PVIO)
+	    IoPAGE_LEN(sv)	= 60;
+	if (old_type < SVt_RV)
+	    SvPV_set(sv, 0);
 	break;
     default:
 	Perl_croak(aTHX_ "panic: sv_upgrade to unknown type %lu", mt);
@@ -1584,7 +1576,8 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 #ifdef PURIFY
 	my_safefree(old_body);
 #else
-	S_del_body(aTHX_ old_body, old_body_arena, old_body_offset);
+	del_body((void*)((char*)old_body + old_body_offset),
+		 old_body_arena);
 #endif
     }
 }
@@ -10110,7 +10103,7 @@ Perl_ptr_table_new(pTHX)
 #endif
 
 #define new_pte()	new_body(struct ptr_tbl_ent, pte)
-#define del_pte(p)	del_body(p, struct ptr_tbl_ent, pte)
+#define del_pte(p)	del_body_type(p, struct ptr_tbl_ent, pte)
 
 /* map an existing pointer using a table */
 
@@ -10295,8 +10288,6 @@ S_gv_share(pTHX_ SV *sstr, CLONE_PARAMS *param)
     return sstr; /* he_dup() will SvREFCNT_inc() */
 }
 
-/* duplicate an SV of any type (including AV, HV etc) */
-
 void
 Perl_rvpv_dup(pTHX_ SV *dstr, SV *sstr, CLONE_PARAMS* param)
 {
@@ -10341,6 +10332,8 @@ Perl_rvpv_dup(pTHX_ SV *dstr, SV *sstr, CLONE_PARAMS* param)
     }
 }
 
+/* duplicate an SV of any type (including AV, HV etc) */
+
 SV *
 Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
 {
@@ -10418,273 +10411,297 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
 	SvANY(dstr)	= &(dstr->sv_u.svu_rv);
 	Perl_rvpv_dup(aTHX_ dstr, sstr, param);
 	break;
-    case SVt_PV:
-	SvANY(dstr)	= new_XPV();
-	SvCUR_set(dstr, SvCUR(sstr));
-	SvLEN_set(dstr, SvLEN(sstr));
-	Perl_rvpv_dup(aTHX_ dstr, sstr, param);
-	break;
-    case SVt_PVIV:
-	SvANY(dstr)	= new_XPVIV();
-	SvCUR_set(dstr, SvCUR(sstr));
-	SvLEN_set(dstr, SvLEN(sstr));
-	SvIV_set(dstr, SvIVX(sstr));
-	Perl_rvpv_dup(aTHX_ dstr, sstr, param);
-	break;
-    case SVt_PVNV:
-	SvANY(dstr)	= new_XPVNV();
-	SvCUR_set(dstr, SvCUR(sstr));
-	SvLEN_set(dstr, SvLEN(sstr));
-	SvIV_set(dstr, SvIVX(sstr));
-	SvNV_set(dstr, SvNVX(sstr));
-	Perl_rvpv_dup(aTHX_ dstr, sstr, param);
-	break;
-    case SVt_PVMG:
-	SvANY(dstr)	= new_XPVMG();
-	SvCUR_set(dstr, SvCUR(sstr));
-	SvLEN_set(dstr, SvLEN(sstr));
-	SvIV_set(dstr, SvIVX(sstr));
-	SvNV_set(dstr, SvNVX(sstr));
-	SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
-	SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
-	Perl_rvpv_dup(aTHX_ dstr, sstr, param);
-	break;
-    case SVt_PVBM:
-	SvANY(dstr)	= new_XPVBM();
-	SvCUR_set(dstr, SvCUR(sstr));
-	SvLEN_set(dstr, SvLEN(sstr));
-	SvIV_set(dstr, SvIVX(sstr));
-	SvNV_set(dstr, SvNVX(sstr));
-	SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
-	SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
-	Perl_rvpv_dup(aTHX_ dstr, sstr, param);
-	BmRARE(dstr)	= BmRARE(sstr);
-	BmUSEFUL(dstr)	= BmUSEFUL(sstr);
-	BmPREVIOUS(dstr)= BmPREVIOUS(sstr);
-	break;
-    case SVt_PVLV:
-	SvANY(dstr)	= new_XPVLV();
-	SvCUR_set(dstr, SvCUR(sstr));
-	SvLEN_set(dstr, SvLEN(sstr));
-	SvIV_set(dstr, SvIVX(sstr));
-	SvNV_set(dstr, SvNVX(sstr));
-	SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
-	SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
-	Perl_rvpv_dup(aTHX_ dstr, sstr, param);
-	LvTARGOFF(dstr)	= LvTARGOFF(sstr);	/* XXX sometimes holds PMOP* when DEBUGGING */
-	LvTARGLEN(dstr)	= LvTARGLEN(sstr);
-	if (LvTYPE(sstr) == 't') /* for tie: unrefcnted fake (SV**) */
-	    LvTARG(dstr) = dstr;
-	else if (LvTYPE(sstr) == 'T') /* for tie: fake HE */
-	    LvTARG(dstr) = (SV*)he_dup((HE*)LvTARG(sstr), 0, param);
-	else
-	    LvTARG(dstr) = sv_dup_inc(LvTARG(sstr), param);
-	LvTYPE(dstr)	= LvTYPE(sstr);
-	break;
-    case SVt_PVGV:
-	if (GvUNIQUE((GV*)sstr)) {
-            SV *share;
-            if ((share = gv_share(sstr, param))) {
-                del_SV(dstr);
-                dstr = share;
-                ptr_table_store(PL_ptr_table, sstr, dstr);
+    default:
+	{
+	    /* These are all the types that need complex bodies allocating.  */
+	    size_t new_body_length;
+	    size_t new_body_offset = 0;
+	    void **new_body_arena;
+	    void **new_body_arenaroot;
+	    void *new_body;
+
+	    switch (SvTYPE(sstr)) {
+	    default:
+		Perl_croak(aTHX_ "Bizarre SvTYPE [%" IVdf "]",
+			   (IV)SvTYPE(sstr));
+		break;
+
+	    case SVt_PVIO:
+		new_body = new_XPVIO();
+		new_body_length = sizeof(XPVIO);
+		break;
+	    case SVt_PVFM:
+		new_body = new_XPVFM();
+		new_body_length = sizeof(XPVFM);
+		break;
+
+	    case SVt_PVHV:
+		new_body_arena = (void **) &PL_xpvhv_root;
+		new_body_arenaroot = (void **) &PL_xpvhv_arenaroot;
+		new_body_offset = STRUCT_OFFSET(XPVHV, xhv_fill)
+		    - STRUCT_OFFSET(xpvhv_allocated, xhv_fill);
+		new_body_length = STRUCT_OFFSET(XPVHV, xmg_stash)
+		    + sizeof (((XPVHV*)SvANY(sstr))->xmg_stash)
+		    - new_body_offset;
+		goto new_body;
+	    case SVt_PVAV:
+		new_body_arena = (void **) &PL_xpvav_root;
+		new_body_arenaroot = (void **) &PL_xpvav_arenaroot;
+		new_body_offset = STRUCT_OFFSET(XPVAV, xav_fill)
+		    - STRUCT_OFFSET(xpvav_allocated, xav_fill);
+		new_body_length = STRUCT_OFFSET(XPVHV, xmg_stash)
+		    + sizeof (((XPVHV*)SvANY(sstr))->xmg_stash)
+		    - new_body_offset;
+		goto new_body;
+	    case SVt_PVBM:
+		new_body_length = sizeof(XPVBM);
+		new_body_arena = (void **) &PL_xpvbm_root;
+		new_body_arenaroot = (void **) &PL_xpvbm_arenaroot;
+		goto new_body;
+	    case SVt_PVGV:
+		if (GvUNIQUE((GV*)sstr)) {
+		    SV *share;
+		    if ((share = gv_share(sstr, param))) {
+			del_SV(dstr);
+			dstr = share;
+			ptr_table_store(PL_ptr_table, sstr, dstr);
 #if 0
-                PerlIO_printf(Perl_debug_log, "sv_dup: sharing %s::%s\n",
-                              HvNAME_get(GvSTASH(share)), GvNAME(share));
+			PerlIO_printf(Perl_debug_log, "sv_dup: sharing %s::%s\n",
+				      HvNAME_get(GvSTASH(share)), GvNAME(share));
+#endif
+			goto done_share;
+		    }
+		}
+		new_body_length = sizeof(XPVGV);
+		new_body_arena = (void **) &PL_xpvgv_root;
+		new_body_arenaroot = (void **) &PL_xpvgv_arenaroot;
+		goto new_body;
+	    case SVt_PVCV:
+		new_body_length = sizeof(XPVCV);
+		new_body_arena = (void **) &PL_xpvcv_root;
+		new_body_arenaroot = (void **) &PL_xpvcv_arenaroot;
+		goto new_body;
+	    case SVt_PVLV:
+		new_body_length = sizeof(XPVLV);
+		new_body_arena = (void **) &PL_xpvlv_root;
+		new_body_arenaroot = (void **) &PL_xpvlv_arenaroot;
+		goto new_body;
+	    case SVt_PVMG:
+		new_body_length = sizeof(XPVMG);
+		new_body_arena = (void **) &PL_xpvmg_root;
+		new_body_arenaroot = (void **) &PL_xpvmg_arenaroot;
+		goto new_body;
+	    case SVt_PVNV:
+		new_body_length = sizeof(XPVNV);
+		new_body_arena = (void **) &PL_xpvnv_root;
+		new_body_arenaroot = (void **) &PL_xpvnv_arenaroot;
+		goto new_body;
+	    case SVt_PVIV:
+		new_body_offset = STRUCT_OFFSET(XPVIV, xpv_cur)
+		    - STRUCT_OFFSET(xpviv_allocated, xpv_cur);
+		new_body_length = sizeof(XPVIV) - new_body_offset;
+		new_body_arena = (void **) &PL_xpviv_root;
+		new_body_arenaroot = (void **) &PL_xpviv_arenaroot;
+		goto new_body; 
+	    case SVt_PV:
+		new_body_offset = STRUCT_OFFSET(XPV, xpv_cur)
+		    - STRUCT_OFFSET(xpv_allocated, xpv_cur);
+		new_body_length = sizeof(XPV) - new_body_offset;
+		new_body_arena = (void **) &PL_xpv_root;
+		new_body_arenaroot = (void **) &PL_xpv_arenaroot;
+	    new_body:
+		assert(new_body_length);
+#ifndef PURIFY
+		new_body = (void*)((char*)S_new_body(aTHX_ new_body_arenaroot,
+						     new_body_arena,
+						     new_body_length)
+				   - new_body_offset);
+#else
+		/* We always allocated the full length item with PURIFY */
+		new_body_length += new_body_offset;
+		new_body_offset = 0;
+		new_body = my_safemalloc(new_body_length);
 #endif
-                break;
-            }
-	}
-	SvANY(dstr)	= new_XPVGV();
-	SvCUR_set(dstr, SvCUR(sstr));
-	SvLEN_set(dstr, SvLEN(sstr));
-	SvIV_set(dstr, SvIVX(sstr));
-	SvNV_set(dstr, SvNVX(sstr));
-	SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
-	SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
-	Perl_rvpv_dup(aTHX_ dstr, sstr, param);
-	GvNAMELEN(dstr)	= GvNAMELEN(sstr);
-	GvNAME(dstr)	= SAVEPVN(GvNAME(sstr), GvNAMELEN(sstr));
-    	GvSTASH(dstr)	= hv_dup_inc(GvSTASH(sstr), param);
-	GvFLAGS(dstr)	= GvFLAGS(sstr);
-	GvGP(dstr)	= gp_dup(GvGP(sstr), param);
-	(void)GpREFCNT_inc(GvGP(dstr));
-	break;
-    case SVt_PVIO:
-	SvANY(dstr)	= new_XPVIO();
-	SvCUR_set(dstr, SvCUR(sstr));
-	SvLEN_set(dstr, SvLEN(sstr));
-	SvIV_set(dstr, SvIVX(sstr));
-	SvNV_set(dstr, SvNVX(sstr));
-	SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
-	SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
-	Perl_rvpv_dup(aTHX_ dstr, sstr, param);
-	IoIFP(dstr)	= fp_dup(IoIFP(sstr), IoTYPE(sstr), param);
-	if (IoOFP(sstr) == IoIFP(sstr))
-	    IoOFP(dstr) = IoIFP(dstr);
-	else
-	    IoOFP(dstr)	= fp_dup(IoOFP(sstr), IoTYPE(sstr), param);
-	/* PL_rsfp_filters entries have fake IoDIRP() */
-	if (IoDIRP(sstr) && !(IoFLAGS(sstr) & IOf_FAKE_DIRP))
-	    IoDIRP(dstr)	= dirp_dup(IoDIRP(sstr));
-	else
-	    IoDIRP(dstr)	= IoDIRP(sstr);
-	IoLINES(dstr)		= IoLINES(sstr);
-	IoPAGE(dstr)		= IoPAGE(sstr);
-	IoPAGE_LEN(dstr)	= IoPAGE_LEN(sstr);
-	IoLINES_LEFT(dstr)	= IoLINES_LEFT(sstr);
-        if(IoFLAGS(sstr) & IOf_FAKE_DIRP) {
-            /* I have no idea why fake dirp (rsfps)
-               should be treaded differently but otherwise
-               we end up with leaks -- sky*/
-            IoTOP_GV(dstr)      = gv_dup_inc(IoTOP_GV(sstr), param);
-            IoFMT_GV(dstr)      = gv_dup_inc(IoFMT_GV(sstr), param);
-            IoBOTTOM_GV(dstr)   = gv_dup_inc(IoBOTTOM_GV(sstr), param);
-        } else {
-            IoTOP_GV(dstr)      = gv_dup(IoTOP_GV(sstr), param);
-            IoFMT_GV(dstr)      = gv_dup(IoFMT_GV(sstr), param);
-            IoBOTTOM_GV(dstr)   = gv_dup(IoBOTTOM_GV(sstr), param);
-        }
-	IoTOP_NAME(dstr)	= SAVEPV(IoTOP_NAME(sstr));
-	IoFMT_NAME(dstr)	= SAVEPV(IoFMT_NAME(sstr));
-	IoBOTTOM_NAME(dstr)	= SAVEPV(IoBOTTOM_NAME(sstr));
-	IoSUBPROCESS(dstr)	= IoSUBPROCESS(sstr);
-	IoTYPE(dstr)		= IoTYPE(sstr);
-	IoFLAGS(dstr)		= IoFLAGS(sstr);
-	break;
-    case SVt_PVAV:
-	SvANY(dstr)	= new_XPVAV();
-	SvCUR_set(dstr, SvCUR(sstr));
-	SvLEN_set(dstr, SvLEN(sstr));
-	SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
-	SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
-	if (AvARRAY((AV*)sstr)) {
-	    SV **dst_ary, **src_ary;
-	    SSize_t items = AvFILLp((AV*)sstr) + 1;
-
-	    src_ary = AvARRAY((AV*)sstr);
-	    Newz(0, dst_ary, AvMAX((AV*)sstr)+1, SV*);
-	    ptr_table_store(PL_ptr_table, src_ary, dst_ary);
-	    SvPV_set(dstr, (char*)dst_ary);
-	    AvALLOC((AV*)dstr) = dst_ary;
-	    if (AvREAL((AV*)sstr)) {
-		while (items-- > 0)
-		    *dst_ary++ = sv_dup_inc(*src_ary++, param);
-	    }
-	    else {
-		while (items-- > 0)
-		    *dst_ary++ = sv_dup(*src_ary++, param);
 	    }
-	    items = AvMAX((AV*)sstr) - AvFILLp((AV*)sstr);
-	    while (items-- > 0) {
-		*dst_ary++ = &PL_sv_undef;
+	    assert(new_body);
+	    SvANY(dstr) = new_body;
+
+	    Copy(((char*)SvANY(sstr)) + new_body_offset,
+		 ((char*)SvANY(dstr)) + new_body_offset,
+		 new_body_length, char);
+
+	    if (SvTYPE(sstr) != SVt_PVAV && SvTYPE(sstr) != SVt_PVHV)
+		Perl_rvpv_dup(aTHX_ dstr, sstr, param);
+
+	    /* The Copy above means that all the source (unduplicated) pointers
+	       are now in the destination.  We can check the flags and the
+	       pointers in either, but it's possible that there's less cache
+	       missing by always going for the destination.
+	       FIXME - instrument and check that assumption  */
+	    if (SvTYPE(sstr) >= SVt_PVMG) {
+		if (SvMAGIC(dstr))
+		    SvMAGIC_set(dstr, mg_dup(SvMAGIC(dstr), param));
+		if (SvSTASH(dstr))
+		    SvSTASH_set(dstr, hv_dup_inc(SvSTASH(dstr), param));
 	    }
-	}
-	else {
-	    SvPV_set(dstr, Nullch);
-	    AvALLOC((AV*)dstr)	= (SV**)NULL;
-	}
-	break;
-    case SVt_PVHV:
-	SvANY(dstr)	= new_XPVHV();
-	SvCUR_set(dstr, SvCUR(sstr));
-	SvLEN_set(dstr, SvLEN(sstr));
-	HvTOTALKEYS(dstr) = HvTOTALKEYS(sstr);
-	SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
-	SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
-	{
-	    HEK *hvname = 0;
-
-	    if (HvARRAY((HV*)sstr)) {
-		STRLEN i = 0;
-		const bool sharekeys = !!HvSHAREKEYS(sstr);
-		XPVHV * const dxhv = (XPVHV*)SvANY(dstr);
-		XPVHV * const sxhv = (XPVHV*)SvANY(sstr);
-		char *darray;
-		New(0, darray,
-		     PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1)
-		     + (SvOOK(sstr) ? sizeof(struct xpvhv_aux) : 0), char);
-		HvARRAY(dstr) = (HE**)darray;
-		while (i <= sxhv->xhv_max) {
-		    HE *source = HvARRAY(sstr)[i];
-		    HvARRAY(dstr)[i]
-			= source ? he_dup(source, sharekeys, param) : 0;
-		    ++i;
+
+	    switch (SvTYPE(sstr)) {
+	    case SVt_PV:
+		break;
+	    case SVt_PVIV:
+		break;
+	    case SVt_PVNV:
+		break;
+	    case SVt_PVMG:
+		break;
+	    case SVt_PVBM:
+		break;
+	    case SVt_PVLV:
+		/* XXX LvTARGOFF sometimes holds PMOP* when DEBUGGING */
+		if (LvTYPE(dstr) == 't') /* for tie: unrefcnted fake (SV**) */
+		    LvTARG(dstr) = dstr;
+		else if (LvTYPE(dstr) == 'T') /* for tie: fake HE */
+		    LvTARG(dstr) = (SV*)he_dup((HE*)LvTARG(dstr), 0, param);
+		else
+		    LvTARG(dstr) = sv_dup_inc(LvTARG(dstr), param);
+		break;
+	    case SVt_PVGV:
+		GvNAME(dstr)	= SAVEPVN(GvNAME(dstr), GvNAMELEN(dstr));
+		GvSTASH(dstr)	= hv_dup_inc(GvSTASH(dstr), param);
+		GvGP(dstr)	= gp_dup(GvGP(dstr), param);
+		(void)GpREFCNT_inc(GvGP(dstr));
+		break;
+	    case SVt_PVIO:
+		IoIFP(dstr)	= fp_dup(IoIFP(dstr), IoTYPE(dstr), param);
+		if (IoOFP(dstr) == IoIFP(sstr))
+		    IoOFP(dstr) = IoIFP(dstr);
+		else
+		    IoOFP(dstr)	= fp_dup(IoOFP(dstr), IoTYPE(dstr), param);
+		/* PL_rsfp_filters entries have fake IoDIRP() */
+		if (IoDIRP(dstr) && !(IoFLAGS(dstr) & IOf_FAKE_DIRP))
+		    IoDIRP(dstr)	= dirp_dup(IoDIRP(dstr));
+		if(IoFLAGS(dstr) & IOf_FAKE_DIRP) {
+		    /* I have no idea why fake dirp (rsfps)
+		       should be treated differently but otherwise
+		       we end up with leaks -- sky*/
+		    IoTOP_GV(dstr)      = gv_dup_inc(IoTOP_GV(dstr), param);
+		    IoFMT_GV(dstr)      = gv_dup_inc(IoFMT_GV(dstr), param);
+		    IoBOTTOM_GV(dstr)   = gv_dup_inc(IoBOTTOM_GV(dstr), param);
+		} else {
+		    IoTOP_GV(dstr)      = gv_dup(IoTOP_GV(dstr), param);
+		    IoFMT_GV(dstr)      = gv_dup(IoFMT_GV(dstr), param);
+		    IoBOTTOM_GV(dstr)   = gv_dup(IoBOTTOM_GV(dstr), param);
 		}
-		if (SvOOK(sstr)) {
-		    struct xpvhv_aux *saux = HvAUX(sstr);
-		    struct xpvhv_aux *daux = HvAUX(dstr);
-		    /* This flag isn't copied.  */
-		    /* SvOOK_on(hv) attacks the IV flags.  */
-		    SvFLAGS(dstr) |= SVf_OOK;
-
-		    hvname = saux->xhv_name;
-		    daux->xhv_name = hvname ? hek_dup(hvname, param) : hvname;
-
-		    daux->xhv_riter = saux->xhv_riter;
-		    daux->xhv_eiter = saux->xhv_eiter
-			? he_dup(saux->xhv_eiter, (bool)!!HvSHAREKEYS(sstr),
-				 param) : 0;
+		IoTOP_NAME(dstr)	= SAVEPV(IoTOP_NAME(dstr));
+		IoFMT_NAME(dstr)	= SAVEPV(IoFMT_NAME(dstr));
+		IoBOTTOM_NAME(dstr)	= SAVEPV(IoBOTTOM_NAME(dstr));
+		break;
+	    case SVt_PVAV:
+		if (AvARRAY((AV*)sstr)) {
+		    SV **dst_ary, **src_ary;
+		    SSize_t items = AvFILLp((AV*)sstr) + 1;
+
+		    src_ary = AvARRAY((AV*)sstr);
+		    Newz(0, dst_ary, AvMAX((AV*)sstr)+1, SV*);
+		    ptr_table_store(PL_ptr_table, src_ary, dst_ary);
+		    SvPV_set(dstr, (char*)dst_ary);
+		    AvALLOC((AV*)dstr) = dst_ary;
+		    if (AvREAL((AV*)sstr)) {
+			while (items-- > 0)
+			    *dst_ary++ = sv_dup_inc(*src_ary++, param);
+		    }
+		    else {
+			while (items-- > 0)
+			    *dst_ary++ = sv_dup(*src_ary++, param);
+		    }
+		    items = AvMAX((AV*)sstr) - AvFILLp((AV*)sstr);
+		    while (items-- > 0) {
+			*dst_ary++ = &PL_sv_undef;
+		    }
 		}
+		else {
+		    SvPV_set(dstr, Nullch);
+		    AvALLOC((AV*)dstr)	= (SV**)NULL;
+		}
+		break;
+	    case SVt_PVHV:
+		{
+		    HEK *hvname = 0;
+
+		    if (HvARRAY((HV*)sstr)) {
+			STRLEN i = 0;
+			const bool sharekeys = !!HvSHAREKEYS(sstr);
+			XPVHV * const dxhv = (XPVHV*)SvANY(dstr);
+			XPVHV * const sxhv = (XPVHV*)SvANY(sstr);
+			char *darray;
+			New(0, darray,
+			    PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1)
+			    + (SvOOK(sstr) ? sizeof(struct xpvhv_aux) : 0),
+			    char);
+			HvARRAY(dstr) = (HE**)darray;
+			while (i <= sxhv->xhv_max) {
+			    HE *source = HvARRAY(sstr)[i];
+			    HvARRAY(dstr)[i] = source
+				? he_dup(source, sharekeys, param) : 0;
+			    ++i;
+			}
+			if (SvOOK(sstr)) {
+			    struct xpvhv_aux *saux = HvAUX(sstr);
+			    struct xpvhv_aux *daux = HvAUX(dstr);
+			    /* This flag isn't copied.  */
+			    /* SvOOK_on(hv) attacks the IV flags.  */
+			    SvFLAGS(dstr) |= SVf_OOK;
+
+			    hvname = saux->xhv_name;
+			    daux->xhv_name
+				= hvname ? hek_dup(hvname, param) : hvname;
+
+			    daux->xhv_riter = saux->xhv_riter;
+			    daux->xhv_eiter = saux->xhv_eiter
+				? he_dup(saux->xhv_eiter,
+					 (bool)!!HvSHAREKEYS(sstr), param) : 0;
+			}
+		    }
+		    else {
+			SvPV_set(dstr, Nullch);
+		    }
+		    /* Record stashes for possible cloning in Perl_clone(). */
+		    if(hvname)
+			av_push(param->stashes, dstr);
+		}
+		break;
+	    case SVt_PVFM:
+	    case SVt_PVCV:
+		/* NOTE: not refcounted */
+		CvSTASH(dstr)	= hv_dup(CvSTASH(dstr), param);
+		OP_REFCNT_LOCK;
+		CvROOT(dstr)	= OpREFCNT_inc(CvROOT(dstr));
+		OP_REFCNT_UNLOCK;
+		if (CvCONST(dstr)) {
+		    CvXSUBANY(dstr).any_ptr = GvUNIQUE(CvGV(dstr)) ?
+			SvREFCNT_inc(CvXSUBANY(dstr).any_ptr) :
+			sv_dup_inc((SV *)CvXSUBANY(dstr).any_ptr, param);
+		}
+		/* don't dup if copying back - CvGV isn't refcounted, so the
+		 * duped GV may never be freed. A bit of a hack! DAPM */
+		CvGV(dstr)	= (param->flags & CLONEf_JOIN_IN) ?
+		    Nullgv : gv_dup(CvGV(dstr), param) ;
+		if (!(param->flags & CLONEf_COPY_STACKS)) {
+		    CvDEPTH(dstr) = 0;
+		}
+		PAD_DUP(CvPADLIST(dstr), CvPADLIST(sstr), param);
+		CvOUTSIDE(dstr)	=
+		    CvWEAKOUTSIDE(sstr)
+		    ? cv_dup(    CvOUTSIDE(dstr), param)
+		    : cv_dup_inc(CvOUTSIDE(dstr), param);
+		if (!CvXSUB(dstr))
+		    CvFILE(dstr) = SAVEPV(CvFILE(dstr));
+		break;
 	    }
-	    else {
-		SvPV_set(dstr, Nullch);
-	    }
-	    /* Record stashes for possible cloning in Perl_clone(). */
-	    if(hvname)
-		av_push(param->stashes, dstr);
 	}
-	break;
-    case SVt_PVFM:
-	SvANY(dstr)	= new_XPVFM();
-	FmLINES(dstr)	= FmLINES(sstr);
-	goto dup_pvcv;
-	/* NOTREACHED */
-    case SVt_PVCV:
-	SvANY(dstr)	= new_XPVCV();
-        dup_pvcv:
-	SvCUR_set(dstr, SvCUR(sstr));
-	SvLEN_set(dstr, SvLEN(sstr));
-	SvIV_set(dstr, SvIVX(sstr));
-	SvNV_set(dstr, SvNVX(sstr));
-	SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
-	SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
-	Perl_rvpv_dup(aTHX_ dstr, sstr, param);
-	CvSTASH(dstr)	= hv_dup(CvSTASH(sstr), param); /* NOTE: not refcounted */
-	CvSTART(dstr)	= CvSTART(sstr);
-	OP_REFCNT_LOCK;
-	CvROOT(dstr)	= OpREFCNT_inc(CvROOT(sstr));
-	OP_REFCNT_UNLOCK;
-	CvXSUB(dstr)	= CvXSUB(sstr);
-	CvXSUBANY(dstr)	= CvXSUBANY(sstr);
-	if (CvCONST(sstr)) {
-	    CvXSUBANY(dstr).any_ptr = GvUNIQUE(CvGV(sstr)) ?
-                SvREFCNT_inc(CvXSUBANY(sstr).any_ptr) :
-                sv_dup_inc((SV *)CvXSUBANY(sstr).any_ptr, param);
-	}
-	/* don't dup if copying back - CvGV isn't refcounted, so the
-	 * duped GV may never be freed. A bit of a hack! DAPM */
-	CvGV(dstr)	= (param->flags & CLONEf_JOIN_IN) ?
-		Nullgv : gv_dup(CvGV(sstr), param) ;
-	if (param->flags & CLONEf_COPY_STACKS) {
-	  CvDEPTH(dstr)	= CvDEPTH(sstr);
-	} else {
-	  CvDEPTH(dstr) = 0;
-	}
-	PAD_DUP(CvPADLIST(dstr), CvPADLIST(sstr), param);
-	CvOUTSIDE_SEQ(dstr) = CvOUTSIDE_SEQ(sstr);
-	CvOUTSIDE(dstr)	=
-		CvWEAKOUTSIDE(sstr)
-			? cv_dup(    CvOUTSIDE(sstr), param)
-			: cv_dup_inc(CvOUTSIDE(sstr), param);
-	CvFLAGS(dstr)	= CvFLAGS(sstr);
-	CvFILE(dstr) = CvXSUB(sstr) ? CvFILE(sstr) : SAVEPV(CvFILE(sstr));
-	break;
-    default:
-	Perl_croak(aTHX_ "Bizarre SvTYPE [%" IVdf "]", (IV)SvTYPE(sstr));
-	break;
     }
 
+ done_share:
     if (SvOBJECT(dstr) && SvTYPE(dstr) != SVt_PVIO)
 	++PL_sv_objcount;
 
@@ -11567,7 +11584,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_mess_sv		= Nullsv;
 
     PL_ors_sv		= sv_dup_inc(proto_perl->Iors_sv, param);
-    PL_ofmt		= SAVEPV(proto_perl->Iofmt);
 
     /* interpreter atexit processing */
     PL_exitlistlen	= proto_perl->Iexitlistlen;