sv_clear can manipulate the arena array directly too.
[p5sagit/p5-mst-13.2.git] / sv.c
diff --git a/sv.c b/sv.c
index 7267fa7..3f70368 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1149,12 +1149,13 @@ S_more_bodies (pTHX_ size_t size, svtype sv_type)
 
 /* 1st, the inline version  */
 
-#define new_body_inline(xpv, root, size, sv_type) \
+#define new_body_inline(xpv, size, sv_type) \
     STMT_START { \
+       void **r3wt = &PL_body_roots[sv_type]; \
        LOCK_SV_MUTEX; \
-       xpv = *((void **)(root)) \
-         ? *((void **)(root)) : S_more_bodies(aTHX_ size, sv_type); \
-       *(root) = *(void**)(xpv); \
+       xpv = *((void **)(r3wt)) \
+         ? *((void **)(r3wt)) : S_more_bodies(aTHX_ size, sv_type); \
+       *(r3wt) = *(void**)(xpv); \
        UNLOCK_SV_MUTEX; \
     } STMT_END
 
@@ -1169,7 +1170,7 @@ STATIC void *
 S_new_body(pTHX_ size_t size, svtype sv_type)
 {
     void *xpv;
-    new_body_inline(xpv, &PL_body_roots[sv_type], size, sv_type);
+    new_body_inline(xpv, size, sv_type);
     return xpv;
 }
 
@@ -1227,56 +1228,74 @@ struct body_details {
     size_t size;       /* Size to allocate  */
     size_t copy;       /* Size of structure to copy (may be shorter)  */
     int offset;
+    bool cant_upgrade; /* Can upgrade this type */
+    bool zero_nv;      /* zero the NV when upgrading from this */
+    bool arena;                /* Allocated from an arena */
 };
 
-struct body_details bodies_by_type[] = {
-    {0, 0, 0},
+#define HADNV FALSE
+#define NONV TRUE
+
+#define HASARENA TRUE
+#define NOARENA FALSE
+
+static const struct body_details bodies_by_type[] = {
+    {0, 0, 0, FALSE, NONV, NOARENA},
     /* IVs are in the head, so the allocation size is 0  */
-    {0, sizeof(IV), STRUCT_OFFSET(XPVIV, xiv_iv)},
+    {0, sizeof(IV), -STRUCT_OFFSET(XPVIV, xiv_iv), FALSE, NONV, NOARENA},
     /* 8 bytes on most ILP32 with IEEE doubles */
-    {sizeof(NV), sizeof(NV), 0},
+    {sizeof(NV), sizeof(NV), 0, FALSE, HADNV, HASARENA},
     /* RVs are in the head now */
-    {0, 0, 0},
+    /* However, this slot is overloaded and used by the pte  */
+    {0, 0, 0, FALSE, NONV, NOARENA},
     /* 8 bytes on most ILP32 with IEEE doubles */
     {sizeof(xpv_allocated),
      STRUCT_OFFSET(XPV, xpv_len) + sizeof (((XPV*)SvANY((SV*)0))->xpv_len)
-     - STRUCT_OFFSET(xpv_allocated, xpv_cur) + STRUCT_OFFSET(XPV, xpv_cur),
+     + STRUCT_OFFSET(xpv_allocated, xpv_cur) - STRUCT_OFFSET(XPV, xpv_cur),
      + STRUCT_OFFSET(xpv_allocated, xpv_cur) - STRUCT_OFFSET(XPV, xpv_cur)
-     },
+     , FALSE, NONV, HASARENA},
     /* 12 */
     {sizeof(xpviv_allocated),
      STRUCT_OFFSET(XPVIV, xiv_u) + sizeof (((XPVIV*)SvANY((SV*)0))->xiv_u)
-     - STRUCT_OFFSET(xpviv_allocated, xpv_cur) + STRUCT_OFFSET(XPVIV, xpv_cur),
+     + STRUCT_OFFSET(xpviv_allocated, xpv_cur) - STRUCT_OFFSET(XPVIV, xpv_cur),
      + STRUCT_OFFSET(xpviv_allocated, xpv_cur) - STRUCT_OFFSET(XPVIV, xpv_cur)
-    },
+    , FALSE, NONV, HASARENA},
     /* 20 */
     {sizeof(XPVNV),
      STRUCT_OFFSET(XPVNV, xiv_u) + sizeof (((XPVNV*)SvANY((SV*)0))->xiv_u),
-     0},
+     0, FALSE, HADNV, HASARENA},
     /* 28 */
     {sizeof(XPVMG),
      STRUCT_OFFSET(XPVMG, xmg_stash) + sizeof (((XPVMG*)SvANY((SV*)0))->xmg_stash),
-     0},
+     0, FALSE, HADNV, HASARENA},
     /* 36 */
-    {sizeof(XPVBM), 0, 0},
+    {sizeof(XPVBM), sizeof(XPVBM), 0, TRUE, HADNV, HASARENA},
     /* 48 */
-    {sizeof(XPVGV), 0, 0},
+    {sizeof(XPVGV), sizeof(XPVGV), 0, TRUE, HADNV, HASARENA},
     /* 64 */
-    {sizeof(XPVLV), 0, 0},
+    {sizeof(XPVLV), sizeof(XPVLV), 0, TRUE, HADNV, HASARENA},
     /* 20 */
-    {sizeof(xpvav_allocated), 0,
+    {sizeof(xpvav_allocated),
+     STRUCT_OFFSET(XPVAV, xmg_stash)
+     + sizeof (((XPVAV*)SvANY((SV *)0))->xmg_stash)
+     + STRUCT_OFFSET(xpvav_allocated, xav_fill)
+     - STRUCT_OFFSET(XPVAV, xav_fill),
      STRUCT_OFFSET(xpvav_allocated, xav_fill)
-     - STRUCT_OFFSET(XPVAV, xav_fill)},
+     - STRUCT_OFFSET(XPVAV, xav_fill), TRUE, HADNV, HASARENA},
     /* 20 */
-    {sizeof(xpvhv_allocated), 0, 
+    {sizeof(xpvhv_allocated),
+     STRUCT_OFFSET(XPVHV, xmg_stash)
+     + sizeof (((XPVHV*)SvANY((SV *)0))->xmg_stash)
+     + STRUCT_OFFSET(xpvhv_allocated, xhv_fill)
+     - STRUCT_OFFSET(XPVHV, xhv_fill),
      STRUCT_OFFSET(xpvhv_allocated, xhv_fill)
-     - STRUCT_OFFSET(XPVHV, xhv_fill)},
+     - STRUCT_OFFSET(XPVHV, xhv_fill), TRUE, HADNV, HASARENA},
     /* 76 */
-    {sizeof(XPVCV), 0, 0},
+    {sizeof(XPVCV), sizeof(XPVCV), 0, TRUE, HADNV, HASARENA},
     /* 80 */
-    {sizeof(XPVFM), 0, 0},
+    {sizeof(XPVFM), sizeof(XPVFM), 0, TRUE, HADNV, NOARENA},
     /* 84 */
-    {sizeof(XPVIO), 0, 0}
+    {sizeof(XPVIO), sizeof(XPVIO), 0, TRUE, HADNV, NOARENA}
 };
 
 #define new_body_type(sv_type)                 \
@@ -1296,6 +1315,7 @@ struct body_details bodies_by_type[] = {
 
 
 #define my_safemalloc(s)       (void*)safemalloc(s)
+#define my_safecalloc(s)       (void*)safecalloc(s, 1)
 #define my_safefree(p) safefree((char*)p)
 
 #ifdef PURIFY
@@ -1371,6 +1391,12 @@ struct body_details bodies_by_type[] = {
 #endif /* PURIFY */
 
 /* no arena for you! */
+
+#define new_NOARENA(details) \
+       my_safemalloc((details)->size - (details)->offset)
+#define new_NOARENAZ(details) \
+       my_safecalloc((details)->size - (details)->offset)
+
 #define new_XPVFM()    my_safemalloc(sizeof(XPVFM))
 #define del_XPVFM(p)   my_safefree(p)
 
@@ -1390,42 +1416,28 @@ You generally want to use the C<SvUPGRADE> macro wrapper. See also C<svtype>.
 */
 
 void
-Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
+Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
 {
-    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;
     const U32  old_type = SvTYPE(sv);
+    const struct body_details *const old_type_details
+       = bodies_by_type + old_type;
+    const struct body_details *new_type_details = bodies_by_type + new_type;
 
-    if (mt != SVt_PV && SvIsCOW(sv)) {
+    if (new_type != SVt_PV && SvIsCOW(sv)) {
        sv_force_normal_flags(sv, 0);
     }
 
-    if (old_type == mt)
+    if (old_type == new_type)
        return;
 
-    if (old_type > mt)
+    if (old_type > new_type)
        Perl_croak(aTHX_ "sv_upgrade from type %d down to type %d",
-               (int)old_type, (int)mt);
+               (int)old_type, (int)new_type);
 
 
     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
@@ -1467,49 +1479,28 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
     case SVt_NULL:
        break;
     case SVt_IV:
-       if (mt == SVt_NV)
-           mt = SVt_PVNV;
-       else if (mt < SVt_PVIV)
-           mt = SVt_PVIV;
-       old_body_offset = bodies_by_type[old_type].offset;
-       old_body_length = bodies_by_type[old_type].copy;
+       if (new_type < SVt_PVIV) {
+           new_type = (new_type == SVt_NV)
+               ? SVt_PVNV : SVt_PVIV;
+           new_type_details = bodies_by_type + new_type;
+       }
        break;
     case SVt_NV:
-       old_body_arena = &PL_body_roots[old_type];
-       old_body_length = bodies_by_type[old_type].copy;
-#ifndef NV_ZERO_IS_ALLBITS_ZERO
-       zero_nv = FALSE;
-#endif
-       if (mt < SVt_PVNV)
-           mt = SVt_PVNV;
+       if (new_type < SVt_PVNV) {
+           new_type = SVt_PVNV;
+           new_type_details = bodies_by_type + new_type;
+       }
        break;
     case SVt_RV:
        break;
     case SVt_PV:
-       old_body_arena = &PL_body_roots[SVt_PV];
-       old_body_offset = - bodies_by_type[SVt_PV].offset;
-       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;
+       assert(new_type > SVt_PV);
+       assert(SVt_IV < SVt_PV);
+       assert(SVt_NV < SVt_PV);
        break;
     case SVt_PVIV:
-       old_body_arena = &PL_body_roots[SVt_PVIV];
-       old_body_offset = - bodies_by_type[SVt_PVIV].offset;
-       old_body_length = STRUCT_OFFSET(XPVIV, xiv_u);
-       old_body_length += sizeof (((XPVIV*)SvANY(sv))->xiv_u);
-       old_body_length -= old_body_offset;
        break;
     case SVt_PVNV:
-       old_body_arena = &PL_body_roots[SVt_PVNV];
-       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,
@@ -1520,21 +1511,16 @@ 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);
-       old_body_arena = &PL_body_roots[SVt_PVMG];
-       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");
+       if (old_type_details->cant_upgrade)
+           Perl_croak(aTHX_ "Can't upgrade that kind of scalar");
     }
 
     SvFLAGS(sv) &= ~SVTYPEMASK;
-    SvFLAGS(sv) |= mt;
+    SvFLAGS(sv) |= new_type;
 
-    switch (mt) {
+    switch (new_type) {
     case SVt_NULL:
        Perl_croak(aTHX_ "Can't upgrade to undef");
     case SVt_IV:
@@ -1589,92 +1575,67 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
        }
        break;
 
+
+    case SVt_PVIV:
+       /* XXX Is this still needed?  Was it ever needed?   Surely as there is
+          no route from NV to PVIV, NOK can never be true  */
+       assert(!SvNOKp(sv));
+       assert(!SvNOK(sv));
     case SVt_PVIO:
-       new_body = new_XPVIO();
-       new_body_length = sizeof(XPVIO);
-       goto zero;
     case SVt_PVFM:
-       new_body = new_XPVFM();
-       new_body_length = sizeof(XPVFM);
-       goto zero;
-
     case SVt_PVBM:
     case SVt_PVGV:
     case SVt_PVCV:
     case SVt_PVLV:
     case SVt_PVMG:
     case SVt_PVNV:
-       new_body_length = bodies_by_type[mt].size;
-       new_body_arena = &PL_body_roots[mt];
-       new_body_arenaroot = &PL_body_arenaroots[mt];
-       goto new_body;
-
-    case SVt_PVIV:
-       new_body_offset = - bodies_by_type[SVt_PVIV].offset;
-       new_body_length = sizeof(XPVIV) - new_body_offset;
-       new_body_arena = &PL_body_roots[SVt_PVIV];
-       new_body_arenaroot = &PL_body_arenaroots[SVt_PVIV];
-       /* XXX Is this still needed?  Was it ever needed?   Surely as there is
-          no route from NV to PVIV, NOK can never be true  */
-       if (SvNIOK(sv))
-           (void)SvIOK_on(sv);
-       SvNOK_off(sv);
-       goto new_body_no_NV; 
     case SVt_PV:
-       new_body_offset = - bodies_by_type[SVt_PV].offset;
-       new_body_length = sizeof(XPV) - new_body_offset;
-       new_body_arena = &PL_body_roots[SVt_PV];
-       new_body_arenaroot = &PL_body_arenaroots[SVt_PV];
-    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);
+       assert(new_type_details->size);
 #ifndef PURIFY
-       /* This points to the start of the allocated area.  */
-       new_body_inline(new_body, new_body_arena, new_body_length, mt);
+       if(new_type_details->arena) {
+           /* This points to the start of the allocated area.  */
+           new_body_inline(new_body, new_type_details->size, new_type);
+           Zero(new_body, new_type_details->size, char);
+           new_body = ((char *)new_body) + new_type_details->offset;
+       } else {
+           new_body = new_NOARENAZ(new_type_details);
+       }
 #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);
-
+       new_body = new_NOARENAZ(new_type_details);
 #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);
+       if (old_type_details->copy) {
+           Copy((char *)old_body - old_type_details->offset,
+                (char *)new_body - old_type_details->offset,
+                old_type_details->copy, char);
        }
 
 #ifndef NV_ZERO_IS_ALLBITS_ZERO
-       if (zero_nv)
+    /* If NV 0.0 is store as all bits 0 then Zero() already creates a correct
+       0.0 for us.  */
+       if (old_type_details->zero_nv)
            SvNV_set(sv, 0);
 #endif
 
-       if (mt == SVt_PVIO)
+       if (new_type == 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);
+       Perl_croak(aTHX_ "panic: sv_upgrade to unknown type %lu", new_type);
     }
 
-
-    if (old_body_arena) {
+    if (old_type_details->size) {
+       /* If the old body had an allocated size, then we need to free it.  */
 #ifdef PURIFY
        my_safefree(old_body);
 #else
-       del_body((void*)((char*)old_body + old_body_offset),
-                old_body_arena);
+       del_body((void*)((char*)old_body - old_type_details->offset),
+                &PL_body_roots[old_type]);
 #endif
     }
 }
@@ -5390,9 +5351,9 @@ void
 Perl_sv_clear(pTHX_ register SV *sv)
 {
     dVAR;
-    void** old_body_arena;
-    size_t old_body_offset;
     const U32 type = SvTYPE(sv);
+    const struct body_details *const sv_type_details
+       = bodies_by_type + type;
 
     assert(sv);
     assert(SvREFCNT(sv) == 0);
@@ -5400,9 +5361,6 @@ Perl_sv_clear(pTHX_ register SV *sv)
     if (type <= SVt_IV)
        return;
 
-    old_body_arena = 0;
-    old_body_offset = 0;
-
     if (SvOBJECT(sv)) {
        if (PL_defstash) {              /* Still have a symbol table? */
            dSP;
@@ -5474,26 +5432,18 @@ Perl_sv_clear(pTHX_ register SV *sv)
        Safefree(IoTOP_NAME(sv));
        Safefree(IoFMT_NAME(sv));
        Safefree(IoBOTTOM_NAME(sv));
-       /* PVIOs aren't from arenas  */
        goto freescalar;
     case SVt_PVBM:
-       old_body_arena = &PL_body_roots[SVt_PVBM];
        goto freescalar;
     case SVt_PVCV:
-       old_body_arena = &PL_body_roots[SVt_PVCV];
     case SVt_PVFM:
-       /* PVFMs aren't from arenas  */
        cv_undef((CV*)sv);
        goto freescalar;
     case SVt_PVHV:
        hv_undef((HV*)sv);
-       old_body_arena = &PL_body_roots[SVt_PVHV];
-       old_body_offset = STRUCT_OFFSET(XPVHV, xhv_fill);
        break;
     case SVt_PVAV:
        av_undef((AV*)sv);
-       old_body_arena = &PL_body_roots[SVt_PVAV];
-       old_body_offset = STRUCT_OFFSET(XPVAV, xav_fill);
        break;
     case SVt_PVLV:
        if (LvTYPE(sv) == 'T') { /* for tie: return HE to pool */
@@ -5503,7 +5453,6 @@ Perl_sv_clear(pTHX_ register SV *sv)
        }
        else if (LvTYPE(sv) != 't') /* unless tie: unrefcnted fake SV**  */
            SvREFCNT_dec(LvTARG(sv));
-       old_body_arena = &PL_body_roots[SVt_PVLV];
        goto freescalar;
     case SVt_PVGV:
        gp_free((GV*)sv);
@@ -5512,29 +5461,17 @@ Perl_sv_clear(pTHX_ register SV *sv)
           have a back reference to us, which needs to be cleared.  */
        if (GvSTASH(sv))
            sv_del_backref((SV*)GvSTASH(sv), sv);
-       old_body_arena = &PL_body_roots[SVt_PVGV];
-       goto freescalar;
     case SVt_PVMG:
-       old_body_arena = &PL_body_roots[SVt_PVMG];
-       goto freescalar;
     case SVt_PVNV:
-       old_body_arena = &PL_body_roots[SVt_PVNV];
-       goto freescalar;
     case SVt_PVIV:
-       old_body_arena = &PL_body_roots[SVt_PVIV];
-       old_body_offset = STRUCT_OFFSET(XPVIV, xpv_cur);
       freescalar:
        /* Don't bother with SvOOK_off(sv); as we're only going to free it.  */
        if (SvOOK(sv)) {
            SvPV_set(sv, SvPVX_mutable(sv) - SvIVX(sv));
            /* Don't even bother with turning off the OOK flag.  */
        }
-       goto pvrv_common;
     case SVt_PV:
-       old_body_arena = &PL_body_roots[SVt_PV];
-       old_body_offset = STRUCT_OFFSET(XPV, xpv_cur);
     case SVt_RV:
-    pvrv_common:
        if (SvROK(sv)) {
            SV *target = SvRV(sv);
            if (SvWEAKREF(sv))
@@ -5569,7 +5506,6 @@ Perl_sv_clear(pTHX_ register SV *sv)
 #endif
        break;
     case SVt_NV:
-       old_body_arena = PL_body_roots[SVt_NV];
        break;
     }
 
@@ -5577,14 +5513,18 @@ Perl_sv_clear(pTHX_ register SV *sv)
     SvFLAGS(sv) |= SVTYPEMASK;
 
 #ifndef PURIFY
-    if (old_body_arena) {
-       del_body(((char *)SvANY(sv) + old_body_offset), old_body_arena);
+    if (sv_type_details->arena) {
+       del_body(((char *)SvANY(sv) - sv_type_details->offset),
+                &PL_body_roots[type]);
+    }
+    else if (sv_type_details->size) {
+       my_safefree(SvANY(sv));
+    }
+#else
+    if (sv_type_details->size) {
+       my_safefree(SvANY(sv));
     }
-    else
 #endif
-       if (type > SVt_RV) {
-           my_safefree(SvANY(sv));
-       }
 }
 
 /*
@@ -9879,8 +9819,7 @@ Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, const void *oldsv, void *newsv)
            return;
        }
     }
-    new_body_inline(tblent, &PL_body_roots[PTE_SVSLOT],
-                   sizeof(struct ptr_tbl_ent), PTE_SVSLOT);
+    new_body_inline(tblent, sizeof(struct ptr_tbl_ent), PTE_SVSLOT);
     tblent->oldval = oldsv;
     tblent->newval = newsv;
     tblent->next = *otblent;
@@ -10096,12 +10035,10 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
     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;
-           svtype sv_type = SvTYPE(sstr);
+           const svtype sv_type = SvTYPE(sstr);
+           const struct body_details *const sv_type_details
+               = bodies_by_type + sv_type;
 
            switch (sv_type) {
            default:
@@ -10109,80 +10046,49 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
                           (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 = &PL_body_roots[SVt_PVHV];
-               new_body_arenaroot = &PL_body_arenaroots[SVt_PVHV];
-               new_body_offset = - bodies_by_type[SVt_PVHV].offset;
-
-               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 = &PL_body_roots[SVt_PVAV];
-               new_body_arenaroot = &PL_body_arenaroots[SVt_PVAV];
-               new_body_offset =  - bodies_by_type[SVt_PVAV].offset;
-
-               new_body_length = STRUCT_OFFSET(XPVHV, xmg_stash)
-                   + sizeof (((XPVHV*)SvANY(sstr))->xmg_stash)
-                   - new_body_offset;
-               goto new_body;
            case SVt_PVGV:
                if (GvUNIQUE((GV*)sstr)) {
                    /* Do sharing here, and fall through */
                }
+           case SVt_PVIO:
+           case SVt_PVFM:
+           case SVt_PVHV:
+           case SVt_PVAV:
            case SVt_PVBM:
            case SVt_PVCV:
            case SVt_PVLV:
            case SVt_PVMG:
            case SVt_PVNV:
-               new_body_length = bodies_by_type[sv_type].size;
-               new_body_arena = &PL_body_roots[sv_type];
-               new_body_arenaroot = &PL_body_arenaroots[sv_type];
-               goto new_body;
-
            case SVt_PVIV:
-               new_body_offset = - bodies_by_type[SVt_PVIV].offset;
-               new_body_length = sizeof(XPVIV) - new_body_offset;
-               new_body_arena = &PL_body_roots[SVt_PVIV];
-               new_body_arenaroot = &PL_body_arenaroots[SVt_PVIV];
-               goto new_body; 
            case SVt_PV:
-               new_body_offset = - bodies_by_type[SVt_PV].offset;
-               new_body_length = sizeof(XPV) - new_body_offset;
-               new_body_arena = &PL_body_roots[SVt_PV];
-               new_body_arenaroot = &PL_body_arenaroots[SVt_PV];
-           new_body:
-               assert(new_body_length);
+               assert(sv_type_details->copy);
 #ifndef PURIFY
-               new_body_inline(new_body, new_body_arena,
-                               new_body_length, SvTYPE(sstr));
-
-               new_body = (void*)((char*)new_body - new_body_offset);
+               if (sv_type_details->arena) {
+                   new_body_inline(new_body, sv_type_details->copy, sv_type);
+                   new_body
+                       = (void*)((char*)new_body + sv_type_details->offset);
+               } else {
+                   new_body = new_NOARENA(sv_type_details);
+               }
 #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);
+               new_body = new_NOARENA(sv_type_details);
 #endif
            }
            assert(new_body);
            SvANY(dstr) = new_body;
 
-           Copy(((char*)SvANY(sstr)) + new_body_offset,
-                ((char*)SvANY(dstr)) + new_body_offset,
-                new_body_length, char);
+#ifndef PURIFY
+           Copy(((char*)SvANY(sstr)) - sv_type_details->offset,
+                ((char*)SvANY(dstr)) - sv_type_details->offset,
+                sv_type_details->copy, char);
+#else
+           Copy(((char*)SvANY(sstr)),
+                ((char*)SvANY(dstr)),
+                sv_type_details->size - sv_type_details->offset, char);
+#endif
 
-           if (SvTYPE(sstr) != SVt_PVAV && SvTYPE(sstr) != SVt_PVHV)
+           if (sv_type != SVt_PVAV && sv_type != SVt_PVHV)
                Perl_rvpv_dup(aTHX_ dstr, sstr, param);
 
            /* The Copy above means that all the source (unduplicated) pointers
@@ -10190,14 +10096,15 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
               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 (sv_type >= 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));
            }
 
-           switch (SvTYPE(sstr)) {
+           /* The cast silences a GCC warning about unhandled types.  */
+           switch ((int)sv_type) {
            case SVt_PV:
                break;
            case SVt_PVIV: