Deprecate Perl_ptr_table_clear(). Nothing outside sv.c uses it.

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index 40c95d5..2e3ba69 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -689,7 +689,6 @@ Perl_sv_free_arenas(pTHX)
   2. regular body arenas
   3. arenas for reduced-size bodies
   4. Hash-Entry arenas
   2. regular body arenas
   3. arenas for reduced-size bodies
   4. Hash-Entry arenas

-  5. pte arenas (thread related)

 
   Arena types 2 & 3 are chained by body-type off an array of
   arena-root pointers, which is indexed by svtype.  Some of the
 
   Arena types 2 & 3 are chained by body-type off an array of
   arena-root pointers, which is indexed by svtype.  Some of the


@@ -708,12 +707,6 @@ Perl_sv_free_arenas(pTHX)
 
   HE, HEK arenas are managed separately, with separate code, but may
   be merge-able later..
 
   HE, HEK arenas are managed separately, with separate code, but may
   be merge-able later..

-
-  PTE arenas are not sv-bodies, but they share these mid-level
-  mechanics, so are considered here.  The new mid-level mechanics rely
-  on the sv_type of the body being allocated, so we just reserve one
-  of the unused body-slots for PTEs, then use it in those (2) PTE
-  contexts below (line ~10k)

 */
 
 /* get_arena(size): this creates custom-sized arenas
 */
 
 /* get_arena(size): this creates custom-sized arenas


@@ -852,13 +845,6 @@ PL_body_roots[HE_SVSLOT=SVt_NULL] is filled by S_more_he, but the
 bodies_by_type[SVt_NULL] slot is not used, as the table is not
 available in hv.c.
 
 bodies_by_type[SVt_NULL] slot is not used, as the table is not
 available in hv.c.
 

-PTEs also use arenas, but are never seen in Perl_sv_upgrade. Nonetheless,
-they get their own slot in bodies_by_type[PTE_SVSLOT =SVt_IV], so they can
-just use the same allocation semantics.  At first, PTEs were also
-overloaded to a non-body sv-type, but this yielded hard-to-find malloc
-bugs, so was simplified by claiming a new slot.  This choice has no
-consequence at this time.
-

 */
 
 struct body_details {
 */
 
 struct body_details {


@@ -921,14 +907,11 @@ static const struct body_details bodies_by_type[] = {
        implemented.  */
     { 0, 0, 0, SVt_BIND, TRUE, NONV, NOARENA, 0 },
 
        implemented.  */
     { 0, 0, 0, SVt_BIND, TRUE, NONV, NOARENA, 0 },
 

-    /* IVs are in the head, so the allocation size is 0.
-       However, the slot is overloaded for PTEs.  */
-    { sizeof(struct ptr_tbl_ent), /* This is used for PTEs.  */
+    /* IVs are in the head, so the allocation size is 0.  */
+    { 0,

       sizeof(IV), /* This is used to copy out the IV body.  */
       STRUCT_OFFSET(XPVIV, xiv_iv), SVt_IV, FALSE, NONV,
       sizeof(IV), /* This is used to copy out the IV body.  */
       STRUCT_OFFSET(XPVIV, xiv_iv), SVt_IV, FALSE, NONV,

-      NOARENA /* IVS don't need an arena  */,
-      /* But PTEs need to know the size of their arena  */
-      FIT_ARENA(0, sizeof(struct ptr_tbl_ent))
+      NOARENA /* IVS don't need an arena  */, 0

     },
 
     /* 8 bytes on most ILP32 with IEEE doubles */
     },
 
     /* 8 bytes on most ILP32 with IEEE doubles */


@@ -1455,7 +1438,7 @@ Perl_sv_upgrade(pTHX_ register SV *const sv, svtype new_type)
                   (unsigned long)new_type);
     }
 
                   (unsigned long)new_type);
     }
 

-    if (old_type > SVt_IV) { /* SVt_IVs are overloaded for PTEs */
+    if (old_type > SVt_IV) {

 #ifdef PURIFY
        my_safefree(old_body);
 #else
 #ifdef PURIFY
        my_safefree(old_body);
 #else


@@ -1717,7 +1700,7 @@ Perl_sv_setnv(pTHX_ register SV *const sv, const NV num)
     case SVt_PVFM:
     case SVt_PVIO:
        Perl_croak(aTHX_ "Can't coerce %s to number in %s", sv_reftype(sv,0),
     case SVt_PVFM:
     case SVt_PVIO:
        Perl_croak(aTHX_ "Can't coerce %s to number in %s", sv_reftype(sv,0),

-                  OP_NAME(PL_op));
+                  OP_DESC(PL_op));

     default: NOOP;
     }
     SvNV_set(sv, num);
     default: NOOP;
     }
     SvNV_set(sv, num);


@@ -3124,7 +3107,7 @@ Perl_sv_2bool(pTHX_ register SV *const sv)
        if (SvAMAGIC(sv)) {
            SV * const tmpsv = AMG_CALLun(sv,bool_);
            if (tmpsv && (!SvROK(tmpsv) || (SvRV(tmpsv) != SvRV(sv))))
        if (SvAMAGIC(sv)) {
            SV * const tmpsv = AMG_CALLun(sv,bool_);
            if (tmpsv && (!SvROK(tmpsv) || (SvRV(tmpsv) != SvRV(sv))))

-               return (bool)SvTRUE(tmpsv);
+               return cBOOL(SvTRUE(tmpsv));

        }
        return SvRV(sv) != 0;
     }
        }
        return SvRV(sv) != 0;
     }


@@ -3685,7 +3668,6 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
     SV **location;
     U8 import_flag = 0;
     const U32 stype = SvTYPE(sref);
     SV **location;
     U8 import_flag = 0;
     const U32 stype = SvTYPE(sref);

-    bool mro_changes = FALSE;

 
     PERL_ARGS_ASSERT_GLOB_ASSIGN_REF;
 
 
     PERL_ARGS_ASSERT_GLOB_ASSIGN_REF;
 


@@ -3706,8 +3688,6 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
        goto common;
     case SVt_PVAV:
        location = (SV **) &GvAV(dstr);
        goto common;
     case SVt_PVAV:
        location = (SV **) &GvAV(dstr);

-        if (strEQ(GvNAME((GV*)dstr), "ISA"))
-           mro_changes = TRUE;

        import_flag = GVf_IMPORTED_AV;
        goto common;
     case SVt_PVIO:
        import_flag = GVf_IMPORTED_AV;
        goto common;
     case SVt_PVIO:


@@ -3781,12 +3761,15 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
            && CopSTASH_ne(PL_curcop, GvSTASH(dstr))) {
            GvFLAGS(dstr) |= import_flag;
        }
            && CopSTASH_ne(PL_curcop, GvSTASH(dstr))) {
            GvFLAGS(dstr) |= import_flag;
        }

+       if (stype == SVt_PVAV && strEQ(GvNAME((GV*)dstr), "ISA")) {
+           sv_magic(sref, dstr, PERL_MAGIC_isa, NULL, 0);
+           mro_isa_changed_in(GvSTASH(dstr));
+       }

        break;
     }
     SvREFCNT_dec(dref);
     if (SvTAINTED(sstr))
        SvTAINT(dstr);
        break;
     }
     SvREFCNT_dec(dref);
     if (SvTAINTED(sstr))
        SvTAINT(dstr);

-    if (mro_changes) mro_isa_changed_in(GvSTASH(dstr));

     return;
 }
 
     return;
 }
 


@@ -3914,7 +3897,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
        {
        const char * const type = sv_reftype(sstr,0);
        if (PL_op)
        {
        const char * const type = sv_reftype(sstr,0);
        if (PL_op)

-           Perl_croak(aTHX_ "Bizarre copy of %s in %s", type, OP_NAME(PL_op));
+           Perl_croak(aTHX_ "Bizarre copy of %s in %s", type, OP_DESC(PL_op));

        else
            Perl_croak(aTHX_ "Bizarre copy of %s", type);
        }
        else
            Perl_croak(aTHX_ "Bizarre copy of %s", type);
        }


@@ -3974,7 +3957,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
     } else if (dtype == SVt_PVAV || dtype == SVt_PVHV) {
        const char * const type = sv_reftype(dstr,0);
        if (PL_op)
     } else if (dtype == SVt_PVAV || dtype == SVt_PVHV) {
        const char * const type = sv_reftype(dstr,0);
        if (PL_op)

-           Perl_croak(aTHX_ "Cannot copy to %s in %s", type, OP_NAME(PL_op));
+           Perl_croak(aTHX_ "Cannot copy to %s in %s", type, OP_DESC(PL_op));

        else
            Perl_croak(aTHX_ "Cannot copy to %s", type);
     } else if (sflags & SVf_ROK) {
        else
            Perl_croak(aTHX_ "Cannot copy to %s", type);
     } else if (sflags & SVf_ROK) {


@@ -5676,15 +5659,9 @@ Perl_sv_clear(pTHX_ register SV *const sv)
 
     if (type <= SVt_IV) {
        /* See the comment in sv.h about the collusion between this early
 
     if (type <= SVt_IV) {
        /* See the comment in sv.h about the collusion between this early

-          return and the overloading of the NULL and IV slots in the size
-          table.  */
-       if (SvROK(sv)) {
-           SV * const target = SvRV(sv);
-           if (SvWEAKREF(sv))
-               sv_del_backref(target, sv);
-           else
-               SvREFCNT_dec(target);
-       }
+          return and the overloading of the NULL slots in the size table.  */
+       if (SvROK(sv))
+           goto free_rv;

        SvFLAGS(sv) &= SVf_BREAK;
        SvFLAGS(sv) |= SVTYPEMASK;
        return;
        SvFLAGS(sv) &= SVf_BREAK;
        SvFLAGS(sv) |= SVTYPEMASK;
        return;


@@ -5836,11 +5813,14 @@ Perl_sv_clear(pTHX_ register SV *const sv)
            /* Don't even bother with turning off the OOK flag.  */
        }
        if (SvROK(sv)) {
            /* Don't even bother with turning off the OOK flag.  */
        }
        if (SvROK(sv)) {

-           SV * const target = SvRV(sv);
-           if (SvWEAKREF(sv))
-               sv_del_backref(target, sv);
-           else
-               SvREFCNT_dec(target);
+       free_rv:
+           {
+               SV * const target = SvRV(sv);
+               if (SvWEAKREF(sv))
+                   sv_del_backref(target, sv);
+               else
+                   SvREFCNT_dec(target);
+           }

        }
 #ifdef PERL_OLD_COPY_ON_WRITE
        else if (SvPVX_const(sv)) {
        }
 #ifdef PERL_OLD_COPY_ON_WRITE
        else if (SvPVX_const(sv)) {


@@ -6072,6 +6052,10 @@ Perl_sv_len_utf8(pTHX_ register SV *const sv)
                    }
                    assert(mg);
                    mg->mg_len = ulen;
                    }
                    assert(mg);
                    mg->mg_len = ulen;

+                   /* For now, treat "overflowed" as "still unknown".
+                      See RT #72924.  */
+                   if (ulen != (STRLEN) mg->mg_len)
+                       mg->mg_len = -1;

                }
            }
            return ulen;
                }
            }
            return ulen;


@@ -7670,7 +7654,8 @@ string.  You are responsible for ensuring that the source string is at least
 C<len> bytes long.  If the C<s> argument is NULL the new SV will be undefined.
 Currently the only flag bits accepted are C<SVf_UTF8> and C<SVs_TEMP>.
 If C<SVs_TEMP> is set, then C<sv2mortal()> is called on the result before
 C<len> bytes long.  If the C<s> argument is NULL the new SV will be undefined.
 Currently the only flag bits accepted are C<SVf_UTF8> and C<SVs_TEMP>.
 If C<SVs_TEMP> is set, then C<sv2mortal()> is called on the result before

-returning. If C<SVf_UTF8> is set, then it will be set on the new SV.
+returning. If C<SVf_UTF8> is set, C<s> is considered to be in UTF-8 and the
+C<SVf_UTF8> flag will be set on the new SV.

 C<newSVpvn_utf8()> is a convenience wrapper for this function, defined as
 
     #define newSVpvn_utf8(s, len, u)                   \
 C<newSVpvn_utf8()> is a convenience wrapper for this function, defined as
 
     #define newSVpvn_utf8(s, len, u)                   \


@@ -8430,14 +8415,14 @@ Perl_sv_pvn_force_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
            const char * const ref = sv_reftype(sv,0);
            if (PL_op)
                Perl_croak(aTHX_ "Can't coerce readonly %s to string in %s",
            const char * const ref = sv_reftype(sv,0);
            if (PL_op)
                Perl_croak(aTHX_ "Can't coerce readonly %s to string in %s",

-                          ref, OP_NAME(PL_op));
+                          ref, OP_DESC(PL_op));

            else
                Perl_croak(aTHX_ "Can't coerce readonly %s to string", ref);
        }
        if ((SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM)
            || isGV_with_GP(sv))
            Perl_croak(aTHX_ "Can't coerce %s to string in %s", sv_reftype(sv,0),
            else
                Perl_croak(aTHX_ "Can't coerce readonly %s to string", ref);
        }
        if ((SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM)
            || isGV_with_GP(sv))
            Perl_croak(aTHX_ "Can't coerce %s to string in %s", sv_reftype(sv,0),

-               OP_NAME(PL_op));
+               OP_DESC(PL_op));

        s = sv_2pv_flags(sv, &len, flags);
        if (lp)
            *lp = len;
        s = sv_2pv_flags(sv, &len, flags);
        if (lp)
            *lp = len;


@@ -9286,7 +9271,7 @@ S_expect_number(pTHX_ char **const pattern)
        while (isDIGIT(**pattern)) {
            const I32 tmp = var * 10 + (*(*pattern)++ - '0');
            if (tmp < var)
        while (isDIGIT(**pattern)) {
            const I32 tmp = var * 10 + (*(*pattern)++ - '0');
            if (tmp < var)

-               Perl_croak(aTHX_ "Integer overflow in format string for %s", (PL_op ? OP_NAME(PL_op) : "sv_vcatpvfn"));
+               Perl_croak(aTHX_ "Integer overflow in format string for %s", (PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn"));

            var = tmp;
        }
     }
            var = tmp;
        }
     }


@@ -10426,6 +10411,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
            goto vector;
        }
     }
            goto vector;
        }
     }

+    SvTAINT(sv);

 }
 
 /* =========================================================================
 }
 
 /* =========================================================================


@@ -10731,6 +10717,11 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *const param)
 
 #endif /* USE_ITHREADS */
 
 
 #endif /* USE_ITHREADS */
 

+struct ptr_tbl_arena {
+    struct ptr_tbl_arena *next;
+    struct ptr_tbl_ent array[1023/3]; /* as ptr_tbl_ent has 3 pointers.  */
+};
+

 /* create a new pointer-mapping table */
 
 PTR_TBL_t *
 /* create a new pointer-mapping table */
 
 PTR_TBL_t *


@@ -10742,6 +10733,9 @@ Perl_ptr_table_new(pTHX)
     Newx(tbl, 1, PTR_TBL_t);
     tbl->tbl_max       = 511;
     tbl->tbl_items     = 0;
     Newx(tbl, 1, PTR_TBL_t);
     tbl->tbl_max       = 511;
     tbl->tbl_items     = 0;

+    tbl->tbl_arena     = NULL;
+    tbl->tbl_arena_next        = NULL;
+    tbl->tbl_arena_end = NULL;

     Newxz(tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
     return tbl;
 }
     Newxz(tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
     return tbl;
 }


@@ -10749,14 +10743,6 @@ Perl_ptr_table_new(pTHX)
 #define PTR_TABLE_HASH(ptr) \
   ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))
 
 #define PTR_TABLE_HASH(ptr) \
   ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))
 

-/* 
-   we use the PTE_SVSLOT 'reservation' made above, both here (in the
-   following define) and at call to new_body_inline made below in 
-   Perl_ptr_table_store()
- */
-
-#define del_pte(p)     del_body_type(p, PTE_SVSLOT)
-

 /* map an existing pointer using a table */
 
 STATIC PTR_TBL_ENT_t *
 /* map an existing pointer using a table */
 
 STATIC PTR_TBL_ENT_t *


@@ -10801,7 +10787,18 @@ Perl_ptr_table_store(pTHX_ PTR_TBL_t *const tbl, const void *const oldsv, void *
     } else {
        const UV entry = PTR_TABLE_HASH(oldsv) & tbl->tbl_max;
 
     } else {
        const UV entry = PTR_TABLE_HASH(oldsv) & tbl->tbl_max;
 

-       new_body_inline(tblent, PTE_SVSLOT);
+       if (tbl->tbl_arena_next == tbl->tbl_arena_end) {
+           struct ptr_tbl_arena *new_arena;
+
+           Newx(new_arena, 1, struct ptr_tbl_arena);
+           new_arena->next = tbl->tbl_arena;
+           tbl->tbl_arena = new_arena;
+           tbl->tbl_arena_next = new_arena->array;
+           tbl->tbl_arena_end = new_arena->array
+               + sizeof(new_arena->array) / sizeof(new_arena->array[0]);
+       }
+
+       tblent = tbl->tbl_arena_next++;

 
        tblent->oldval = oldsv;
        tblent->newval = newsv;
 
        tblent->oldval = oldsv;
        tblent->newval = newsv;


@@ -10849,25 +10846,27 @@ Perl_ptr_table_split(pTHX_ PTR_TBL_t *const tbl)
 }
 
 /* remove all the entries from a ptr table */
 }
 
 /* remove all the entries from a ptr table */

+/* Deprecated - will be removed post 5.14 */

 
 void
 Perl_ptr_table_clear(pTHX_ PTR_TBL_t *const tbl)
 {
     if (tbl && tbl->tbl_items) {
 
 void
 Perl_ptr_table_clear(pTHX_ PTR_TBL_t *const tbl)
 {
     if (tbl && tbl->tbl_items) {

-       register PTR_TBL_ENT_t * const * const array = tbl->tbl_ary;
-       UV riter = tbl->tbl_max;
+       struct ptr_tbl_arena *arena = tbl->tbl_arena;

 
 

-       do {
-           PTR_TBL_ENT_t *entry = array[riter];
+       Zero(tbl->tbl_ary, tbl->tbl_max + 1, struct ptr_tbl_ent **);

 
 

-           while (entry) {
-               PTR_TBL_ENT_t * const oentry = entry;
-               entry = entry->next;
-               del_pte(oentry);
-           }
-       } while (riter--);
+       while (arena) {
+           struct ptr_tbl_arena *next = arena->next;
+
+           Safefree(arena);
+           arena = next;
+       };

 
        tbl->tbl_items = 0;
 
        tbl->tbl_items = 0;

+       tbl->tbl_arena = NULL;
+       tbl->tbl_arena_next = NULL;
+       tbl->tbl_arena_end = NULL;

     }
 }
 
     }
 }
 


@@ -10876,10 +10875,21 @@ Perl_ptr_table_clear(pTHX_ PTR_TBL_t *const tbl)
 void
 Perl_ptr_table_free(pTHX_ PTR_TBL_t *const tbl)
 {
 void
 Perl_ptr_table_free(pTHX_ PTR_TBL_t *const tbl)
 {

+    struct ptr_tbl_arena *arena;
+

     if (!tbl) {
         return;
     }
     if (!tbl) {
         return;
     }

-    ptr_table_clear(tbl);
+
+    arena = tbl->tbl_arena;
+
+    while (arena) {
+       struct ptr_tbl_arena *next = arena->next;
+
+       Safefree(arena);
+       arena = next;
+    }
+

     Safefree(tbl->tbl_ary);
     Safefree(tbl);
 }
     Safefree(tbl->tbl_ary);
     Safefree(tbl);
 }


@@ -11237,7 +11247,7 @@ Perl_sv_dup(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
                        daux->xhv_riter = saux->xhv_riter;
                        daux->xhv_eiter = saux->xhv_eiter
                            ? he_dup(saux->xhv_eiter,
                        daux->xhv_riter = saux->xhv_riter;
                        daux->xhv_eiter = saux->xhv_eiter
                            ? he_dup(saux->xhv_eiter,

-                                       (bool)!!HvSHAREKEYS(sstr), param) : 0;
+                                       cBOOL(HvSHAREKEYS(sstr)), param) : 0;

                        /* backref array needs refcnt=2; see sv_add_backref */
                        daux->xhv_backreferences =
                            saux->xhv_backreferences
                        /* backref array needs refcnt=2; see sv_add_backref */
                        daux->xhv_backreferences =
                            saux->xhv_backreferences


@@ -11583,12 +11593,14 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            TOPPTR(nss,ix) = pv_dup(c);
            break;
        case SAVEt_GP:                          /* scalar reference */
            TOPPTR(nss,ix) = pv_dup(c);
            break;
        case SAVEt_GP:                          /* scalar reference */

+           gv = (const GV *)POPPTR(ss,ix);
+           TOPPTR(nss,ix) = gv_dup_inc(gv, param);

            gp = (GP*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = gp = gp_dup(gp, param);
            (void)GpREFCNT_inc(gp);
            gp = (GP*)POPPTR(ss,ix);
            TOPPTR(nss,ix) = gp = gp_dup(gp, param);
            (void)GpREFCNT_inc(gp);

-           gv = (const GV *)POPPTR(ss,ix);
-           TOPPTR(nss,ix) = gv_dup_inc(gv, param);
-            break;
+           i = POPINT(ss,ix);
+           TOPINT(nss,ix) = i;
+           break;

        case SAVEt_FREEOP:
            ptr = POPPTR(ss,ix);
            if (ptr && (((OP*)ptr)->op_private & OPpREFCOUNTED)) {
        case SAVEt_FREEOP:
            ptr = POPPTR(ss,ix);
            if (ptr && (((OP*)ptr)->op_private & OPpREFCOUNTED)) {


@@ -11690,7 +11702,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            ptr = POPPTR(ss,ix);
            TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
            longval = (long)POPBOOL(ss,ix);
            ptr = POPPTR(ss,ix);
            TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
            longval = (long)POPBOOL(ss,ix);

-           TOPBOOL(nss,ix) = (bool)longval;
+           TOPBOOL(nss,ix) = cBOOL(longval);

            break;
        case SAVEt_SET_SVFLAGS:
            i = POPINT(ss,ix);
            break;
        case SAVEt_SET_SVFLAGS:
            i = POPINT(ss,ix);


@@ -12004,9 +12016,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     SvNV_set(&PL_sv_yes, 1);
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
 
     SvNV_set(&PL_sv_yes, 1);
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
 

-    /* dbargs array probably holds garbage; give the child a clean array */
-    PL_dbargs          = newAV();
-    ptr_table_store(PL_ptr_table, proto_perl->Idbargs, PL_dbargs);
+    /* dbargs array probably holds garbage */
+    PL_dbargs          = NULL;

 
     /* create (a non-shared!) shared string table */
     PL_strtab          = newHV();
 
     /* create (a non-shared!) shared string table */
     PL_strtab          = newHV();


@@ -12478,6 +12489,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_bodytarget      = sv_dup_inc(proto_perl->Ibodytarget, param);
     PL_formtarget      = sv_dup(proto_perl->Iformtarget, param);
 
     PL_bodytarget      = sv_dup_inc(proto_perl->Ibodytarget, param);
     PL_formtarget      = sv_dup(proto_perl->Iformtarget, param);
 

+    PL_restartjmpenv   = proto_perl->Irestartjmpenv;

     PL_restartop       = proto_perl->Irestartop;
     PL_in_eval         = proto_perl->Iin_eval;
     PL_delaymagic      = proto_perl->Idelaymagic;
     PL_restartop       = proto_perl->Irestartop;
     PL_in_eval         = proto_perl->Iin_eval;
     PL_delaymagic      = proto_perl->Idelaymagic;