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 e67c716..3f70368 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1393,6 +1393,8 @@ static const struct body_details bodies_by_type[] = {
 /* 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))
@@ -1597,11 +1599,11 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
            Zero(new_body, new_type_details->size, char);
            new_body = ((char *)new_body) + new_type_details->offset;
        } else {
-           new_body = new_NOARENA(new_type_details);
+           new_body = new_NOARENAZ(new_type_details);
        }
 #else
        /* We always allocated the full length item with PURIFY */
-       new_body = new_NOARENA(new_type_details);
+       new_body = new_NOARENAZ(new_type_details);
 #endif
        SvANY(sv) = new_body;
 
@@ -5349,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);
@@ -5359,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;
@@ -5433,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 */
@@ -5462,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);
@@ -5471,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))
@@ -5528,7 +5506,6 @@ Perl_sv_clear(pTHX_ register SV *sv)
 #endif
        break;
     case SVt_NV:
-       old_body_arena = PL_body_roots[SVt_NV];
        break;
     }
 
@@ -5536,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));
-       }
 }
 
 /*
@@ -10058,7 +10039,6 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
            const svtype sv_type = SvTYPE(sstr);
            const struct body_details *const sv_type_details
                = bodies_by_type + sv_type;
-           
 
            switch (sv_type) {
            default: