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

diff --git a/sv.c b/sv.c
index 52f1da3..2d6d84d 100644
--- a/sv.c
+++ b/sv.c
@@ -524,6 +524,43 @@ Perl_sv_free_arenas(pTHX)
     SV* sva;
     SV* svanext;
     void *arena, *arenanext;
+    int i;
+    void **arenaroots[] = {
+	(void**) &PL_xnv_arenaroot,
+	(void**) &PL_xpv_arenaroot,
+	(void**) &PL_xpviv_arenaroot,
+	(void**) &PL_xpvnv_arenaroot,
+	(void**) &PL_xpvcv_arenaroot,
+	(void**) &PL_xpvav_arenaroot,
+	(void**) &PL_xpvhv_arenaroot,
+	(void**) &PL_xpvmg_arenaroot,
+	(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[] = {
+	(void**) &PL_xnv_root,
+	(void**) &PL_xpv_root,
+	(void**) &PL_xpviv_root,
+	(void**) &PL_xpvnv_root,
+	(void**) &PL_xpvcv_root,
+	(void**) &PL_xpvav_root,
+	(void**) &PL_xpvhv_root,
+	(void**) &PL_xpvmg_root,
+	(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
+    };
 
     /* Free arenas here, but be careful about fake ones.  (We assume
        contiguity of the fake ones with the corresponding real ones.) */
@@ -536,107 +573,19 @@ Perl_sv_free_arenas(pTHX)
 	if (!SvFAKE(sva))
 	    Safefree(sva);
     }
+    
+    assert(sizeof(arenaroots) == sizeof(roots));
 
-    for (arena = PL_xnv_arenaroot; arena; arena = arenanext) {
-	arenanext = *(void **)arena;
-	Safefree(arena);
-    }
-    PL_xnv_arenaroot = 0;
-    PL_xnv_root = 0;
-
-    for (arena = PL_xpv_arenaroot; arena; arena = arenanext) {
-	arenanext = *(void **)arena;
-	Safefree(arena);
-    }
-    PL_xpv_arenaroot = 0;
-    PL_xpv_root = 0;
-
-    for (arena = PL_xpviv_arenaroot; arena; arena = arenanext) {
-	arenanext = *(void **)arena;
-	Safefree(arena);
-    }
-    PL_xpviv_arenaroot = 0;
-    PL_xpviv_root = 0;
-
-    for (arena = PL_xpvnv_arenaroot; arena; arena = arenanext) {
-	arenanext = *(void **)arena;
-	Safefree(arena);
-    }
-    PL_xpvnv_arenaroot = 0;
-    PL_xpvnv_root = 0;
-
-    for (arena = PL_xpvcv_arenaroot; arena; arena = arenanext) {
-	arenanext = *(void **)arena;
-	Safefree(arena);
-    }
-    PL_xpvcv_arenaroot = 0;
-    PL_xpvcv_root = 0;
-
-    for (arena = PL_xpvav_arenaroot; arena; arena = arenanext) {
-	arenanext = *(void **)arena;
-	Safefree(arena);
-    }
-    PL_xpvav_arenaroot = 0;
-    PL_xpvav_root = 0;
-
-    for (arena = PL_xpvhv_arenaroot; arena; arena = arenanext) {
-	arenanext = *(void **)arena;
-	Safefree(arena);
-    }
-    PL_xpvhv_arenaroot = 0;
-    PL_xpvhv_root = 0;
-
-    for (arena = PL_xpvmg_arenaroot; arena; arena = arenanext) {
-	arenanext = *(void **)arena;
-	Safefree(arena);
-    }
-    PL_xpvmg_arenaroot = 0;
-    PL_xpvmg_root = 0;
-
-    for (arena = PL_xpvgv_arenaroot; arena; arena = arenanext) {
-	arenanext = *(void **)arena;
-	Safefree(arena);
-    }
-    PL_xpvgv_arenaroot = 0;
-    PL_xpvgv_root = 0;
-
-    for (arena = PL_xpvlv_arenaroot; arena; arena = arenanext) {
-	arenanext = *(void **)arena;
-	Safefree(arena);
-    }
-    PL_xpvlv_arenaroot = 0;
-    PL_xpvlv_root = 0;
-
-    for (arena = PL_xpvbm_arenaroot; arena; arena = arenanext) {
-	arenanext = *(void **)arena;
-	Safefree(arena);
-    }
-    PL_xpvbm_arenaroot = 0;
-    PL_xpvbm_root = 0;
+    for (i=0; arenaroots[i]; i++) {
 
-    {
-	HE *he;
-	HE *he_next;
-	for (he = PL_he_arenaroot; he; he = he_next) {
-	    he_next = HeNEXT(he);
-	    Safefree(he);
+	arena = *arenaroots[i];
+	for (; arena; arena = arenanext) {
+	    arenanext = *(void **)arena;
+	    Safefree(arena);
 	}
+	*arenaroots[i] = 0;
+	*roots[i] = 0;
     }
-    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);
@@ -758,15 +707,12 @@ S_varname(pTHX_ GV *gv, const char *gvtype, PADOFFSET targ,
     else {
 	U32 u;
 	CV *cv = find_runcv(&u);
-	STRLEN len;
-	const char *str;
 	if (!cv || !CvPADLIST(cv))
 	    return Nullsv;;
 	av = (AV*)(*av_fetch(CvPADLIST(cv), 0, FALSE));
 	sv = *av_fetch(av, targ, FALSE);
 	/* SvLEN in a pad name is not to be trusted */
-	str = SvPV(sv,len);
-	sv_setpvn(name, str, len);
+	sv_setpv(name, SvPV_nolen_const(sv));
     }
 
     if (subscript_type == FUV_SUBSCRIPT_HASH) {
@@ -1120,7 +1066,7 @@ Perl_report_uninit(pTHX_ SV* uninit_sv)
 		sv_insert(varname, 0, 0, " ", 1);
 	}
 	Perl_warner(aTHX_ packWARN(WARN_UNINITIALIZED), PL_warn_uninit,
-		varname ? SvPV_nolen(varname) : "",
+		varname ? SvPV_nolen_const(varname) : "",
 		" in ", OP_DESC(PL_op));
     }
     else
@@ -1128,543 +1074,108 @@ Perl_report_uninit(pTHX_ SV* uninit_sv)
 		    "", "", "");
 }
 
-/* allocate another arena's worth of NV bodies */
-
-STATIC void
-S_more_xnv(pTHX)
+STATIC void *
+S_more_bodies (pTHX_ void **arena_root, void **root, size_t size)
 {
-    NV* xnv;
-    NV* xnvend;
-    void *ptr;
-    New(711, ptr, PERL_ARENA_SIZE/sizeof(NV), NV);
-    *((void **) ptr) = (void *)PL_xnv_arenaroot;
-    PL_xnv_arenaroot = ptr;
+    char *start;
+    const char *end;
+    size_t count = PERL_ARENA_SIZE/size;
+    New(0, start, count*size, char);
+    *((void **) start) = *arena_root;
+    *arena_root = (void *)start;
 
-    xnv = (NV*) ptr;
-    xnvend = &xnv[PERL_ARENA_SIZE / sizeof(NV) - 1];
-    xnv += (sizeof(XPVIV) - 1) / sizeof(NV) + 1; /* fudge by sizeof XPVIV */
-    PL_xnv_root = xnv;
-    while (xnv < xnvend) {
-	*(NV**)xnv = (NV*)(xnv + 1);
-	xnv++;
-    }
-    *(NV**)xnv = 0;
-}
+    end = start + (count-1) * size;
 
-/* allocate another arena's worth of struct xpv */
-
-STATIC void
-S_more_xpv(pTHX)
-{
-    xpv_allocated* xpv;
-    xpv_allocated* xpvend;
-    New(713, xpv, PERL_ARENA_SIZE/sizeof(xpv_allocated), xpv_allocated);
-    *((xpv_allocated**)xpv) = PL_xpv_arenaroot;
-    PL_xpv_arenaroot = xpv;
-
-    xpvend = &xpv[PERL_ARENA_SIZE / sizeof(xpv_allocated) - 1];
-    PL_xpv_root = ++xpv;
-    while (xpv < xpvend) {
-	*((xpv_allocated**)xpv) = xpv + 1;
-	xpv++;
-    }
-    *((xpv_allocated**)xpv) = 0;
-}
+    /* The initial slot is used to link the arenas together, so it isn't to be
+       linked into the list of ready-to-use bodies.  */
 
-/* allocate another arena's worth of struct xpviv */
+    start += size;
 
-STATIC void
-S_more_xpviv(pTHX)
-{
-    xpviv_allocated* xpviv;
-    xpviv_allocated* xpvivend;
-    New(713, xpviv, PERL_ARENA_SIZE/sizeof(xpviv_allocated), xpviv_allocated);
-    *((xpviv_allocated**)xpviv) = PL_xpviv_arenaroot;
-    PL_xpviv_arenaroot = xpviv;
+    *root = (void *)start;
 
-    xpvivend = &xpviv[PERL_ARENA_SIZE / sizeof(xpviv_allocated) - 1];
-    PL_xpviv_root = ++xpviv;
-    while (xpviv < xpvivend) {
-	*((xpviv_allocated**)xpviv) = xpviv + 1;
-	xpviv++;
+    while (start < end) {
+	char *next = start + size;
+	*(void**) start = (void *)next;
+	start = next;
     }
-    *((xpviv_allocated**)xpviv) = 0;
-}
-
-/* allocate another arena's worth of struct xpvnv */
-
-STATIC void
-S_more_xpvnv(pTHX)
-{
-    XPVNV* xpvnv;
-    XPVNV* xpvnvend;
-    New(715, xpvnv, PERL_ARENA_SIZE/sizeof(XPVNV), XPVNV);
-    *((XPVNV**)xpvnv) = PL_xpvnv_arenaroot;
-    PL_xpvnv_arenaroot = xpvnv;
+    *(void **)start = 0;
 
-    xpvnvend = &xpvnv[PERL_ARENA_SIZE / sizeof(XPVNV) - 1];
-    PL_xpvnv_root = ++xpvnv;
-    while (xpvnv < xpvnvend) {
-	*((XPVNV**)xpvnv) = xpvnv + 1;
-	xpvnv++;
-    }
-    *((XPVNV**)xpvnv) = 0;
+    return *root;
 }
 
-/* allocate another arena's worth of struct xpvcv */
+/* grab a new thing from the free list, allocating more if necessary */
 
-STATIC void
-S_more_xpvcv(pTHX)
+STATIC void *
+S_new_body(pTHX_ void **arena_root, void **root, size_t size)
 {
-    XPVCV* xpvcv;
-    XPVCV* xpvcvend;
-    New(716, xpvcv, PERL_ARENA_SIZE/sizeof(XPVCV), XPVCV);
-    *((XPVCV**)xpvcv) = PL_xpvcv_arenaroot;
-    PL_xpvcv_arenaroot = xpvcv;
-
-    xpvcvend = &xpvcv[PERL_ARENA_SIZE / sizeof(XPVCV) - 1];
-    PL_xpvcv_root = ++xpvcv;
-    while (xpvcv < xpvcvend) {
-	*((XPVCV**)xpvcv) = xpvcv + 1;
-	xpvcv++;
-    }
-    *((XPVCV**)xpvcv) = 0;
-}
-
-/* allocate another arena's worth of struct xpvav */
-
-STATIC void
-S_more_xpvav(pTHX)
-{
-    xpvav_allocated* xpvav;
-     xpvav_allocated* xpvavend;
-    New(717, xpvav, PERL_ARENA_SIZE/sizeof(xpvav_allocated),
-	xpvav_allocated);
-    *((xpvav_allocated**)xpvav) = PL_xpvav_arenaroot;
-    PL_xpvav_arenaroot = xpvav;
-
-    xpvavend = &xpvav[PERL_ARENA_SIZE / sizeof(xpvav_allocated) - 1];
-    PL_xpvav_root = ++xpvav;
-    while (xpvav < xpvavend) {
-	*((xpvav_allocated**)xpvav) = xpvav + 1;
-	xpvav++;
-    }
-    *((xpvav_allocated**)xpvav) = 0;
-}
-
-/* allocate another arena's worth of struct xpvhv */
-
-STATIC void
-S_more_xpvhv(pTHX)
-{
-    xpvhv_allocated* xpvhv;
-    xpvhv_allocated* xpvhvend;
-    New(718, xpvhv, PERL_ARENA_SIZE/sizeof(xpvhv_allocated),
-	xpvhv_allocated);
-    *((xpvhv_allocated**)xpvhv) = PL_xpvhv_arenaroot;
-    PL_xpvhv_arenaroot = xpvhv;
-
-    xpvhvend = &xpvhv[PERL_ARENA_SIZE / sizeof(xpvhv_allocated) - 1];
-    PL_xpvhv_root = ++xpvhv;
-    while (xpvhv < xpvhvend) {
-	*((xpvhv_allocated**)xpvhv) = xpvhv + 1;
-	xpvhv++;
-    }
-    *((xpvhv_allocated**)xpvhv) = 0;
-}
-
-/* allocate another arena's worth of struct xpvmg */
-
-STATIC void
-S_more_xpvmg(pTHX)
-{
-    XPVMG* xpvmg;
-    XPVMG* xpvmgend;
-    New(719, xpvmg, PERL_ARENA_SIZE/sizeof(XPVMG), XPVMG);
-    *((XPVMG**)xpvmg) = PL_xpvmg_arenaroot;
-    PL_xpvmg_arenaroot = xpvmg;
-
-    xpvmgend = &xpvmg[PERL_ARENA_SIZE / sizeof(XPVMG) - 1];
-    PL_xpvmg_root = ++xpvmg;
-    while (xpvmg < xpvmgend) {
-	*((XPVMG**)xpvmg) = xpvmg + 1;
-	xpvmg++;
-    }
-    *((XPVMG**)xpvmg) = 0;
-}
-
-/* allocate another arena's worth of struct xpvgv */
-
-STATIC void
-S_more_xpvgv(pTHX)
-{
-    XPVGV* xpvgv;
-    XPVGV* xpvgvend;
-    New(720, xpvgv, PERL_ARENA_SIZE/sizeof(XPVGV), XPVGV);
-    *((XPVGV**)xpvgv) = PL_xpvgv_arenaroot;
-    PL_xpvgv_arenaroot = xpvgv;
-
-    xpvgvend = &xpvgv[PERL_ARENA_SIZE / sizeof(XPVGV) - 1];
-    PL_xpvgv_root = ++xpvgv;
-    while (xpvgv < xpvgvend) {
-	*((XPVGV**)xpvgv) = xpvgv + 1;
-	xpvgv++;
-    }
-    *((XPVGV**)xpvgv) = 0;
-}
-
-/* allocate another arena's worth of struct xpvlv */
-
-STATIC void
-S_more_xpvlv(pTHX)
-{
-    XPVLV* xpvlv;
-    XPVLV* xpvlvend;
-    New(720, xpvlv, PERL_ARENA_SIZE/sizeof(XPVLV), XPVLV);
-    *((XPVLV**)xpvlv) = PL_xpvlv_arenaroot;
-    PL_xpvlv_arenaroot = xpvlv;
-
-    xpvlvend = &xpvlv[PERL_ARENA_SIZE / sizeof(XPVLV) - 1];
-    PL_xpvlv_root = ++xpvlv;
-    while (xpvlv < xpvlvend) {
-	*((XPVLV**)xpvlv) = xpvlv + 1;
-	xpvlv++;
-    }
-    *((XPVLV**)xpvlv) = 0;
-}
-
-/* allocate another arena's worth of struct xpvbm */
-
-STATIC void
-S_more_xpvbm(pTHX)
-{
-    XPVBM* xpvbm;
-    XPVBM* xpvbmend;
-    New(721, xpvbm, PERL_ARENA_SIZE/sizeof(XPVBM), XPVBM);
-    *((XPVBM**)xpvbm) = PL_xpvbm_arenaroot;
-    PL_xpvbm_arenaroot = xpvbm;
-
-    xpvbmend = &xpvbm[PERL_ARENA_SIZE / sizeof(XPVBM) - 1];
-    PL_xpvbm_root = ++xpvbm;
-    while (xpvbm < xpvbmend) {
-	*((XPVBM**)xpvbm) = xpvbm + 1;
-	xpvbm++;
-    }
-    *((XPVBM**)xpvbm) = 0;
-}
-
-/* grab a new NV body from the free list, allocating more if necessary */
-
-STATIC XPVNV*
-S_new_xnv(pTHX)
-{
-    NV* xnv;
-    LOCK_SV_MUTEX;
-    if (!PL_xnv_root)
-	S_more_xnv(aTHX);
-    xnv = PL_xnv_root;
-    PL_xnv_root = *(NV**)xnv;
-    UNLOCK_SV_MUTEX;
-    return (XPVNV*)((char*)xnv - STRUCT_OFFSET(XPVNV, xnv_nv));
-}
-
-/* return an NV body to the free list */
-
-STATIC void
-S_del_xnv(pTHX_ XPVNV *p)
-{
-    NV* xnv = (NV*)((char*)(p) + STRUCT_OFFSET(XPVNV, xnv_nv));
+    void *xpv;
     LOCK_SV_MUTEX;
-    *(NV**)xnv = PL_xnv_root;
-    PL_xnv_root = xnv;
+    xpv = *root ? *root : S_more_bodies(aTHX_ arena_root, root, size);
+    *root = *(void**)xpv;
     UNLOCK_SV_MUTEX;
+    return xpv;
 }
 
-/* grab a new struct xpv from the free list, allocating more if necessary */
-
-STATIC XPV*
-S_new_xpv(pTHX)
-{
-    xpv_allocated* xpv;
-    LOCK_SV_MUTEX;
-    if (!PL_xpv_root)
-	S_more_xpv(aTHX);
-    xpv = PL_xpv_root;
-    PL_xpv_root = *(xpv_allocated**)xpv;
-    UNLOCK_SV_MUTEX;
-    /* If xpv_allocated is the same structure as XPV then the two OFFSETs
-       sum to zero, and the pointer is unchanged. If the allocated structure
-       is smaller (no initial IV actually allocated) then the net effect is
-       to subtract the size of the IV from the pointer, to return a new pointer
-       as if an initial IV were actually allocated.  */
-    return (XPV*)((char*)xpv - STRUCT_OFFSET(XPV, xpv_cur)
-		  + STRUCT_OFFSET(xpv_allocated, xpv_cur));
-}
+/* return a thing to the free list */
 
-/* return a struct xpv to the free list */
-
-STATIC void
-S_del_xpv(pTHX_ XPV *p)
-{
-    xpv_allocated* xpv
-	= (xpv_allocated*)((char*)(p) + STRUCT_OFFSET(XPV, xpv_cur)
-			   - STRUCT_OFFSET(xpv_allocated, xpv_cur));
-    LOCK_SV_MUTEX;
-    *(xpv_allocated**)xpv = PL_xpv_root;
-    PL_xpv_root = xpv;
-    UNLOCK_SV_MUTEX;
-}
-
-/* grab a new struct xpviv from the free list, allocating more if necessary */
-
-STATIC XPVIV*
-S_new_xpviv(pTHX)
-{
-    xpviv_allocated* xpviv;
-    LOCK_SV_MUTEX;
-    if (!PL_xpviv_root)
-	S_more_xpviv(aTHX);
-    xpviv = PL_xpviv_root;
-    PL_xpviv_root = *(xpviv_allocated**)xpviv;
-    UNLOCK_SV_MUTEX;
-    /* If xpviv_allocated is the same structure as XPVIV then the two OFFSETs
-       sum to zero, and the pointer is unchanged. If the allocated structure
-       is smaller (no initial IV actually allocated) then the net effect is
-       to subtract the size of the IV from the pointer, to return a new pointer
-       as if an initial IV were actually allocated.  */
-    return (XPVIV*)((char*)xpviv - STRUCT_OFFSET(XPVIV, xpv_cur)
-		  + STRUCT_OFFSET(xpviv_allocated, xpv_cur));
-}
-
-/* return a struct xpviv to the free list */
-
-STATIC void
-S_del_xpviv(pTHX_ XPVIV *p)
-{
-    xpviv_allocated* xpviv
-	= (xpviv_allocated*)((char*)(p) + STRUCT_OFFSET(XPVIV, xpv_cur)
-			   - STRUCT_OFFSET(xpviv_allocated, xpv_cur));
-    LOCK_SV_MUTEX;
-    *(xpviv_allocated**)xpviv = PL_xpviv_root;
-    PL_xpviv_root = xpviv;
-    UNLOCK_SV_MUTEX;
-}
-
-/* grab a new struct xpvnv from the free list, allocating more if necessary */
-
-STATIC XPVNV*
-S_new_xpvnv(pTHX)
-{
-    XPVNV* xpvnv;
-    LOCK_SV_MUTEX;
-    if (!PL_xpvnv_root)
-	S_more_xpvnv(aTHX);
-    xpvnv = PL_xpvnv_root;
-    PL_xpvnv_root = *(XPVNV**)xpvnv;
-    UNLOCK_SV_MUTEX;
-    return xpvnv;
-}
-
-/* return a struct xpvnv to the free list */
-
-STATIC void
-S_del_xpvnv(pTHX_ XPVNV *p)
-{
-    LOCK_SV_MUTEX;
-    *(XPVNV**)p = PL_xpvnv_root;
-    PL_xpvnv_root = p;
-    UNLOCK_SV_MUTEX;
-}
-
-/* grab a new struct xpvcv from the free list, allocating more if necessary */
-
-STATIC XPVCV*
-S_new_xpvcv(pTHX)
-{
-    XPVCV* xpvcv;
-    LOCK_SV_MUTEX;
-    if (!PL_xpvcv_root)
-	S_more_xpvcv(aTHX);
-    xpvcv = PL_xpvcv_root;
-    PL_xpvcv_root = *(XPVCV**)xpvcv;
-    UNLOCK_SV_MUTEX;
-    return xpvcv;
-}
-
-/* return a struct xpvcv to the free list */
-
-STATIC void
-S_del_xpvcv(pTHX_ XPVCV *p)
-{
-    LOCK_SV_MUTEX;
-    *(XPVCV**)p = PL_xpvcv_root;
-    PL_xpvcv_root = p;
-    UNLOCK_SV_MUTEX;
-}
-
-/* grab a new struct xpvav from the free list, allocating more if necessary */
-
-STATIC XPVAV*
-S_new_xpvav(pTHX)
-{
-    xpvav_allocated* xpvav;
-    LOCK_SV_MUTEX;
-    if (!PL_xpvav_root)
-	S_more_xpvav(aTHX);
-    xpvav = PL_xpvav_root;
-    PL_xpvav_root = *(xpvav_allocated**)xpvav;
-    UNLOCK_SV_MUTEX;
-    return (XPVAV*)((char*)xpvav - STRUCT_OFFSET(XPVAV, xav_fill)
-		    + STRUCT_OFFSET(xpvav_allocated, xav_fill));
-}
-
-/* return a struct xpvav to the free list */
-
-STATIC void
-S_del_xpvav(pTHX_ XPVAV *p)
-{
-    xpvav_allocated* xpvav
-	= (xpvav_allocated*)((char*)(p) + STRUCT_OFFSET(XPVAV, xav_fill)
-			     - STRUCT_OFFSET(xpvav_allocated, xav_fill));
-    LOCK_SV_MUTEX;
-    *(xpvav_allocated**)xpvav = PL_xpvav_root;
-    PL_xpvav_root = xpvav;
-    UNLOCK_SV_MUTEX;
-}
-
-/* grab a new struct xpvhv from the free list, allocating more if necessary */
-
-STATIC XPVHV*
-S_new_xpvhv(pTHX)
-{
-    xpvhv_allocated* xpvhv;
-    LOCK_SV_MUTEX;
-    if (!PL_xpvhv_root)
-	S_more_xpvhv(aTHX);
-    xpvhv = PL_xpvhv_root;
-    PL_xpvhv_root = *(xpvhv_allocated**)xpvhv;
-    UNLOCK_SV_MUTEX;
-    return (XPVHV*)((char*)xpvhv - STRUCT_OFFSET(XPVHV, xhv_fill)
-		    + STRUCT_OFFSET(xpvhv_allocated, xhv_fill));
-}
-
-/* return a struct xpvhv to the free list */
-
-STATIC void
-S_del_xpvhv(pTHX_ XPVHV *p)
-{
-    xpvhv_allocated* xpvhv
-	= (xpvhv_allocated*)((char*)(p) + STRUCT_OFFSET(XPVHV, xhv_fill)
-			     - STRUCT_OFFSET(xpvhv_allocated, xhv_fill));
-    LOCK_SV_MUTEX;
-    *(xpvhv_allocated**)xpvhv = PL_xpvhv_root;
-    PL_xpvhv_root = xpvhv;
-    UNLOCK_SV_MUTEX;
-}
-
-/* grab a new struct xpvmg from the free list, allocating more if necessary */
-
-STATIC XPVMG*
-S_new_xpvmg(pTHX)
-{
-    XPVMG* xpvmg;
-    LOCK_SV_MUTEX;
-    if (!PL_xpvmg_root)
-	S_more_xpvmg(aTHX);
-    xpvmg = PL_xpvmg_root;
-    PL_xpvmg_root = *(XPVMG**)xpvmg;
-    UNLOCK_SV_MUTEX;
-    return xpvmg;
-}
-
-/* return a struct xpvmg to the free list */
-
-STATIC void
-S_del_xpvmg(pTHX_ XPVMG *p)
-{
-    LOCK_SV_MUTEX;
-    *(XPVMG**)p = PL_xpvmg_root;
-    PL_xpvmg_root = p;
-    UNLOCK_SV_MUTEX;
-}
-
-/* grab a new struct xpvgv from the free list, allocating more if necessary */
-
-STATIC XPVGV*
-S_new_xpvgv(pTHX)
-{
-    XPVGV* xpvgv;
-    LOCK_SV_MUTEX;
-    if (!PL_xpvgv_root)
-	S_more_xpvgv(aTHX);
-    xpvgv = PL_xpvgv_root;
-    PL_xpvgv_root = *(XPVGV**)xpvgv;
-    UNLOCK_SV_MUTEX;
-    return xpvgv;
-}
-
-/* return a struct xpvgv to the free list */
-
-STATIC void
-S_del_xpvgv(pTHX_ XPVGV *p)
-{
-    LOCK_SV_MUTEX;
-    *(XPVGV**)p = PL_xpvgv_root;
-    PL_xpvgv_root = p;
-    UNLOCK_SV_MUTEX;
-}
-
-/* grab a new struct xpvlv from the free list, allocating more if necessary */
-
-STATIC XPVLV*
-S_new_xpvlv(pTHX)
-{
-    XPVLV* xpvlv;
-    LOCK_SV_MUTEX;
-    if (!PL_xpvlv_root)
-	S_more_xpvlv(aTHX);
-    xpvlv = PL_xpvlv_root;
-    PL_xpvlv_root = *(XPVLV**)xpvlv;
-    UNLOCK_SV_MUTEX;
-    return xpvlv;
-}
-
-/* return a struct xpvlv to the free list */
-
-STATIC void
-S_del_xpvlv(pTHX_ XPVLV *p)
-{
-    LOCK_SV_MUTEX;
-    *(XPVLV**)p = PL_xpvlv_root;
-    PL_xpvlv_root = p;
-    UNLOCK_SV_MUTEX;
-}
+#define del_body(thing, root)			\
+    STMT_START {				\
+	LOCK_SV_MUTEX;				\
+	*(void **)thing = *root;		\
+	*root = (void*)thing;			\
+	UNLOCK_SV_MUTEX;			\
+    } STMT_END
 
-/* grab a new struct xpvbm from the free list, allocating more if necessary */
+/* Conventionally we simply malloc() a big block of memory, then divide it
+   up into lots of the thing that we're allocating.
 
-STATIC XPVBM*
-S_new_xpvbm(pTHX)
-{
-    XPVBM* xpvbm;
-    LOCK_SV_MUTEX;
-    if (!PL_xpvbm_root)
-	S_more_xpvbm(aTHX);
-    xpvbm = PL_xpvbm_root;
-    PL_xpvbm_root = *(XPVBM**)xpvbm;
-    UNLOCK_SV_MUTEX;
-    return xpvbm;
-}
+   This macro will expand to call to S_new_body. So for XPVBM (with ithreads),
+   it would become
 
-/* return a struct xpvbm to the free list */
+   S_new_body(my_perl, (void**)&(my_perl->Ixpvbm_arenaroot),
+	      (void**)&(my_perl->Ixpvbm_root), sizeof(XPVBM), 0)
+*/
 
-STATIC void
-S_del_xpvbm(pTHX_ XPVBM *p)
-{
-    LOCK_SV_MUTEX;
-    *(XPVBM**)p = PL_xpvbm_root;
-    PL_xpvbm_root = p;
-    UNLOCK_SV_MUTEX;
-}
+#define new_body(TYPE,lctype)						\
+    S_new_body(aTHX_ (void**)&PL_ ## lctype ## _arenaroot,		\
+		 (void**)&PL_ ## lctype ## _root,			\
+		 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
+   member, then adjust the pointer back in memory by the size of the bit not
+   allocated, so it's as if we allocated the full structure.
+   (But things will all go boom if you write to the part that is "not there",
+   because you'll be overwriting the last members of the preceding structure
+   in memory.)
+
+   We calculate the correction using the STRUCT_OFFSET macro. For example, if
+   xpv_allocated is the same structure as XPV then the two OFFSETs sum to zero,
+   and the pointer is unchanged. If the allocated structure is smaller (no
+   initial NV actually allocated) then the net effect is to subtract the size
+   of the NV from the pointer, to return a new pointer as if an initial NV were
+   actually allocated.
+
+   This is the same trick as was used for NV and IV bodies. Ironically it
+   doesn't need to be used for NV bodies any more, because NV is now at the
+   start of the structure. IV bodies don't need it either, because they are
+   no longer allocated.  */
+
+#define new_body_allocated(TYPE,lctype,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_allocated(p,TYPE,lctype,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)
@@ -1706,38 +1217,38 @@ S_del_xpvbm(pTHX_ XPVBM *p)
 
 #else /* !PURIFY */
 
-#define new_XNV()	(void*)new_xnv()
-#define del_XNV(p)	del_xnv((XPVNV*) p)
+#define new_XNV()	new_body(NV, xnv)
+#define del_XNV(p)	del_body_type(p, NV, xnv)
 
-#define new_XPV()	(void*)new_xpv()
-#define del_XPV(p)	del_xpv((XPV *)p)
+#define new_XPV()	new_body_allocated(XPV, xpv, xpv_cur)
+#define del_XPV(p)	del_body_allocated(p, XPV, xpv, xpv_cur)
 
-#define new_XPVIV()	(void*)new_xpviv()
-#define del_XPVIV(p)	del_xpviv((XPVIV *)p)
+#define new_XPVIV()	new_body_allocated(XPVIV, xpviv, xpv_cur)
+#define del_XPVIV(p)	del_body_allocated(p, XPVIV, xpviv, xpv_cur)
 
-#define new_XPVNV()	(void*)new_xpvnv()
-#define del_XPVNV(p)	del_xpvnv((XPVNV *)p)
+#define new_XPVNV()	new_body(XPVNV, xpvnv)
+#define del_XPVNV(p)	del_body_type(p, XPVNV, xpvnv)
 
-#define new_XPVCV()	(void*)new_xpvcv()
-#define del_XPVCV(p)	del_xpvcv((XPVCV *)p)
+#define new_XPVCV()	new_body(XPVCV, xpvcv)
+#define del_XPVCV(p)	del_body_type(p, XPVCV, xpvcv)
 
-#define new_XPVAV()	(void*)new_xpvav()
-#define del_XPVAV(p)	del_xpvav((XPVAV *)p)
+#define new_XPVAV()	new_body_allocated(XPVAV, xpvav, xav_fill)
+#define del_XPVAV(p)	del_body_allocated(p, XPVAV, xpvav, xav_fill)
 
-#define new_XPVHV()	(void*)new_xpvhv()
-#define del_XPVHV(p)	del_xpvhv((XPVHV *)p)
+#define new_XPVHV()	new_body_allocated(XPVHV, xpvhv, xhv_fill)
+#define del_XPVHV(p)	del_body_allocated(p, XPVHV, xpvhv, xhv_fill)
 
-#define new_XPVMG()	(void*)new_xpvmg()
-#define del_XPVMG(p)	del_xpvmg((XPVMG *)p)
+#define new_XPVMG()	new_body(XPVMG, xpvmg)
+#define del_XPVMG(p)	del_body_type(p, XPVMG, xpvmg)
 
-#define new_XPVGV()	(void*)new_xpvgv()
-#define del_XPVGV(p)	del_xpvgv((XPVGV *)p)
+#define new_XPVGV()	new_body(XPVGV, xpvgv)
+#define del_XPVGV(p)	del_body_type(p, XPVGV, xpvgv)
 
-#define new_XPVLV()	(void*)new_xpvlv()
-#define del_XPVLV(p)	del_xpvlv((XPVLV *)p)
+#define new_XPVLV()	new_body(XPVLV, xpvlv)
+#define del_XPVLV(p)	del_body_type(p, XPVLV, xpvlv)
 
-#define new_XPVBM()	(void*)new_xpvbm()
-#define del_XPVBM(p)	del_xpvbm((XPVBM *)p)
+#define new_XPVBM()	new_body(XPVBM, xpvbm)
+#define del_XPVBM(p)	del_body_type(p, XPVBM, xpvbm)
 
 #endif /* PURIFY */
 
@@ -1757,76 +1268,129 @@ You generally want to use the C<SvUPGRADE> macro wrapper. See also C<svtype>.
 =cut
 */
 
-bool
+void
 Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 {
-
-    char*	pv;
-    U32		cur;
-    U32		len;
-    IV		iv;
-    NV		nv;
-    MAGIC*	magic;
-    HV*		stash;
+    void**	old_body_arena;
+    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;
+    void**	new_body_arena;
+    void**	new_body_arenaroot;
+    U32		old_type = SvTYPE(sv);
 
     if (mt != SVt_PV && SvIsCOW(sv)) {
 	sv_force_normal_flags(sv, 0);
     }
 
     if (SvTYPE(sv) == mt)
-	return TRUE;
+	return;
+
+    if (SvTYPE(sv) > mt)
+	Perl_croak(aTHX_ "sv_upgrade from type %d down to type %d",
+		(int)SvTYPE(sv), (int)mt);
 
-    pv = NULL;
-    cur = 0;
-    len = 0;
-    iv = 0;
-    nv = 0.0;
-    magic = NULL;
-    stash = Nullhv;
+
+    old_body = SvANY(sv);
+    old_body_arena = 0;
+    old_body_offset = 0;
+    old_body_length = 0;
+    new_body_offset = 0;
+    new_body_length = ~0;
+
+    /* Copying structures onto other structures that have been neatly zeroed
+       has a subtle gotcha. Consider XPVMG
+
+       +------+------+------+------+------+-------+-------+
+       |     NV      | CUR  | LEN  |  IV  | MAGIC | STASH |
+       +------+------+------+------+------+-------+-------+
+       0      4      8     12     16     20      24      28
+
+       where NVs are aligned to 8 bytes, so that sizeof that structure is
+       actually 32 bytes long, with 4 bytes of padding at the end:
+
+       +------+------+------+------+------+-------+-------+------+
+       |     NV      | CUR  | LEN  |  IV  | MAGIC | STASH | ???  |
+       +------+------+------+------+------+-------+-------+------+
+       0      4      8     12     16     20      24      28     32
+
+       so what happens if you allocate memory for this structure:
+
+       +------+------+------+------+------+-------+-------+------+------+...
+       |     NV      | CUR  | LEN  |  IV  | MAGIC | STASH |  GP  | NAME |
+       +------+------+------+------+------+-------+-------+------+------+...
+       0      4      8     12     16     20      24      28     32     36
+
+       zero it, then copy sizeof(XPVMG) bytes on top of it? Not quite what you
+       expect, because you copy the area marked ??? onto GP. Now, ??? may have
+       started out as zero once, but it's quite possible that it isn't. So now,
+       rather than a nicely zeroed GP, you have it pointing somewhere random.
+       Bugs ensue.
+
+       (In fact, GP ends up pointing at a previous GP structure, because the
+       principle cause of the padding in XPVMG getting garbage is a copy of
+       sizeof(XPVMG) bytes from a XPVGV structure in sv_unglob)
+
+       So we are careful and work out the size of used parts of all the
+       structures.  */
 
     switch (SvTYPE(sv)) {
     case SVt_NULL:
 	break;
     case SVt_IV:
-	iv	= SvIVX(sv);
 	if (mt == SVt_NV)
 	    mt = SVt_PVNV;
 	else if (mt < SVt_PVIV)
 	    mt = SVt_PVIV;
+	old_body_offset = STRUCT_OFFSET(XPVIV, xiv_iv);
+	old_body_length = sizeof(IV);
 	break;
     case SVt_NV:
-	nv	= SvNVX(sv);
-	del_XNV(SvANY(sv));
+	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;
     case SVt_RV:
-	pv	= (char*)SvRV(sv);
 	break;
     case SVt_PV:
-	pv	= SvPVX_mutable(sv);
-	cur	= SvCUR(sv);
-	len	= SvLEN(sv);
-	del_XPV(SvANY(sv));
+	old_body_arena = (void **) &PL_xpv_root;
+	old_body_offset = STRUCT_OFFSET(XPV, xpv_cur)
+	    - STRUCT_OFFSET(xpv_allocated, xpv_cur);
+	old_body_length = STRUCT_OFFSET(XPV, xpv_len)
+	    + sizeof (((XPV*)SvANY(sv))->xpv_len)
+	    - old_body_offset;
 	if (mt <= SVt_IV)
 	    mt = SVt_PVIV;
 	else if (mt == SVt_NV)
 	    mt = SVt_PVNV;
 	break;
     case SVt_PVIV:
-	pv	= SvPVX_mutable(sv);
-	cur	= SvCUR(sv);
-	len	= SvLEN(sv);
-	iv	= SvIVX(sv);
-	del_XPVIV(SvANY(sv));
+	old_body_arena = (void **) &PL_xpviv_root;
+	old_body_offset = STRUCT_OFFSET(XPVIV, xpv_cur)
+	    - STRUCT_OFFSET(xpviv_allocated, xpv_cur);
+	old_body_length =  STRUCT_OFFSET(XPVIV, xiv_u)
+	    + sizeof (((XPVIV*)SvANY(sv))->xiv_u)
+	    - old_body_offset;
 	break;
     case SVt_PVNV:
-	pv	= SvPVX_mutable(sv);
-	cur	= SvCUR(sv);
-	len	= SvLEN(sv);
-	iv	= SvIVX(sv);
-	nv	= SvNVX(sv);
-	del_XPVNV(SvANY(sv));
+	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,
@@ -1837,14 +1401,12 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 	   Given that it only has meaning inside the pad, it shouldn't be set
 	   on anything that can get upgraded.  */
 	assert((SvFLAGS(sv) & SVpad_TYPED) == 0);
-	pv	= SvPVX_mutable(sv);
-	cur	= SvCUR(sv);
-	len	= SvLEN(sv);
-	iv	= SvIVX(sv);
-	nv	= SvNVX(sv);
-	magic	= SvMAGIC(sv);
-	stash	= SvSTASH(sv);
-	del_XPVMG(SvANY(sv));
+	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");
@@ -1857,16 +1419,19 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
     case SVt_NULL:
 	Perl_croak(aTHX_ "Can't upgrade to undef");
     case SVt_IV:
+	assert(old_type == SVt_NULL);
 	SvANY(sv) = (XPVIV*)((char*)&(sv->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
-	SvIV_set(sv, iv);
+	SvIV_set(sv, 0);
 	break;
     case SVt_NV:
+	assert(old_type == SVt_NULL);
 	SvANY(sv) = new_XNV();
-	SvNV_set(sv, nv);
+	SvNV_set(sv, 0);
 	break;
     case SVt_RV:
+	assert(old_type == SVt_NULL);
 	SvANY(sv) = &sv->sv_u.svu_rv;
-	SvRV_set(sv, (SV*)pv);
+	SvRV_set(sv, 0);
 	break;
     case SVt_PVHV:
 	SvANY(sv) = new_XPVHV();
@@ -1874,102 +1439,147 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 	HvMAX(sv)	= 0;
 	HvTOTALKEYS(sv)	= 0;
 
-	/* Fall through...  */
-	if (0) {
-	case SVt_PVAV:
-	    SvANY(sv) = new_XPVAV();
-	    AvMAX(sv)	= -1;
-	    AvFILLp(sv)	= -1;
-	    AvALLOC(sv)	= 0;
-	    AvREAL_only(sv);
-	}
-	/* to here.  */
-	/* XXX? Only SVt_NULL is ever upgraded to AV or HV?  */
-	assert(!pv);
-	/* FIXME. Should be able to remove all this if()... if the above
-	   assertion is genuinely always true.  */
-	if(SvOOK(sv)) {
-	    pv -= iv;
-	    SvFLAGS(sv) &= ~SVf_OOK;
-	}
-	Safefree(pv);
+	goto hv_av_common;
+
+    case SVt_PVAV:
+	SvANY(sv) = new_XPVAV();
+	AvMAX(sv)	= -1;
+	AvFILLp(sv)	= -1;
+	AvALLOC(sv)	= 0;
+	AvREAL_only(sv);
+
+    hv_av_common:
+	/* 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) {
+	    assert(SvPVX_const(sv) == 0);
+	}
+
+	/* Could put this in the else clause below, as PVMG must have SvPVX
+	   0 already (the assertion above)  */
 	SvPV_set(sv, (char*)0);
-	SvMAGIC_set(sv, magic);
-	SvSTASH_set(sv, stash);
+
+	if (old_type >= SVt_PVMG) {
+	    SvMAGIC_set(sv, ((XPVMG*)old_body)->xmg_magic);
+	    SvSTASH_set(sv, ((XPVMG*)old_body)->xmg_stash);
+	} else {
+	    SvMAGIC_set(sv, 0);
+	    SvSTASH_set(sv, 0);
+	}
 	break;
 
     case SVt_PVIO:
-	SvANY(sv) = new_XPVIO();
-	Zero(SvANY(sv), 1, XPVIO);
-	IoPAGE_LEN(sv)	= 60;
-	goto set_magic_common;
+	new_body = new_XPVIO();
+	new_body_length = sizeof(XPVIO);
+	goto zero;
     case SVt_PVFM:
-	SvANY(sv) = new_XPVFM();
-	Zero(SvANY(sv), 1, XPVFM);
-	goto set_magic_common;
+	new_body = new_XPVFM();
+	new_body_length = sizeof(XPVFM);
+	goto zero;
+
     case SVt_PVBM:
-	SvANY(sv) = new_XPVBM();
-	BmRARE(sv)	= 0;
-	BmUSEFUL(sv)	= 0;
-	BmPREVIOUS(sv)	= 0;
-	goto set_magic_common;
+	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:
-	SvANY(sv) = new_XPVGV();
-	GvGP(sv)	= 0;
-	GvNAME(sv)	= 0;
-	GvNAMELEN(sv)	= 0;
-	GvSTASH(sv)	= 0;
-	GvFLAGS(sv)	= 0;
-	goto set_magic_common;
+	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:
-	SvANY(sv) = new_XPVCV();
-	Zero(SvANY(sv), 1, XPVCV);
-	goto set_magic_common;
+	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:
-	SvANY(sv) = new_XPVLV();
-	LvTARGOFF(sv)	= 0;
-	LvTARGLEN(sv)	= 0;
-	LvTARG(sv)	= 0;
-	LvTYPE(sv)	= 0;
-	GvGP(sv)	= 0;
-	GvNAME(sv)	= 0;
-	GvNAMELEN(sv)	= 0;
-	GvSTASH(sv)	= 0;
-	GvFLAGS(sv)	= 0;
-	/* Fall through.  */
-	if (0) {
-	case SVt_PVMG:
-	    SvANY(sv) = new_XPVMG();
-	}
-    set_magic_common:
-	SvMAGIC_set(sv, magic);
-	SvSTASH_set(sv, stash);
-	/* Fall through.  */
-	if (0) {
-	case SVt_PVNV:
-	    SvANY(sv) = new_XPVNV();
-	}
-	SvNV_set(sv, nv);
-	/* Fall through.  */
-	if (0) {
-	case SVt_PVIV:
-	    SvANY(sv) = new_XPVIV();
-	    if (SvNIOK(sv))
-		(void)SvIOK_on(sv);
-	    SvNOK_off(sv);
-	}
-	SvIV_set(sv, iv);
-	/* Fall through.  */
-	if (0) {
-	case SVt_PV:
-	    SvANY(sv) = new_XPV();
+	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;
+	/* XXX Is this still needed?  Was it ever needed?   Surely as there is
+	   no route from NV to PVIV, NOK can never be true  */
+	if (SvNIOK(sv))
+	    (void)SvIOK_on(sv);
+	SvNOK_off(sv);
+	goto new_body_no_NV; 
+    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_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);
+#ifndef PURIFY
+	/* 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);
+
+#endif
+    zero:
+	Zero(new_body, new_body_length, char);
+	new_body = ((char *)new_body) - new_body_offset;
+	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);
 	}
-	SvPV_set(sv, pv);
-	SvCUR_set(sv, cur);
-	SvLEN_set(sv, len);
+
+#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);
+    }
+
+
+    if (old_body_arena) {
+#ifdef PURIFY
+	my_safefree(old_body);
+#else
+	del_body((void*)((char*)old_body + old_body_offset),
+		 old_body_arena);
+#endif
     }
-    return TRUE;
 }
 
 /*
@@ -2024,11 +1634,11 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
 	sv_unref(sv);
     if (SvTYPE(sv) < SVt_PV) {
 	sv_upgrade(sv, SVt_PV);
-	s = SvPVX(sv);
+	s = SvPVX_mutable(sv);
     }
     else if (SvOOK(sv)) {	/* pv is offset? */
 	sv_backoff(sv);
-	s = SvPVX(sv);
+	s = SvPVX_mutable(sv);
 	if (newlen > SvLEN(sv))
 	    newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */
 #ifdef HAS_64K_LIMIT
@@ -2043,7 +1653,7 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
 	newlen = PERL_STRLEN_ROUNDUP(newlen);
 	if (SvLEN(sv) && s) {
 #ifdef MYMALLOC
-	    const STRLEN l = malloced_size((void*)SvPVX(sv));
+	    const STRLEN l = malloced_size((void*)SvPVX_const(sv));
 	    if (newlen <= l) {
 		SvLEN_set(sv, l);
 		return s;
@@ -3441,7 +3051,22 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
             register const char *typestr;
             if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)) &&
                 (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
-                char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr);
+		/* Unwrap this:  */
+		/* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr); */
+
+                char *pv;
+		if ((SvFLAGS(tmpstr) & (SVf_POK)) == SVf_POK) {
+		    if (flags & SV_CONST_RETURN) {
+			pv = (char *) SvPVX_const(tmpstr);
+		    } else {
+			pv = (flags & SV_MUTABLE_RETURN)
+			    ? SvPVX_mutable(tmpstr) : SvPVX(tmpstr);
+		    }
+		    if (lp)
+			*lp = SvCUR(tmpstr);
+		} else {
+		    pv = sv_2pv_flags(tmpstr, lp, flags);
+		}
                 if (SvUTF8(tmpstr))
                     SvUTF8_on(sv);
                 else
@@ -3598,7 +3223,8 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 	    ptr = uiv_2buf(buf, 0, SvUVX(sv), 1, &ebuf);
 	else
 	    ptr = uiv_2buf(buf, SvIVX(sv), 0, 0, &ebuf);
-	SvGROW(sv, (STRLEN)(ebuf - ptr + 1));	/* 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);
@@ -3614,8 +3240,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 	if (SvTYPE(sv) < SVt_PVNV)
 	    sv_upgrade(sv, SVt_PVNV);
 	/* The +20 is pure guesswork.  Configure test needed. --jhi */
-	SvGROW(sv, NV_DIG + 20);
-	s = SvPVX_mutable(sv);
+	s = SvGROW_mutable(sv, NV_DIG + 20);
 	olderrno = errno;	/* some Xenix systems wipe out errno here */
 #ifdef apollo
 	if (SvNVX(sv) == 0.0)
@@ -3697,7 +3322,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 	SvUPGRADE(sv, SVt_PV);
 	if (lp)
 	    *lp = len;
-	s = SvGROW(sv, len + 1);
+	s = SvGROW_mutable(sv, len + 1);
 	SvCUR_set(sv, len);
 	SvPOKp_on(sv);
 	return strcpy(s, t);
@@ -3764,7 +3389,7 @@ char *
 Perl_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
 {
     sv_utf8_downgrade(sv,0);
-    return SvPV(sv,*lp);
+    return lp ? SvPV(sv,*lp) : SvPV_nolen(sv);
 }
 
 /*
@@ -3916,9 +3541,9 @@ Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags)
 	 * had a FLAG in SVs to signal if there are any hibit
 	 * chars in the PV.  Given that there isn't such a flag
 	 * make the loop as fast as possible. */
-	U8 *s = (U8 *) SvPVX(sv);
-	U8 *e = (U8 *) SvEND(sv);
-	U8 *t = s;
+	const U8 *s = (U8 *) SvPVX_const(sv);
+	const U8 *e = (U8 *) SvEND(sv);
+	const U8 *t = s;
 	int hibit = 0;
 	
 	while (t < e) {
@@ -3928,11 +3553,11 @@ Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags)
 	}
 	if (hibit) {
 	    STRLEN len = SvCUR(sv) + 1; /* Plus the \0 */
-	    s = bytes_to_utf8((U8*)s, &len);
+	    U8 *recoded = bytes_to_utf8((U8*)s, &len);
 
 	    SvPV_free(sv); /* No longer using what was there before. */
 
-	    SvPV_set(sv, (char*)s);
+	    SvPV_set(sv, (char*)recoded);
 	    SvCUR_set(sv, len - 1);
 	    SvLEN_set(sv, len); /* No longer know the real size. */
 	}
@@ -4024,8 +3649,8 @@ bool
 Perl_sv_utf8_decode(pTHX_ register SV *sv)
 {
     if (SvPOKp(sv)) {
-        U8 *c;
-        U8 *e;
+        const U8 *c;
+        const U8 *e;
 
 	/* The octets may have got themselves encoded - get them back as
 	 * bytes
@@ -4036,10 +3661,10 @@ Perl_sv_utf8_decode(pTHX_ register SV *sv)
         /* it is actually just a matter of turning the utf8 flag on, but
          * we want to make sure everything inside is valid utf8 first.
          */
-        c = (U8 *) SvPVX(sv);
+        c = (const U8 *) SvPVX_const(sv);
 	if (!is_utf8_string(c, SvCUR(sv)+1))
 	    return FALSE;
-        e = (U8 *) SvEND(sv);
+        e = (const U8 *) SvEND(sv);
         while (c < e) {
 	    U8 ch = *c++;
             if (!UTF8_IS_INVARIANT(ch)) {
@@ -4373,7 +3998,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
 			    }
 			    if (!intro)
 				cv_ckproto(cv, (GV*)dstr,
-					SvPOK(sref) ? SvPVX(sref) : Nullch);
+					   SvPOK(sref)
+					   ? SvPVX_const(sref) : Nullch);
 			}
 			GvCV(dstr) = (CV*)sref;
 			GvCVGEN(dstr) = 0; /* Switch off cacheness. */
@@ -4541,21 +4167,18 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                     /* splice us in between source and next-after-source.  */
                     SV_COW_NEXT_SV_SET(dstr, SV_COW_NEXT_SV(sstr));
                     SV_COW_NEXT_SV_SET(sstr, dstr);
-                    SvPV_set(dstr, SvPVX(sstr));
+                    SvPV_set(dstr, SvPVX_mutable(sstr));
                 } else
 #endif
 		{
                     /* SvIsCOW_shared_hash */
-                    UV hash = SvSHARED_HASH(sstr);
                     DEBUG_C(PerlIO_printf(Perl_debug_log,
                                           "Copy on write: Sharing hash\n"));
 
-		    assert (SvTYPE(dstr) >= SVt_PVIV);
+		    assert (SvTYPE(dstr) >= SVt_PV);
                     SvPV_set(dstr,
-                             sharepvn(SvPVX_const(sstr),
-                                      (sflags & SVf_UTF8?-cur:cur), hash));
-                    SvUV_set(dstr, hash);
-                }
+			     HEK_KEY(share_hek_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr)))));
+		}
                 SvLEN_set(dstr, len);
                 SvCUR_set(dstr, cur);
                 SvREADONLY_on(dstr);
@@ -4578,7 +4201,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
         }
 	if (sflags & SVf_UTF8)
 	    SvUTF8_on(dstr);
-	/*SUPPRESS 560*/
 	if (sflags & SVp_NOK) {
 	    SvNOKp_on(dstr);
 	    if (sflags & SVf_NOK)
@@ -4692,11 +4314,9 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
 
 	if (SvLEN(sstr) == 0) {
 	    /* source is a COW shared hash key.  */
-	    UV hash = SvSHARED_HASH(sstr);
 	    DEBUG_C(PerlIO_printf(Perl_debug_log,
 				  "Fast copy on write: Sharing hash\n"));
-	    SvUV_set(dstr, hash);
-	    new_pv = sharepvn(SvPVX_const(sstr), (SvUTF8(sstr)?-cur:cur), hash);
+	    new_pv = HEK_KEY(share_hek_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr))));
 	    goto common_exit;
 	}
 	SV_COW_NEXT_SV_SET(dstr, SV_COW_NEXT_SV(sstr));
@@ -4710,7 +4330,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
 	SV_COW_NEXT_SV_SET(dstr, sstr);
     }
     SV_COW_NEXT_SV_SET(sstr, dstr);
-    new_pv = SvPVX(sstr);
+    new_pv = SvPVX_mutable(sstr);
 
   common_exit:
     SvPV_set(dstr, new_pv);
@@ -4754,8 +4374,7 @@ Perl_sv_setpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN
     }
     SvUPGRADE(sv, SVt_PV);
 
-    SvGROW(sv, len + 1);
-    dptr = SvPVX(sv);
+    dptr = SvGROW(sv, len + 1);
     Move(ptr,dptr,len,char);
     dptr[len] = '\0';
     SvCUR_set(sv, len);
@@ -4881,8 +4500,7 @@ Perl_sv_usepvn_mg(pTHX_ register SV *sv, register char *ptr, register STRLEN len
    (which it can do by means other than releasing copy-on-write Svs)
    or by changing the other copy-on-write SVs in the loop.  */
 STATIC void
-S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, STRLEN cur, STRLEN len,
-                 U32 hash, SV *after)
+S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, STRLEN len, SV *after)
 {
     if (len) { /* this SV was SvIsCOW_normal(sv) */
          /* we need to find the SV pointing to us.  */
@@ -4909,7 +4527,7 @@ S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, STRLEN cur, STRLEN len,
             SV_COW_NEXT_SV_SET(current, after);
         }
     } else {
-        unsharepvn(pvx, SvUTF8(sv) ? -(I32)cur : cur, hash);
+        unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
     }
 }
 
@@ -4945,11 +4563,10 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
     if (SvREADONLY(sv)) {
         /* At this point I believe I should acquire a global SV mutex.  */
 	if (SvFAKE(sv)) {
-            const char *pvx = SvPVX_const(sv);
-            const STRLEN len = SvLEN(sv);
-            const STRLEN cur = SvCUR(sv);
-            const U32 hash = SvSHARED_HASH(sv);
-            SV *const next = SV_COW_NEXT_SV(sv);   /* next COW sv in the loop. */
+	    const char *pvx = SvPVX_const(sv);
+	    const STRLEN len = SvLEN(sv);
+	    const STRLEN cur = SvCUR(sv);
+	    SV * const next = SV_COW_NEXT_SV(sv);   /* next COW sv in the loop. */
             if (DEBUG_C_TEST) {
                 PerlIO_printf(Perl_debug_log,
                               "Copy on write: Force normal %ld\n",
@@ -4970,7 +4587,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
                 SvCUR_set(sv, cur);
                 *SvEND(sv) = '\0';
             }
-            sv_release_COW(sv, pvx, cur, len, hash, next);
+            sv_release_COW(sv, pvx, len, next);
             if (DEBUG_C_TEST) {
                 sv_dump(sv);
             }
@@ -4983,9 +4600,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
     if (SvREADONLY(sv)) {
 	if (SvFAKE(sv)) {
 	    const char *pvx = SvPVX_const(sv);
-	    const int is_utf8 = SvUTF8(sv);
 	    const STRLEN len = SvCUR(sv);
-	    const U32 hash   = SvSHARED_HASH(sv);
 	    SvFAKE_off(sv);
 	    SvREADONLY_off(sv);
 	    SvPV_set(sv, Nullch);
@@ -4993,7 +4608,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
 	    SvGROW(sv, len + 1);
 	    Move(pvx,SvPVX_const(sv),len,char);
 	    *SvEND(sv) = '\0';
-	    unsharepvn(pvx, is_utf8 ? -(I32)len : len, hash);
+	    unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
 	}
 	else if (IN_PERL_RUNTIME)
 	    Perl_croak(aTHX_ PL_no_modify);
@@ -5048,7 +4663,7 @@ Perl_sv_chop(pTHX_ register SV *sv, register const char *ptr)
     if (!SvOOK(sv)) {
 	if (!SvLEN(sv)) { /* make copy of shared string */
 	    const char *pvx = SvPVX_const(sv);
-	    STRLEN len = SvCUR(sv);
+	    const STRLEN len = SvCUR(sv);
 	    SvGROW(sv, len + 1);
 	    Move(pvx,SvPVX_const(sv),len,char);
 	    *SvEND(sv) = '\0';
@@ -5181,7 +4796,7 @@ Perl_sv_catsv_flags(pTHX_ SV *dsv, register SV *ssv, I32 flags)
 		SV* csv = sv_2mortal(newSVpvn(spv, slen));
 
 		sv_utf8_upgrade(csv);
-		spv = SvPV(csv, slen);
+		spv = SvPV_const(csv, slen);
 	    }
 	    else
 		sv_utf8_upgrade_nomg(dsv);
@@ -5691,7 +5306,7 @@ Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, const char *little,
     (void)SvPOK_only_UTF8(bigstr);
     if (offset + len > curlen) {
 	SvGROW(bigstr, offset+len+1);
-	Zero(SvPVX_const(bigstr)+curlen, offset+len-curlen, char);
+	Zero(SvPVX(bigstr)+curlen, offset+len-curlen, char);
 	SvCUR_set(bigstr, offset+len);
     }
 
@@ -5737,7 +5352,6 @@ Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, const char *little,
 	*mid = '\0';
 	SvCUR_set(bigstr, mid - big);
     }
-    /*SUPPRESS 560*/
     else if ((i = mid - big)) {	/* faster from front */
 	midend -= littlelen;
 	mid = midend;
@@ -5796,6 +5410,7 @@ Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv)
     sv->sv_flags  = nsv->sv_flags;
     sv->sv_any    = nsv->sv_any;
     sv->sv_refcnt = nsv->sv_refcnt;
+    sv->sv_u      = nsv->sv_u;
 #else
     StructCopy(nsv,sv,SV);
 #endif
@@ -5967,7 +5582,7 @@ Perl_sv_clear(pTHX_ register SV *sv)
       freescalar:
 	/* Don't bother with SvOOK_off(sv); as we're only going to free it.  */
 	if (SvOOK(sv)) {
-	    SvPV_set(sv, SvPVX(sv) - SvIVX(sv));
+	    SvPV_set(sv, SvPVX_mutable(sv) - SvIVX(sv));
 	    /* Don't even bother with turning off the OOK flag.  */
 	}
 	/* FALL THROUGH */
@@ -5988,8 +5603,8 @@ Perl_sv_clear(pTHX_ register SV *sv)
                     PerlIO_printf(Perl_debug_log, "Copy on write: clear\n");
                     sv_dump(sv);
                 }
-                sv_release_COW(sv, SvPVX_const(sv), SvCUR(sv), SvLEN(sv),
-                                 SvUVX(sv), SV_COW_NEXT_SV(sv));
+                sv_release_COW(sv, SvPVX_const(sv), SvLEN(sv),
+			       SV_COW_NEXT_SV(sv));
                 /* And drop it here.  */
                 SvFAKE_off(sv);
             } else if (SvLEN(sv)) {
@@ -6000,9 +5615,7 @@ Perl_sv_clear(pTHX_ register SV *sv)
 	else if (SvPVX_const(sv) && SvLEN(sv))
 	    Safefree(SvPVX_const(sv));
 	else if (SvPVX_const(sv) && SvREADONLY(sv) && SvFAKE(sv)) {
-	    unsharepvn(SvPVX_const(sv),
-		       SvUTF8(sv) ? -(I32)SvCUR(sv) : SvCUR(sv),
-		       SvUVX(sv));
+	    unshare_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv)));
 	    SvFAKE_off(sv);
 	}
 #endif
@@ -6631,12 +6244,12 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
 	      if (SvUTF8(sv1)) {
 		   svrecode = newSVpvn(pv2, cur2);
 		   sv_recode_to_utf8(svrecode, PL_encoding);
-		   pv2 = SvPV(svrecode, cur2);
+		   pv2 = SvPV_const(svrecode, cur2);
 	      }
 	      else {
 		   svrecode = newSVpvn(pv1, cur1);
 		   sv_recode_to_utf8(svrecode, PL_encoding);
-		   pv1 = SvPV(svrecode, cur1);
+		   pv1 = SvPV_const(svrecode, cur1);
 	      }
 	      /* Now both are in UTF-8. */
 	      if (cur1 != cur2) {
@@ -6724,7 +6337,7 @@ Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
 	    if (PL_encoding) {
 		 svrecode = newSVpvn(pv2, cur2);
 		 sv_recode_to_utf8(svrecode, PL_encoding);
-		 pv2 = SvPV(svrecode, cur2);
+		 pv2 = SvPV_const(svrecode, cur2);
 	    }
 	    else {
 		 pv2 = tpv = (char*)bytes_to_utf8((const U8*)pv2, &cur2);
@@ -6734,7 +6347,7 @@ Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
 	    if (PL_encoding) {
 		 svrecode = newSVpvn(pv1, cur1);
 		 sv_recode_to_utf8(svrecode, PL_encoding);
-		 pv1 = SvPV(svrecode, cur1);
+		 pv1 = SvPV_const(svrecode, cur1);
 	    }
 	    else {
 		 pv1 = tpv = (char*)bytes_to_utf8((const U8*)pv1, &cur1);
@@ -6848,12 +6461,13 @@ Perl_sv_collxfrm(pTHX_ SV *sv, STRLEN *nxp)
 
     mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_collxfrm) : (MAGIC *) NULL;
     if (!mg || !mg->mg_ptr || *(U32*)mg->mg_ptr != PL_collation_ix) {
-	char *s, *xf;
+	const char *s;
+	char *xf;
 	STRLEN len, xlen;
 
 	if (mg)
 	    Safefree(mg->mg_ptr);
-	s = SvPV(sv, len);
+	s = SvPV_const(sv, len);
 	if ((xf = mem_collxfrm(s, len, &xlen))) {
 	    if (SvREADONLY(sv)) {
 		SAVEFREEPV(xf);
@@ -7001,7 +6615,7 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
 		    Perl_croak(aTHX_ "Wide character in $/");
 		}
 	    }
-	    rsptr = SvPV(PL_rs, rslen);
+	    rsptr = SvPV_const(PL_rs, rslen);
 	}
     }
 
@@ -7313,7 +6927,7 @@ Perl_sv_inc(pTHX_ register SV *sv)
 
     if (!(flags & SVp_POK) || !*SvPVX_const(sv)) {
 	if ((flags & SVTYPEMASK) < SVt_PVIV)
-	    sv_upgrade(sv, SVt_IV);
+	    sv_upgrade(sv, ((flags & SVTYPEMASK) > SVt_IV ? SVt_PVIV : SVt_IV));
 	(void)SvIOK_only(sv);
 	SvIV_set(sv, 1);
 	return;
@@ -7712,10 +7326,9 @@ Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
     if (!hash)
 	PERL_HASH(hash, src, len);
     new_SV(sv);
-    sv_upgrade(sv, SVt_PVIV);
+    sv_upgrade(sv, SVt_PV);
     SvPV_set(sv, sharepvn(src, is_utf8?-len:len, hash));
     SvCUR_set(sv, len);
-    SvUV_set(sv, hash);
     SvLEN_set(sv, 0);
     SvREADONLY_on(sv);
     SvFAKE_on(sv);
@@ -8214,12 +7827,10 @@ Perl_sv_nv(pTHX_ register SV *sv)
 char *
 Perl_sv_pv(pTHX_ SV *sv)
 {
-    STRLEN n_a;
-
     if (SvPOK(sv))
 	return SvPVX(sv);
 
-    return sv_2pv(sv, &n_a);
+    return sv_2pv(sv, 0);
 }
 
 /*
@@ -8870,7 +8481,7 @@ bool
 Perl_sv_tainted(pTHX_ SV *sv)
 {
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
-	MAGIC *mg = mg_find(sv, PERL_MAGIC_taint);
+	MAGIC * const mg = mg_find(sv, PERL_MAGIC_taint);
 	if (mg && ((mg->mg_len & 1) || ((mg->mg_len & 2) && mg->mg_obj == sv)))
 	    return TRUE;
     }
@@ -10119,7 +9730,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	     else {
 		  SV *nsv = sv_2mortal(newSVpvn(eptr, elen));
 		  sv_utf8_upgrade(nsv);
-		  eptr = SvPVX(nsv);
+		  eptr = SvPVX_const(nsv);
 		  elen = SvCUR(nsv);
 	     }
 	     SvGROW(sv, SvCUR(sv) + elen + 1);
@@ -10491,43 +10102,8 @@ Perl_ptr_table_new(pTHX)
 #  define PTR_TABLE_HASH(ptr) (PTR2UV(ptr) >> 2)
 #endif
 
-
-
-STATIC void
-S_more_pte(pTHX)
-{
-    struct ptr_tbl_ent* pte;
-    struct ptr_tbl_ent* pteend;
-    New(0, pte, PERL_ARENA_SIZE/sizeof(struct ptr_tbl_ent), struct ptr_tbl_ent);
-    pte->next = PL_pte_arenaroot;
-    PL_pte_arenaroot = pte;
-
-    pteend = &pte[PERL_ARENA_SIZE / sizeof(struct ptr_tbl_ent) - 1];
-    PL_pte_root = ++pte;
-    while (pte < pteend) {
-	pte->next = pte + 1;
-	pte++;
-    }
-    pte->next = 0;
-}
-
-STATIC struct ptr_tbl_ent*
-S_new_pte(pTHX)
-{
-    struct ptr_tbl_ent* pte;
-    if (!PL_pte_root)
-	S_more_pte(aTHX);
-    pte = PL_pte_root;
-    PL_pte_root = pte->next;
-    return pte;
-}
-
-STATIC void
-S_del_pte(pTHX_ struct ptr_tbl_ent*p)
-{
-    p->next = PL_pte_root;
-    PL_pte_root = p;
-}
+#define new_pte()	new_body(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 */
 
@@ -10565,7 +10141,7 @@ Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldv, void *newv)
 	    return;
 	}
     }
-    tblent = S_new_pte(aTHX);
+    tblent = new_pte();
     tblent->oldval = oldv;
     tblent->newval = newv;
     tblent->next = *otblent;
@@ -10629,7 +10205,7 @@ Perl_ptr_table_clear(pTHX_ PTR_TBL_t *tbl)
         if (entry) {
             PTR_TBL_ENT_t *oentry = entry;
             entry = entry->next;
-            S_del_pte(aTHX_ oentry);
+            del_pte(oentry);
         }
         if (!entry) {
             if (++riter > max) {
@@ -10712,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)
 {
@@ -10737,22 +10311,11 @@ Perl_rvpv_dup(pTHX_ SV *dstr, SV *sstr, CLONE_PARAMS* param)
 	}
 	else {
 	    /* Special case - not normally malloced for some reason */
-	    if (SvREADONLY(sstr) && SvFAKE(sstr)) {
-		/* A "shared" PV - clone it as unshared string */
-                if(SvPADTMP(sstr)) {
-                    /* However, some of them live in the pad
-                       and they should not have these flags
-                       turned off */
-
-                    SvPV_set(dstr, sharepvn(SvPVX_const(sstr), SvCUR(sstr),
-                                           SvUVX(sstr)));
-                    SvUV_set(dstr, SvUVX(sstr));
-                } else {
-
-                    SvPV_set(dstr, SAVEPVN(SvPVX_const(sstr), SvCUR(sstr)));
-                    SvFAKE_off(dstr);
-                    SvREADONLY_off(dstr);
-                }
+	    if ((SvREADONLY(sstr) && SvFAKE(sstr))) {
+		/* A "shared" PV - clone it as "shared" PV */
+		SvPV_set(dstr,
+			 HEK_KEY(hek_dup(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr)),
+					 param)));
 	    }
 	    else {
 		/* Some other special case - random pointer */
@@ -10769,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)
 {
@@ -10846,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);
+		}
+		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;
+		    }
 		}
-		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);
+		    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;
 
@@ -11309,9 +10898,6 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
     void (*dptr) (void*);
     void (*dxptr) (pTHX_ void*);
     OP *o;
-    /* Unions for circumventing strict ANSI C89 casting rules. */
-    union { void *vptr; void (*dptr)(void*); } u1, u2;
-    union { void *vptr; void (*dxptr)(pTHX_ void*); } u3, u4;
 
     Newz(54, nss, max, ANY);
 
@@ -11483,17 +11069,17 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 	    ptr = POPPTR(ss,ix);
 	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);	/* XXX quite arbitrary */
 	    dptr = POPDPTR(ss,ix);
-	    u1.dptr = dptr;
-	    u2.vptr = any_dup(u1.vptr, proto_perl);
-	    TOPDPTR(nss,ix) = u2.dptr;
+	    TOPDPTR(nss,ix) = DPTR2FPTR(void (*)(void*),
+					any_dup(FPTR2DPTR(void *, dptr),
+						proto_perl));
 	    break;
 	case SAVEt_DESTRUCTOR_X:
 	    ptr = POPPTR(ss,ix);
 	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);	/* XXX quite arbitrary */
 	    dxptr = POPDXPTR(ss,ix);
-	    u3.dxptr = dxptr;
-	    u4.vptr = any_dup(u3.vptr, proto_perl);;
-	    TOPDXPTR(nss,ix) = u4.dxptr;
+	    TOPDXPTR(nss,ix) = DPTR2FPTR(void (*)(pTHX_ void*),
+					 any_dup(FPTR2DPTR(void *, dxptr),
+						 proto_perl));
 	    break;
 	case SAVEt_REGCONTEXT:
 	case SAVEt_ALLOC:
@@ -11787,8 +11373,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     /* create SV map for pointer relocation */
     PL_ptr_table = ptr_table_new();
-    /* and one for finding shared hash keys quickly */
-    PL_shared_hek_table = ptr_table_new();
 
     /* initialize these special pointers as early as possible */
     SvANY(&PL_sv_undef)		= NULL;
@@ -12000,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;
@@ -12418,8 +12001,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
         ptr_table_free(PL_ptr_table);
         PL_ptr_table = NULL;
-        ptr_table_free(PL_shared_hek_table);
-        PL_shared_hek_table = NULL;
     }
 
     /* Call the ->CLONE method, if it exists, for each of the stashes
@@ -12479,7 +12060,7 @@ Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding)
     if (SvPOK(sv) && !SvUTF8(sv) && !IN_BYTES && SvROK(encoding)) {
 	SV *uni;
 	STRLEN len;
-	char *s;
+	const char *s;
 	dSP;
 	ENTER;
 	SAVETMPS;
@@ -12503,12 +12084,11 @@ Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding)
 	SPAGAIN;
 	uni = POPs;
 	PUTBACK;
-	s = SvPV(uni, len);
+	s = SvPV_const(uni, len);
 	if (s != SvPVX_const(sv)) {
 	    SvGROW(sv, len + 1);
-	    Move(s, SvPVX_const(sv), len, char);
+	    Move(s, SvPVX(sv), len + 1, char);
 	    SvCUR_set(sv, len);
-	    SvPVX(sv)[len] = 0;	
 	}
 	FREETMPS;
 	LEAVE;