Third consting batch
[p5sagit/p5-mst-13.2.git] / sv.c
diff --git a/sv.c b/sv.c
index 50501e7..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);
@@ -789,8 +787,8 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
       {
        bool pad  = (obase->op_type == OP_PADAV || obase->op_type == OP_PADHV);
        bool hash = (obase->op_type == OP_PADHV || obase->op_type == OP_RV2HV);
-       I32 index;
-       SV *keysv;
+       I32 index = 0;
+       SV *keysv = Nullsv;
        int subscript_type = FUV_SUBSCRIPT_WITHIN;
 
        if (pad) { /* @lex, %lex */
@@ -1072,7 +1070,7 @@ void
 Perl_report_uninit(pTHX_ SV* uninit_sv)
 {
     if (PL_op) {
-       SV* varname;
+       SV* varname = Nullsv;
        if (uninit_sv) {
            varname = find_uninit_var(PL_op, uninit_sv,0);
            if (varname)
@@ -1756,6 +1754,7 @@ You generally want to use the C<SvUPGRADE> macro wrapper. See also C<svtype>.
 bool
 Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 {
+
     char*      pv = NULL;
     U32                cur = 0;
     U32                len = 0;
@@ -1953,7 +1952,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
        SvSTASH(sv)     = stash;
        AvALLOC(sv)     = 0;
        AvARYLEN(sv)    = 0;
-       AvFLAGS(sv)     = 0;
+       AvFLAGS(sv)     = AVf_REAL;
        break;
     case SVt_PVHV:
        SvANY(sv) = new_XPVHV();
@@ -2113,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);
@@ -3493,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);
@@ -3505,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;
                
@@ -3515,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;
@@ -3558,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 == '#') {
@@ -3601,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))
@@ -3642,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;
 
@@ -3742,9 +3738,8 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
        *lp = len;
        s = SvGROW(sv, len + 1);
        SvCUR_set(sv, len);
-       (void)strcpy(s, t);
        SvPOKp_on(sv);
-       return s;
+       return strcpy(s, t);
     }
 }
 
@@ -4130,8 +4125,9 @@ function if the source SV needs to be reused. Does not handle 'set' magic.
 Loosely speaking, it performs a copy-by-value, obliterating any previous
 content of the destination.
 If the C<flags> parameter has the C<SV_GMAGIC> bit set, will C<mg_get> on
-C<ssv> if appropriate, else not. C<sv_setsv> and C<sv_setsv_nomg> are
-implemented in terms of this function.
+C<ssv> if appropriate, else not. If the C<flags> parameter has the
+C<NOSTEAL> bit set then the buffers of temps will not be stolen. <sv_setsv>
+and C<sv_setsv_nomg> are implemented in terms of this function.
 
 You probably want to use one of the assortment of wrappers, such as
 C<SvSetSV>, C<SvSetSV_nosteal>, C<SvSetMagicSV> and
@@ -4515,6 +4511,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
             !(isSwipe =
                  (sflags & SVs_TEMP) &&   /* slated for free anyway? */
                  !(sflags & SVf_OOK) &&   /* and not involved in OOK hack? */
+                (!(flags & SV_NOSTEAL)) &&
+                                       /* and we're allowed to steal temps */
                  SvREFCNT(sstr) == 1 &&   /* and no other references to it? */
                  SvLEN(sstr)   &&        /* and really is a string */
                                /* and won't be needed again, potentially */
@@ -4953,7 +4951,8 @@ Perl_sv_release_IVX(pTHX_ register SV *sv)
 {
     if (SvIsCOW(sv))
         sv_force_normal_flags(sv, 0);
-    return SvOOK_off(sv);
+    SvOOK_off(sv);
+    return 0;
 }
 #endif
 /*
@@ -5310,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;
@@ -5338,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.
@@ -5400,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))
@@ -5581,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);
@@ -5700,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;
@@ -5976,7 +5981,7 @@ Perl_sv_clear(pTHX_ register SV *sv)
     case SVt_PVNV:
     case SVt_PVIV:
       freescalar:
-       (void)SvOOK_off(sv);
+       SvOOK_off(sv);
        /* FALL THROUGH */
     case SVt_PV:
     case SVt_RV:
@@ -6608,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;
@@ -6656,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;
@@ -6664,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;
@@ -6704,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;
 
@@ -6732,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 {
@@ -6742,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);
            }
        }
     }
@@ -6752,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;
@@ -6904,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;
@@ -7667,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)
@@ -7849,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;
 }
 
@@ -7869,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;
@@ -7918,7 +7921,7 @@ Perl_sv_reset(pTHX_ register char *s, HV *stash)
                        sv_unref(sv);
                    continue;
                }
-               (void)SvOK_off(sv);
+               SvOK_off(sv);
                if (SvTYPE(sv) >= SVt_PV) {
                    SvCUR_set(sv, 0);
                    if (SvPVX(sv) != Nullch)
@@ -7963,7 +7966,6 @@ Perl_sv_2io(pTHX_ SV *sv)
 {
     IO* io;
     GV* gv;
-    STRLEN n_a;
 
     switch (SvTYPE(sv)) {
     case SVt_PVIO:
@@ -7980,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
@@ -8006,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;
@@ -8047,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;
@@ -8090,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')))
@@ -8394,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)) {
@@ -8522,14 +8521,14 @@ Perl_newSVrv(pTHX_ SV *rv, const char *classname)
     if (SvTYPE(rv) < SVt_RV)
        sv_upgrade(rv, SVt_RV);
     else if (SvTYPE(rv) > SVt_RV) {
-       (void)SvOOK_off(rv);
+       SvOOK_off(rv);
        if (SvPVX(rv) && SvLEN(rv))
            Safefree(SvPVX(rv));
        SvCUR_set(rv, 0);
        SvLEN_set(rv, 0);
     }
 
-    (void)SvOK_off(rv);
+    SvOK_off(rv);
     SvRV(rv) = sv;
     SvROK_on(rv);
 
@@ -8899,8 +8898,8 @@ Perl_sv_setpvf_mg_nocontext(SV *sv, const char* pat, ...)
 /*
 =for apidoc sv_setpvf
 
-Processes its arguments like C<sprintf> and sets an SV to the formatted
-output.  Does not handle 'set' magic.  See C<sv_setpvf_mg>.
+Works like C<sv_catpvf> but copies the text into the SV instead of
+appending it.  Does not handle 'set' magic.  See C<sv_setpvf_mg>.
 
 =cut
 */
@@ -8914,7 +8913,16 @@ Perl_sv_setpvf(pTHX_ SV *sv, const char* pat, ...)
     va_end(args);
 }
 
-/* backend for C<sv_setpvf> and C<sv_setpvf_nocontext> */
+/*
+=for apidoc sv_vsetpvf
+
+Works like C<sv_vcatpvf> but copies the text into the SV instead of
+appending it.  Does not handle 'set' magic.  See C<sv_vsetpvf_mg>.
+
+Usually used via its frontend C<sv_setpvf>.
+
+=cut
+*/
 
 void
 Perl_sv_vsetpvf(pTHX_ SV *sv, const char* pat, va_list* args)
@@ -8939,7 +8947,15 @@ Perl_sv_setpvf_mg(pTHX_ SV *sv, const char* pat, ...)
     va_end(args);
 }
 
-/* backend for C<sv_setpvf_mg> C<setpvf_mg_nocontext> */
+/*
+=for apidoc sv_vsetpvf_mg
+
+Like C<sv_vsetpvf>, but also handles 'set' magic.
+
+Usually used via its frontend C<sv_setpvf_mg>.
+
+=cut
+*/
 
 void
 Perl_sv_vsetpvf_mg(pTHX_ SV *sv, const char* pat, va_list* args)
@@ -8988,9 +9004,9 @@ Processes its arguments like C<sprintf> and appends the formatted
 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.
-C<SvSETMAGIC()> must typically be called after calling this function
-to handle 'set' magic.
+upgraded to UTF-8.  Handles 'get' magic, but not 'set' magic.  See
+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 */
 
@@ -9003,7 +9019,16 @@ Perl_sv_catpvf(pTHX_ SV *sv, const char* pat, ...)
     va_end(args);
 }
 
-/* backend for C<sv_catpvf> and C<catpvf_mg_nocontext> */
+/*
+=for apidoc sv_vcatpvf
+
+Processes its arguments like C<vsprintf> and appends the formatted output
+to an SV.  Does not handle 'set' magic.  See C<sv_vcatpvf_mg>.
+
+Usually used via its frontend C<sv_catpvf>.
+
+=cut
+*/
 
 void
 Perl_sv_vcatpvf(pTHX_ SV *sv, const char* pat, va_list* args)
@@ -9028,7 +9053,15 @@ Perl_sv_catpvf_mg(pTHX_ SV *sv, const char* pat, ...)
     va_end(args);
 }
 
-/* backend for C<catpvf_mg> and C<catpvf_mg_nocontext> */
+/*
+=for apidoc sv_vcatpvf_mg
+
+Like C<sv_vcatpvf>, but also handles 'set' magic.
+
+Usually used via its frontend C<sv_catpvf_mg>.
+
+=cut
+*/
 
 void
 Perl_sv_vcatpvf_mg(pTHX_ SV *sv, const char* pat, va_list* args)
@@ -9040,10 +9073,10 @@ Perl_sv_vcatpvf_mg(pTHX_ SV *sv, const char* pat, va_list* args)
 /*
 =for apidoc sv_vsetpvfn
 
-Works like C<vcatpvfn> but copies the text into the SV instead of
+Works like C<sv_vcatpvfn> but copies the text into the SV instead of
 appending it.
 
-Usually used via one of its frontends C<sv_setpvf> and C<sv_setpvf_mg>.
+Usually used via one of its frontends C<sv_vsetpvf> and C<sv_vsetpvf_mg>.
 
 =cut
 */
@@ -9108,7 +9141,7 @@ missing (NULL).  When running with taint checks enabled, indicates via
 C<maybe_tainted> if results are untrustworthy (often due to the use of
 locales).
 
-Usually used via one of its frontends C<sv_catpvf> and C<sv_catpvf_mg>.
+Usually used via one of its frontends C<sv_vcatpvf> and C<sv_vcatpvf_mg>.
 
 =cut
 */
@@ -9235,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;
@@ -9259,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 */
@@ -9374,6 +9407,18 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                vecsv = svargs[efix ? efix-1 : svix++];
                vecstr = (U8*)SvPVx(vecsv,veclen);
                vec_utf8 = DO_UTF8(vecsv);
+               /* if this is a version object, we need to return the
+                * stringified representation (which the SvPVX has
+                * already done for us), but not vectorize the args
+                */
+               if ( *q == 'd' && sv_derived_from(vecsv,"version") )
+               {
+                       q++; /* skip past the rest of the %vd format */
+                       eptr = (char *) vecstr;
+                       elen = strlen(eptr);
+                       vectorize=FALSE;
+                       goto string;
+               }
            }
            else {
                vecstr = (U8*)"";
@@ -9533,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.
@@ -9554,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);
@@ -10038,14 +10097,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
             p = SvEND(sv);
             *p = '\0';
        }
-       /* Use memchr() instead of strchr(), as eptr is not guaranteed */
-       /* to point to a null-terminated string.                       */
-       if (left && ckWARN(WARN_PRINTF) && memchr(eptr, '\n', elen) &&
-           (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF))
-           Perl_warner(aTHX_ packWARN(WARN_PRINTF),
-               "Newline in left-justified string for %sprintf",
-                       (PL_op->op_type == OP_PRTF) ? "" : "s");
-       
+
        need = (have > width ? have : width);
        gap = need - have;
 
@@ -10173,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);
@@ -10183,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;
@@ -10199,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]);
            }
        }
 
@@ -10331,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;
@@ -10910,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)) {
@@ -10976,7 +11042,6 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
        else {
            ncx->blk_oldsp      = cx->blk_oldsp;
            ncx->blk_oldcop     = cx->blk_oldcop;
-           ncx->blk_oldretsp   = cx->blk_oldretsp;
            ncx->blk_oldmarksp  = cx->blk_oldmarksp;
            ncx->blk_oldscopesp = cx->blk_oldscopesp;
            ncx->blk_oldpm      = cx->blk_oldpm;
@@ -10993,6 +11058,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
                ncx->blk_sub.olddepth   = cx->blk_sub.olddepth;
                ncx->blk_sub.hasargs    = cx->blk_sub.hasargs;
                ncx->blk_sub.lval       = cx->blk_sub.lval;
+               ncx->blk_sub.retop      = cx->blk_sub.retop;
                break;
            case CXt_EVAL:
                ncx->blk_eval.old_in_eval = cx->blk_eval.old_in_eval;
@@ -11000,6 +11066,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
                ncx->blk_eval.old_namesv = sv_dup_inc(cx->blk_eval.old_namesv, param);
                ncx->blk_eval.old_eval_root = cx->blk_eval.old_eval_root;
                ncx->blk_eval.cur_text  = sv_dup(cx->blk_eval.cur_text, param);
+               ncx->blk_eval.retop = cx->blk_eval.retop;
                break;
            case CXt_LOOP:
                ncx->blk_loop.label     = cx->blk_loop.label;
@@ -11024,6 +11091,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
                ncx->blk_sub.gv         = gv_dup(cx->blk_sub.gv, param);
                ncx->blk_sub.dfoutgv    = gv_dup_inc(cx->blk_sub.dfoutgv, param);
                ncx->blk_sub.hasargs    = cx->blk_sub.hasargs;
+               ncx->blk_sub.retop      = cx->blk_sub.retop;
                break;
            case CXt_BLOCK:
            case CXt_NULL:
@@ -11473,7 +11541,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_savestack = 0;
     PL_savestack_ix = 0;
     PL_savestack_max = -1;
-    PL_retstack = 0;
     PL_sig_pending = 0;
     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
 #  else        /* !DEBUGGING */
@@ -11506,7 +11573,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_savestack = 0;
     PL_savestack_ix = 0;
     PL_savestack_max = -1;
-    PL_retstack = 0;
     PL_sig_pending = 0;
     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
 #    else      /* !DEBUGGING */
@@ -11571,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);
 
@@ -12044,13 +12114,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
        Newz(54, PL_scopestack, PL_scopestack_max, I32);
        Copy(proto_perl->Tscopestack, PL_scopestack, PL_scopestack_ix, I32);
 
-       /* next push_return() sets PL_retstack[PL_retstack_ix]
-        * NOTE: unlike the others! */
-       PL_retstack_ix          = proto_perl->Tretstack_ix;
-       PL_retstack_max         = proto_perl->Tretstack_max;
-       Newz(54, PL_retstack, PL_retstack_max, OP*);
-       Copy(proto_perl->Tretstack, PL_retstack, PL_retstack_ix, OP*);
-
        /* NOTE: si_dup() looks at PL_markstack */
        PL_curstackinfo         = si_dup(proto_perl->Tcurstackinfo, param);
 
@@ -12110,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;
@@ -12284,8 +12344,9 @@ Perl_sv_recode_to_utf8(pTHX_ SV *sv, SV *encoding)
        FREETMPS;
        LEAVE;
        SvUTF8_on(sv);
+       return SvPVX(sv);
     }
-    return SvPVX(sv);
+    return SvPOKp(sv) ? SvPVX(sv) : NULL;
 }
 
 /*
@@ -12335,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:
+*/