As Perl_get_arena() is dealing with sizes, use size_t rather than int,
[p5sagit/p5-mst-13.2.git] / sv.c
diff --git a/sv.c b/sv.c
index 58c495e..ac5eeb0 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1,7 +1,7 @@
 /*    sv.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -443,7 +443,8 @@ static void
 do_clean_objs(pTHX_ SV *ref)
 {
     dVAR;
-    if (SvROK(ref)) {
+    assert (SvROK(ref));
+    {
        SV * const target = SvRV(ref);
        if (SvOBJECT(target)) {
            DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning object ref:\n "), sv_dump(ref)));
@@ -469,7 +470,9 @@ static void
 do_clean_named_objs(pTHX_ SV *sv)
 {
     dVAR;
-    if (SvTYPE(sv) == SVt_PVGV && isGV_with_GP(sv) && GvGP(sv)) {
+    assert(SvTYPE(sv) == SVt_PVGV);
+    assert(isGV_with_GP(sv));
+    if (GvGP(sv)) {
        if ((
 #ifdef PERL_DONT_CREATE_GVSV
             GvSV(sv) &&
@@ -504,7 +507,7 @@ Perl_sv_clean_objs(pTHX)
     visit(do_clean_objs, SVf_ROK, SVf_ROK);
 #ifndef DISABLE_DESTRUCTOR_KLUDGE
     /* some barnacles may yet remain, clinging to typeglobs */
-    visit(do_clean_named_objs, SVt_PVGV, SVTYPEMASK);
+    visit(do_clean_named_objs, SVt_PVGV|SVpgv_GP, SVTYPEMASK|SVp_POK|SVpgv_GP);
 #endif
     PL_in_clean_objs = FALSE;
 }
@@ -676,7 +679,7 @@ Perl_sv_free_arenas(pTHX)
    TBD: export properly for hv.c: S_more_he().
 */
 void*
-Perl_get_arena(pTHX_ int arena_size)
+Perl_get_arena(pTHX_ size_t arena_size)
 {
     dVAR;
     struct arena_desc* adesc;
@@ -701,10 +704,10 @@ Perl_get_arena(pTHX_ int arena_size)
     adesc = &((*aroot)->set[curr]);
     assert(!adesc->arena);
     
-    Newxz(adesc->arena, arena_size, char);
+    Newx(adesc->arena, arena_size, char);
     adesc->size = arena_size;
     DEBUG_m(PerlIO_printf(Perl_debug_log, "arena %d added: %p size %d\n", 
-                         curr, adesc->arena, arena_size));
+                         curr, (void*)adesc->arena, arena_size));
 
     return adesc->arena;
 }
@@ -1033,10 +1036,6 @@ static const struct body_details bodies_by_type[] = {
 #define new_NOARENAZ(details) \
        my_safecalloc((details)->body_size + (details)->offset)
 
-#if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
-static bool done_sanity_check;
-#endif
-
 STATIC void *
 S_more_bodies (pTHX_ svtype sv_type)
 {
@@ -1046,10 +1045,9 @@ S_more_bodies (pTHX_ svtype sv_type)
     const size_t body_size = bdp->body_size;
     char *start;
     const char *end;
-
-    assert(bdp->arena_size);
-
 #if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
+    static bool done_sanity_check;
+
     /* PERL_GLOBAL_STRUCT_PRIVATE cannot coexist with global
      * variables like done_sanity_check. */
     if (!done_sanity_check) {
@@ -1062,6 +1060,8 @@ S_more_bodies (pTHX_ svtype sv_type)
     }
 #endif
 
+    assert(bdp->arena_size);
+
     start = (char*) Perl_get_arena(aTHX_ bdp->arena_size);
 
     end = start + bdp->arena_size - body_size;
@@ -1069,7 +1069,7 @@ S_more_bodies (pTHX_ svtype sv_type)
     /* 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,
+                         (void*)start, (void*)end,
                          (int)bdp->arena_size, sv_type, (int)body_size,
                          (int)bdp->arena_size / (int)body_size));
 
@@ -1178,7 +1178,9 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
 
        (In fact, GP ends up pointing at a previous GP structure, because the
        principle cause of the padding in XPVMG getting garbage is a copy of
-       sizeof(XPVMG) bytes from a XPVGV structure in sv_unglob)
+       sizeof(XPVMG) bytes from a XPVGV structure in sv_unglob. Right now
+       this happens to be moot because XPVGV has been re-ordered, with GP
+       no longer after STASH)
 
        So we are careful and work out the size of used parts of all the
        structures.  */
@@ -3169,15 +3171,14 @@ S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype)
     if (dtype != SVt_PVGV) {
        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_PV) {
                SvPV_free(dstr);
                SvPV_set(dstr, 0);
                SvLEN_set(dstr, 0);
                SvCUR_set(dstr, 0);
            }
-           sv_upgrade(dstr, SVt_PVGV);
+           SvUPGRADE(dstr, SVt_PVGV);
            (void)SvOK_off(dstr);
            /* FIXME - why are we doing this, then turning it off and on again
               below?  */
@@ -3337,14 +3338,14 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
 
     if (SvIS_FREED(dstr)) {
        Perl_croak(aTHX_ "panic: attempt to copy value %" SVf
-                  " to a freed scalar %p", sstr, dstr);
+                  " to a freed scalar %p", SVfARG(sstr), (void *)dstr);
     }
     SV_CHECK_THINKFIRST_COW_DROP(dstr);
     if (!sstr)
        sstr = &PL_sv_undef;
     if (SvIS_FREED(sstr)) {
-       Perl_croak(aTHX_ "panic: attempt to copy freed scalar %p to %p", sstr,
-                  dstr);
+       Perl_croak(aTHX_ "panic: attempt to copy freed scalar %p to %p",
+                  (void*)sstr, (void*)dstr);
     }
     stype = SvTYPE(sstr);
     dtype = SvTYPE(dstr);
@@ -3456,6 +3457,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
        break;
 
        /* case SVt_BIND: */
+    case SVt_PVLV:
     case SVt_PVGV:
        if (isGV_with_GP(sstr) && dtype <= SVt_PVGV) {
            glob_assign_glob(dstr, sstr, dtype);
@@ -3465,7 +3467,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
        /*FALLTHROUGH*/
 
     case SVt_PVMG:
-    case SVt_PVLV:
        if (SvGMAGICAL(sstr) && (flags & SV_GMAGIC)) {
            mg_get(sstr);
            if (SvTYPE(sstr) != stype) {
@@ -3487,7 +3488,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
     dtype = SvTYPE(dstr);
     sflags = SvFLAGS(sstr);
 
-    if (dtype == SVt_PVCV) {
+    if (dtype == SVt_PVCV || dtype == SVt_PVFM) {
        /* Assigning to a subroutine sets the prototype.  */
        if (SvOK(sstr)) {
            STRLEN len;
@@ -3497,9 +3498,16 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
             Copy(ptr, SvPVX(dstr), len + 1, char);
             SvCUR_set(dstr, len);
            SvPOK_only(dstr);
+           SvFLAGS(dstr) |= sflags & SVf_UTF8;
        } else {
            SvOK_off(dstr);
        }
+    } 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));
+       else
+           Perl_croak(aTHX_ "Cannot copy to %s", type);
     } else if (sflags & SVf_ROK) {
        if (isGV_with_GP(dstr) && dtype == SVt_PVGV
            && SvTYPE(SvRV(sstr)) == SVt_PVGV) {
@@ -3697,7 +3705,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            SvNV_set(dstr, SvNVX(sstr));
        }
        if (sflags & SVp_IOK) {
-           SvRELEASE_IVX(dstr);
+           SvOOK_off(dstr);
            SvIV_set(dstr, SvIVX(sstr));
            /* Must do this otherwise some other overloaded use of 0x80000000
               gets confused. I guess SVpbm_VALID */
@@ -3769,7 +3777,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
 
     if (DEBUG_C_TEST) {
        PerlIO_printf(Perl_debug_log, "Fast copy on write: %p -> %p\n",
-                     sstr, dstr);
+                     (void*)sstr, (void*)dstr);
        sv_dump(sstr);
        if (dstr)
                    sv_dump(dstr);
@@ -4002,9 +4010,9 @@ Perl_sv_usepvn_flags(pTHX_ SV *sv, char *ptr, STRLEN len, U32 flags)
    (which it can do by means other than releasing copy-on-write Svs)
    or by changing the other copy-on-write SVs in the loop.  */
 STATIC void
-S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, STRLEN len, SV *after)
+S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, SV *after)
 {
-    if (len) { /* this SV was SvIsCOW_normal(sv) */
+    { /* this SV was SvIsCOW_normal(sv) */
          /* we need to find the SV pointing to us.  */
         SV *current = SV_COW_NEXT_SV(after);
 
@@ -4028,19 +4036,8 @@ S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, STRLEN len, SV *after)
             /* Make the SV before us point to the SV after us.  */
             SV_COW_NEXT_SV_SET(current, after);
         }
-    } else {
-        unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
     }
 }
-
-int
-Perl_sv_release_IVX(pTHX_ register SV *sv)
-{
-    if (SvIsCOW(sv))
-        sv_force_normal_flags(sv, 0);
-    SvOOK_off(sv);
-    return 0;
-}
 #endif
 /*
 =for apidoc sv_force_normal_flags
@@ -4069,7 +4066,11 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
            const char * const pvx = SvPVX_const(sv);
            const STRLEN len = SvLEN(sv);
            const STRLEN cur = SvCUR(sv);
-           SV * const next = SV_COW_NEXT_SV(sv);   /* next COW sv in the loop. */
+           /* next COW sv in the loop.  If len is 0 then this is a shared-hash
+              key scalar, so we mustn't attempt to call SV_COW_NEXT_SV(), as
+              we'll fail an assertion.  */
+           SV * const next = len ? SV_COW_NEXT_SV(sv) : 0;
+
             if (DEBUG_C_TEST) {
                 PerlIO_printf(Perl_debug_log,
                               "Copy on write: Force normal %ld\n",
@@ -4090,7 +4091,11 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
                 SvCUR_set(sv, cur);
                 *SvEND(sv) = '\0';
             }
-            sv_release_COW(sv, pvx, len, next);
+           if (len) {
+               sv_release_COW(sv, pvx, next);
+           } else {
+               unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
+           }
             if (DEBUG_C_TEST) {
                 sv_dump(sv);
             }
@@ -4358,7 +4363,7 @@ to contain an C<SV*> and is stored as-is with its REFCNT incremented.
 =cut
 */
 MAGIC *        
-Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
+Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, const MGVTBL *vtable,
                 const char* name, I32 namlen)
 {
     dVAR;
@@ -4420,7 +4425,7 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
        else
            mg->mg_ptr = (char *) name;
     }
-    mg->mg_virtual = vtable;
+    mg->mg_virtual = (MGVTBL *) vtable;
 
     mg_magical(sv);
     if (SvGMAGICAL(sv))
@@ -4447,7 +4452,7 @@ void
 Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 namlen)
 {
     dVAR;
-    MGVTBL *vtable;
+    const MGVTBL *vtable;
     MAGIC* mg;
 
 #ifdef PERL_OLD_COPY_ON_WRITE
@@ -4506,9 +4511,6 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
     case PERL_MAGIC_regdata:
        vtable = &PL_vtbl_regdata;
        break;
-    case PERL_MAGIC_regdata_names:
-       vtable = &PL_vtbl_regdata_names;
-       break;
     case PERL_MAGIC_regdatum:
        vtable = &PL_vtbl_regdatum;
        break;
@@ -5111,7 +5113,7 @@ Perl_sv_clear(pTHX_ register SV *sv)
     }
     if (type >= SVt_PVMG) {
        if (type == SVt_PVMG && SvPAD_OUR(sv)) {
-           SvREFCNT_dec(OURSTASH(sv));
+           SvREFCNT_dec(SvOURSTASH(sv));
        } else if (SvMAGIC(sv))
            mg_free(sv);
        if (type == SVt_PVMG && SvPAD_TYPED(sv))
@@ -5153,7 +5155,6 @@ Perl_sv_clear(pTHX_ register SV *sv)
        }
        else if (LvTYPE(sv) != 't') /* unless tie: unrefcnted fake SV**  */
            SvREFCNT_dec(LvTARG(sv));
-       goto freescalar;
     case SVt_PVGV:
        if (isGV_with_GP(sv)) {
            gp_free((GV*)sv);
@@ -5191,8 +5192,12 @@ Perl_sv_clear(pTHX_ register SV *sv)
                     PerlIO_printf(Perl_debug_log, "Copy on write: clear\n");
                     sv_dump(sv);
                 }
-                sv_release_COW(sv, SvPVX_const(sv), SvLEN(sv),
-                              SV_COW_NEXT_SV(sv));
+               if (SvLEN(sv)) {
+                   sv_release_COW(sv, SvPVX_const(sv), SV_COW_NEXT_SV(sv));
+               } else {
+                   unshare_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv)));
+               }
+
                 /* And drop it here.  */
                 SvFAKE_off(sv);
             } else if (SvLEN(sv)) {
@@ -5380,7 +5385,7 @@ Perl_sv_len_utf8(pTHX_ register SV *sv)
                        PL_utf8cache = 0;
                        Perl_croak(aTHX_ "panic: sv_len_utf8 cache %"UVuf
                                   " real %"UVuf" for %"SVf,
-                                  (UV) ulen, (UV) real, (void*)sv);
+                                  (UV) ulen, (UV) real, SVfARG(sv));
                    }
                }
            }
@@ -5538,7 +5543,7 @@ S_sv_pos_u2b_cached(pTHX_ SV *sv, MAGIC **mgp, const U8 *const start,
                PL_utf8cache = 0;
                Perl_croak(aTHX_ "panic: sv_pos_u2b_cache cache %"UVuf
                           " real %"UVuf" for %"SVf,
-                          (UV) boffset, (UV) real_boffset, (void*)sv);
+                          (UV) boffset, (UV) real_boffset, SVfARG(sv));
            }
        }
        boffset = real_boffset;
@@ -5660,7 +5665,7 @@ S_utf8_mg_pos_cache_update(pTHX_ SV *sv, MAGIC **mgp, STRLEN byte, STRLEN utf8,
            SAVEI8(PL_utf8cache);
            PL_utf8cache = 0;
            Perl_croak(aTHX_ "panic: utf8_mg_pos_cache_update cache %"UVuf
-                      " real %"UVuf" for %"SVf, (UV) utf8, (UV) realutf8, (void*)sv);
+                      " real %"UVuf" for %"SVf, (UV) utf8, (UV) realutf8, SVfARG(sv));
        }
     }
 
@@ -5883,7 +5888,7 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp)
                PL_utf8cache = 0;
                Perl_croak(aTHX_ "panic: sv_pos_b2u cache %"UVuf
                           " real %"UVuf" for %"SVf,
-                          (UV) len, (UV) real_len, (void*)sv);
+                          (UV) len, (UV) real_len, SVfARG(sv));
            }
        }
        len = real_len;
@@ -7377,7 +7382,7 @@ Perl_sv_2io(pTHX_ SV *sv)
        else
            io = 0;
        if (!io)
-           Perl_croak(aTHX_ "Bad filehandle: %"SVf, (void*)sv);
+           Perl_croak(aTHX_ "Bad filehandle: %"SVf, SVfARG(sv));
        break;
     }
     return io;
@@ -7469,7 +7474,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
            LEAVE;
            if (!GvCVu(gv))
                Perl_croak(aTHX_ "Unable to create sub named \"%"SVf"\"",
-                          (void*)sv);
+                          SVfARG(sv));
        }
        return GvCVu(gv);
     }
@@ -8405,7 +8410,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
     }
     if (args && patlen == 3 && pat[0] == '%' &&
                pat[1] == '-' && pat[2] == 'p') {
-       argsv = va_arg(*args, SV*);
+       argsv = (SV*)va_arg(*args, void*);
        sv_catsv(sv, argsv);
        return;
     }
@@ -8561,7 +8566,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                        precis = n;
                        has_precis = TRUE;
                    }
-                   argsv = va_arg(*args, SV*);
+                   argsv = (SV*)va_arg(*args, void*);
                    eptr = SvPVx_const(argsv, elen);
                    if (DO_UTF8(argsv))
                        is_utf8 = TRUE;
@@ -9338,7 +9343,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                                       (UV)c & 0xFF);
                } else
                    sv_catpvs(msg, "end of string");
-               Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%"SVf, (void*)msg); /* yes, this is reentrant */
+               Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%"SVf, SVfARG(msg)); /* yes, this is reentrant */
            }
 
            /* output mangled stuff ... */
@@ -9479,6 +9484,77 @@ ptr_table_* functions.
 #define SAVEPV(p)      ((p) ? savepv(p) : NULL)
 #define SAVEPVN(p,n)   ((p) ? savepvn(p,n) : NULL)
 
+/* clone a parser */
+
+yy_parser *
+Perl_parser_dup(pTHX_ const yy_parser *proto, CLONE_PARAMS* param)
+{
+    yy_parser *parser;
+
+    if (!proto)
+       return NULL;
+
+    /* look for it in the table first */
+    parser = (yy_parser *)ptr_table_fetch(PL_ptr_table, proto);
+    if (parser)
+       return parser;
+
+    /* create anew and remember what it is */
+    Newxz(parser, 1, yy_parser);
+    ptr_table_store(PL_ptr_table, proto, parser);
+
+    parser->yyerrstatus = 0;
+    parser->yychar = YYEMPTY;          /* Cause a token to be read.  */
+
+    /* XXX these not yet duped */
+    parser->old_parser = NULL;
+    parser->stack = NULL;
+    parser->ps = NULL;
+    parser->stack_size = 0;
+    /* XXX parser->stack->state = 0; */
+
+    /* XXX eventually, just Copy() most of the parser struct ? */
+
+    parser->lex_brackets = proto->lex_brackets;
+    parser->lex_casemods = proto->lex_casemods;
+    parser->lex_brackstack = savepvn(proto->lex_brackstack,
+                   (proto->lex_brackets < 120 ? 120 : proto->lex_brackets));
+    parser->lex_casestack = savepvn(proto->lex_casestack,
+                   (proto->lex_casemods < 12 ? 12 : proto->lex_casemods));
+    parser->lex_defer  = proto->lex_defer;
+    parser->lex_dojoin = proto->lex_dojoin;
+    parser->lex_expect = proto->lex_expect;
+    parser->lex_formbrack = proto->lex_formbrack;
+    parser->lex_inpat  = proto->lex_inpat;
+    parser->lex_inwhat = proto->lex_inwhat;
+    parser->lex_op     = proto->lex_op;
+    parser->lex_repl   = sv_dup_inc(proto->lex_repl, param);
+    parser->lex_starts = proto->lex_starts;
+    parser->lex_stuff  = sv_dup_inc(proto->lex_stuff, param);
+    parser->multi_close        = proto->multi_close;
+    parser->multi_open = proto->multi_open;
+    parser->multi_start        = proto->multi_start;
+    parser->pending_ident = proto->pending_ident;
+    parser->preambled  = proto->preambled;
+    parser->sublex_info        = proto->sublex_info; /* XXX not quite right */
+
+#ifdef PERL_MAD
+    parser->endwhite   = proto->endwhite;
+    parser->faketokens = proto->faketokens;
+    parser->lasttoke   = proto->lasttoke;
+    parser->nextwhite  = proto->nextwhite;
+    parser->realtokenstart = proto->realtokenstart;
+    parser->skipwhite  = proto->skipwhite;
+    parser->thisclose  = proto->thisclose;
+    parser->thismad    = proto->thismad;
+    parser->thisopen   = proto->thisopen;
+    parser->thisstuff  = proto->thisstuff;
+    parser->thistoken  = proto->thistoken;
+    parser->thiswhite  = proto->thiswhite;
+#endif
+    return parser;
+}
+
 
 /* duplicate a file handle */
 
@@ -9616,6 +9692,8 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS* param)
     return mgret;
 }
 
+#endif /* USE_ITHREADS */
+
 /* create a new pointer-mapping table */
 
 PTR_TBL_t *
@@ -9759,6 +9837,7 @@ Perl_ptr_table_free(pTHX_ PTR_TBL_t *tbl)
     Safefree(tbl);
 }
 
+#if defined(USE_ITHREADS)
 
 void
 Perl_rvpv_dup(pTHX_ SV *dstr, const SV *sstr, CLONE_PARAMS* param)
@@ -9854,7 +9933,7 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
 #ifdef DEBUGGING
     if (SvANY(sstr) && PL_watch_pvx && SvPVX_const(sstr) == PL_watch_pvx)
        PerlIO_printf(Perl_debug_log, "watch at %p hit, found string \"%s\"\n",
-                     PL_watch_pvx, SvPVX_const(sstr));
+                     (void*)PL_watch_pvx, SvPVX_const(sstr));
 #endif
 
     /* don't clone objects whose class has asked us not to */
@@ -9941,7 +10020,7 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
               FIXME - instrument and check that assumption  */
            if (sv_type >= SVt_PVMG) {
                if ((sv_type == SVt_PVMG) && SvPAD_OUR(dstr)) {
-                   OURSTASH_set(dstr, hv_dup_inc(OURSTASH(dstr), param));
+                   SvOURSTASH_set(dstr, hv_dup_inc(SvOURSTASH(dstr), param));
                } else if (SvMAGIC(dstr))
                    SvMAGIC_set(dstr, mg_dup(SvMAGIC(dstr), param));
                if (SvSTASH(dstr))
@@ -9966,20 +10045,16 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
                    LvTARG(dstr) = (SV*)he_dup((HE*)LvTARG(dstr), 0, param);
                else
                    LvTARG(dstr) = sv_dup_inc(LvTARG(dstr), param);
-               break;
            case SVt_PVGV:
                if(isGV_with_GP(sstr)) {
                    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.  */
-               if(!SvVALID(dstr))
-                   GvSTASH(dstr) = hv_dup(GvSTASH(dstr), param);
-               if(isGV_with_GP(sstr)) {
+                   /* Don't call sv_add_backref here as it's going to be
+                      created as part of the magic cloning of the symbol
+                      table.  */
                    /* Danger Will Robinson - GvGP(dstr) isn't initialised
                       at the point of this comment.  */
+                   GvSTASH(dstr) = hv_dup(GvSTASH(dstr), param);
                    GvGP(dstr)  = gp_dup(GvGP(sstr), param);
                    (void)GpREFCNT_inc(GvGP(dstr));
                } else
@@ -10298,6 +10373,7 @@ Perl_any_dup(pTHX_ void *v, const PerlInterpreter *proto_perl)
 ANY *
 Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 {
+    dVAR;
     ANY * const ss     = proto_perl->Tsavestack;
     const I32 max      = proto_perl->Tsavestack_max;
     I32 ix             = proto_perl->Tsavestack_ix;
@@ -10593,6 +10669,10 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            ptr = POPPTR(ss,ix);
            TOPPTR(nss,ix) = DUP_WARNINGS((STRLEN*)ptr);
            break;
+       case SAVEt_PARSER:
+           ptr = POPPTR(ss,ix);
+           TOPPTR(nss,ix) = parser_dup(ptr, param);
+           break;
        default:
            Perl_croak(aTHX_
                       "panic: ss_dup inconsistency (%"IVdf")", (IV) type);
@@ -10940,6 +11020,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
                        newSViv(PTR2IV(CALLREGDUPE(
                                INT2PTR(REGEXP *, SvIVX(regex)), param))))
                ;
+           if (SvFLAGS(regex) & SVf_BREAK)
+               SvFLAGS(sv) |= SVf_BREAK; /* unrefcnted PL_curpm */
            av_push(PL_regex_padav, sv);
        }
     }
@@ -11021,7 +11103,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_Argv            = NULL;
     PL_Cmd             = NULL;
     PL_gensym          = proto_perl->Igensym;
-    PL_preambled       = proto_perl->Ipreambled;
     PL_preambleav      = av_dup_inc(proto_perl->Ipreambleav, param);
     PL_laststatval     = proto_perl->Ilaststatval;
     PL_laststype       = proto_perl->Ilaststype;
@@ -11042,9 +11123,17 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     if (PL_my_cxt_size) {
        Newx(PL_my_cxt_list, PL_my_cxt_size, void *);
        Copy(proto_perl->Imy_cxt_list, PL_my_cxt_list, PL_my_cxt_size, void *);
+#ifdef PERL_GLOBAL_STRUCT_PRIVATE
+       Newx(PL_my_cxt_keys, PL_my_cxt_size, char *);
+       Copy(proto_perl->Imy_cxt_keys, PL_my_cxt_keys, PL_my_cxt_size, char *);
+#endif
     }
-    else
+    else {
        PL_my_cxt_list  = (void**)NULL;
+#ifdef PERL_GLOBAL_STRUCT_PRIVATE
+       PL_my_cxt_keys  = (void**)NULL;
+#endif
+    }
     PL_modglobal       = hv_dup_inc(proto_perl->Imodglobal, param);
     PL_custom_op_names  = hv_dup_inc(proto_perl->Icustom_op_names,param);
     PL_custom_op_descs  = hv_dup_inc(proto_perl->Icustom_op_descs,param);
@@ -11093,38 +11182,12 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_cshname         = proto_perl->Icshname; /* XXX never deallocated */
 #endif
 
+    PL_parser          = parser_dup(proto_perl->Iparser, param);
+
     PL_lex_state       = proto_perl->Ilex_state;
-    PL_lex_defer       = proto_perl->Ilex_defer;
-    PL_lex_expect      = proto_perl->Ilex_expect;
-    PL_lex_formbrack   = proto_perl->Ilex_formbrack;
-    PL_lex_dojoin      = proto_perl->Ilex_dojoin;
-    PL_lex_starts      = proto_perl->Ilex_starts;
-    PL_lex_stuff       = sv_dup_inc(proto_perl->Ilex_stuff, param);
-    PL_lex_repl                = sv_dup_inc(proto_perl->Ilex_repl, param);
-    PL_lex_op          = proto_perl->Ilex_op;
-    PL_lex_inpat       = proto_perl->Ilex_inpat;
-    PL_lex_inwhat      = proto_perl->Ilex_inwhat;
-    PL_lex_brackets    = proto_perl->Ilex_brackets;
-    i = (PL_lex_brackets < 120 ? 120 : PL_lex_brackets);
-    PL_lex_brackstack  = SAVEPVN(proto_perl->Ilex_brackstack,i);
-    PL_lex_casemods    = proto_perl->Ilex_casemods;
-    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);
@@ -11142,15 +11205,10 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     i = proto_perl->Ilinestart - SvPVX_const(proto_perl->Ilinestr);
     PL_linestart       = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
     PL_bufend          = SvPVX(PL_linestr) + SvCUR(PL_linestr);
-    PL_pending_ident   = proto_perl->Ipending_ident;
-    PL_sublex_info     = proto_perl->Isublex_info;     /* XXX not quite right */
 
     PL_expect          = proto_perl->Iexpect;
 
-    PL_multi_start     = proto_perl->Imulti_start;
     PL_multi_end       = proto_perl->Imulti_end;
-    PL_multi_open      = proto_perl->Imulti_open;
-    PL_multi_close     = proto_perl->Imulti_close;
 
     PL_error_count     = proto_perl->Ierror_count;
     PL_subline         = proto_perl->Isubline;