This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Further conversion of overload.t
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index 010ee49..e5e997c 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -435,6 +435,8 @@ Perl_sv_report_used(pTHX)
 {
 #ifdef DEBUGGING
     visit(do_report_used, 0, 0);
 {
 #ifdef DEBUGGING
     visit(do_report_used, 0, 0);
+#else
+    PERL_UNUSED_CONTEXT;
 #endif
 }
 
 #endif
 }
 
@@ -470,7 +472,7 @@ static void
 do_clean_named_objs(pTHX_ SV *sv)
 {
     dVAR;
 do_clean_named_objs(pTHX_ SV *sv)
 {
     dVAR;
-    if (SvTYPE(sv) == SVt_PVGV && GvGP(sv)) {
+    if (SvTYPE(sv) == SVt_PVGV && isGV_with_GP(sv) && GvGP(sv)) {
        if ((
 #ifdef PERL_DONT_CREATE_GVSV
             GvSV(sv) &&
        if ((
 #ifdef PERL_DONT_CREATE_GVSV
             GvSV(sv) &&
@@ -585,18 +587,6 @@ struct arena_set {
     struct arena_desc set[ARENAS_PER_SET];
 };
 
     struct arena_desc set[ARENAS_PER_SET];
 };
 
-#if !ARENASETS
-
-static void 
-S_free_arena(pTHX_ void **root) {
-    while (root) {
-       void ** const next = *(void **)root;
-       Safefree(root);
-       root = next;
-    }
-}
-#endif
-
 /*
 =for apidoc sv_free_arenas
 
 /*
 =for apidoc sv_free_arenas
 
@@ -625,12 +615,11 @@ Perl_sv_free_arenas(pTHX)
            Safefree(sva);
     }
 
            Safefree(sva);
     }
 
-#if ARENASETS
     {
        struct arena_set *next, *aroot = (struct arena_set*) PL_body_arenas;
        
        for (; aroot; aroot = next) {
     {
        struct arena_set *next, *aroot = (struct arena_set*) PL_body_arenas;
        
        for (; aroot; aroot = next) {
-           int max = aroot->curr;
+           const int max = aroot->curr;
            for (i=0; i<max; i++) {
                assert(aroot->set[i].arena);
                Safefree(aroot->set[i].arena);
            for (i=0; i<max; i++) {
                assert(aroot->set[i].arena);
                Safefree(aroot->set[i].arena);
@@ -639,9 +628,6 @@ Perl_sv_free_arenas(pTHX)
            Safefree(aroot);
        }
     }
            Safefree(aroot);
        }
     }
-#else
-    S_free_arena(aTHX_ (void**) PL_body_arenas);
-#endif
     PL_body_arenas = 0;
 
     for (i=0; i<PERL_ARENA_ROOTS_SIZE; i++)
     PL_body_arenas = 0;
 
     for (i=0; i<PERL_ARENA_ROOTS_SIZE; i++)
@@ -689,24 +675,12 @@ Perl_sv_free_arenas(pTHX)
   contexts below (line ~10k)
 */
 
   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.
+/* get_arena(size): this creates custom-sized arenas
    TBD: export properly for hv.c: S_more_he().
 */
 void*
 Perl_get_arena(pTHX_ int arena_size)
 {
    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, 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;
     struct arena_desc* adesc;
     struct arena_set *newroot, **aroot = (struct arena_set**) &PL_body_arenas;
     int curr;
@@ -735,7 +709,6 @@ Perl_get_arena(pTHX_ int arena_size)
                          curr, adesc->arena, arena_size));
 
     return adesc->arena;
                          curr, adesc->arena, arena_size));
 
     return adesc->arena;
-#endif
 }
 
 
 }
 
 
@@ -843,12 +816,13 @@ has no consequence at this time.
 
 struct body_details {
     U8 body_size;      /* Size to allocate  */
 
 struct body_details {
     U8 body_size;      /* Size to allocate  */
-    U8 copy;   /* Size of structure to copy (may be shorter)  */
+    U8 copy;           /* Size of structure to copy (may be shorter)  */
     U8 offset;
     U8 offset;
-    bool cant_upgrade; /* Cannot upgrade this type */
-    bool zero_nv;      /* zero the NV when upgrading from this */
-    bool arena;                /* Allocated from an arena */
-    size_t arena_size; /* Size of arena to allocate */
+    unsigned int type : 4;         /* We have space for a sanity check.  */
+    unsigned int cant_upgrade : 1;  /* Cannot upgrade this type */
+    unsigned int zero_nv : 1;      /* zero the NV when upgrading from this */
+    unsigned int arena : 1;        /* Allocated from an arena */
+    size_t arena_size;             /* Size of arena to allocate */
 };
 
 #define HADNV FALSE
 };
 
 #define HADNV FALSE
@@ -872,9 +846,16 @@ struct body_details {
    limited by PERL_ARENA_SIZE, so we can safely oversize the
    declarations.
  */
    limited by PERL_ARENA_SIZE, so we can safely oversize the
    declarations.
  */
-#define FIT_ARENA(count, body_size)                    \
-    (!count || count * body_size > PERL_ARENA_SIZE)    \
-       ? (int)(PERL_ARENA_SIZE / body_size) * body_size : count * body_size
+#define FIT_ARENA0(body_size)                          \
+    ((size_t)(PERL_ARENA_SIZE / body_size) * body_size)
+#define FIT_ARENAn(count,body_size)                    \
+    ( count * body_size <= PERL_ARENA_SIZE)            \
+    ? count * body_size                                        \
+    : FIT_ARENA0 (body_size)
+#define FIT_ARENA(count,body_size)                     \
+    count                                              \
+    ? FIT_ARENAn (count, body_size)                    \
+    : FIT_ARENA0 (body_size)
 
 /* A macro to work out the offset needed to subtract from a pointer to (say)
 
 
 /* A macro to work out the offset needed to subtract from a pointer to (say)
 
@@ -905,82 +886,83 @@ struct xpv {
        + sizeof (((type*)SvANY((SV*)0))->last_member)
 
 static const struct body_details bodies_by_type[] = {
        + sizeof (((type*)SvANY((SV*)0))->last_member)
 
 static const struct body_details bodies_by_type[] = {
-    { sizeof(HE), 0, 0, FALSE, NONV, NOARENA, FIT_ARENA(0, sizeof(HE)) },
+    { sizeof(HE), 0, 0, SVt_NULL,
+      FALSE, NONV, NOARENA, FIT_ARENA(0, sizeof(HE)) },
 
     /* 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.  */
       sizeof(IV), /* This is used to copy out the IV body.  */
 
     /* 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.  */
       sizeof(IV), /* This is used to copy out the IV body.  */
-      STRUCT_OFFSET(XPVIV, xiv_iv), FALSE, NONV,
+      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))
     },
 
     /* 8 bytes on most ILP32 with IEEE doubles */
       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))
     },
 
     /* 8 bytes on most ILP32 with IEEE doubles */
-    { sizeof(NV), sizeof(NV), 0, FALSE, HADNV, HASARENA,
+    { sizeof(NV), sizeof(NV), 0, SVt_NV, FALSE, HADNV, HASARENA,
       FIT_ARENA(0, sizeof(NV)) },
 
     /* RVs are in the head now.  */
       FIT_ARENA(0, sizeof(NV)) },
 
     /* RVs are in the head now.  */
-    { 0, 0, 0, FALSE, NONV, NOARENA, 0 },
+    { 0, 0, 0, SVt_RV, FALSE, NONV, NOARENA, 0 },
 
     /* 8 bytes on most ILP32 with IEEE doubles */
     { sizeof(xpv_allocated),
       copy_length(XPV, xpv_len)
       - relative_STRUCT_OFFSET(xpv_allocated, XPV, xpv_cur),
       + relative_STRUCT_OFFSET(xpv_allocated, XPV, xpv_cur),
 
     /* 8 bytes on most ILP32 with IEEE doubles */
     { sizeof(xpv_allocated),
       copy_length(XPV, xpv_len)
       - relative_STRUCT_OFFSET(xpv_allocated, XPV, xpv_cur),
       + relative_STRUCT_OFFSET(xpv_allocated, XPV, xpv_cur),
-      FALSE, NONV, HASARENA, FIT_ARENA(0, sizeof(xpv_allocated)) },
+      SVt_PV, FALSE, NONV, HASARENA, FIT_ARENA(0, sizeof(xpv_allocated)) },
 
     /* 12 */
     { sizeof(xpviv_allocated),
       copy_length(XPVIV, xiv_u)
       - relative_STRUCT_OFFSET(xpviv_allocated, XPVIV, xpv_cur),
       + relative_STRUCT_OFFSET(xpviv_allocated, XPVIV, xpv_cur),
 
     /* 12 */
     { sizeof(xpviv_allocated),
       copy_length(XPVIV, xiv_u)
       - relative_STRUCT_OFFSET(xpviv_allocated, XPVIV, xpv_cur),
       + relative_STRUCT_OFFSET(xpviv_allocated, XPVIV, xpv_cur),
-      FALSE, NONV, HASARENA, FIT_ARENA(0, sizeof(xpviv_allocated)) },
+      SVt_PVIV, FALSE, NONV, HASARENA, FIT_ARENA(0, sizeof(xpviv_allocated)) },
 
     /* 20 */
 
     /* 20 */
-    { sizeof(XPVNV), copy_length(XPVNV, xiv_u), 0, FALSE, HADNV,
+    { sizeof(XPVNV), copy_length(XPVNV, xiv_u), 0, SVt_PVNV, FALSE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVNV)) },
 
     /* 28 */
       HASARENA, FIT_ARENA(0, sizeof(XPVNV)) },
 
     /* 28 */
-    { sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, FALSE, HADNV,
+    { sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, SVt_PVMG, FALSE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
     
     /* 36 */
       HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
     
     /* 36 */
-    { sizeof(XPVBM), sizeof(XPVBM), 0, TRUE, HADNV,
+    { sizeof(XPVBM), sizeof(XPVBM), 0, SVt_PVBM, TRUE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVBM)) },
 
     /* 48 */
       HASARENA, FIT_ARENA(0, sizeof(XPVBM)) },
 
     /* 48 */
-    { sizeof(XPVGV), sizeof(XPVGV), 0, TRUE, HADNV,
+    { sizeof(XPVGV), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVGV)) },
     
     /* 64 */
       HASARENA, FIT_ARENA(0, sizeof(XPVGV)) },
     
     /* 64 */
-    { sizeof(XPVLV), sizeof(XPVLV), 0, TRUE, HADNV,
+    { sizeof(XPVLV), sizeof(XPVLV), 0, SVt_PVLV, TRUE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVLV)) },
 
     { sizeof(xpvav_allocated),
       copy_length(XPVAV, xmg_stash)
       - relative_STRUCT_OFFSET(xpvav_allocated, XPVAV, xav_fill),
       + relative_STRUCT_OFFSET(xpvav_allocated, XPVAV, xav_fill),
       HASARENA, FIT_ARENA(0, sizeof(XPVLV)) },
 
     { sizeof(xpvav_allocated),
       copy_length(XPVAV, xmg_stash)
       - relative_STRUCT_OFFSET(xpvav_allocated, XPVAV, xav_fill),
       + relative_STRUCT_OFFSET(xpvav_allocated, XPVAV, xav_fill),
-      TRUE, HADNV, HASARENA, FIT_ARENA(0, sizeof(xpvav_allocated)) },
+      SVt_PVAV, TRUE, HADNV, HASARENA, FIT_ARENA(0, sizeof(xpvav_allocated)) },
 
     { sizeof(xpvhv_allocated),
       copy_length(XPVHV, xmg_stash)
       - relative_STRUCT_OFFSET(xpvhv_allocated, XPVHV, xhv_fill),
       + relative_STRUCT_OFFSET(xpvhv_allocated, XPVHV, xhv_fill),
 
     { sizeof(xpvhv_allocated),
       copy_length(XPVHV, xmg_stash)
       - relative_STRUCT_OFFSET(xpvhv_allocated, XPVHV, xhv_fill),
       + relative_STRUCT_OFFSET(xpvhv_allocated, XPVHV, xhv_fill),
-      TRUE, HADNV, HASARENA, FIT_ARENA(0, sizeof(xpvhv_allocated)) },
+      SVt_PVHV, TRUE, HADNV, HASARENA, FIT_ARENA(0, sizeof(xpvhv_allocated)) },
 
     /* 56 */
     { sizeof(xpvcv_allocated), sizeof(xpvcv_allocated),
       + relative_STRUCT_OFFSET(xpvcv_allocated, XPVCV, xpv_cur),
 
     /* 56 */
     { sizeof(xpvcv_allocated), sizeof(xpvcv_allocated),
       + relative_STRUCT_OFFSET(xpvcv_allocated, XPVCV, xpv_cur),
-      TRUE, NONV, HASARENA, FIT_ARENA(0, sizeof(xpvcv_allocated)) },
+      SVt_PVCV, TRUE, NONV, HASARENA, FIT_ARENA(0, sizeof(xpvcv_allocated)) },
 
     { sizeof(xpvfm_allocated), sizeof(xpvfm_allocated),
       + relative_STRUCT_OFFSET(xpvfm_allocated, XPVFM, xpv_cur),
 
     { sizeof(xpvfm_allocated), sizeof(xpvfm_allocated),
       + relative_STRUCT_OFFSET(xpvfm_allocated, XPVFM, xpv_cur),
-      TRUE, NONV, NOARENA, FIT_ARENA(20, sizeof(xpvfm_allocated)) },
+      SVt_PVFM, TRUE, NONV, NOARENA, FIT_ARENA(20, sizeof(xpvfm_allocated)) },
 
     /* XPVIO is 84 bytes, fits 48x */
 
     /* XPVIO is 84 bytes, fits 48x */
-    { sizeof(XPVIO), sizeof(XPVIO), 0, TRUE, HADNV,
+    { sizeof(XPVIO), sizeof(XPVIO), 0, SVt_PVIO, TRUE, HADNV,
       HASARENA, FIT_ARENA(24, sizeof(XPVIO)) },
 };
 
       HASARENA, FIT_ARENA(24, sizeof(XPVIO)) },
 };
 
@@ -1052,32 +1034,42 @@ static const struct body_details bodies_by_type[] = {
 #define new_NOARENAZ(details) \
        my_safecalloc((details)->body_size + (details)->offset)
 
 #define new_NOARENAZ(details) \
        my_safecalloc((details)->body_size + (details)->offset)
 
+#ifdef DEBUGGING
+static bool done_sanity_check;
+#endif
+
 STATIC void *
 S_more_bodies (pTHX_ svtype sv_type)
 {
     dVAR;
     void ** const root = &PL_body_roots[sv_type];
 STATIC void *
 S_more_bodies (pTHX_ svtype sv_type)
 {
     dVAR;
     void ** const root = &PL_body_roots[sv_type];
-    const struct body_details *bdp = &bodies_by_type[sv_type];
+    const struct body_details * const bdp = &bodies_by_type[sv_type];
     const size_t body_size = bdp->body_size;
     char *start;
     const char *end;
 
     assert(bdp->arena_size);
     const size_t body_size = bdp->body_size;
     char *start;
     const char *end;
 
     assert(bdp->arena_size);
+
+#ifdef DEBUGGING
+    if (!done_sanity_check) {
+       unsigned int i = SVt_LAST;
+
+       done_sanity_check = TRUE;
+
+       while (i--)
+           assert (bodies_by_type[i].type == i);
+    }
+#endif
+
     start = (char*) Perl_get_arena(aTHX_ bdp->arena_size);
 
     end = start + bdp->arena_size - body_size;
 
     start = (char*) Perl_get_arena(aTHX_ bdp->arena_size);
 
     end = start + bdp->arena_size - body_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 += body_size;
-#else
     /* computed count doesnt reflect the 1st slot reservation */
     DEBUG_m(PerlIO_printf(Perl_debug_log,
                          "arena %p end %p arena-size %d type %d size %d ct %d\n",
                          start, end, bdp->arena_size, sv_type, body_size,
                          bdp->arena_size / body_size));
     /* computed count doesnt reflect the 1st slot reservation */
     DEBUG_m(PerlIO_printf(Perl_debug_log,
                          "arena %p end %p arena-size %d type %d size %d ct %d\n",
                          start, end, bdp->arena_size, sv_type, body_size,
                          bdp->arena_size / body_size));
-#endif
 
     *root = (void *)start;
 
 
     *root = (void *)start;
 
@@ -1222,7 +1214,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
        /* This flag bit is used to mean other things in other scalar types.
           Given that it only has meaning inside the pad, it shouldn't be set
           on anything that can get upgraded.  */
        /* This flag bit is used to mean other things in other scalar types.
           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);
+       assert(!SvPAD_TYPED(sv));
        break;
     default:
        if (old_type_details->cant_upgrade)
        break;
     default:
        if (old_type_details->cant_upgrade)
@@ -1289,7 +1281,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
        SvPV_set(sv, NULL);
 
        if (old_type >= SVt_PVMG) {
        SvPV_set(sv, NULL);
 
        if (old_type >= SVt_PVMG) {
-           SvMAGIC_set(sv, ((XPVMG*)old_body)->xmg_magic);
+           SvMAGIC_set(sv, ((XPVMG*)old_body)->xmg_u.xmg_magic);
            SvSTASH_set(sv, ((XPVMG*)old_body)->xmg_stash);
        }
        break;
            SvSTASH_set(sv, ((XPVMG*)old_body)->xmg_stash);
        }
        break;
@@ -1324,9 +1316,21 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
        SvANY(sv) = new_body;
 
        if (old_type_details->copy) {
        SvANY(sv) = new_body;
 
        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);
+           /* There is now the potential for an upgrade from something without
+              an offset (PVNV or PVMG) to something with one (PVCV, PVFM)  */
+           int offset = old_type_details->offset;
+           int length = old_type_details->copy;
+
+           if (new_type_details->offset > old_type_details->offset) {
+               int difference
+                   = new_type_details->offset - old_type_details->offset;
+               offset += difference;
+               length -= difference;
+           }
+           assert (length >= 0);
+               
+           Copy((char *)old_body + offset, (char *)new_body + offset, length,
+                char);
        }
 
 #ifndef NV_ZERO_IS_ALLBITS_ZERO
        }
 
 #ifndef NV_ZERO_IS_ALLBITS_ZERO
@@ -1375,6 +1379,7 @@ wrapper instead.
 int
 Perl_sv_backoff(pTHX_ register SV *sv)
 {
 int
 Perl_sv_backoff(pTHX_ register SV *sv)
 {
+    PERL_UNUSED_CONTEXT;
     assert(SvOOK(sv));
     assert(SvTYPE(sv) != SVt_PVHV);
     assert(SvTYPE(sv) != SVt_PVAV);
     assert(SvOOK(sv));
     assert(SvTYPE(sv) != SVt_PVHV);
     assert(SvTYPE(sv) != SVt_PVAV);
@@ -1404,6 +1409,10 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
 {
     register char *s;
 
 {
     register char *s;
 
+    if (PL_madskills && newlen >= 0x100000) {
+       PerlIO_printf(Perl_debug_log,
+                     "Allocation too large: %"UVxf"\n", (UV)newlen);
+    }
 #ifdef HAS_64K_LIMIT
     if (newlen >= 0x10000) {
        PerlIO_printf(Perl_debug_log,
 #ifdef HAS_64K_LIMIT
     if (newlen >= 0x10000) {
        PerlIO_printf(Perl_debug_log,
@@ -2096,12 +2105,9 @@ S_sv_2iuv_common(pTHX_ SV *sv) {
        }
     }
     else  {
        }
     }
     else  {
-       if (((SvFLAGS(sv) & (SVp_POK|SVp_SCREAM)) == SVp_SCREAM)
-           && (SvTYPE(sv) == SVt_PVGV || SvTYPE(sv) == SVt_PVLV)) {
-           return PTR2IV(glob_2inpuv((GV *)sv, NULL, TRUE));
+       if (isGV_with_GP(sv)) {
+           return (bool)PTR2IV(glob_2inpuv((GV *)sv, NULL, TRUE));
        }
        }
-       if (SvTYPE(sv) == SVt_PVGV)
-           sv_dump(sv);
 
        if (!(SvFLAGS(sv) & SVs_PADTMP)) {
            if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
 
        if (!(SvFLAGS(sv) & SVs_PADTMP)) {
            if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
@@ -2450,8 +2456,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 #endif /* NV_PRESERVES_UV */
     }
     else  {
 #endif /* NV_PRESERVES_UV */
     }
     else  {
-       if (((SvFLAGS(sv) & (SVp_POK|SVp_SCREAM)) == SVp_SCREAM)
-           && (SvTYPE(sv) == SVt_PVGV || SvTYPE(sv) == SVt_PVLV)) {
+       if (isGV_with_GP(sv)) {
            glob_2inpuv((GV *)sv, NULL, TRUE);
            return 0.0;
        }
            glob_2inpuv((GV *)sv, NULL, TRUE);
            return 0.0;
        }
@@ -2788,8 +2793,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 #endif
     }
     else {
 #endif
     }
     else {
-       if (((SvFLAGS(sv) & (SVp_POK|SVp_SCREAM)) == SVp_SCREAM)
-           && (SvTYPE(sv) == SVt_PVGV || SvTYPE(sv) == SVt_PVLV)) {
+       if (isGV_with_GP(sv)) {
            return glob_2inpuv((GV *)sv, lp, FALSE);
        }
 
            return glob_2inpuv((GV *)sv, lp, FALSE);
        }
 
@@ -2924,8 +2928,7 @@ Perl_sv_2bool(pTHX_ register SV *sv)
            if (SvNOKp(sv))
                return SvNVX(sv) != 0.0;
            else {
            if (SvNOKp(sv))
                return SvNVX(sv) != 0.0;
            else {
-               if ((SvFLAGS(sv) & SVp_SCREAM)
-                   && (SvTYPE(sv) == (SVt_PVGV) || SvTYPE(sv) == (SVt_PVLV)))
+               if (isGV_with_GP(sv))
                    return TRUE;
                else
                    return FALSE;
                    return TRUE;
                else
                    return FALSE;
@@ -3168,13 +3171,21 @@ S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype)
        const char * const name = GvNAME(sstr);
        const STRLEN len = GvNAMELEN(sstr);
        /* don't upgrade SVt_PVLV: it can hold a glob */
        const char * const name = GvNAME(sstr);
        const STRLEN len = GvNAMELEN(sstr);
        /* don't upgrade SVt_PVLV: it can hold a glob */
-       if (dtype != SVt_PVLV)
+       if (dtype != SVt_PVLV) {
+           if (dtype >= SVt_PV) {
+               SvPV_free(dstr);
+               SvPV_set(dstr, 0);
+               SvLEN_set(dstr, 0);
+               SvCUR_set(dstr, 0);
+           }
            sv_upgrade(dstr, SVt_PVGV);
            sv_upgrade(dstr, SVt_PVGV);
+           (void)SvOK_off(dstr);
+           SvSCREAM_on(dstr);
+       }
        GvSTASH(dstr) = GvSTASH(sstr);
        if (GvSTASH(dstr))
            Perl_sv_add_backref(aTHX_ (SV*)GvSTASH(dstr), dstr);
        GvSTASH(dstr) = GvSTASH(sstr);
        if (GvSTASH(dstr))
            Perl_sv_add_backref(aTHX_ (SV*)GvSTASH(dstr), dstr);
-       GvNAME(dstr) = savepvn(name, len);
-       GvNAMELEN(dstr) = len;
+       gv_name_set((GV *)dstr, name, len, GV_ADD);
        SvFAKE_on(dstr);        /* can coerce to non-glob */
     }
 
        SvFAKE_on(dstr);        /* can coerce to non-glob */
     }
 
@@ -3184,10 +3195,11 @@ S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype)
     }
 #endif
 
     }
 #endif
 
+    gp_free((GV*)dstr);
+    SvSCREAM_off(dstr);
     (void)SvOK_off(dstr);
     SvSCREAM_on(dstr);
     GvINTRO_off(dstr);         /* one-shot flag */
     (void)SvOK_off(dstr);
     SvSCREAM_on(dstr);
     GvINTRO_off(dstr);         /* one-shot flag */
-    gp_free((GV*)dstr);
     GvGP(dstr) = gp_ref(GvGP(sstr));
     if (SvTAINTED(sstr))
        SvTAINT(dstr);
     GvGP(dstr) = gp_ref(GvGP(sstr));
     if (SvTAINTED(sstr))
        SvTAINT(dstr);
@@ -3303,8 +3315,7 @@ S_glob_assign_ref(pTHX_ SV *dstr, SV *sstr) {
        }
        break;
     }
        }
        break;
     }
-    if (dref)
-       SvREFCNT_dec(dref);
+    SvREFCNT_dec(dref);
     if (SvTAINTED(sstr))
        SvTAINT(dstr);
     return;
     if (SvTAINTED(sstr))
        SvTAINT(dstr);
     return;
@@ -3418,10 +3429,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
        if (dtype < SVt_PVNV)
            sv_upgrade(dstr, SVt_PVNV);
        break;
        if (dtype < SVt_PVNV)
            sv_upgrade(dstr, SVt_PVNV);
        break;
-    case SVt_PVAV:
-    case SVt_PVHV:
-    case SVt_PVCV:
-    case SVt_PVIO:
+    default:
        {
        const char * const type = sv_reftype(sstr,0);
        if (PL_op)
        {
        const char * const type = sv_reftype(sstr,0);
        if (PL_op)
@@ -3438,7 +3446,9 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
        }
        /*FALLTHROUGH*/
 
        }
        /*FALLTHROUGH*/
 
-    default:
+    case SVt_PVMG:
+    case SVt_PVLV:
+    case SVt_PVBM:
        if (SvGMAGICAL(sstr) && (flags & SV_GMAGIC)) {
            mg_get(sstr);
            if ((int)SvTYPE(sstr) != stype) {
        if (SvGMAGICAL(sstr) && (flags & SV_GMAGIC)) {
            mg_get(sstr);
            if ((int)SvTYPE(sstr) != stype) {
@@ -3664,8 +3674,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
        }
     }
     else {
        }
     }
     else {
-       if ((stype == SVt_PVGV || stype == SVt_PVLV)
-                && (sflags & SVp_SCREAM)) {
+       if (isGV_with_GP(sstr)) {
            /* This stringification rule for globs is spread in 3 places.
               This feels bad. FIXME.  */
            const U32 wasfake = sflags & SVf_FAKE;
            /* This stringification rule for globs is spread in 3 places.
               This feels bad. FIXME.  */
            const U32 wasfake = sflags & SVf_FAKE;
@@ -4314,7 +4323,7 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
        mg->mg_obj = obj;
     }
     else {
        mg->mg_obj = obj;
     }
     else {
-       mg->mg_obj = SvREFCNT_inc(obj);
+       mg->mg_obj = SvREFCNT_inc_simple(obj);
        mg->mg_flags |= MGf_REFCOUNTED;
     }
 
        mg->mg_flags |= MGf_REFCOUNTED;
     }
 
@@ -4338,7 +4347,7 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
        if (namlen > 0)
            mg->mg_ptr = savepvn(name, namlen);
        else if (namlen == HEf_SVKEY)
        if (namlen > 0)
            mg->mg_ptr = savepvn(name, namlen);
        else if (namlen == HEf_SVKEY)
-           mg->mg_ptr = (char*)SvREFCNT_inc((SV*)name);
+           mg->mg_ptr = (char*)SvREFCNT_inc_simple_NN((SV*)name);
        else
            mg->mg_ptr = (char *) name;
     }
        else
            mg->mg_ptr = (char *) name;
     }
@@ -4552,7 +4561,7 @@ Perl_sv_unmagic(pTHX_ SV *sv, int type)
     MAGIC** mgp;
     if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
        return 0;
     MAGIC** mgp;
     if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
        return 0;
-    mgp = &SvMAGIC(sv);
+    mgp = &(((XPVMG*) SvANY(sv))->xmg_u.xmg_magic);
     for (mg = *mgp; mg; mg = *mgp) {
        if (mg->mg_type == type) {
             const MGVTBL* const vtbl = mg->mg_virtual;
     for (mg = *mgp; mg; mg = *mgp) {
        if (mg->mg_type == type) {
             const MGVTBL* const vtbl = mg->mg_virtual;
@@ -4644,7 +4653,7 @@ Perl_sv_add_backref(pTHX_ SV *tsv, SV *sv)
            } else {
                av = newAV();
                AvREAL_off(av);
            } else {
                av = newAV();
                AvREAL_off(av);
-               SvREFCNT_inc(av);
+               SvREFCNT_inc_simple_void(av);
            }
            *avp = av;
        }
            }
            *avp = av;
        }
@@ -5022,9 +5031,13 @@ Perl_sv_clear(pTHX_ register SV *sv)
        }
     }
     if (type >= SVt_PVMG) {
        }
     }
     if (type >= SVt_PVMG) {
-       if (SvMAGIC(sv))
+       HV *ourstash;
+       if ((type == SVt_PVMG || type == SVt_PVGV) &&
+           (ourstash = OURSTASH(sv))) {
+           SvREFCNT_dec(ourstash);
+       } else if (SvMAGIC(sv))
            mg_free(sv);
            mg_free(sv);
-       if (type == SVt_PVMG && SvFLAGS(sv) & SVpad_TYPED)
+       if (type == SVt_PVMG && SvPAD_TYPED(sv))
            SvREFCNT_dec(SvSTASH(sv));
     }
     switch (type) {
            SvREFCNT_dec(SvSTASH(sv));
     }
     switch (type) {
@@ -5067,7 +5080,9 @@ Perl_sv_clear(pTHX_ register SV *sv)
        goto freescalar;
     case SVt_PVGV:
        gp_free((GV*)sv);
        goto freescalar;
     case SVt_PVGV:
        gp_free((GV*)sv);
-       Safefree(GvNAME(sv));
+       if (GvNAME_HEK(sv)) {
+           unshare_hek(GvNAME_HEK(sv));
+       }
        /* If we're in a stash, we don't own a reference to it. However it does
           have a back reference to us, which needs to be cleared.  */
        if (GvSTASH(sv))
        /* If we're in a stash, we don't own a reference to it. However it does
           have a back reference to us, which needs to be cleared.  */
        if (GvSTASH(sv))
@@ -5084,7 +5099,7 @@ Perl_sv_clear(pTHX_ register SV *sv)
     case SVt_PV:
     case SVt_RV:
        if (SvROK(sv)) {
     case SVt_PV:
     case SVt_RV:
        if (SvROK(sv)) {
-           SV *target = SvRV(sv);
+           SV * const target = SvRV(sv);
            if (SvWEAKREF(sv))
                sv_del_backref(target, sv);
            else
            if (SvWEAKREF(sv))
                sv_del_backref(target, sv);
            else
@@ -5144,6 +5159,7 @@ instead.
 SV *
 Perl_sv_newref(pTHX_ SV *sv)
 {
 SV *
 Perl_sv_newref(pTHX_ SV *sv)
 {
+    PERL_UNUSED_CONTEXT;
     if (sv)
        (SvREFCNT(sv))++;
     return sv;
     if (sv)
        (SvREFCNT(sv))++;
     return sv;
@@ -5737,9 +5753,7 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
     if (cur1 == cur2)
        eq = (pv1 == pv2) || memEQ(pv1, pv2, cur1);
        
     if (cur1 == cur2)
        eq = (pv1 == pv2) || memEQ(pv1, pv2, cur1);
        
-    if (svrecode)
-        SvREFCNT_dec(svrecode);
-
+    SvREFCNT_dec(svrecode);
     if (tpv)
        Safefree(tpv);
 
     if (tpv)
        Safefree(tpv);
 
@@ -5822,9 +5836,7 @@ Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
        }
     }
 
        }
     }
 
-    if (svrecode)
-        SvREFCNT_dec(svrecode);
-
+    SvREFCNT_dec(svrecode);
     if (tpv)
        Safefree(tpv);
 
     if (tpv)
        Safefree(tpv);
 
@@ -6939,10 +6951,10 @@ Perl_newRV_noinc(pTHX_ SV *tmpRef)
  */
 
 SV *
  */
 
 SV *
-Perl_newRV(pTHX_ SV *tmpRef)
+Perl_newRV(pTHX_ SV *sv)
 {
     dVAR;
 {
     dVAR;
-    return newRV_noinc(SvREFCNT_inc(tmpRef));
+    return newRV_noinc(SvREFCNT_inc_simple_NN(sv));
 }
 
 /*
 }
 
 /*
@@ -7636,7 +7648,7 @@ Perl_sv_bless(pTHX_ SV *sv, HV *stash)
     if (SvTYPE(tmpRef) != SVt_PVIO)
        ++PL_sv_objcount;
     SvUPGRADE(tmpRef, SVt_PVMG);
     if (SvTYPE(tmpRef) != SVt_PVIO)
        ++PL_sv_objcount;
     SvUPGRADE(tmpRef, SVt_PVMG);
-    SvSTASH_set(tmpRef, (HV*)SvREFCNT_inc(stash));
+    SvSTASH_set(tmpRef, (HV*)SvREFCNT_inc_simple(stash));
 
     if (Gv_AMG(stash))
        SvAMAGIC_on(sv);
 
     if (Gv_AMG(stash))
        SvAMAGIC_on(sv);
@@ -7660,21 +7672,24 @@ S_sv_unglob(pTHX_ SV *sv)
 {
     dVAR;
     void *xpvmg;
 {
     dVAR;
     void *xpvmg;
-    SV *temp = sv_newmortal();
+    SV * const temp = sv_newmortal();
 
     assert(SvTYPE(sv) == SVt_PVGV);
     SvFAKE_off(sv);
     gv_efullname3(temp, (GV *) sv, "*");
 
 
     assert(SvTYPE(sv) == SVt_PVGV);
     SvFAKE_off(sv);
     gv_efullname3(temp, (GV *) sv, "*");
 
-    if (GvGP(sv))
+    if (GvGP(sv)) {
        gp_free((GV*)sv);
        gp_free((GV*)sv);
+    }
     if (GvSTASH(sv)) {
        sv_del_backref((SV*)GvSTASH(sv), sv);
        GvSTASH(sv) = NULL;
     }
     if (GvSTASH(sv)) {
        sv_del_backref((SV*)GvSTASH(sv), sv);
        GvSTASH(sv) = NULL;
     }
-    SvSCREAM_off(sv);
-    Safefree(GvNAME(sv));
     GvMULTI_off(sv);
     GvMULTI_off(sv);
+    if (GvNAME_HEK(sv)) {
+       unshare_hek(GvNAME_HEK(sv));
+    }
+    SvSCREAM_off(sv);
 
     /* need to keep SvANY(sv) in the right arena */
     xpvmg = new_XPVMG();
 
     /* need to keep SvANY(sv) in the right arena */
     xpvmg = new_XPVMG();
@@ -9171,6 +9186,7 @@ ptr_table_* functions.
 
 
 #define sv_dup_inc(s,t)        SvREFCNT_inc(sv_dup(s,t))
 
 
 #define sv_dup_inc(s,t)        SvREFCNT_inc(sv_dup(s,t))
+#define sv_dup_inc_NN(s,t)     SvREFCNT_inc_NN(sv_dup(s,t))
 #define av_dup(s,t)    (AV*)sv_dup((SV*)s,t)
 #define av_dup_inc(s,t)        (AV*)SvREFCNT_inc(sv_dup((SV*)s,t))
 #define hv_dup(s,t)    (HV*)sv_dup((SV*)s,t)
 #define av_dup(s,t)    (AV*)sv_dup((SV*)s,t)
 #define av_dup_inc(s,t)        (AV*)SvREFCNT_inc(sv_dup((SV*)s,t))
 #define hv_dup(s,t)    (HV*)sv_dup((SV*)s,t)
@@ -9330,6 +9346,7 @@ Perl_fp_dup(pTHX_ PerlIO *fp, char type, CLONE_PARAMS *param)
 DIR *
 Perl_dirp_dup(pTHX_ DIR *dp)
 {
 DIR *
 Perl_dirp_dup(pTHX_ DIR *dp)
 {
+    PERL_UNUSED_CONTEXT;
     if (!dp)
        return (DIR*)NULL;
     /* XXX TODO */
     if (!dp)
        return (DIR*)NULL;
     /* XXX TODO */
@@ -9342,6 +9359,7 @@ GP *
 Perl_gp_dup(pTHX_ GP *gp, CLONE_PARAMS* param)
 {
     GP *ret;
 Perl_gp_dup(pTHX_ GP *gp, CLONE_PARAMS* param)
 {
     GP *ret;
+
     if (!gp)
        return (GP*)NULL;
     /* look for it in the table first */
     if (!gp)
        return (GP*)NULL;
     /* look for it in the table first */
@@ -9442,6 +9460,8 @@ PTR_TBL_t *
 Perl_ptr_table_new(pTHX)
 {
     PTR_TBL_t *tbl;
 Perl_ptr_table_new(pTHX)
 {
     PTR_TBL_t *tbl;
+    PERL_UNUSED_CONTEXT;
+
     Newxz(tbl, 1, PTR_TBL_t);
     tbl->tbl_max       = 511;
     tbl->tbl_items     = 0;
     Newxz(tbl, 1, PTR_TBL_t);
     tbl->tbl_max       = 511;
     tbl->tbl_items     = 0;
@@ -9479,6 +9499,7 @@ void *
 Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, const void *sv)
 {
     PTR_TBL_ENT_t const *const tblent = ptr_table_find(tbl, sv);
 Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, const void *sv)
 {
     PTR_TBL_ENT_t const *const tblent = ptr_table_find(tbl, sv);
+    PERL_UNUSED_CONTEXT;
     return tblent ? tblent->newval : (void *) 0;
 }
 
     return tblent ? tblent->newval : (void *) 0;
 }
 
@@ -9487,7 +9508,8 @@ Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, const void *sv)
 void
 Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, const void *oldsv, void *newsv)
 {
 void
 Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, const void *oldsv, void *newsv)
 {
-    PTR_TBL_ENT_t *tblent = S_ptr_table_find(tbl, oldsv);
+    PTR_TBL_ENT_t *tblent = ptr_table_find(tbl, oldsv);
+    PERL_UNUSED_CONTEXT;
 
     if (tblent) {
        tblent->newval = newsv;
 
     if (tblent) {
        tblent->newval = newsv;
@@ -9515,6 +9537,7 @@ Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl)
     const UV oldsize = tbl->tbl_max + 1;
     UV newsize = oldsize * 2;
     UV i;
     const UV oldsize = tbl->tbl_max + 1;
     UV newsize = oldsize * 2;
     UV i;
+    PERL_UNUSED_CONTEXT;
 
     Renew(ary, newsize, PTR_TBL_ENT_t*);
     Zero(&ary[oldsize], newsize-oldsize, PTR_TBL_ENT_t*);
 
     Renew(ary, newsize, PTR_TBL_ENT_t*);
     Zero(&ary[oldsize], newsize-oldsize, PTR_TBL_ENT_t*);
@@ -9598,7 +9621,10 @@ Perl_rvpv_dup(pTHX_ SV *dstr, const SV *sstr, CLONE_PARAMS* param)
        }
        else {
            /* Special case - not normally malloced for some reason */
        }
        else {
            /* Special case - not normally malloced for some reason */
-           if ((SvREADONLY(sstr) && SvFAKE(sstr))) {
+           if (isGV_with_GP(sstr)) {
+               /* Don't need to do anything here.  */
+           }
+           else 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)),
                /* A "shared" PV - clone it as "shared" PV */
                SvPV_set(dstr,
                         HEK_KEY(hek_dup(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr)),
@@ -9742,7 +9768,8 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
                 sv_type_details->body_size + sv_type_details->offset, char);
 #endif
 
                 sv_type_details->body_size + sv_type_details->offset, char);
 #endif
 
-           if (sv_type != SVt_PVAV && sv_type != SVt_PVHV)
+           if (sv_type != SVt_PVAV && sv_type != SVt_PVHV
+               && !isGV_with_GP(dstr))
                Perl_rvpv_dup(aTHX_ dstr, sstr, param);
 
            /* The Copy above means that all the source (unduplicated) pointers
                Perl_rvpv_dup(aTHX_ dstr, sstr, param);
 
            /* The Copy above means that all the source (unduplicated) pointers
@@ -9751,7 +9778,10 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
               missing by always going for the destination.
               FIXME - instrument and check that assumption  */
            if (sv_type >= SVt_PVMG) {
               missing by always going for the destination.
               FIXME - instrument and check that assumption  */
            if (sv_type >= SVt_PVMG) {
-               if (SvMAGIC(dstr))
+               HV *ourstash;
+               if ((sv_type == SVt_PVMG) && (ourstash = OURSTASH(dstr))) {
+                   OURSTASH_set(dstr, hv_dup_inc(ourstash, param));
+               } else if (SvMAGIC(dstr))
                    SvMAGIC_set(dstr, mg_dup(SvMAGIC(dstr), param));
                if (SvSTASH(dstr))
                    SvSTASH_set(dstr, hv_dup_inc(SvSTASH(dstr), param));
                    SvMAGIC_set(dstr, mg_dup(SvMAGIC(dstr), param));
                if (SvSTASH(dstr))
                    SvSTASH_set(dstr, hv_dup_inc(SvSTASH(dstr), param));
@@ -9779,12 +9809,19 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
                    LvTARG(dstr) = sv_dup_inc(LvTARG(dstr), param);
                break;
            case SVt_PVGV:
                    LvTARG(dstr) = sv_dup_inc(LvTARG(dstr), param);
                break;
            case SVt_PVGV:
-               GvNAME(dstr)    = SAVEPVN(GvNAME(dstr), GvNAMELEN(dstr));
-               GvSTASH(dstr)   = hv_dup(GvSTASH(dstr), param);
+               if (GvNAME_HEK(dstr))
+                   GvNAME_HEK(dstr) = hek_dup(GvNAME_HEK(dstr), param);
+
                /* Don't call sv_add_backref here as it's going to be created
                   as part of the magic cloning of the symbol table.  */
                /* Don't call sv_add_backref here as it's going to be created
                   as part of the magic cloning of the symbol table.  */
-               GvGP(dstr)      = gp_dup(GvGP(dstr), param);
-               (void)GpREFCNT_inc(GvGP(dstr));
+               GvSTASH(dstr)   = hv_dup(GvSTASH(dstr), param);
+               if(isGV_with_GP(sstr)) {
+                   /* Danger Will Robinson - GvGP(dstr) isn't initialised
+                      at the point of this comment.  */
+                   GvGP(dstr)  = gp_dup(GvGP(sstr), param);
+                   (void)GpREFCNT_inc(GvGP(dstr));
+               } else
+                   Perl_rvpv_dup(aTHX_ dstr, sstr, param);
                break;
            case SVt_PVIO:
                IoIFP(dstr)     = fp_dup(IoIFP(dstr), IoTYPE(dstr), param);
                break;
            case SVt_PVIO:
                IoIFP(dstr)     = fp_dup(IoIFP(dstr), IoTYPE(dstr), param);
@@ -10694,8 +10731,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
        const I32 len = av_len((AV*)proto_perl->Iregex_padav);
        SV* const * const regexen = AvARRAY((AV*)proto_perl->Iregex_padav);
        IV i;
        const I32 len = av_len((AV*)proto_perl->Iregex_padav);
        SV* const * const regexen = AvARRAY((AV*)proto_perl->Iregex_padav);
        IV i;
-       av_push(PL_regex_padav,
-               sv_dup_inc(regexen[0],param));
+       av_push(PL_regex_padav, sv_dup_inc_NN(regexen[0],param));
        for(i = 1; i <= len; i++) {
            const SV * const regex = regexen[i];
            SV * const sv =
        for(i = 1; i <= len; i++) {
            const SV * const regex = regexen[i];
            SV * const sv =
@@ -10872,9 +10908,26 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     i = (PL_lex_casemods < 12 ? 12 : PL_lex_casemods);
     PL_lex_casestack   = SAVEPVN(proto_perl->Ilex_casestack,i);
 
     i = (PL_lex_casemods < 12 ? 12 : PL_lex_casemods);
     PL_lex_casestack   = SAVEPVN(proto_perl->Ilex_casestack,i);
 
+#ifdef PERL_MAD
+    Copy(proto_perl->Inexttoke, PL_nexttoke, 5, NEXTTOKE);
+    PL_lasttoke                = proto_perl->Ilasttoke;
+    PL_realtokenstart  = proto_perl->Irealtokenstart;
+    PL_faketokens      = proto_perl->Ifaketokens;
+    PL_thismad         = proto_perl->Ithismad;
+    PL_thistoken       = proto_perl->Ithistoken;
+    PL_thisopen                = proto_perl->Ithisopen;
+    PL_thisstuff       = proto_perl->Ithisstuff;
+    PL_thisclose       = proto_perl->Ithisclose;
+    PL_thiswhite       = proto_perl->Ithiswhite;
+    PL_nextwhite       = proto_perl->Inextwhite;
+    PL_skipwhite       = proto_perl->Iskipwhite;
+    PL_endwhite                = proto_perl->Iendwhite;
+    PL_curforce                = proto_perl->Icurforce;
+#else
     Copy(proto_perl->Inextval, PL_nextval, 5, YYSTYPE);
     Copy(proto_perl->Inexttype, PL_nexttype, 5,        I32);
     PL_nexttoke                = proto_perl->Inexttoke;
     Copy(proto_perl->Inextval, PL_nextval, 5, YYSTYPE);
     Copy(proto_perl->Inexttype, PL_nexttype, 5,        I32);
     PL_nexttoke                = proto_perl->Inexttoke;
+#endif
 
     /* XXX This is probably masking the deeper issue of why
      * SvANY(proto_perl->Ilinestr) can be NULL at this point. For test case:
 
     /* XXX This is probably masking the deeper issue of why
      * SvANY(proto_perl->Ilinestr) can be NULL at this point. For test case:
@@ -11104,7 +11157,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
                    proto_perl->Ttmps_stack[i]);
            if (nsv && !SvREFCNT(nsv)) {
                EXTEND_MORTAL(1);
                    proto_perl->Ttmps_stack[i]);
            if (nsv && !SvREFCNT(nsv)) {
                EXTEND_MORTAL(1);
-               PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc(nsv);
+               PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple(nsv);
            }
        }
     }
            }
        }
     }
@@ -11252,7 +11305,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     /* orphaned? eg threads->new inside BEGIN or use */
     if (PL_compcv && ! SvREFCNT(PL_compcv)) {
 
     /* orphaned? eg threads->new inside BEGIN or use */
     if (PL_compcv && ! SvREFCNT(PL_compcv)) {
-       (void)SvREFCNT_inc(PL_compcv);
+       SvREFCNT_inc_simple_void(PL_compcv);
        SAVEFREESV(PL_compcv);
     }
 
        SAVEFREESV(PL_compcv);
     }
 
Unnamed repository; edit this file 'description' to name the repository.