X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=f2d0abaedf370bbb09739eea55b1089ddfca5080;hb=9c6b46e2ec49ec38e1f74cac342d7860abe20c23;hp=268cb3a3b422666ffde8a52950d7050d34b52e4c;hpb=a02a5408b2f199007c4dcb74559cc79066307ada;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index 268cb3a..f2d0aba 100644
--- a/sv.c
+++ b/sv.c
@@ -1112,18 +1112,7 @@ S_more_bodies (pTHX_ void **arena_root, void **root, size_t size)
 
 /* grab a new thing from the free list, allocating more if necessary */
 
-STATIC void *
-S_new_body(pTHX_ void **arena_root, void **root, size_t size)
-{
-    void *xpv;
-    LOCK_SV_MUTEX;
-    xpv = *root ? *root : S_more_bodies(aTHX_ arena_root, root, size);
-    *root = *(void**)xpv;
-    UNLOCK_SV_MUTEX;
-    return xpv;
-}
-
-/* and an inline version  */
+/* 1st, the inline version  */
 
 #define new_body_inline(xpv, arena_root, root, size) \
     STMT_START { \
@@ -1134,6 +1123,16 @@ S_new_body(pTHX_ void **arena_root, void **root, size_t size)
 	UNLOCK_SV_MUTEX; \
     } STMT_END
 
+/* now use the inline version in the proper function */
+
+STATIC void *
+S_new_body(pTHX_ void **arena_root, void **root, size_t size)
+{
+    void *xpv;
+    new_body_inline(xpv, arena_root, root, size);
+    return xpv;
+}
+
 /* return a thing to the free list */
 
 #define del_body(thing, root)			\
@@ -1861,7 +1860,7 @@ S_not_a_number(pTHX_ SV *sv)
           pv = sv_uni_display(dsv, sv, 10, 0);
      } else {
 	  char *d = tmpbuf;
-	  char *limit = tmpbuf + sizeof(tmpbuf) - 8;
+	  const char * const limit = tmpbuf + sizeof(tmpbuf) - 8;
 	  /* each *s can expand to 4 chars + "...\0",
 	     i.e. need room for 8 chars */
 	
@@ -2114,7 +2113,7 @@ Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
 	    return asIV(sv);
 	if (!SvROK(sv)) {
 	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-		if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+		if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
 		    report_uninit(sv);
 	    }
 	    return 0;
@@ -2122,11 +2121,13 @@ Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
     }
     if (SvTHINKFIRST(sv)) {
 	if (SvROK(sv)) {
-	  SV* tmpstr;
-          if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)) &&
-                (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv))))
-	      return SvIV(tmpstr);
-	  return PTR2IV(SvRV(sv));
+	    if (SvAMAGIC(sv)) {
+		SV * const tmpstr=AMG_CALLun(sv,numer);
+		if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
+		    return SvIV(tmpstr);
+		}
+	    }
+	    return PTR2IV(SvRV(sv));
 	}
 	if (SvIsCOW(sv)) {
 	    sv_force_normal_flags(sv, 0);
@@ -2374,7 +2375,7 @@ Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
 #endif /* NV_PRESERVES_UV */
 	}
     } else  {
-	if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+	if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
 	    report_uninit(sv);
 	if (SvTYPE(sv) < SVt_IV)
 	    /* Typically the caller expects that sv_any is not NULL now.  */
@@ -2422,7 +2423,7 @@ Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
 	    return asUV(sv);
 	if (!SvROK(sv)) {
 	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-		if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+		if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
 		    report_uninit(sv);
 	    }
 	    return 0;
@@ -2663,7 +2664,7 @@ Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
     }
     else  {
 	if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-	    if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+	    if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
 		report_uninit(sv);
 	}
 	if (SvTYPE(sv) < SVt_IV)
@@ -2697,7 +2698,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	if (SvNOKp(sv))
 	    return SvNVX(sv);
 	if (SvPOKp(sv) && SvLEN(sv)) {
-	    if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) &&
+	    if (!SvIOKp(sv) && ckWARN(WARN_NUMERIC) &&
 		!grok_number(SvPVX_const(sv), SvCUR(sv), NULL))
 		not_a_number(sv);
 	    return Atof(SvPVX_const(sv));
@@ -2710,7 +2711,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	}	
         if (!SvROK(sv)) {
 	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-		if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+		if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
 		    report_uninit(sv);
 	    }
             return (NV)0;
@@ -2777,7 +2778,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
     else if (SvPOKp(sv) && SvLEN(sv)) {
 	UV value;
 	const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
-	if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !numtype)
+	if (!SvIOKp(sv) && !numtype && ckWARN(WARN_NUMERIC))
 	    not_a_number(sv);
 #ifdef NV_PRESERVES_UV
 	if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
@@ -2859,7 +2860,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 #endif /* NV_PRESERVES_UV */
     }
     else  {
-	if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+	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.  */
@@ -2957,7 +2958,7 @@ Perl_sv_2pv_nolen(pTHX_ register SV *sv)
  */
 
 static char *
-uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob)
+S_uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob)
 {
     char *ptr = buf + TYPE_CHARS(UV);
     char *ebuf = ptr;
@@ -3044,7 +3045,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 	}
         if (!SvROK(sv)) {
 	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-		if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
+		if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
 		    report_uninit(sv);
 	    }
 	    if (lp)
@@ -3269,8 +3270,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 #endif
     }
     else {
-	if (ckWARN(WARN_UNINITIALIZED)
-	    && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+	if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
 	    report_uninit(sv);
 	if (lp)
 	*lp = 0;
@@ -3430,7 +3430,7 @@ char *
 Perl_sv_2pvutf8(pTHX_ register SV *sv, STRLEN *lp)
 {
     sv_utf8_upgrade(sv);
-    return SvPV(sv,*lp);
+    return lp ? SvPV(sv,*lp) : SvPV_nolen(sv);
 }
 
 /*
@@ -3445,8 +3445,7 @@ sv_true() or its macro equivalent.
 bool
 Perl_sv_2bool(pTHX_ register SV *sv)
 {
-    if (SvGMAGICAL(sv))
-	mg_get(sv);
+    SvGETMAGIC(sv);
 
     if (!SvOK(sv))
 	return 0;
@@ -4507,7 +4506,7 @@ S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, STRLEN len, SV *after)
 {
     if (len) { /* this SV was SvIsCOW_normal(sv) */
          /* we need to find the SV pointing to us.  */
-        SV *current = SV_COW_NEXT_SV(after);
+        SV * const current = SV_COW_NEXT_SV(after);
 
         if (current == sv) {
             /* The SV we point to points back to us (there were only two of us
@@ -4578,7 +4577,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
             }
             SvFAKE_off(sv);
             SvREADONLY_off(sv);
-            /* This SV doesn't own the buffer, so need to New() a new one:  */
+            /* This SV doesn't own the buffer, so need to Newx() a new one:  */
             SvPV_set(sv, (char*)0);
             SvLEN_set(sv, 0);
             if (flags & SV_COW_DROP_PV) {
@@ -4609,7 +4608,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
 	    SvPV_set(sv, Nullch);
 	    SvLEN_set(sv, 0);
 	    SvGROW(sv, len + 1);
-	    Move(pvx,SvPVX_const(sv),len,char);
+	    Move(pvx,SvPVX(sv),len,char);
 	    *SvEND(sv) = '\0';
 	    unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
 	}
@@ -4668,7 +4667,7 @@ Perl_sv_chop(pTHX_ register SV *sv, register const char *ptr)
 	    const char *pvx = SvPVX_const(sv);
 	    const STRLEN len = SvCUR(sv);
 	    SvGROW(sv, len + 1);
-	    Move(pvx,SvPVX_const(sv),len,char);
+	    Move(pvx,SvPVX(sv),len,char);
 	    *SvEND(sv) = '\0';
 	}
 	SvIV_set(sv, 0);
@@ -4996,7 +4995,7 @@ to add more than one instance of the same 'how'.
 void
 Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 namlen)
 {
-    const MGVTBL *vtable = 0;
+    const MGVTBL *vtable;
     MAGIC* mg;
 
 #ifdef PERL_OLD_COPY_ON_WRITE
@@ -5075,7 +5074,7 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
 	vtable = &PL_vtbl_nkeys;
 	break;
     case PERL_MAGIC_dbfile:
-	vtable = 0;
+	vtable = NULL;
 	break;
     case PERL_MAGIC_dbline:
 	vtable = &PL_vtbl_dbline;
@@ -5114,7 +5113,7 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
     case PERL_MAGIC_rhash:
     case PERL_MAGIC_symtab:
     case PERL_MAGIC_vstring:
-	vtable = 0;
+	vtable = NULL;
 	break;
     case PERL_MAGIC_utf8:
 	vtable = &PL_vtbl_utf8;
@@ -5142,13 +5141,14 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
 	/* Useful for attaching extension internal data to perl vars.	*/
 	/* Note that multiple extensions may clash if magical scalars	*/
 	/* etc holding private data from one are passed to another.	*/
+	vtable = NULL;
 	break;
     default:
 	Perl_croak(aTHX_ "Don't know how to handle magic of type \\%o", how);
     }
 
     /* Rest of work is done else where */
-    mg = sv_magicext(sv,obj,how,(MGVTBL*)vtable,name,namlen);
+    mg = sv_magicext(sv,obj,how,vtable,name,namlen);
 
     switch (how) {
     case PERL_MAGIC_taint:
@@ -5410,8 +5410,10 @@ Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv)
 {
     const U32 refcnt = SvREFCNT(sv);
     SV_CHECK_THINKFIRST_COW_DROP(sv);
-    if (SvREFCNT(nsv) != 1 && ckWARN_d(WARN_INTERNAL))
-	Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Reference miscount in sv_replace()");
+    if (SvREFCNT(nsv) != 1) {
+	Perl_croak(aTHX_ "panic: reference miscount on nsv in sv_replace() (%"
+		   UVuf " != 1)", (UV) SvREFCNT(nsv));
+    }
     if (SvMAGICAL(sv)) {
 	if (SvMAGICAL(nsv))
 	    mg_free(nsv);
@@ -6797,7 +6799,7 @@ thats_really_all_folks:
 
 screamer2:
 	if (rslen) {
-            const register STDCHAR *bpe = buf + sizeof(buf);
+            register const STDCHAR *bpe = buf + sizeof(buf);
 	    bp = buf;
 	    while ((i = PerlIO_getc(fp)) != EOF && (*bp++ = (STDCHAR)i) != rslast && bp < bpe)
 		; /* keep reading */
@@ -6878,8 +6880,7 @@ Perl_sv_inc(pTHX_ register SV *sv)
 
     if (!sv)
 	return;
-    if (SvGMAGICAL(sv))
-	mg_get(sv);
+    SvGETMAGIC(sv);
     if (SvTHINKFIRST(sv)) {
 	if (SvIsCOW(sv))
 	    sv_force_normal_flags(sv, 0);
@@ -7034,8 +7035,7 @@ Perl_sv_dec(pTHX_ register SV *sv)
 
     if (!sv)
 	return;
-    if (SvGMAGICAL(sv))
-	mg_get(sv);
+    SvGETMAGIC(sv);
     if (SvTHINKFIRST(sv)) {
 	if (SvIsCOW(sv))
 	    sv_force_normal_flags(sv, 0);
@@ -7067,7 +7067,7 @@ Perl_sv_dec(pTHX_ register SV *sv)
 	    }
 	    else {
 		(void)SvIOK_only_UV(sv);
-		SvUV_set(sv, SvUVX(sv) + 1);
+		SvUV_set(sv, SvUVX(sv) - 1);
 	    }	
 	} else {
 	    if (SvIVX(sv) == IV_MIN)
@@ -7532,7 +7532,7 @@ Perl_sv_reset(pTHX_ register const char *s, HV *stash)
 	return;
 
     if (!*s) {		/* reset ?? searches */
-	MAGIC *mg = mg_find((SV *)stash, PERL_MAGIC_symtab);
+	MAGIC * const mg = mg_find((SV *)stash, PERL_MAGIC_symtab);
 	if (mg) {
 	    PMOP *pm = (PMOP *) mg->mg_obj;
 	    while (pm) {
@@ -7688,8 +7688,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
 	goto fix_gv;
 
     default:
-	if (SvGMAGICAL(sv))
-	    mg_get(sv);
+	SvGETMAGIC(sv);
 	if (SvROK(sv)) {
 	    SV **sp = &sv;		/* Used in tryAMAGICunDEREF macro. */
 	    tryAMAGICunDEREF(to_cv);
@@ -7752,7 +7751,7 @@ Perl_sv_true(pTHX_ register SV *sv)
     if (!sv)
 	return 0;
     if (SvPOK(sv)) {
-	const register XPV* tXpv;
+	register const XPV* tXpv;
 	if ((tXpv = (XPV*)SvANY(sv)) &&
 		(tXpv->xpv_cur > 1 ||
 		(tXpv->xpv_cur && *sv->sv_u.svu_pv != '0')))
@@ -7940,7 +7939,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags)
 		sv_unref(sv);
 	    SvUPGRADE(sv, SVt_PV);		/* Never FALSE */
 	    SvGROW(sv, len + 1);
-	    Move(s,SvPVX_const(sv),len,char);
+	    Move(s,SvPVX(sv),len,char);
 	    SvCUR_set(sv, len);
 	    *SvEND(sv) = '\0';
 	}
@@ -8122,8 +8121,7 @@ Perl_sv_isobject(pTHX_ SV *sv)
 {
     if (!sv)
 	return 0;
-    if (SvGMAGICAL(sv))
-	mg_get(sv);
+    SvGETMAGIC(sv);
     if (!SvROK(sv))
 	return 0;
     sv = (SV*)SvRV(sv);
@@ -8148,8 +8146,7 @@ Perl_sv_isa(pTHX_ SV *sv, const char *name)
     const char *hvname;
     if (!sv)
 	return 0;
-    if (SvGMAGICAL(sv))
-	mg_get(sv);
+    SvGETMAGIC(sv);
     if (!SvROK(sv))
 	return 0;
     sv = (SV*)SvRV(sv);
@@ -8817,6 +8814,11 @@ Usually used via one of its frontends C<sv_vcatpvf> and C<sv_vcatpvf_mg>.
 =cut
 */
 
+
+#define VECTORIZE_ARGS	vecsv = va_arg(*args, SV*);\
+			vecstr = (U8*)SvPV_const(vecsv,veclen);\
+			vec_utf8 = DO_UTF8(vecsv);
+
 /* XXX maybe_tainted is never assigned to, so the doc above is lying. */
 
 void
@@ -8844,30 +8846,28 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
     /* no matter what, this is a string now */
     (void)SvPV_force(sv, origlen);
 
-    /* special-case "", "%s", and "%-p" (SVf) */
+    /* special-case "", "%s", and "%-p" (SVf - see below) */
     if (patlen == 0)
 	return;
     if (patlen == 2 && pat[0] == '%' && pat[1] == 's') {
-	    if (args) {
-		const char * const s = va_arg(*args, char*);
-		sv_catpv(sv, s ? s : nullstr);
-	    }
-	    else if (svix < svmax) {
-		sv_catsv(sv, *svargs);
-		if (DO_UTF8(*svargs))
-		    SvUTF8_on(sv);
-	    }
-	    return;
+	if (args) {
+	    const char * const s = va_arg(*args, char*);
+	    sv_catpv(sv, s ? s : nullstr);
+	}
+	else if (svix < svmax) {
+	    sv_catsv(sv, *svargs);
+	    if (DO_UTF8(*svargs))
+		SvUTF8_on(sv);
+	}
+	return;
     }
-    if (patlen == 3 && pat[0] == '%' &&
-	pat[1] == '-' && pat[2] == 'p') {
-	    if (args) {
-		argsv = va_arg(*args, SV*);
-		sv_catsv(sv, argsv);
-		if (DO_UTF8(argsv))
-		    SvUTF8_on(sv);
-		return;
-	    }
+    if (args && patlen == 3 && pat[0] == '%' &&
+		pat[1] == '-' && pat[2] == 'p') {
+	argsv = va_arg(*args, SV*);
+	sv_catsv(sv, argsv);
+	if (DO_UTF8(argsv))
+	    SvUTF8_on(sv);
+	return;
     }
 
 #ifndef USE_LONG_DOUBLE
@@ -8989,8 +8989,60 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	\d+|\*(\d+\$)?     width using optional (optionally specified) arg
 	\.(\d*|\*(\d+\$)?) precision using optional (optionally specified) arg
 	[hlqLV]            size
-    [%bcdefginopsux_DFOUX] format (mandatory)
+    [%bcdefginopsuxDFOUX] format (mandatory)
+*/
+
+	if (args) {
+/*  
+	As of perl5.9.3, printf format checking is on by default.
+	Internally, perl uses %p formats to provide an escape to
+	some extended formatting.  This block deals with those
+	extensions: if it does not match, (char*)q is reset and
+	the normal format processing code is used.
+
+	Currently defined extensions are:
+		%p		include pointer address (standard)	
+		%-p	(SVf)	include an SV (previously %_)
+		%-<num>p	include an SV with precision <num>	
+		%1p	(VDf)	include a v-string (as %vd)
+		%<num>p		reserved for future extensions
+
+	Robin Barker 2005-07-14
 */
+ 	    char* r = q; 
+	    bool sv = FALSE;	
+	    STRLEN n = 0;
+	    if (*q == '-')
+		sv = *q++;
+	    EXPECT_NUMBER(q, n);
+	    if (*q++ == 'p') {
+		if (sv) {			/* SVf */
+		    if (n) {
+			precis = n;
+			has_precis = TRUE;
+		    }
+		    argsv = va_arg(*args, SV*);
+		    eptr = SvPVx_const(argsv, elen);
+		    if (DO_UTF8(argsv))
+			is_utf8 = TRUE;
+		    goto string;
+		}
+#if vdNUMBER
+		else if (n == vdNUMBER) {	/* VDf */
+		    vectorize = TRUE;
+		    VECTORIZE_ARGS
+		    goto format_vd;
+	  	}
+#endif
+		else if (n) {
+		    if (ckWARN_d(WARN_INTERNAL))
+			Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
+			"internal %%<num>p might conflict with future printf extensions");
+		}
+	    }
+	    q = r; 
+	}
+
 	if (EXPECT_NUMBER(q, width)) {
 	    if (*q == '$') {
 		++q;
@@ -9051,9 +9103,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	}
 
 	if (!asterisk)
+	{
 	    if( *q == '0' )
 		fill = *q++;
 	    EXPECT_NUMBER(q, width);
+	}
 
 	if (vectorize) {
 	    if (vectorarg) {
@@ -9067,9 +9121,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		    is_utf8 = TRUE;
 	    }
 	    if (args) {
-		vecsv = va_arg(*args, SV*);
-		vecstr = (U8*)SvPV_const(vecsv,veclen);
-		vec_utf8 = DO_UTF8(vecsv);
+		VECTORIZE_ARGS
 	    }
 	    else if (efix ? efix <= svmax : svix < svmax) {
 		vecsv = svargs[efix ? efix-1 : svix++];
@@ -9253,21 +9305,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    /* INTEGERS */
 
 	case 'p':
-	    if (left && args) {		/* SVf */
-		left = FALSE;
-		if (width) {
-		    precis = width;
-		    has_precis = TRUE;
-		    width = 0;
-		}
-		if (vectorize)
-		    goto unknown;
-		argsv = va_arg(*args, SV*);
-		eptr = SvPVx_const(argsv, elen);
-		if (DO_UTF8(argsv))
-		    is_utf8 = TRUE;
-		goto string;
-	    }
 	    if (alt || vectorize)
 		goto unknown;
 	    uv = PTR2UV(args ? va_arg(*args, void*) : argsv);
@@ -9283,6 +9320,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    /* FALL THROUGH */
 	case 'd':
 	case 'i':
+#if vdNUMBER
+	format_vd:
+#endif
 	    if (vectorize) {
 		STRLEN ulen;
 		if (!veclen)
@@ -9691,8 +9731,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 
 	default:
       unknown:
-	    if (!args && ckWARN(WARN_PRINTF) &&
-		  (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)) {
+	    if (!args
+		&& (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)
+		&& ckWARN(WARN_PRINTF))
+	    {
 		SV *msg = sv_newmortal();
 		Perl_sv_setpvf(aTHX_ msg, "Invalid conversion in %sprintf: ",
 			  (PL_op->op_type == OP_PRTF) ? "" : "s");
@@ -10134,27 +10176,27 @@ Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, const void *sv)
 /* add a new entry to a pointer-mapping table */
 
 void
-Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, const void *oldv, void *newv)
+Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, const void *oldsv, void *newsv)
 {
     PTR_TBL_ENT_t *tblent, **otblent;
     /* XXX this may be pessimal on platforms where pointers aren't good
      * hash values e.g. if they grow faster in the most significant
      * bits */
-    const UV hash = PTR_TABLE_HASH(oldv);
+    const UV hash = PTR_TABLE_HASH(oldsv);
     bool empty = 1;
 
     assert(tbl);
     otblent = &tbl->tbl_ary[hash & tbl->tbl_max];
     for (tblent = *otblent; tblent; empty=0, tblent = tblent->next) {
-	if (tblent->oldval == oldv) {
-	    tblent->newval = newv;
+	if (tblent->oldval == oldsv) {
+	    tblent->newval = newsv;
 	    return;
 	}
     }
     new_body_inline(tblent, (void**)&PL_pte_arenaroot, (void**)&PL_pte_root,
 		    sizeof(struct ptr_tbl_ent));
-    tblent->oldval = oldv;
-    tblent->newval = newv;
+    tblent->oldval = oldsv;
+    tblent->newval = newsv;
     tblent->next = *otblent;
     *otblent = tblent;
     tbl->tbl_items++;
@@ -10310,8 +10352,7 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
         if(SvTYPE(sstr) == SVt_PVHV &&
 	   (hvname = HvNAME_get(sstr))) {
 	    /** don't clone stashes if they already exist **/
-	    HV* old_stash = gv_stashpv(hvname,0);
-	    return (SV*) old_stash;
+	    return (SV*)gv_stashpv(hvname,0);
         }
     }
 
@@ -10585,7 +10626,7 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
 			    char);
 			HvARRAY(dstr) = (HE**)darray;
 			while (i <= sxhv->xhv_max) {
-			    HE *source = HvARRAY(sstr)[i];
+			    const HE *source = HvARRAY(sstr)[i];
 			    HvARRAY(dstr)[i] = source
 				? he_dup(source, sharekeys, param) : 0;
 			    ++i;
@@ -11374,6 +11415,10 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     param->stashes      = newAV();  /* Setup array of objects to call clone on */
 
+    /* Set tainting stuff before PerlIO_debug can possibly get called */
+    PL_tainting		= proto_perl->Itainting;
+    PL_taint_warn	= proto_perl->Itaint_warn;
+
 #ifdef PERLIO_LAYERS
     /* Clone PerlIO tables as soon as we can handle general xx_dup() */
     PerlIO_clone(aTHX_ proto_perl, param);
@@ -11418,6 +11463,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_statusvalue	= proto_perl->Istatusvalue;
 #ifdef VMS
     PL_statusvalue_vms	= proto_perl->Istatusvalue_vms;
+#else
+    PL_statusvalue_posix = proto_perl->Istatusvalue_posix;
 #endif
     PL_encoding		= sv_dup(proto_perl->Iencoding, param);
 
@@ -11495,8 +11542,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_fdpid		= av_dup_inc(proto_perl->Ifdpid, param);
 
     /* internal state */
-    PL_tainting		= proto_perl->Itainting;
-    PL_taint_warn       = proto_perl->Itaint_warn;
     PL_maxo		= proto_perl->Imaxo;
     if (proto_perl->Iop_mask)
 	PL_op_mask	= SAVEPVN(proto_perl->Iop_mask, PL_maxo);