Third consting batch
[p5sagit/p5-mst-13.2.git] / sv.c
diff --git a/sv.c b/sv.c
index aec9802..8d8b446 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, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 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.
@@ -682,7 +682,7 @@ S_find_array_subscript(pTHX_ AV *av, SV* val)
 #define FUV_SUBSCRIPT_WITHIN   4       /* "within @foo"   */
 
 STATIC SV*
-S_varname(pTHX_ GV *gv, char *gvtype, PADOFFSET targ,
+S_varname(pTHX_ GV *gv, const char *gvtype, PADOFFSET targ,
        SV* keyname, I32 aindex, int subscript_type)
 {
     AV *av;
@@ -696,15 +696,13 @@ S_varname(pTHX_ GV *gv, char *gvtype, PADOFFSET targ,
         * XXX get rid of all this if gv_fullnameX() ever supports this
         * directly */
 
-       char *p;
+       const char *p;
        HV *hv = GvSTASH(gv);
        sv_setpv(name, gvtype);
        if (!hv)
            p = "???";
-       else if (!HvNAME(hv))
+       else if (!(p=HvNAME(hv)))
            p = "__ANON__";
-       else
-           p = HvNAME(hv);
        if (strNE(p, "main")) {
            sv_catpv(name,p);
            sv_catpvn(name,"::", 2);
@@ -2114,7 +2112,7 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
 #endif
            Renew(s,newlen,char);
        }
-        else {
+       else {
            New(703, s, newlen, char);
            if (SvPVX(sv) && SvCUR(sv)) {
                Move(SvPVX(sv), s, (newlen < SvCUR(sv)) ? newlen : SvCUR(sv), char);
@@ -3494,6 +3492,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
     if (SvTHINKFIRST(sv)) {
        if (SvROK(sv)) {
            SV* tmpstr;
+            register const char *typestr;
             if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)) &&
                 (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
                 char *pv = SvPV(tmpstr, *lp);
@@ -3506,7 +3505,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
            origsv = sv;
            sv = (SV*)SvRV(sv);
            if (!sv)
-               s = "NULLREF";
+               typestr = "NULLREF";
            else {
                MAGIC *mg;
                
@@ -3516,10 +3515,10 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                           (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
                          == (SVs_OBJECT|SVs_SMG))
                         && (mg = mg_find(sv, PERL_MAGIC_qr))) {
-                       regexp *re = (regexp *)mg->mg_obj;
+                        const regexp *re = (regexp *)mg->mg_obj;
 
                        if (!mg->mg_ptr) {
-                           char *fptr = "msix";
+                            const char *fptr = "msix";
                            char reflags[6];
                            char ch;
                            int left = 0;
@@ -3559,10 +3558,10 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                              */
                             if (PMf_EXTENDED & re->reganch)
                             {
-                                char *endptr = re->precomp + re->prelen;
+                                const char *endptr = re->precomp + re->prelen;
                                 while (endptr >= re->precomp)
                                 {
-                                    char c = *(endptr--);
+                                    const char c = *(endptr--);
                                     if (c == '\n')
                                         break; /* don't need another */
                                     if (c == '#') {
@@ -3602,36 +3601,32 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                case SVt_PV:
                case SVt_PVIV:
                case SVt_PVNV:
-               case SVt_PVBM:  if (SvROK(sv))
-                                   s = "REF";
-                               else
-                                   s = "SCALAR";               break;
-               case SVt_PVLV:  s = SvROK(sv) ? "REF"
+               case SVt_PVBM:  typestr = SvROK(sv) ? "REF" : "SCALAR"; break;
+               case SVt_PVLV:  typestr = SvROK(sv) ? "REF"
                                /* tied lvalues should appear to be
                                 * scalars for backwards compatitbility */
                                : (LvTYPE(sv) == 't' || LvTYPE(sv) == 'T')
                                    ? "SCALAR" : "LVALUE";      break;
-               case SVt_PVAV:  s = "ARRAY";                    break;
-               case SVt_PVHV:  s = "HASH";                     break;
-               case SVt_PVCV:  s = "CODE";                     break;
-               case SVt_PVGV:  s = "GLOB";                     break;
-               case SVt_PVFM:  s = "FORMAT";                   break;
-               case SVt_PVIO:  s = "IO";                       break;
-               default:        s = "UNKNOWN";                  break;
+               case SVt_PVAV:  typestr = "ARRAY";      break;
+               case SVt_PVHV:  typestr = "HASH";       break;
+               case SVt_PVCV:  typestr = "CODE";       break;
+               case SVt_PVGV:  typestr = "GLOB";       break;
+               case SVt_PVFM:  typestr = "FORMAT";     break;
+               case SVt_PVIO:  typestr = "IO";         break;
+               default:        typestr = "UNKNOWN";    break;
                }
                tsv = NEWSV(0,0);
-               if (SvOBJECT(sv))
-                   if (HvNAME(SvSTASH(sv)))
-                       Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)), s);
-                   else
-                       Perl_sv_setpvf(aTHX_ tsv, "__ANON__=%s", s);
+               if (SvOBJECT(sv)) {
+                   const char *name = HvNAME(SvSTASH(sv));
+                   Perl_sv_setpvf(aTHX_ tsv, "%s=%s(0x%"UVxf")",
+                                  name ? name : "__ANON__" , typestr, PTR2UV(sv));
+               }
                else
-                   sv_setpv(tsv, s);
-               Perl_sv_catpvf(aTHX_ tsv, "(0x%"UVxf")", PTR2UV(sv));
+                   Perl_sv_setpvf(aTHX_ tsv, "%s(0x%"UVxf")", typestr, PTR2UV(sv));
                goto tokensaveref;
            }
-           *lp = strlen(s);
-           return s;
+           *lp = strlen(typestr);
+           return typestr;
        }
        if (SvREADONLY(sv) && !SvOK(sv)) {
            if (ckWARN(WARN_UNINITIALIZED))
@@ -3643,8 +3638,8 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
     if (SvIOK(sv) || ((SvIOKp(sv) && !SvNOKp(sv)))) {
        /* I'm assuming that if both IV and NV are equally valid then
           converting the IV is going to be more efficient */
-       U32 isIOK = SvIOK(sv);
-       U32 isUIOK = SvIsUV(sv);
+       const U32 isIOK = SvIOK(sv);
+       const U32 isUIOK = SvIsUV(sv);
        char buf[TYPE_CHARS(UV)];
        char *ebuf, *ptr;
 
@@ -5314,23 +5309,23 @@ Perl_newSV(pTHX_ STRLEN len)
 =for apidoc sv_magicext
 
 Adds magic to an SV, upgrading it if necessary. Applies the
-supplied vtable and returns pointer to the magic added.
+supplied vtable and returns a pointer to the magic added.
 
-Note that sv_magicext will allow things that sv_magic will not.
-In particular you can add magic to SvREADONLY SVs and and more than
-one instance of the same 'how'
+Note that C<sv_magicext> will allow things that C<sv_magic> will not.
+In particular, you can add magic to SvREADONLY SVs, and add more than
+one instance of the same 'how'.
 
-I C<namelen> is greater then zero then a savepvn() I<copy> of C<name> is stored,
-if C<namelen> is zero then C<name> is stored as-is and - as another special
-case - if C<(name && namelen == HEf_SVKEY)> then C<name> is assumed to contain
-an C<SV*> and has its REFCNT incremented
+If C<namlen> is greater than zero then a C<savepvn> I<copy> of C<name> is
+stored, if C<namlen> is zero then C<name> is stored as-is and - as another
+special case - if C<(name && namlen == HEf_SVKEY)> then C<name> is assumed
+to contain an C<SV*> and is stored as-is with its REFCNT incremented.
 
-(This is now used as a subroutine by sv_magic.)
+(This is now used as a subroutine by C<sv_magic>.)
 
 =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)
 {
     MAGIC* mg;
@@ -5342,10 +5337,10 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
     mg->mg_moremagic = SvMAGIC(sv);
     SvMAGIC(sv) = mg;
 
-    /* Some magic sontains a reference loop, where the sv and object refer to
-       each other.  To prevent a reference loop that would prevent such
-       objects being freed, we look for such loops and if we find one we
-       avoid incrementing the object refcount.
+    /* Sometimes a magic contains a reference loop, where the sv and
+       object refer to each other.  To prevent a reference loop that
+       would prevent such objects being freed, we look for such loops
+       and if we find one we avoid incrementing the object refcount.
 
        Note we cannot do this to avoid self-tie loops as intervening RV must
        have its REFCNT incremented to keep it in existence.
@@ -5404,14 +5399,20 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
 Adds magic to an SV. First upgrades C<sv> to type C<SVt_PVMG> if necessary,
 then adds a new magic item of type C<how> to the head of the magic list.
 
+See C<sv_magicext> (which C<sv_magic> now calls) for a description of the
+handling of the C<name> and C<namlen> arguments.
+
+You need to use C<sv_magicext> to add magic to SvREADONLY SVs and also
+to add more than one instance of the same 'how'.
+
 =cut
 */
 
 void
 Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 namlen)
 {
+    const MGVTBL *vtable = 0;
     MAGIC* mg;
-    MGVTBL *vtable = 0;
 
 #ifdef PERL_COPY_ON_WRITE
     if (SvIsCOW(sv))
@@ -5585,7 +5586,7 @@ Perl_sv_unmagic(pTHX_ SV *sv, int type)
     mgp = &SvMAGIC(sv);
     for (mg = *mgp; mg; mg = *mgp) {
        if (mg->mg_type == type) {
-           MGVTBL* vtbl = mg->mg_virtual;
+            const MGVTBL* const vtbl = mg->mg_virtual;
            *mgp = mg->mg_moremagic;
            if (vtbl && vtbl->svt_free)
                CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg);
@@ -5704,7 +5705,7 @@ the Perl substr() function.
 */
 
 void
-Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN littlelen)
+Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, const char *little, STRLEN littlelen)
 {
     register char *big;
     register char *mid;
@@ -6612,9 +6613,9 @@ coerce its args to strings if necessary.
 I32
 Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
 {
-    char *pv1;
+    const char *pv1;
     STRLEN cur1;
-    char *pv2;
+    const char *pv2;
     STRLEN cur2;
     I32  eq     = 0;
     char *tpv   = Nullch;
@@ -6660,7 +6661,7 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
              if (SvUTF8(sv1)) {
                   /* sv1 is the UTF-8 one,
                    * if is equal it must be downgrade-able */
-                  char *pv = (char*)bytes_from_utf8((U8*)pv1,
+                  char *pv = (char*)bytes_from_utf8((const U8*)pv1,
                                                     &cur1, &is_utf8);
                   if (pv != pv1)
                        pv1 = tpv = pv;
@@ -6668,7 +6669,7 @@ Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
              else {
                   /* sv2 is the UTF-8 one,
                    * if is equal it must be downgrade-able */
-                  char *pv = (char *)bytes_from_utf8((U8*)pv2,
+                  char *pv = (char *)bytes_from_utf8((const U8*)pv2,
                                                      &cur2, &is_utf8);
                   if (pv != pv2)
                        pv2 = tpv = pv;
@@ -6708,7 +6709,8 @@ I32
 Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
 {
     STRLEN cur1, cur2;
-    char *pv1, *pv2, *tpv = Nullch;
+    const char *pv1, *pv2;
+    char *tpv = Nullch;
     I32  cmp;
     SV *svrecode = Nullsv;
 
@@ -6736,7 +6738,7 @@ Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
                 pv2 = SvPV(svrecode, cur2);
            }
            else {
-                pv2 = tpv = (char*)bytes_to_utf8((U8*)pv2, &cur2);
+                pv2 = tpv = (char*)bytes_to_utf8((const U8*)pv2, &cur2);
            }
        }
        else {
@@ -6746,7 +6748,7 @@ Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
                 pv1 = SvPV(svrecode, cur1);
            }
            else {
-                pv1 = tpv = (char*)bytes_to_utf8((U8*)pv1, &cur1);
+                pv1 = tpv = (char*)bytes_to_utf8((const U8*)pv1, &cur1);
            }
        }
     }
@@ -6756,7 +6758,7 @@ Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
     } else if (!cur2) {
        cmp = 1;
     } else {
-       I32 retval = memcmp((void*)pv1, (void*)pv2, cur1 < cur2 ? cur1 : cur2);
+        const I32 retval = memcmp((const void*)pv1, (const void*)pv2, cur1 < cur2 ? cur1 : cur2);
 
        if (retval) {
            cmp = retval < 0 ? -1 : 1;
@@ -6908,7 +6910,7 @@ appending to the currently-stored string.
 char *
 Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
 {
-    char *rsptr;
+    const char *rsptr;
     STRLEN rslen;
     register STDCHAR rslast;
     register STDCHAR *bp;
@@ -7671,7 +7673,7 @@ Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
        STRLEN tmplen = -len;
         is_utf8 = TRUE;
        /* See the note in hv.c:hv_fetch() --jhi */
-       src = (char*)bytes_from_utf8((U8*)src, &tmplen, &is_utf8);
+       src = (char*)bytes_from_utf8((const U8*)src, &tmplen, &is_utf8);
        len = tmplen;
     }
     if (!hash)
@@ -7853,13 +7855,10 @@ Perl_newSVsv(pTHX_ register SV *old)
        return Nullsv;
     }
     new_SV(sv);
-    if (SvTEMP(old)) {
-       SvTEMP_off(old);
-       sv_setsv(sv,old);
-       SvTEMP_on(old);
-    }
-    else
-       sv_setsv(sv,old);
+    /* SV_GMAGIC is the default for sv_setv()
+       SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
+       with SvTEMP_off and SvTEMP_on round a call to sv_setsv.  */
+    sv_setsv_flags(sv, old, SV_GMAGIC | SV_NOSTEAL);
     return sv;
 }
 
@@ -7873,7 +7872,7 @@ Note that the perl-level function is vaguely deprecated.
 */
 
 void
-Perl_sv_reset(pTHX_ register char *s, HV *stash)
+Perl_sv_reset(pTHX_ register const char *s, HV *stash)
 {
     register HE *entry;
     register GV *gv;
@@ -7967,7 +7966,6 @@ Perl_sv_2io(pTHX_ SV *sv)
 {
     IO* io;
     GV* gv;
-    STRLEN n_a;
 
     switch (SvTYPE(sv)) {
     case SVt_PVIO:
@@ -7984,7 +7982,7 @@ Perl_sv_2io(pTHX_ SV *sv)
            Perl_croak(aTHX_ PL_no_usym, "filehandle");
        if (SvROK(sv))
            return sv_2io(SvRV(sv));
-       gv = gv_fetchpv(SvPV(sv,n_a), FALSE, SVt_PVIO);
+       gv = gv_fetchsv(sv, FALSE, SVt_PVIO);
        if (gv)
            io = GvIO(gv);
        else
@@ -8010,7 +8008,6 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
 {
     GV *gv = Nullgv;
     CV *cv = Nullcv;
-    STRLEN n_a;
 
     if (!sv)
        return *gvp = Nullgv, Nullcv;
@@ -8051,7 +8048,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
        else if (isGV(sv))
            gv = (GV*)sv;
        else
-           gv = gv_fetchpv(SvPV(sv, n_a), lref, SVt_PVCV);
+           gv = gv_fetchsv(sv, lref, SVt_PVCV);
        *gvp = gv;
        if (!gv)
            return Nullcv;
@@ -8094,7 +8091,7 @@ Perl_sv_true(pTHX_ register SV *sv)
     if (!sv)
        return 0;
     if (SvPOK(sv)) {
-       register XPV* tXpv;
+       const register XPV* tXpv;
        if ((tXpv = (XPV*)SvANY(sv)) &&
                (tXpv->xpv_cur > 1 ||
                (tXpv->xpv_cur && *tXpv->xpv_pv != '0')))
@@ -8398,14 +8395,12 @@ Returns a string describing what the SV is a reference to.
 =cut
 */
 
-char *
-Perl_sv_reftype(pTHX_ SV *sv, int ob)
+const char *
+Perl_sv_reftype(pTHX_ const SV *sv, int ob)
 {
     if (ob && SvOBJECT(sv)) {
-       if (HvNAME(SvSTASH(sv)))
-           return HvNAME(SvSTASH(sv));
-       else
-           return "__ANON__";
+        const char *name = HvNAME(SvSTASH(sv));
+       return name ? name : "__ANON__";
     }
     else {
        switch (SvTYPE(sv)) {
@@ -9010,7 +9005,8 @@ output to an SV.  If the appended data contains "wide" characters
 (including, but not limited to, SVs with a UTF-8 PV formatted with %s,
 and characters >255 formatted with %c), the original SV might get
 upgraded to UTF-8.  Handles 'get' magic, but not 'set' magic.  See
-C<sv_catpvf_mg>.
+C<sv_catpvf_mg>. If the original SV was UTF-8, the pattern should be
+valid UTF-8; if the original SV was bytes, the pattern should be too.
 
 =cut */
 
@@ -9272,7 +9268,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 #endif
 
        char esignbuf[4];
-       U8 utf8buf[UTF8_MAXLEN+1];
+       U8 utf8buf[UTF8_MAXBYTES+1];
        STRLEN esignlen = 0;
 
        char *eptr = Nullch;
@@ -9296,7 +9292,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        STRLEN have;
        STRLEN need;
        STRLEN gap;
-       char *dotstr = ".";
+        const char *dotstr = ".";
        STRLEN dotstrlen = 1;
        I32 efix = 0; /* explicit format parameter index */
        I32 ewix = 0; /* explicit width index */
@@ -9582,6 +9578,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            goto string;
 
        case '_':
+#ifdef CHECK_FORMAT
+       format_sv:
+#endif
            /*
             * The "%_" hack might have to be changed someday,
             * if ISO or ANSI decide to use '_' for something.
@@ -9603,6 +9602,17 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            /* INTEGERS */
 
        case 'p':
+#ifdef CHECK_FORMAT
+           if (left) {
+               left = FALSE;
+               if (!width)
+                   goto format_sv;     /* %-p  -> %_   */
+               precis = width;
+               has_precis = TRUE;
+               width = 0;
+               goto format_sv;         /* %-Np -> %.N_ */      
+           }
+#endif
            if (alt || vectorize)
                goto unknown;
            uv = PTR2UV(args ? va_arg(*args, void*) : argsv);
@@ -10215,7 +10225,7 @@ Perl_re_dup(pTHX_ REGEXP *r, CLONE_PARAMS *param)
     ret->regstclass = NULL;
     if (r->data) {
        struct reg_data *d;
-       int count = r->data->count;
+        const int count = r->data->count;
 
        Newc(0, d, sizeof(struct reg_data) + count*sizeof(void *),
                char, struct reg_data);
@@ -10225,6 +10235,8 @@ Perl_re_dup(pTHX_ REGEXP *r, CLONE_PARAMS *param)
        for (i = 0; i < count; i++) {
            d->what[i] = r->data->what[i];
            switch (d->what[i]) {
+               /* legal options are one of: sfpont
+                  see also regcomp.h and pregfree() */
            case 's':
                d->data[i] = sv_dup_inc((SV *)r->data->data[i], param);
                break;
@@ -10241,11 +10253,21 @@ Perl_re_dup(pTHX_ REGEXP *r, CLONE_PARAMS *param)
            case 'o':
                /* Compiled op trees are readonly, and can thus be
                   shared without duplication. */
+               OP_REFCNT_LOCK;
                d->data[i] = (void*)OpREFCNT_inc((OP*)r->data->data[i]);
+               OP_REFCNT_UNLOCK;
                break;
            case 'n':
                d->data[i] = r->data->data[i];
                break;
+           case 't':
+               d->data[i] = r->data->data[i];
+               OP_REFCNT_LOCK;
+               ((reg_trie_data*)d->data[i])->refcount++;
+               OP_REFCNT_UNLOCK;
+               break;
+            default:
+               Perl_croak(aTHX_ "panic: re_dup unknown data code '%c'", r->data->what[i]);
            }
        }
 
@@ -10373,10 +10395,10 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS* param)
            nmg->mg_obj = (SV*)re_dup((REGEXP*)mg->mg_obj, param);
        }
        else if(mg->mg_type == PERL_MAGIC_backref) {
-           AV *av = (AV*) mg->mg_obj;
+           const AV * const av = (AV*) mg->mg_obj;
            SV **svp;
            I32 i;
-           SvREFCNT_inc(nmg->mg_obj = (SV*)newAV());
+           (void)SvREFCNT_inc(nmg->mg_obj = (SV*)newAV());
            svp = AvARRAY(av);
            for (i = AvFILLp(av); i >= 0; i--) {
                if (!svp[i]) continue;
@@ -10952,7 +10974,9 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
        Perl_rvpv_dup(aTHX_ dstr, sstr, param);
        CvSTASH(dstr)   = hv_dup(CvSTASH(sstr), param); /* NOTE: not refcounted */
        CvSTART(dstr)   = CvSTART(sstr);
+       OP_REFCNT_LOCK;
        CvROOT(dstr)    = OpREFCNT_inc(CvROOT(sstr));
+       OP_REFCNT_UNLOCK;
        CvXSUB(dstr)    = CvXSUB(sstr);
        CvXSUBANY(dstr) = CvXSUBANY(sstr);
        if (CvCONST(sstr)) {
@@ -11613,19 +11637,23 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     SvANY(&PL_sv_no)           = new_XPVNV();
     SvREFCNT(&PL_sv_no)                = (~(U32)0)/2;
-    SvFLAGS(&PL_sv_no)         = SVp_NOK|SVf_NOK|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
+    SvFLAGS(&PL_sv_no)         = SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
+                                 |SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
     SvPVX(&PL_sv_no)           = SAVEPVN(PL_No, 0);
     SvCUR(&PL_sv_no)           = 0;
     SvLEN(&PL_sv_no)           = 1;
+    SvIVX(&PL_sv_no)           = 0;
     SvNVX(&PL_sv_no)           = 0;
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_no, &PL_sv_no);
 
     SvANY(&PL_sv_yes)          = new_XPVNV();
     SvREFCNT(&PL_sv_yes)       = (~(U32)0)/2;
-    SvFLAGS(&PL_sv_yes)                = SVp_NOK|SVf_NOK|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
+    SvFLAGS(&PL_sv_yes)                = SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
+                                 |SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
     SvPVX(&PL_sv_yes)          = SAVEPVN(PL_Yes, 1);
     SvCUR(&PL_sv_yes)          = 1;
     SvLEN(&PL_sv_yes)          = 2;
+    SvIVX(&PL_sv_yes)          = 1;
     SvNVX(&PL_sv_yes)          = 1;
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
 
@@ -12145,9 +12173,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_dirty           = proto_perl->Tdirty;
     PL_localizing      = proto_perl->Tlocalizing;
 
-#ifdef PERL_FLEXIBLE_EXCEPTIONS
-    PL_protect         = proto_perl->Tprotect;
-#endif
     PL_errors          = sv_dup_inc(proto_perl->Terrors, param);
     PL_hv_fetch_ent_mh = Nullhe;
     PL_modcount                = proto_perl->Tmodcount;
@@ -12371,3 +12396,12 @@ Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding,
     return ret;
 }
 
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * vim: shiftwidth=4:
+*/