Upgrade to Time-HiRes-1.85
[p5sagit/p5-mst-13.2.git] / sv.c
diff --git a/sv.c b/sv.c
index d4baffc..f918d5a 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -520,7 +520,7 @@ do_clean_all(pTHX_ SV *sv)
     DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) ));
     SvFLAGS(sv) |= SVf_BREAK;
     if (PL_comppad == (AV*)sv) {
-       PL_comppad = Nullav;
+       PL_comppad = NULL;
        PL_curpad = Null(SV**);
     }
     SvREFCNT_dec(sv);
@@ -640,8 +640,8 @@ Perl_sv_free_arenas(pTHX)
 STATIC void *
 S_more_bodies (pTHX_ size_t size, svtype sv_type)
 {
-    void **arena_root  = &PL_body_arenaroots[sv_type];
-    void **root                = &PL_body_roots[sv_type];
+    void ** const arena_root   = &PL_body_arenaroots[sv_type];
+    void ** const root         = &PL_body_roots[sv_type];
     char *start;
     const char *end;
     const size_t count = PERL_ARENA_SIZE / size;
@@ -675,7 +675,7 @@ S_more_bodies (pTHX_ size_t size, svtype sv_type)
 
 #define new_body_inline(xpv, size, sv_type) \
     STMT_START { \
-       void **r3wt = &PL_body_roots[sv_type]; \
+       void ** const r3wt = &PL_body_roots[sv_type]; \
        LOCK_SV_MUTEX; \
        xpv = *((void **)(r3wt)) \
          ? *((void **)(r3wt)) : S_more_bodies(aTHX_ size, sv_type); \
@@ -704,7 +704,7 @@ S_new_body(pTHX_ size_t size, svtype sv_type)
 
 #define del_body(thing, root)                  \
     STMT_START {                               \
-       void **thing_copy = (void **)thing;     \
+       void ** const thing_copy = (void **)thing;\
        LOCK_SV_MUTEX;                          \
        *thing_copy = *root;                    \
        *root = (void*)thing_copy;              \
@@ -1413,9 +1413,9 @@ S_not_a_number(pTHX_ SV *sv)
          /* each *s can expand to 4 chars + "...\0",
             i.e. need room for 8 chars */
        
-         const char *s, *end;
-         for (s = SvPVX_const(sv), end = s + SvCUR(sv); s < end && d < limit;
-              s++) {
+         const char *s = SvPVX_const(sv);
+         const char * const end = s + SvCUR(sv);
+         for ( ; s < end && d < limit; s++ ) {
               int ch = *s & 0xFF;
               if (ch & 128 && !isPRINT_LC(ch)) {
                    *d++ = 'M';
@@ -1888,18 +1888,37 @@ Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
        if (SvNOKp(sv)) {
            return I_V(SvNVX(sv));
        }
-       if (SvPOKp(sv) && SvLEN(sv))
-           return asIV(sv);
-       if (!SvROK(sv)) {
-           if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-               if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
-                   report_uninit(sv);
+       if (SvPOKp(sv) && SvLEN(sv)) {
+           UV value;
+           const int numtype
+               = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
+
+           if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
+               == IS_NUMBER_IN_UV) {
+               /* It's definitely an integer */
+               if (numtype & IS_NUMBER_NEG) {
+                   if (value < (UV)IV_MIN)
+                       return -(IV)value;
+               } else {
+                   if (value < (UV)IV_MAX)
+                       return (IV)value;
+               }
            }
-           return 0;
+           if (!numtype) {
+               if (ckWARN(WARN_NUMERIC))
+                   not_a_number(sv);
+           }
+           return I_V(Atof(SvPVX_const(sv)));
+       }
+        if (SvROK(sv)) {
+           goto return_rok;
        }
+       assert(SvTYPE(sv) >= SVt_PVMG);
+       /* This falls through to the report_uninit inside S_sv_2iuv_common.  */
     }
     if (SvTHINKFIRST(sv)) {
        if (SvROK(sv)) {
+       return_rok:
            if (SvAMAGIC(sv)) {
                SV * const tmpstr=AMG_CALLun(sv,numer);
                if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
@@ -1948,23 +1967,39 @@ Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
            return SvUVX(sv);
        if (SvNOKp(sv))
            return U_V(SvNVX(sv));
-       if (SvPOKp(sv) && SvLEN(sv))
-           return asUV(sv);
-       if (!SvROK(sv)) {
-           if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-               if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
-                   report_uninit(sv);
+       if (SvPOKp(sv) && SvLEN(sv)) {
+           UV value;
+           const int numtype
+               = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
+
+           if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
+               == IS_NUMBER_IN_UV) {
+               /* It's definitely an integer */
+               if (!(numtype & IS_NUMBER_NEG))
+                   return value;
            }
-           return 0;
+           if (!numtype) {
+               if (ckWARN(WARN_NUMERIC))
+                   not_a_number(sv);
+           }
+           return U_V(Atof(SvPVX_const(sv)));
+       }
+        if (SvROK(sv)) {
+           goto return_rok;
        }
+       assert(SvTYPE(sv) >= SVt_PVMG);
+       /* This falls through to the report_uninit inside S_sv_2iuv_common.  */
     }
     if (SvTHINKFIRST(sv)) {
        if (SvROK(sv)) {
-         SV* tmpstr;
-          if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)) &&
-                (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv))))
-             return SvUV(tmpstr);
-         return PTR2UV(SvRV(sv));
+       return_rok:
+           if (SvAMAGIC(sv)) {
+               SV *const tmpstr = AMG_CALLun(sv,numer);
+               if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
+                   return SvUV(tmpstr);
+               }
+           }
+           return PTR2UV(SvRV(sv));
        }
        if (SvIsCOW(sv)) {
            sv_force_normal_flags(sv, 0);
@@ -2015,22 +2050,23 @@ Perl_sv_2nv(pTHX_ register SV *sv)
                return (NV)SvUVX(sv);
            else
                return (NV)SvIVX(sv);
-       }       
-        if (!SvROK(sv)) {
-           if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-               if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
-                   report_uninit(sv);
-           }
-            return (NV)0;
-        }
-    }
-    if (SvTHINKFIRST(sv)) {
+       }
+        if (SvROK(sv)) {
+           goto return_rok;
+       }
+       assert(SvTYPE(sv) >= SVt_PVMG);
+       /* This falls through to the report_uninit near the end of the
+          function. */
+    } else if (SvTHINKFIRST(sv)) {
        if (SvROK(sv)) {
-         SV* tmpstr;
-          if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)) &&
-                (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv))))
-             return SvNV(tmpstr);
-         return PTR2NV(SvRV(sv));
+       return_rok:
+           if (SvAMAGIC(sv)) {
+               SV *const tmpstr = AMG_CALLun(sv,numer);
+                if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
+                   return SvNV(tmpstr);
+               }
+           }
+           return PTR2NV(SvRV(sv));
        }
        if (SvIsCOW(sv)) {
            sv_force_normal_flags(sv, 0);
@@ -2042,10 +2078,8 @@ Perl_sv_2nv(pTHX_ register SV *sv)
        }
     }
     if (SvTYPE(sv) < SVt_NV) {
-       if (SvTYPE(sv) == SVt_IV)
-           sv_upgrade(sv, SVt_PVNV);
-       else
-           sv_upgrade(sv, SVt_NV);
+       /* The logic to use SVt_PVNV if necessary is in sv_upgrade.  */
+       sv_upgrade(sv, SVt_NV);
 #ifdef USE_LONG_DOUBLE
        DEBUG_c({
            STORE_NUMERIC_LOCAL_SET_STANDARD();
@@ -2139,11 +2173,10 @@ Perl_sv_2nv(pTHX_ register SV *sv)
                     if (SvNVX(sv) < (NV)IV_MAX + 0.5) {
                         if (SvIVX(sv) == I_V(nv)) {
                             SvNOK_on(sv);
-                            SvIOK_on(sv);
                         } else {
-                            SvIOK_on(sv);
                             /* It had no "." so it must be integer.  */
                         }
+                       SvIOK_on(sv);
                     } else {
                         /* between IV_MAX and NV(UV_MAX).
                            Could be slightly > UV_MAX */
@@ -2155,10 +2188,8 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 
                             if (value == nv_as_uv && SvUVX(sv) != UV_MAX) {
                                 SvNOK_on(sv);
-                                SvIOK_on(sv);
-                            } else {
-                                SvIOK_on(sv);
                             }
+                           SvIOK_on(sv);
                         }
                     }
                 }
@@ -2169,11 +2200,10 @@ Perl_sv_2nv(pTHX_ register SV *sv)
     else  {
        if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
            report_uninit(sv);
-       if (SvTYPE(sv) < SVt_NV)
-           /* Typically the caller expects that sv_any is not NULL now.  */
-           /* XXX Ilya implies that this is a bug in callers that assume this
-              and ideally should be fixed.  */
-           sv_upgrade(sv, SVt_NV);
+       assert (SvTYPE(sv) >= SVt_NV);
+       /* Typically the caller expects that sv_any is not NULL now.  */
+       /* XXX Ilya implies that this is a bug in callers that assume this
+          and ideally should be fixed.  */
        return 0.0;
     }
 #if defined(USE_LONG_DOUBLE)
@@ -2194,55 +2224,6 @@ Perl_sv_2nv(pTHX_ register SV *sv)
     return SvNVX(sv);
 }
 
-/* asIV(): extract an integer from the string value of an SV.
- * Caller must validate PVX  */
-
-STATIC IV
-S_asIV(pTHX_ SV *sv)
-{
-    UV value;
-    const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
-
-    if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
-       == IS_NUMBER_IN_UV) {
-       /* It's definitely an integer */
-       if (numtype & IS_NUMBER_NEG) {
-           if (value < (UV)IV_MIN)
-               return -(IV)value;
-       } else {
-           if (value < (UV)IV_MAX)
-               return (IV)value;
-       }
-    }
-    if (!numtype) {
-       if (ckWARN(WARN_NUMERIC))
-           not_a_number(sv);
-    }
-    return I_V(Atof(SvPVX_const(sv)));
-}
-
-/* asUV(): extract an unsigned integer from the string value of an SV
- * Caller must validate PVX  */
-
-STATIC UV
-S_asUV(pTHX_ SV *sv)
-{
-    UV value;
-    const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
-
-    if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
-       == IS_NUMBER_IN_UV) {
-       /* It's definitely an integer */
-       if (!(numtype & IS_NUMBER_NEG))
-           return value;
-    }
-    if (!numtype) {
-       if (ckWARN(WARN_NUMERIC))
-           not_a_number(sv);
-    }
-    return U_V(Atof(SvPVX_const(sv)));
-}
-
 /* uiv_2buf(): private routine for use by sv_2pv_flags(): print an IV or
  * UV as a string towards the end of buf, and return pointers to start and
  * end of it.
@@ -2281,7 +2262,7 @@ S_uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob)
 
 static char *
 S_stringify_regexp(pTHX_ SV *sv, MAGIC *mg, STRLEN *lp) {
-    const regexp *re = (regexp *)mg->mg_obj;
+    const regexp * const re = (regexp *)mg->mg_obj;
 
     if (!mg->mg_ptr) {
        const char *fptr = "msix";
@@ -2289,7 +2270,7 @@ S_stringify_regexp(pTHX_ SV *sv, MAGIC *mg, STRLEN *lp) {
        char ch;
        int left = 0;
        int right = 4;
-       char need_newline = 0;
+       bool need_newline = 0;
        U16 reganch = (U16)((re->reganch & PMf_COMPILETIME) >> 12);
 
        while((ch = *fptr++)) {
@@ -2403,7 +2384,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
            }
            if (SvROK(sv)) {    /* XXX Skip this when sv_pvn_force calls */
                /* Sneaky stuff here */
-               SV *tsv = newSVpvn(tbuf, len);
+               SV * const tsv = newSVpvn(tbuf, len);
 
                sv_2mortal(tsv);
                if (lp)
@@ -2429,44 +2410,43 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                return memcpy(s, tbuf, len + 1);
            }
        }
-        if (!SvROK(sv)) {
-           if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-               if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
-                   report_uninit(sv);
-           }
-           if (lp)
-               *lp = 0;
-            return (char *)"";
-        }
-    }
-    if (SvTHINKFIRST(sv)) {
+        if (SvROK(sv)) {
+           goto return_rok;
+       }
+       assert(SvTYPE(sv) >= SVt_PVMG);
+       /* This falls through to the report_uninit near the end of the
+          function. */
+    } else if (SvTHINKFIRST(sv)) {
        if (SvROK(sv)) {
-           SV* tmpstr;
-
-            if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)) &&
-                (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
-               /* Unwrap this:  */
-               /* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr); */
-
-                char *pv;
-               if ((SvFLAGS(tmpstr) & (SVf_POK)) == SVf_POK) {
-                   if (flags & SV_CONST_RETURN) {
-                       pv = (char *) SvPVX_const(tmpstr);
+       return_rok:
+            if (SvAMAGIC(sv)) {
+               SV *const tmpstr = AMG_CALLun(sv,string);
+               if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
+                   /* Unwrap this:  */
+                   /* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr);
+                    */
+
+                   char *pv;
+                   if ((SvFLAGS(tmpstr) & (SVf_POK)) == SVf_POK) {
+                       if (flags & SV_CONST_RETURN) {
+                           pv = (char *) SvPVX_const(tmpstr);
+                       } else {
+                           pv = (flags & SV_MUTABLE_RETURN)
+                               ? SvPVX_mutable(tmpstr) : SvPVX(tmpstr);
+                       }
+                       if (lp)
+                           *lp = SvCUR(tmpstr);
                    } else {
-                       pv = (flags & SV_MUTABLE_RETURN)
-                           ? SvPVX_mutable(tmpstr) : SvPVX(tmpstr);
+                       pv = sv_2pv_flags(tmpstr, lp, flags);
                    }
-                   if (lp)
-                       *lp = SvCUR(tmpstr);
-               } else {
-                   pv = sv_2pv_flags(tmpstr, lp, flags);
+                   if (SvUTF8(tmpstr))
+                       SvUTF8_on(sv);
+                   else
+                       SvUTF8_off(sv);
+                   return pv;
                }
-                if (SvUTF8(tmpstr))
-                    SvUTF8_on(sv);
-                else
-                    SvUTF8_off(sv);
-                return pv;
-            } else {
+           }
+           {
                SV *tsv;
                MAGIC *mg;
                const SV *const referent = (SV*)SvRV(sv);
@@ -2562,7 +2542,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
        if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
            report_uninit(sv);
        if (lp)
-       *lp = 0;
+           *lp = 0;
        if (SvTYPE(sv) < SVt_PV)
            /* Typically the caller expects that sv_any is not NULL now.  */
            sv_upgrade(sv, SVt_PV);
@@ -2750,25 +2730,23 @@ Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags)
         * had a FLAG in SVs to signal if there are any hibit
         * chars in the PV.  Given that there isn't such a flag
         * make the loop as fast as possible. */
-       const U8 *s = (U8 *) SvPVX_const(sv);
+       const U8 * const s = (U8 *) SvPVX_const(sv);
        const U8 * const e = (U8 *) SvEND(sv);
        const U8 *t = s;
-       int hibit = 0;
        
        while (t < e) {
            const U8 ch = *t++;
-           if ((hibit = !NATIVE_IS_INVARIANT(ch)))
+           /* Check for hi bit */
+           if (!NATIVE_IS_INVARIANT(ch)) {
+               STRLEN len = SvCUR(sv) + 1; /* Plus the \0 */
+               U8 * const recoded = bytes_to_utf8((U8*)s, &len);
+
+               SvPV_free(sv); /* No longer using what was there before. */
+               SvPV_set(sv, (char*)recoded);
+               SvCUR_set(sv, len - 1);
+               SvLEN_set(sv, len); /* No longer know the real size. */
                break;
-       }
-       if (hibit) {
-           STRLEN len = SvCUR(sv) + 1; /* Plus the \0 */
-           U8 * const recoded = bytes_to_utf8((U8*)s, &len);
-
-           SvPV_free(sv); /* No longer using what was there before. */
-
-           SvPV_set(sv, (char*)recoded);
-           SvCUR_set(sv, len - 1);
-           SvLEN_set(sv, len); /* No longer know the real size. */
+           }
        }
        /* Mark as UTF-8 even if no hibit - saves scanning loop */
        SvUTF8_on(sv);
@@ -3400,7 +3378,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            SvIV_set(dstr, SvIVX(sstr));
        }
        if (SvVOK(sstr)) {
-           MAGIC *smg = mg_find(sstr,PERL_MAGIC_vstring);
+           const MAGIC * const smg = mg_find(sstr,PERL_MAGIC_vstring);
            sv_magic(dstr, NULL, PERL_MAGIC_vstring,
                        smg->mg_ptr, smg->mg_len);
            SvRMAGICAL_on(dstr);
@@ -3906,10 +3884,10 @@ and C<sv_catsv_nomg> are implemented in terms of this function.
 void
 Perl_sv_catsv_flags(pTHX_ SV *dsv, register SV *ssv, I32 flags)
 {
-    const char *spv;
-    STRLEN slen;
     if (ssv) {
-       if ((spv = SvPV_const(ssv, slen))) {
+       STRLEN slen;
+       const char *spv = SvPV_const(ssv, slen);
+       if (spv) {
            /*  sutf8 and dutf8 were type bool, but under USE_ITHREADS,
                gcc version 2.95.2 20000220 (Debian GNU/Linux) for
                Linux xxx 2.2.17 on sparc64 with gcc -O2, we erroneously
@@ -3927,7 +3905,7 @@ Perl_sv_catsv_flags(pTHX_ SV *dsv, register SV *ssv, I32 flags)
            if (dutf8 != sutf8) {
                if (dutf8) {
                    /* Not modifying source SV, so taking a temporary copy. */
-                   SV* csv = sv_2mortal(newSVpvn(spv, slen));
+                   SV* const csv = sv_2mortal(newSVpvn(spv, slen));
 
                    sv_utf8_upgrade(csv);
                    spv = SvPV_const(csv, slen);
@@ -5892,7 +5870,7 @@ thats_really_all_folks:
 
 screamer2:
        if (rslen) {
-            register const STDCHAR *bpe = buf + sizeof(buf);
+            register const STDCHAR * const bpe = buf + sizeof(buf);
            bp = buf;
            while ((i = PerlIO_getc(fp)) != EOF && (*bp++ = (STDCHAR)i) != rslast && bp < bpe)
                ; /* keep reading */
@@ -7283,7 +7261,7 @@ S_sv_unglob(pTHX_ SV *sv)
        gp_free((GV*)sv);
     if (GvSTASH(sv)) {
        sv_del_backref((SV*)GvSTASH(sv), sv);
-       GvSTASH(sv) = Nullhv;
+       GvSTASH(sv) = NULL;
     }
     sv_unmagic(sv, PERL_MAGIC_glob);
     Safefree(GvNAME(sv));
@@ -7639,8 +7617,13 @@ S_expect_number(pTHX_ char** pattern)
     case '1': case '2': case '3':
     case '4': case '5': case '6':
     case '7': case '8': case '9':
-       while (isDIGIT(**pattern))
-           var = var * 10 + (*(*pattern)++ - '0');
+       var = *(*pattern)++ - '0';
+       while (isDIGIT(**pattern)) {
+           I32 tmp = var * 10 + (*(*pattern)++ - '0');
+           if (tmp < var)
+               Perl_croak(aTHX_ "Integer overflow in format string for %s", (PL_op ? OP_NAME(PL_op) : "sv_vcatpvfn"));
+           var = tmp;
+       }
     }
     return var;
 }
@@ -7982,31 +7965,48 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            if (vectorarg) {
                if (args)
                    vecsv = va_arg(*args, SV*);
-               else
-                   vecsv = (evix ? evix <= svmax : svix < svmax) ?
-                       svargs[evix ? evix-1 : svix++] : &PL_sv_undef;
+               else if (evix) {
+                   vecsv = (evix > 0 && evix <= svmax)
+                       ? svargs[evix-1] : &PL_sv_undef;
+               } else {
+                   vecsv = svix < svmax ? svargs[svix++] : &PL_sv_undef;
+               }
                dotstr = SvPV_const(vecsv, dotstrlen);
+               /* Keep the DO_UTF8 test *after* the SvPV call, else things go
+                  bad with tied or overloaded values that return UTF8.  */
                if (DO_UTF8(vecsv))
                    is_utf8 = TRUE;
+               else if (has_utf8) {
+                   vecsv = sv_mortalcopy(vecsv);
+                   sv_utf8_upgrade(vecsv);
+                   dotstr = SvPV_const(vecsv, dotstrlen);
+                   is_utf8 = TRUE;
+               }                   
            }
            if (args) {
                VECTORIZE_ARGS
            }
-           else if (efix ? efix <= svmax : svix < svmax) {
+           else if (efix ? (efix > 0 && efix <= svmax) : svix < svmax) {
                vecsv = svargs[efix ? efix-1 : svix++];
                vecstr = (U8*)SvPV_const(vecsv,veclen);
                vec_utf8 = DO_UTF8(vecsv);
-               /* if this is a version object, we need to return the
-                * stringified representation (which the SvPVX_const has
-                * already done for us), but not vectorize the args
+
+               /* if this is a version object, we need to convert
+                * back into v-string notation and then let the
+                * vectorize happen normally
                 */
-               if ( *q == 'd' && sv_derived_from(vecsv,"version") )
-               {
-                       q++; /* skip past the rest of the %vd format */
-                       eptr = (const char *) vecstr;
-                       elen = veclen;
-                       vectorize=FALSE;
-                       goto string;
+               if (sv_derived_from(vecsv, "version")) {
+                   char *version = savesvpv(vecsv);
+                   vecsv = sv_newmortal();
+                   /* scan_vstring is expected to be called during
+                    * tokenization, so we need to fake up the end
+                    * of the buffer for it
+                    */
+                   PL_bufend = version + veclen;
+                   scan_vstring(version, vecsv);
+                   vecstr = (U8*)SvPV_const(vecsv, veclen);
+                   vec_utf8 = DO_UTF8(vecsv);
+                   Safefree(version);
                }
            }
            else {
@@ -8105,12 +8105,14 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        if (*q == '%') {
            eptr = q++;
            elen = 1;
+           if (vectorize) {
+               c = '%';
+               goto unknown;
+           }
            goto string;
        }
 
-       if (vectorize)
-           argsv = vecsv;
-       else if (!args) {
+       if (!vectorize && !args) {
            if (efix) {
                const I32 i = efix-1;
                argsv = (i >= 0 && i < svmax) ? svargs[i] : &PL_sv_undef;
@@ -8125,7 +8127,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            /* STRINGS */
 
        case 'c':
-           uv = (args && !vectorize) ? va_arg(*args, int) : SvIVx(argsv);
+           if (vectorize)
+               goto unknown;
+           uv = (args) ? va_arg(*args, int) : SvIVx(argsv);
            if ((uv > 255 ||
                 (!UNI_IS_INVARIANT(uv) && SvUTF8(sv)))
                && !IN_BYTES) {
@@ -8141,7 +8145,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            goto string;
 
        case 's':
-           if (args && !vectorize) {
+           if (vectorize)
+               goto unknown;
+           if (args) {
                eptr = va_arg(*args, char*);
                if (eptr)
 #ifdef MACOS_TRADITIONAL
@@ -8172,7 +8178,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            }
 
        string:
-           vectorize = FALSE;
            if (has_precis && elen > precis)
                elen = precis;
            break;
@@ -8387,6 +8392,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
        case 'e': case 'E':
        case 'f':
        case 'g': case 'G':
+           if (vectorize)
+               goto unknown;
 
            /* This is evil, but floating point is even more evil */
 
@@ -8419,7 +8426,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            }
 
            /* now we need (long double) if intsize == 'q', else (double) */
-           nv = (args && !vectorize) ?
+           nv = (args) ?
 #if LONG_DOUBLESIZE > DOUBLESIZE
                intsize == 'q' ?
                    va_arg(*args, long double) :
@@ -8430,7 +8437,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                : SvNVx(argsv);
 
            need = 0;
-           vectorize = FALSE;
            if (c != 'e' && c != 'E') {
                i = PERL_INT_MIN;
                /* FIXME: if HAS_LONG_DOUBLE but not USE_LONG_DOUBLE this
@@ -8588,8 +8594,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            /* SPECIAL */
 
        case 'n':
+           if (vectorize)
+               goto unknown;
            i = SvCUR(sv) - origlen;
-           if (args && !vectorize) {
+           if (args) {
                switch (intsize) {
                case 'h':       *(va_arg(*args, short*)) = i; break;
                default:        *(va_arg(*args, int*)) = i; break;
@@ -8602,7 +8610,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            }
            else
                sv_setuv_mg(argsv, (UV)i);
-           vectorize = FALSE;
            continue;   /* not "break" */
 
            /* UNKNOWN */
@@ -9031,11 +9038,8 @@ Perl_ptr_table_new(pTHX)
     return tbl;
 }
 
-#if (PTRSIZE == 8)
-#  define PTR_TABLE_HASH(ptr) (PTR2UV(ptr) >> 3)
-#else
-#  define PTR_TABLE_HASH(ptr) (PTR2UV(ptr) >> 2)
-#endif
+#define PTR_TABLE_HASH(ptr) \
+  ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))
 
 /* 
    we use the PTE_SVSLOT 'reservation' made above, both here (in the
@@ -9127,27 +9131,22 @@ Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl)
 void
 Perl_ptr_table_clear(pTHX_ PTR_TBL_t *tbl)
 {
-    register PTR_TBL_ENT_t **array;
-    UV riter = 0;
-
-    if (!tbl || !tbl->tbl_items) {
-        return;
-    }
+    if (tbl && tbl->tbl_items) {
+       register PTR_TBL_ENT_t **array = tbl->tbl_ary;
+       UV riter = tbl->tbl_max;
 
-    array = tbl->tbl_ary;
-    riter = tbl->tbl_max;
-
-    do {
-       PTR_TBL_ENT_t *entry = array[riter];
+       do {
+           PTR_TBL_ENT_t *entry = array[riter];
 
-       while (entry) {
-            PTR_TBL_ENT_t *oentry = entry;
-            entry = entry->next;
-            del_pte(oentry);
-        }
-    } while (riter--);
+           while (entry) {
+               PTR_TBL_ENT_t * const oentry = entry;
+               entry = entry->next;
+               del_pte(oentry);
+           }
+       } while (riter--);
 
-    tbl->tbl_items = 0;
+       tbl->tbl_items = 0;
+    }
 }
 
 /* clear and free a ptr table */
@@ -9315,9 +9314,9 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
            case SVt_PVNV:
            case SVt_PVIV:
            case SVt_PV:
-               assert(sv_type_details->copy);
+               assert(sv_type_details->size);
                if (sv_type_details->arena) {
-                   new_body_inline(new_body, sv_type_details->copy, sv_type);
+                   new_body_inline(new_body, sv_type_details->size, sv_type);
                    new_body
                        = (void*)((char*)new_body - sv_type_details->offset);
                } else {
@@ -9455,8 +9454,8 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
                            ++i;
                        }
                        if (SvOOK(sstr)) {
-                           struct xpvhv_aux *saux = HvAUX(sstr);
-                           struct xpvhv_aux *daux = HvAUX(dstr);
+                           struct xpvhv_aux * const saux = HvAUX(sstr);
+                           struct xpvhv_aux * const daux = HvAUX(dstr);
                            /* This flag isn't copied.  */
                            /* SvOOK_on(hv) attacks the IV flags.  */
                            SvFLAGS(dstr) |= SVf_OOK;
@@ -9556,7 +9555,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
                                           : cv_dup(cx->blk_sub.cv,param));
                ncx->blk_sub.argarray   = (cx->blk_sub.hasargs
                                           ? av_dup_inc(cx->blk_sub.argarray, param)
-                                          : Nullav);
+                                          : NULL);
                ncx->blk_sub.savearray  = av_dup_inc(cx->blk_sub.savearray, param);
                ncx->blk_sub.olddepth   = cx->blk_sub.olddepth;
                ncx->blk_sub.hasargs    = cx->blk_sub.hasargs;
@@ -10581,7 +10580,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 #endif
 
     /* swatch cache */
-    PL_last_swash_hv   = Nullhv;       /* reinits on demand */
+    PL_last_swash_hv   = NULL; /* reinits on demand */
     PL_last_swash_klen = 0;
     PL_last_swash_key[0]= '\0';
     PL_last_swash_tmps = (U8*)NULL;
@@ -11233,7 +11232,7 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
                        break;
                }
                else {
-                   SV ** const svp = av_fetch((AV*)sv, SvIV(cSVOPx_sv(kid)), FALSE);
+                   SV * const * const svp = av_fetch((AV*)sv, SvIV(cSVOPx_sv(kid)), FALSE);
                    if (!svp || *svp != uninit_sv)
                        break;
                }
@@ -11244,7 +11243,6 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
            else
                return varname(gv, '@', o->op_targ, Nullsv,
                            SvIV(cSVOPx_sv(kid)), FUV_SUBSCRIPT_ARRAY);
-           ;
        }
        else  {
            /* index is an expression;