Borland's C compiler warns that the & is unnecessary.
[p5sagit/p5-mst-13.2.git] / sv.c
diff --git a/sv.c b/sv.c
index 2b2f188..9c379b8 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -556,6 +556,52 @@ Perl_sv_clean_all(pTHX)
     return cleaned;
 }
 
+/*
+  ARENASETS: a meta-arena implementation which separates arena-info
+  into struct arena_set, which contains an array of struct
+  arena_descs, each holding info for a single arena.  By separating
+  the meta-info from the arena, we recover the 1st slot, formerly
+  borrowed for list management.  The arena_set is about the size of an
+  arena, avoiding the needless malloc overhead of a naive linked-list
+
+  The cost is 1 arena-set malloc per ~320 arena-mallocs, + the unused
+  memory in the last arena-set (1/2 on average).  In trade, we get
+  back the 1st slot in each arena (ie 1.7% of a CV-arena, less for
+  others)
+
+  union arena is declared with a fixed size, but is intended to vary
+  by type, allowing their use for big, rare body-types where theres
+  currently too much wastage (unused arena slots)
+*/
+#define ARENASETS 1
+
+struct arena_desc {
+    char       *arena;         /* the raw storage, allocated aligned */
+    size_t      size;          /* its size ~4k typ */
+    int         unit_type;     /* useful for arena audits */
+    /* info for sv-heads (eventually)
+       int count, flags;
+    */
+};
+
+struct arena_set;
+
+/* Get the maximum number of elements in set[] such that struct arena_set
+   will fit within PERL_ARENA_SIZE, which is probabably just under 4K, and
+   therefore likely to be 1 aligned memory page.  */
+
+#define ARENAS_PER_SET  ((PERL_ARENA_SIZE - sizeof(struct arena_set*) \
+                         - 2 * sizeof(int)) / sizeof (struct arena_desc))
+
+struct arena_set {
+    struct arena_set* next;
+    int   set_size;            /* ie ARENAS_PER_SET */
+    int   curr;                        /* index of next available arena-desc */
+    struct arena_desc set[ARENAS_PER_SET];
+};
+
+#if !ARENASETS
+
 static void 
 S_free_arena(pTHX_ void **root) {
     while (root) {
@@ -564,7 +610,8 @@ S_free_arena(pTHX_ void **root) {
        root = next;
     }
 }
-    
+#endif
+
 /*
 =for apidoc sv_free_arenas
 
@@ -593,7 +640,23 @@ Perl_sv_free_arenas(pTHX)
            Safefree(sva);
     }
 
+#if ARENASETS
+    {
+       struct arena_set *next, *aroot = (struct arena_set*) PL_body_arenas;
+       
+       for (; aroot; aroot = next) {
+           int max = aroot->curr;
+           for (i=0; i<max; i++) {
+               assert(aroot->set[i].arena);
+               Safefree(aroot->set[i].arena);
+           }
+           next = aroot->next;
+           Safefree(aroot);
+       }
+    }
+#else
     S_free_arena(aTHX_ (void**) PL_body_arenas);
+#endif
 
     for (i=0; i<SVt_LAST; i++)
        PL_body_roots[i] = 0;
@@ -640,6 +703,54 @@ Perl_sv_free_arenas(pTHX)
   contexts below (line ~10k)
 */
 
+/* get_arena(size): when ARENASETS is enabled, this creates
+   custom-sized arenas, otherwize it uses PERL_ARENA_SIZE, as
+   previously done.
+   TBD: export properly for hv.c: S_more_he().
+*/
+void*
+Perl_get_arena(pTHX_ int arena_size)
+{
+#if !ARENASETS
+    union arena* arp;
+
+    /* allocate and attach arena */
+    Newx(arp, PERL_ARENA_SIZE, char);
+    arp->next = PL_body_arenas;
+    PL_body_arenas = arp;
+    return arp;
+
+#else
+    struct arena_desc* adesc;
+    struct arena_set *newroot, **aroot = (struct arena_set**) &PL_body_arenas;
+    int curr;
+
+    /* shouldnt need this
+    if (!arena_size)   arena_size = PERL_ARENA_SIZE;
+    */
+
+    /* may need new arena-set to hold new arena */
+    if (!*aroot || (*aroot)->curr >= (*aroot)->set_size) {
+       Newxz(newroot, 1, struct arena_set);
+       newroot->set_size = ARENAS_PER_SET;
+       newroot->next = *aroot;
+       *aroot = newroot;
+       DEBUG_m(PerlIO_printf(Perl_debug_log, "new arenaset %p\n", *aroot));
+    }
+
+    /* ok, now have arena-set with at least 1 empty/available arena-desc */
+    curr = (*aroot)->curr++;
+    adesc = &((*aroot)->set[curr]);
+    assert(!adesc->arena);
+    
+    Newxz(adesc->arena, arena_size, char);
+    adesc->size = arena_size;
+    DEBUG_m(PerlIO_printf(Perl_debug_log, "arena %d added: %p\n", curr, aroot));
+
+    return adesc->arena;
+#endif
+}
+
 STATIC void *
 S_more_bodies (pTHX_ size_t size, svtype sv_type)
 {
@@ -649,16 +760,15 @@ S_more_bodies (pTHX_ size_t size, svtype sv_type)
     const char *end;
     const size_t count = PERL_ARENA_SIZE / size;
 
-    Newx(start, count*size, char);
-    *((void **) start) = PL_body_arenas;
-    PL_body_arenas = (void *)start;
+    start = (char*) Perl_get_arena(aTHX_ PERL_ARENA_SIZE);
 
     end = start + (count-1) * size;
 
+#if !ARENASETS
     /* 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.  */
-
     start += size;
+#endif
 
     *root = (void *)start;
 
@@ -853,8 +963,7 @@ static const struct body_details bodies_by_type[] = {
 };
 
 #define new_body_type(sv_type)                 \
-    (void *)((char *)S_new_body(aTHX_ bodies_by_type[sv_type].size, sv_type)\
-            - bodies_by_type[sv_type].offset)
+    (void *)((char *)S_new_body(aTHX_ bodies_by_type[sv_type].size, sv_type))
 
 #define del_body_type(p, sv_type)      \
     del_body(p, &PL_body_roots[sv_type])
@@ -940,7 +1049,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
     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;
+    const struct body_details *new_type_details;
 
     if (new_type != SVt_PV && SvIsCOW(sv)) {
        sv_force_normal_flags(sv, 0);
@@ -999,13 +1108,11 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
        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:
        if (new_type < SVt_PVNV) {
            new_type = SVt_PVNV;
-           new_type_details = bodies_by_type + new_type;
        }
        break;
     case SVt_RV:
@@ -1031,15 +1138,18 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
        break;
     default:
        if (old_type_details->cant_upgrade)
-           Perl_croak(aTHX_ "Can't upgrade that kind of scalar");
+           Perl_croak(aTHX_ "Can't upgrade %s (%" UVuf ") to %" UVuf,
+                      sv_reftype(sv, 0), (UV) old_type, (UV) new_type);
     }
+    new_type_details = bodies_by_type + new_type;
 
     SvFLAGS(sv) &= ~SVTYPEMASK;
     SvFLAGS(sv) |= new_type;
 
+    /* This can't happen, as SVt_NULL is <= all values of new_type, so one of
+       the return statements above will have triggered.  */
+    assert (new_type != SVt_NULL);
     switch (new_type) {
-    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));
@@ -1056,21 +1166,27 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
        SvRV_set(sv, 0);
        return;
     case SVt_PVHV:
-       SvANY(sv) = new_XPVHV();
-       HvFILL(sv)      = 0;
-       HvMAX(sv)       = 0;
-       HvTOTALKEYS(sv) = 0;
-
-       goto hv_av_common;
-
     case SVt_PVAV:
-       SvANY(sv) = new_XPVAV();
-       AvMAX(sv)       = -1;
-       AvFILLp(sv)     = -1;
-       AvALLOC(sv)     = 0;
-       AvREAL_only(sv);
+       assert(new_type_details->size);
+
+#ifndef PURIFY 
+       assert(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
+       /* We always allocated the full length item with PURIFY. To do this
+          we fake things so that arena is false for all 16 types..  */
+       new_body = new_NOARENAZ(new_type_details);
+#endif
+       SvANY(sv) = new_body;
+       if (new_type == SVt_PVAV) {
+           AvMAX(sv)   = -1;
+           AvFILLp(sv) = -1;
+           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.
@@ -1086,9 +1202,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
        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, NULL);
-           SvSTASH_set(sv, NULL);
        }
        break;
 
@@ -2917,7 +3030,7 @@ copy-ish functions and macros use this underneath.
 */
 
 static void
-S_glob_assign(pTHX_ SV *dstr, SV *sstr, const int dtype)
+S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype)
 {
     if (dtype != SVt_PVGV) {
        const char * const name = GvNAME(sstr);
@@ -2956,10 +3069,14 @@ S_glob_assign(pTHX_ SV *dstr, SV *sstr, const int dtype)
 }
 
 static void
-S_pvgv_assign(pTHX_ SV *dstr, SV *sstr) {
+S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr) {
     SV * const sref = SvREFCNT_inc(SvRV(sstr));
     SV *dref = NULL;
     const int intro = GvINTRO(dstr);
+    SV **location;
+    U8 import_flag = 0;
+    const U32 stype = SvTYPE(sref);
+
 
 #ifdef GV_UNIQUE_CHECK
     if (GvUNIQUE((GV*)dstr)) {
@@ -2973,45 +3090,43 @@ S_pvgv_assign(pTHX_ SV *dstr, SV *sstr) {
        GvEGV(dstr) = (GV*)dstr;
     }
     GvMULTI_on(dstr);
-    switch (SvTYPE(sref)) {
-    case SVt_PVAV:
-       if (intro)
-           SAVEGENERICSV(GvAV(dstr));
-       else
-           dref = (SV*)GvAV(dstr);
-       GvAV(dstr) = (AV*)sref;
-       if (!GvIMPORTED_AV(dstr)
-           && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
-           {
-               GvIMPORTED_AV_on(dstr);
-           }
-       break;
-    case SVt_PVHV:
-       if (intro)
-           SAVEGENERICSV(GvHV(dstr));
-       else
-           dref = (SV*)GvHV(dstr);
-       GvHV(dstr) = (HV*)sref;
-       if (!GvIMPORTED_HV(dstr)
-           && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
-           {
-               GvIMPORTED_HV_on(dstr);
-           }
-       break;
+    switch (stype) {
     case SVt_PVCV:
+       location = (SV **) &GvCV(dstr);
+       import_flag = GVf_IMPORTED_CV;
+       goto common;
+    case SVt_PVHV:
+       location = (SV **) &GvHV(dstr);
+       import_flag = GVf_IMPORTED_HV;
+       goto common;
+    case SVt_PVAV:
+       location = (SV **) &GvAV(dstr);
+       import_flag = GVf_IMPORTED_AV;
+       goto common;
+    case SVt_PVIO:
+       location = (SV **) &GvIOp(dstr);
+       goto common;
+    case SVt_PVFM:
+       location = (SV **) &GvFORM(dstr);
+    default:
+       location = &GvSV(dstr);
+       import_flag = GVf_IMPORTED_SV;
+    common:
        if (intro) {
-           if (GvCVGEN(dstr) && GvCV(dstr) != (CV*)sref) {
-               SvREFCNT_dec(GvCV(dstr));
-               GvCV(dstr) = NULL;
-               GvCVGEN(dstr) = 0; /* Switch off cacheness. */
-               PL_sub_generation++;
+           if (stype == SVt_PVCV) {
+               if (GvCVGEN(dstr) && GvCV(dstr) != (CV*)sref) {
+                   SvREFCNT_dec(GvCV(dstr));
+                   GvCV(dstr) = NULL;
+                   GvCVGEN(dstr) = 0; /* Switch off cacheness. */
+                   PL_sub_generation++;
+               }
            }
-           SAVEGENERICSV(GvCV(dstr));
+           SAVEGENERICSV(*location);
        }
        else
-           dref = (SV*)GvCV(dstr);
-       if (GvCV(dstr) != (CV*)sref) {
-           CV* const cv = GvCV(dstr);
+           dref = *location;
+       if (stype == SVt_PVCV && *location != sref) {
+           CV* const cv = (CV*)*location;
            if (cv) {
                if (!GvCVGEN((GV*)dstr) &&
                    (CvROOT(cv) || CvXSUB(cv)))
@@ -3044,37 +3159,14 @@ S_pvgv_assign(pTHX_ SV *dstr, SV *sstr) {
                    cv_ckproto(cv, (GV*)dstr,
                               SvPOK(sref) ? SvPVX_const(sref) : NULL);
            }
-           GvCV(dstr) = (CV*)sref;
            GvCVGEN(dstr) = 0; /* Switch off cacheness. */
            GvASSUMECV_on(dstr);
            PL_sub_generation++;
        }
-       if (!GvIMPORTED_CV(dstr) && CopSTASH_ne(PL_curcop, GvSTASH(dstr))) {
-           GvIMPORTED_CV_on(dstr);
-       }
-       break;
-    case SVt_PVIO:
-       if (intro)
-           SAVEGENERICSV(GvIOp(dstr));
-       else
-           dref = (SV*)GvIOp(dstr);
-       GvIOp(dstr) = (IO*)sref;
-       break;
-    case SVt_PVFM:
-       if (intro)
-           SAVEGENERICSV(GvFORM(dstr));
-       else
-           dref = (SV*)GvFORM(dstr);
-       GvFORM(dstr) = (CV*)sref;
-       break;
-    default:
-       if (intro)
-           SAVEGENERICSV(GvSV(dstr));
-       else
-           dref = (SV*)GvSV(dstr);
-       GvSV(dstr) = sref;
-       if (!GvIMPORTED_SV(dstr) && CopSTASH_ne(PL_curcop, GvSTASH(dstr))) {
-           GvIMPORTED_SV_on(dstr);
+       *location = sref;
+       if (import_flag && !(GvFLAGS(dstr) & import_flag)
+           && CopSTASH_ne(PL_curcop, GvSTASH(dstr))) {
+           GvFLAGS(dstr) |= import_flag;
        }
        break;
     }
@@ -3173,21 +3265,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
     case SVt_RV:
        if (dtype < SVt_RV)
            sv_upgrade(dstr, SVt_RV);
-       else if (dtype == SVt_PVGV &&
-                SvROK(sstr) && SvTYPE(SvRV(sstr)) == SVt_PVGV) {
-           sstr = SvRV(sstr);
-           if (sstr == dstr) {
-               if (GvIMPORTED(dstr) != GVf_IMPORTED
-                   && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
-               {
-                   GvIMPORTED_on(dstr);
-               }
-               GvMULTI_on(dstr);
-               return;
-           }
-           S_glob_assign(aTHX_ dstr, sstr, dtype);
-           return;
-       }
        break;
     case SVt_PVFM:
 #ifdef PERL_OLD_COPY_ON_WRITE
@@ -3225,7 +3302,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
 
     case SVt_PVGV:
        if (dtype <= SVt_PVGV) {
-           S_glob_assign(aTHX_ dstr, sstr, dtype);
+           S_glob_assign_glob(aTHX_ dstr, sstr, dtype);
            return;
        }
        /* FALL THROUGH */
@@ -3236,7 +3313,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            if ((int)SvTYPE(sstr) != stype) {
                stype = SvTYPE(sstr);
                if (stype == SVt_PVGV && dtype <= SVt_PVGV) {
-                   S_glob_assign(aTHX_ dstr, sstr, dtype);
+                   S_glob_assign_glob(aTHX_ dstr, sstr, dtype);
                    return;
                }
            }
@@ -3250,9 +3327,25 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
     sflags = SvFLAGS(sstr);
 
     if (sflags & SVf_ROK) {
+       if (dtype == SVt_PVGV &&
+           SvROK(sstr) && SvTYPE(SvRV(sstr)) == SVt_PVGV) {
+           sstr = SvRV(sstr);
+           if (sstr == dstr) {
+               if (GvIMPORTED(dstr) != GVf_IMPORTED
+                   && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+               {
+                   GvIMPORTED_on(dstr);
+               }
+               GvMULTI_on(dstr);
+               return;
+           }
+           S_glob_assign_glob(aTHX_ dstr, sstr, dtype);
+           return;
+       }
+
        if (dtype >= SVt_PV) {
            if (dtype == SVt_PVGV) {
-               S_pvgv_assign(aTHX_ dstr, sstr);
+               S_glob_assign_ref(aTHX_ dstr, sstr);
                return;
            }
            if (SvPVX_const(dstr)) {
@@ -3419,7 +3512,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            SvIV_set(dstr, SvIVX(sstr));
        }
        if (sflags & SVp_NOK) {
-           SvFLAGS(dstr) |= sflags & (SVf_NOK|SVp_NOK);
            SvNV_set(dstr, SvNVX(sstr));
        }
     }
@@ -4466,7 +4558,7 @@ S_sv_del_backref(pTHX_ SV *tsv, SV *sv)
                */
                svp[i] = svp[fill];
            }
-           svp[fill] = Nullsv;
+           svp[fill] = NULL;
            AvFILLp(av) = fill - 1;
        }
     }
@@ -4504,7 +4596,7 @@ Perl_sv_kill_backrefs(pTHX_ SV *sv, AV *av)
                               (UV)SvFLAGS(referrer));
                }
 
-               *svp = Nullsv;
+               *svp = NULL;
            }
            svp++;
        }
@@ -5417,7 +5509,7 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
     STRLEN cur2;
     I32  eq     = 0;
     char *tpv   = NULL;
-    SV* svrecode = Nullsv;
+    SV* svrecode = NULL;
 
     if (!sv1) {
        pv1 = "";
@@ -5511,7 +5603,7 @@ Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
     const char *pv1, *pv2;
     char *tpv = NULL;
     I32  cmp;
-    SV *svrecode = Nullsv;
+    SV *svrecode = NULL;
 
     if (!sv1) {
        pv1 = "";
@@ -6711,7 +6803,7 @@ Perl_newSVsv(pTHX_ register SV *old)
     if (SvTYPE(old) == SVTYPEMASK) {
         if (ckWARN_d(WARN_INTERNAL))
            Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string");
-       return Nullsv;
+       return NULL;
     }
     new_SV(sv);
     /* SV_GMAGIC is the default for sv_setv()
@@ -6872,20 +6964,23 @@ CV *
 Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
 {
     dVAR;
-    GV *gv = Nullgv;
+    GV *gv = NULL;
     CV *cv = NULL;
 
-    if (!sv)
-       return *st = NULL, *gvp = Nullgv, NULL;
+    if (!sv) {
+       *st = NULL;
+       *gvp = NULL;
+       return NULL;
+    }
     switch (SvTYPE(sv)) {
     case SVt_PVCV:
        *st = CvSTASH(sv);
-       *gvp = Nullgv;
+       *gvp = NULL;
        return (CV*)sv;
     case SVt_PVHV:
     case SVt_PVAV:
        *st = NULL;
-       *gvp = Nullgv;
+       *gvp = NULL;
        return NULL;
     case SVt_PVGV:
        gv = (GV*)sv;
@@ -6902,7 +6997,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
            sv = SvRV(sv);
            if (SvTYPE(sv) == SVt_PVCV) {
                cv = (CV*)sv;
-               *gvp = Nullgv;
+               *gvp = NULL;
                *st = CvSTASH(cv);
                return cv;
            }
@@ -7835,10 +7930,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
     STRLEN origlen;
     I32 svix = 0;
     static const char nullstr[] = "(null)";
-    SV *argsv = Nullsv;
+    SV *argsv = NULL;
     bool has_utf8 = DO_UTF8(sv);    /* has the result utf8? */
     const bool pat_utf8 = has_utf8; /* the pattern is in utf8? */
-    SV *nsv = Nullsv;
+    SV *nsv = NULL;
     /* Times 4: a decimal digit takes more than 3 binary digits.
      * NV_DIG: mantissa takes than many decimal digits.
      * Plus 32: Playing safe. */
@@ -7942,7 +8037,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 
        const char *eptr = NULL;
        STRLEN elen = 0;
-       SV *vecsv = Nullsv;
+       SV *vecsv = NULL;
        const U8 *vecstr = Null(U8*);
        STRLEN veclen = 0;
        char c = 0;
@@ -9032,7 +9127,7 @@ Perl_re_dup(pTHX_ const REGEXP *r, CLONE_PARAMS *param)
     else
        ret->subbeg = NULL;
 #ifdef PERL_OLD_COPY_ON_WRITE
-    ret->saved_copy = Nullsv;
+    ret->saved_copy = NULL;
 #endif
 
     ptr_table_store(PL_ptr_table, r, ret);
@@ -9642,7 +9737,7 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* 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) ;
+                   NULL : gv_dup(CvGV(dstr), param) ;
                if (!(param->flags & CLONEf_COPY_STACKS)) {
                    CvDEPTH(dstr) = 0;
                }
@@ -10278,6 +10373,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     param->flags = flags;
     param->proto_perl = proto_perl;
 
+    INIT_TRACK_MEMPOOL(my_perl->Imemory_debug_header, my_perl);
+
     PL_body_arenas = NULL;
     Zero(&PL_body_roots, 1, PL_body_roots);
     
@@ -10285,8 +10382,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_nice_chunk_size = 0;
     PL_sv_count                = 0;
     PL_sv_objcount     = 0;
-    PL_sv_root         = Nullsv;
-    PL_sv_arenaroot    = Nullsv;
+    PL_sv_root         = NULL;
+    PL_sv_arenaroot    = NULL;
 
     PL_debug           = proto_perl->Idebug;
 
@@ -10516,7 +10613,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_preambleav      = av_dup_inc(proto_perl->Ipreambleav, param);
     PL_laststatval     = proto_perl->Ilaststatval;
     PL_laststype       = proto_perl->Ilaststype;
-    PL_mess_sv         = Nullsv;
+    PL_mess_sv         = NULL;
 
     PL_ors_sv          = sv_dup_inc(proto_perl->Iors_sv, param);
 
@@ -10844,7 +10941,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_op              = proto_perl->Top;
 
-    PL_Sv              = Nullsv;
+    PL_Sv              = NULL;
     PL_Xpv             = (XPV*)NULL;
     PL_na              = proto_perl->Tna;
 
@@ -10891,7 +10988,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_screamfirst     = NULL;
     PL_screamnext      = NULL;
     PL_maxscream       = -1;                   /* reinits on demand */
-    PL_lastscream      = Nullsv;
+    PL_lastscream      = NULL;
 
     PL_watchaddr       = NULL;
     PL_watchok         = NULL;
@@ -10923,7 +11020,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_reg_call_cc     = (struct re_cc_state*)NULL;
     PL_reg_re          = (regexp*)NULL;
     PL_reg_ganch       = NULL;
-    PL_reg_sv          = Nullsv;
+    PL_reg_sv          = NULL;
     PL_reg_match_utf8  = FALSE;
     PL_reg_magic       = (MAGIC*)NULL;
     PL_reg_oldpos      = 0;
@@ -10932,7 +11029,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_reg_oldsaved    = NULL;
     PL_reg_oldsavedlen = 0;
 #ifdef PERL_OLD_COPY_ON_WRITE
-    PL_nrs             = Nullsv;
+    PL_nrs             = NULL;
 #endif
     PL_reg_maxiter     = 0;
     PL_reg_leftiter    = 0;
@@ -11125,7 +11222,7 @@ S_find_hash_subscript(pTHX_ HV *hv, SV* val)
 
     if (!hv || SvMAGICAL(hv) || !HvARRAY(hv) ||
                        (HvTOTALKEYS(hv) > FUV_MAX_SEARCH_SIZE))
-       return Nullsv;
+       return NULL;
 
     array = HvARRAY(hv);
 
@@ -11138,13 +11235,13 @@ S_find_hash_subscript(pTHX_ HV *hv, SV* val)
                    HeVAL(entry) == &PL_sv_placeholder)
                continue;
            if (!HeKEY(entry))
-               return Nullsv;
+               return NULL;
            if (HeKLEN(entry) == HEf_SVKEY)
                return sv_mortalcopy(HeKEY_sv(entry));
            return sv_2mortal(newSVpvn(HeKEY(entry), HeKLEN(entry)));
        }
     }
-    return Nullsv;
+    return NULL;
 }
 
 /* Look for an entry in the array whose value has the same SV as val;
@@ -11210,7 +11307,7 @@ S_varname(pTHX_ GV *gv, const char gvtype, PADOFFSET targ,
        AV *av;
 
        if (!cv || !CvPADLIST(cv))
-           return Nullsv;
+           return NULL;
        av = (AV*)(*av_fetch(CvPADLIST(cv), 0, FALSE));
        sv = *av_fetch(av, targ, FALSE);
        /* SvLEN in a pad name is not to be trusted */
@@ -11266,7 +11363,7 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
 
     if (!obase || (match && (!uninit_sv || uninit_sv == &PL_sv_undef ||
                            uninit_sv == &PL_sv_placeholder)))
-       return Nullsv;
+       return NULL;
 
     switch (obase->op_type) {
 
@@ -11278,12 +11375,12 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
        const bool pad  = (obase->op_type == OP_PADAV || obase->op_type == OP_PADHV);
        const bool hash = (obase->op_type == OP_PADHV || obase->op_type == OP_RV2HV);
        I32 index = 0;
-       SV *keysv = Nullsv;
+       SV *keysv = NULL;
        int subscript_type = FUV_SUBSCRIPT_WITHIN;
 
        if (pad) { /* @lex, %lex */
            sv = PAD_SVl(obase->op_targ);
-           gv = Nullgv;
+           gv = NULL;
        }
        else {
            if (cUNOPx(obase)->op_first->op_type == OP_GV) {
@@ -11320,14 +11417,14 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
     case OP_PADSV:
        if (match && PAD_SVl(obase->op_targ) != uninit_sv)
            break;
-       return varname(Nullgv, '$', obase->op_targ,
-                                   Nullsv, 0, FUV_SUBSCRIPT_NONE);
+       return varname(NULL, '$', obase->op_targ,
+                                   NULL, 0, FUV_SUBSCRIPT_NONE);
 
     case OP_GVSV:
        gv = cGVOPx_gv(obase);
        if (!gv || (match && GvSV(gv) != uninit_sv))
            break;
-       return varname(gv, '$', 0, Nullsv, 0, FUV_SUBSCRIPT_NONE);
+       return varname(gv, '$', 0, NULL, 0, FUV_SUBSCRIPT_NONE);
 
     case OP_AELEMFAST:
        if (obase->op_flags & OPf_SPECIAL) { /* lexical array */
@@ -11340,8 +11437,8 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
                if (!svp || *svp != uninit_sv)
                    break;
            }
-           return varname(Nullgv, '$', obase->op_targ,
-                   Nullsv, (I32)obase->op_private, FUV_SUBSCRIPT_ARRAY);
+           return varname(NULL, '$', obase->op_targ,
+                   NULL, (I32)obase->op_private, FUV_SUBSCRIPT_ARRAY);
        }
        else {
            gv = cGVOPx_gv(obase);
@@ -11357,7 +11454,7 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
                    break;
            }
            return varname(gv, '$', 0,
-                   Nullsv, (I32)obase->op_private, FUV_SUBSCRIPT_ARRAY);
+                   NULL, (I32)obase->op_private, FUV_SUBSCRIPT_ARRAY);
        }
        break;
 
@@ -11374,12 +11471,12 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
            /* $a[uninit_expr] or $h{uninit_expr} */
            return find_uninit_var(cBINOPx(obase)->op_last, uninit_sv, match);
 
-       gv = Nullgv;
+       gv = NULL;
        o = cBINOPx(obase)->op_first;
        kid = cBINOPx(obase)->op_last;
 
        /* get the av or hv, and optionally the gv */
-       sv = Nullsv;
+       sv = NULL;
        if  (o->op_type == OP_PADAV || o->op_type == OP_PADHV) {
            sv = PAD_SV(o->op_targ);
        }
@@ -11414,7 +11511,7 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
                return varname(gv, '%', o->op_targ,
                            cSVOPx_sv(kid), 0, FUV_SUBSCRIPT_HASH);
            else
-               return varname(gv, '@', o->op_targ, Nullsv,
+               return varname(gv, '@', o->op_targ, NULL,
                            SvIV(cSVOPx_sv(kid)), FUV_SUBSCRIPT_ARRAY);
        }
        else  {
@@ -11430,14 +11527,14 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
                const I32 index = S_find_array_subscript(aTHX_ (AV*)sv, uninit_sv);
                if (index >= 0)
                    return varname(gv, '@', o->op_targ,
-                                       Nullsv, index, FUV_SUBSCRIPT_ARRAY);
+                                       NULL, index, FUV_SUBSCRIPT_ARRAY);
            }
            if (match)
                break;
            return varname(gv,
                (o->op_type == OP_PADAV || o->op_type == OP_RV2AV)
                ? '@' : '%',
-               o->op_targ, Nullsv, 0, FUV_SUBSCRIPT_WITHIN);
+               o->op_targ, NULL, 0, FUV_SUBSCRIPT_WITHIN);
        }
 
        break;
@@ -11459,7 +11556,7 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
                if (match && GvSV(gv) != uninit_sv)
                    break;
                return varname(gv, '$', 0,
-                           Nullsv, 0, FUV_SUBSCRIPT_NONE);
+                           NULL, 0, FUV_SUBSCRIPT_NONE);
            }
            /* other possibilities not handled are:
             * open $x; or open my $x;  should return '${*$x}'
@@ -11545,7 +11642,7 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
        }
        break;
     }
-    return Nullsv;
+    return NULL;
 }
 
 
@@ -11562,7 +11659,7 @@ Perl_report_uninit(pTHX_ SV* uninit_sv)
 {
     dVAR;
     if (PL_op) {
-       SV* varname = Nullsv;
+       SV* varname = NULL;
        if (uninit_sv) {
            varname = find_uninit_var(PL_op, uninit_sv,0);
            if (varname)