X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=74ed663fa3705f5643fd16a3f4ff1c147c63e7ee;hb=624f69f59cd52940ed1e8dbd592bbf1daf38f8e2;hp=26e780e875e48a509cf7f89887ee01b86ee6c19b;hpb=9d4ba2ae61ff15b15f3e889810ff89dfb2ed1738;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index 26e780e..74ed663 100644
--- a/sv.c
+++ b/sv.c
@@ -165,6 +165,27 @@ Public API:
  * "A time to plant, and a time to uproot what was planted..."
  */
 
+/*
+ * nice_chunk and nice_chunk size need to be set
+ * and queried under the protection of sv_mutex
+ */
+void
+Perl_offer_nice_chunk(pTHX_ void *chunk, U32 chunk_size)
+{
+    void *new_chunk;
+    U32 new_chunk_size;
+    LOCK_SV_MUTEX;
+    new_chunk = (void *)(chunk);
+    new_chunk_size = (chunk_size);
+    if (new_chunk_size > PL_nice_chunk_size) {
+	Safefree(PL_nice_chunk);
+	PL_nice_chunk = (char *) new_chunk;
+	PL_nice_chunk_size = new_chunk_size;
+    } else {
+	Safefree(chunk);
+    }
+    UNLOCK_SV_MUTEX;
+}
 
 #ifdef DEBUG_LEAKING_SCALARS
 #  ifdef NETWARE
@@ -209,7 +230,7 @@ S_more_sv(pTHX)
     }
     else {
 	char *chunk;                /* must use New here to match call to */
-	New(704,chunk,PERL_ARENA_SIZE,char);   /* Safefree() in sv_free_arenas()     */
+	Newx(chunk,PERL_ARENA_SIZE,char);   /* Safefree() in sv_free_arenas()     */
 	sv_add_arena(chunk, PERL_ARENA_SIZE, 0);
     }
     uproot_SV(sv);
@@ -441,7 +462,11 @@ static void
 do_clean_named_objs(pTHX_ SV *sv)
 {
     if (SvTYPE(sv) == SVt_PVGV && GvGP(sv)) {
-	if ( SvOBJECT(GvSV(sv)) ||
+	if ((
+#ifdef PERL_DONT_CREATE_GVSV
+	     GvSV(sv) &&
+#endif
+	     SvOBJECT(GvSV(sv))) ||
 	     (GvAV(sv) && SvOBJECT(GvAV(sv))) ||
 	     (GvHV(sv) && SvOBJECT(GvHV(sv))) ||
 	     (GvIO(sv) && SvOBJECT(GvIO(sv))) ||
@@ -568,8 +593,7 @@ Perl_sv_free_arenas(pTHX)
     free_arena(pte);
 #endif
 
-    if (PL_nice_chunk)
-	Safefree(PL_nice_chunk);
+    Safefree(PL_nice_chunk);
     PL_nice_chunk = Nullch;
     PL_nice_chunk_size = 0;
     PL_sv_arenaroot = 0;
@@ -652,7 +676,7 @@ S_find_array_subscript(pTHX_ AV *av, SV* val)
 #define FUV_SUBSCRIPT_WITHIN	4	/* "within @foo"   */
 
 STATIC SV*
-S_varname(pTHX_ GV *gv, const char *gvtype, PADOFFSET targ,
+S_varname(pTHX_ GV *gv, const char gvtype, PADOFFSET targ,
 	SV* keyname, I32 aindex, int subscript_type)
 {
 
@@ -665,15 +689,15 @@ S_varname(pTHX_ GV *gv, const char *gvtype, PADOFFSET targ,
 
 	const char *p;
 	HV * const hv = GvSTASH(gv);
-	sv_setpv(name, gvtype);
 	if (!hv)
 	    p = "???";
 	else if (!(p=HvNAME_get(hv)))
 	    p = "__ANON__";
-	if (strNE(p, "main")) {
-	    sv_catpv(name,p);
-	    sv_catpvn(name,"::", 2);
-	}
+	if (strEQ(p, "main"))
+	    sv_setpvn(name, &gvtype, 1);
+	else
+	    Perl_sv_setpvf(aTHX_ name, "%c%s::", gvtype, p);
+
 	if (GvNAMELEN(gv)>= 1 &&
 	    ((unsigned int)*GvNAME(gv)) <= 26)
 	{ /* handle $^FOO */
@@ -793,21 +817,21 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
 	if (match && subscript_type == FUV_SUBSCRIPT_WITHIN)
 	    break;
 
-	return varname(gv, hash ? "%" : "@", obase->op_targ,
+	return varname(gv, hash ? '%' : '@', obase->op_targ,
 				    keysv, index, subscript_type);
       }
 
     case OP_PADSV:
 	if (match && PAD_SVl(obase->op_targ) != uninit_sv)
 	    break;
-	return varname(Nullgv, "$", obase->op_targ,
+	return varname(Nullgv, '$', obase->op_targ,
 				    Nullsv, 0, FUV_SUBSCRIPT_NONE);
 
     case OP_GVSV:
 	gv = cGVOPx_gv(obase);
 	if (!gv || (match && GvSV(gv) != uninit_sv))
 	    break;
-	return varname(gv, "$", 0, Nullsv, 0, FUV_SUBSCRIPT_NONE);
+	return varname(gv, '$', 0, Nullsv, 0, FUV_SUBSCRIPT_NONE);
 
     case OP_AELEMFAST:
 	if (obase->op_flags & OPf_SPECIAL) { /* lexical array */
@@ -820,7 +844,7 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
 		if (!svp || *svp != uninit_sv)
 		    break;
 	    }
-	    return varname(Nullgv, "$", obase->op_targ,
+	    return varname(Nullgv, '$', obase->op_targ,
 		    Nullsv, (I32)obase->op_private, FUV_SUBSCRIPT_ARRAY);
 	}
 	else {
@@ -836,7 +860,7 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
 		if (!svp || *svp != uninit_sv)
 		    break;
 	    }
-	    return varname(gv, "$", 0,
+	    return varname(gv, '$', 0,
 		    Nullsv, (I32)obase->op_private, FUV_SUBSCRIPT_ARRAY);
 	}
 	break;
@@ -891,10 +915,10 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
 		}
 	    }
 	    if (obase->op_type == OP_HELEM)
-		return varname(gv, "%", o->op_targ,
+		return varname(gv, '%', o->op_targ,
 			    cSVOPx_sv(kid), 0, FUV_SUBSCRIPT_HASH);
 	    else
-		return varname(gv, "@", o->op_targ, Nullsv,
+		return varname(gv, '@', o->op_targ, Nullsv,
 			    SvIV(cSVOPx_sv(kid)), FUV_SUBSCRIPT_ARRAY);
 	    ;
 	}
@@ -904,20 +928,20 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
 	    if (obase->op_type == OP_HELEM) {
 		SV * const keysv = S_find_hash_subscript(aTHX_ (HV*)sv, uninit_sv);
 		if (keysv)
-		    return varname(gv, "%", o->op_targ,
+		    return varname(gv, '%', o->op_targ,
 						keysv, 0, FUV_SUBSCRIPT_HASH);
 	    }
 	    else {
 		const I32 index = S_find_array_subscript(aTHX_ (AV*)sv, uninit_sv);
 		if (index >= 0)
-		    return varname(gv, "@", o->op_targ,
+		    return varname(gv, '@', o->op_targ,
 					Nullsv, index, FUV_SUBSCRIPT_ARRAY);
 	    }
 	    if (match)
 		break;
 	    return varname(gv,
 		(o->op_type == OP_PADAV || o->op_type == OP_RV2AV)
-		? "@" : "%",
+		? '@' : '%',
 		o->op_targ, Nullsv, 0, FUV_SUBSCRIPT_WITHIN);
 	}
 
@@ -939,7 +963,7 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
 		gv = cGVOPx_gv(o);
 		if (match && GvSV(gv) != uninit_sv)
 		    break;
-		return varname(gv, "$", 0,
+		return varname(gv, '$', 0,
 			    Nullsv, 0, FUV_SUBSCRIPT_NONE);
 	    }
 	    /* other possibilities not handled are:
@@ -984,7 +1008,7 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
     case OP_SCHOMP:
     case OP_CHOMP:
 	if (SvROK(PL_rs) && uninit_sv == SvRV(PL_rs))
-	    return sv_2mortal(newSVpv("${$/}", 0));
+	    return sv_2mortal(newSVpvn("${$/}", 5));
 	/* FALL THROUGH */
 
     default:
@@ -1063,7 +1087,7 @@ S_more_bodies (pTHX_ void **arena_root, void **root, size_t size)
     char *start;
     const char *end;
     const size_t count = PERL_ARENA_SIZE/size;
-    New(0, start, count*size, char);
+    Newx(start, count*size, char);
     *((void **) start) = *arena_root;
     *arena_root = (void *)start;
 
@@ -1088,14 +1112,24 @@ S_more_bodies (pTHX_ void **arena_root, void **root, size_t size)
 
 /* grab a new thing from the free list, allocating more if necessary */
 
+/* 1st, the inline version  */
+
+#define new_body_inline(xpv, arena_root, root, size) \
+    STMT_START { \
+	LOCK_SV_MUTEX; \
+	xpv = *((void **)(root)) \
+	  ? *((void **)(root)) : S_more_bodies(aTHX_ arena_root, root, size); \
+	*(root) = *(void**)(xpv); \
+	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;
-    LOCK_SV_MUTEX;
-    xpv = *root ? *root : S_more_bodies(aTHX_ arena_root, root, size);
-    *root = *(void**)xpv;
-    UNLOCK_SV_MUTEX;
+    new_body_inline(xpv, arena_root, root, size);
     return xpv;
 }
 
@@ -1103,9 +1137,10 @@ S_new_body(pTHX_ void **arena_root, void **root, size_t size)
 
 #define del_body(thing, root)			\
     STMT_START {				\
+	void **thing_copy = (void **)thing;	\
 	LOCK_SV_MUTEX;				\
-	*(void **)thing = *root;		\
-	*root = (void*)thing;			\
+	*thing_copy = *root;			\
+	*root = (void*)thing_copy;		\
 	UNLOCK_SV_MUTEX;			\
     } STMT_END
 
@@ -1119,7 +1154,7 @@ S_new_body(pTHX_ void **arena_root, void **root, size_t size)
 	      (void**)&(my_perl->Ixpvbm_root), sizeof(XPVBM), 0)
 */
 
-#define new_body(TYPE,lctype)						\
+#define new_body_type(TYPE,lctype)					\
     S_new_body(aTHX_ (void**)&PL_ ## lctype ## _arenaroot,		\
 		 (void**)&PL_ ## lctype ## _root,			\
 		 sizeof(TYPE))
@@ -1200,7 +1235,7 @@ S_new_body(pTHX_ void **arena_root, void **root, size_t size)
 
 #else /* !PURIFY */
 
-#define new_XNV()	new_body(NV, xnv)
+#define new_XNV()	new_body_type(NV, xnv)
 #define del_XNV(p)	del_body_type(p, NV, xnv)
 
 #define new_XPV()	new_body_allocated(XPV, xpv, xpv_cur)
@@ -1209,10 +1244,10 @@ S_new_body(pTHX_ void **arena_root, void **root, size_t size)
 #define new_XPVIV()	new_body_allocated(XPVIV, xpviv, xpv_cur)
 #define del_XPVIV(p)	del_body_allocated(p, XPVIV, xpviv, xpv_cur)
 
-#define new_XPVNV()	new_body(XPVNV, xpvnv)
+#define new_XPVNV()	new_body_type(XPVNV, xpvnv)
 #define del_XPVNV(p)	del_body_type(p, XPVNV, xpvnv)
 
-#define new_XPVCV()	new_body(XPVCV, xpvcv)
+#define new_XPVCV()	new_body_type(XPVCV, xpvcv)
 #define del_XPVCV(p)	del_body_type(p, XPVCV, xpvcv)
 
 #define new_XPVAV()	new_body_allocated(XPVAV, xpvav, xav_fill)
@@ -1221,16 +1256,16 @@ S_new_body(pTHX_ void **arena_root, void **root, size_t size)
 #define new_XPVHV()	new_body_allocated(XPVHV, xpvhv, xhv_fill)
 #define del_XPVHV(p)	del_body_allocated(p, XPVHV, xpvhv, xhv_fill)
 
-#define new_XPVMG()	new_body(XPVMG, xpvmg)
+#define new_XPVMG()	new_body_type(XPVMG, xpvmg)
 #define del_XPVMG(p)	del_body_type(p, XPVMG, xpvmg)
 
-#define new_XPVGV()	new_body(XPVGV, xpvgv)
+#define new_XPVGV()	new_body_type(XPVGV, xpvgv)
 #define del_XPVGV(p)	del_body_type(p, XPVGV, xpvgv)
 
-#define new_XPVLV()	new_body(XPVLV, xpvlv)
+#define new_XPVLV()	new_body_type(XPVLV, xpvlv)
 #define del_XPVLV(p)	del_body_type(p, XPVLV, xpvlv)
 
-#define new_XPVBM()	new_body(XPVBM, xpvbm)
+#define new_XPVBM()	new_body_type(XPVBM, xpvbm)
 #define del_XPVBM(p)	del_body_type(p, XPVBM, xpvbm)
 
 #endif /* PURIFY */
@@ -1520,8 +1555,8 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 	assert(new_body_length);
 #ifndef PURIFY
 	/* This points to the start of the allocated area.  */
-	new_body = S_new_body(aTHX_ new_body_arenaroot, new_body_arena,
-			      new_body_length);
+	new_body_inline(new_body, new_body_arenaroot, new_body_arena,
+			new_body_length);
 #else
 	/* We always allocated the full length item with PURIFY */
 	new_body_length += new_body_offset;
@@ -1750,21 +1785,9 @@ Like C<sv_setuv>, but also handles 'set' magic.
 void
 Perl_sv_setuv_mg(pTHX_ register SV *sv, UV u)
 {
-    /* With these two if statements:
-       u=1.49  s=0.52  cu=72.49  cs=10.64  scripts=270  tests=20865
-
-       without
-       u=1.35  s=0.47  cu=73.45  cs=11.43  scripts=270  tests=20865
-
-       If you wish to remove them, please benchmark to see what the effect is
-    */
-    if (u <= (UV)IV_MAX) {
-       sv_setiv(sv, (IV)u);
-    } else {
-       sv_setiv(sv, 0);
-       SvIsUV_on(sv);
-       sv_setuv(sv,u);
-    }
+    sv_setiv(sv, 0);
+    SvIsUV_on(sv);
+    sv_setuv(sv,u);
     SvSETMAGIC(sv);
 }
 
@@ -1833,7 +1856,7 @@ S_not_a_number(pTHX_ SV *sv)
      const char *pv;
 
      if (DO_UTF8(sv)) {
-          dsv = sv_2mortal(newSVpv("", 0));
+          dsv = sv_2mortal(newSVpvn("", 0));
           pv = sv_uni_display(dsv, sv, 10, 0);
      } else {
 	  char *d = tmpbuf;
@@ -2090,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;
@@ -2350,7 +2373,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.  */
@@ -2398,7 +2421,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;
@@ -2639,7 +2662,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)
@@ -2673,7 +2696,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));
@@ -2686,7 +2709,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;
@@ -2753,7 +2776,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))
@@ -2835,7 +2858,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.  */
@@ -2933,7 +2956,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;
@@ -3020,7 +3043,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)
@@ -3128,7 +3151,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                                 }
                             }
 
-			    New(616, mg->mg_ptr, mg->mg_len + 1 + left, char);
+			    Newx(mg->mg_ptr, mg->mg_len + 1 + left, char);
 			    Copy("(?", mg->mg_ptr, 2, char);
 			    Copy(reflags, mg->mg_ptr+2, left, char);
 			    Copy(":", mg->mg_ptr+left+2, 1, char);
@@ -3245,8 +3268,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;
@@ -3308,7 +3330,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 	s = SvGROW_mutable(sv, len + 1);
 	SvCUR_set(sv, len);
 	SvPOKp_on(sv);
-	return strcpy(s, t);
+	return memcpy(s, t, len + 1);
     }
 }
 
@@ -3648,7 +3670,7 @@ Perl_sv_utf8_decode(pTHX_ register SV *sv)
 	    return FALSE;
         e = (const U8 *) SvEND(sv);
         while (c < e) {
-	    U8 ch = *c++;
+	    const U8 ch = *c++;
             if (!UTF8_IS_INVARIANT(ch)) {
 		SvUTF8_on(sv);
 		break;
@@ -4483,7 +4505,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
@@ -4542,7 +4564,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
     if (SvREADONLY(sv)) {
         /* At this point I believe I should acquire a global SV mutex.  */
 	if (SvFAKE(sv)) {
-	    const char *pvx = SvPVX_const(sv);
+	    const char * const pvx = SvPVX_const(sv);
 	    const STRLEN len = SvLEN(sv);
 	    const STRLEN cur = SvCUR(sv);
 	    SV * const next = SV_COW_NEXT_SV(sv);   /* next COW sv in the loop. */
@@ -4554,7 +4576,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) {
@@ -4578,7 +4600,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
 #else
     if (SvREADONLY(sv)) {
 	if (SvFAKE(sv)) {
-	    const char *pvx = SvPVX_const(sv);
+	    const char * const pvx = SvPVX_const(sv);
 	    const STRLEN len = SvCUR(sv);
 	    SvFAKE_off(sv);
 	    SvREADONLY_off(sv);
@@ -4893,7 +4915,7 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, const MGVTBL *vtable,
     if (SvTYPE(sv) < SVt_PVMG) {
 	SvUPGRADE(sv, SVt_PVMG);
     }
-    Newz(702,mg, 1, MAGIC);
+    Newxz(mg, 1, MAGIC);
     mg->mg_moremagic = SvMAGIC(sv);
     SvMAGIC_set(sv, mg);
 
@@ -4972,7 +4994,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
@@ -4980,7 +5002,12 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
         sv_force_normal_flags(sv, 0);
 #endif
     if (SvREADONLY(sv)) {
-	if (IN_PERL_RUNTIME
+	if (
+	    /* its okay to attach magic to shared strings; the subsequent
+	     * upgrade to PVMG will unshare the string */
+	    !(SvFAKE(sv) && SvTYPE(sv) < SVt_PVMG)
+
+	    && IN_PERL_RUNTIME
 	    && how != PERL_MAGIC_regex_global
 	    && how != PERL_MAGIC_bm
 	    && how != PERL_MAGIC_fm
@@ -5046,7 +5073,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;
@@ -5085,7 +5112,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;
@@ -5113,13 +5140,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:
@@ -5460,13 +5488,23 @@ void
 Perl_sv_clear(pTHX_ register SV *sv)
 {
     dVAR;
-    HV* stash;
+    void** old_body_arena;
+    size_t old_body_offset;
+    const U32 type = SvTYPE(sv);
+
     assert(sv);
     assert(SvREFCNT(sv) == 0);
 
+    if (type <= SVt_IV)
+	return;
+
+    old_body_arena = 0;
+    old_body_offset = 0;
+
     if (SvOBJECT(sv)) {
 	if (PL_defstash) {		/* Still have a symbol table? */
 	    dSP;
+	    HV* stash;
 	    do {	
 		CV* destructor;
 		stash = SvSTASH(sv);
@@ -5509,18 +5547,17 @@ Perl_sv_clear(pTHX_ register SV *sv)
 	if (SvOBJECT(sv)) {
 	    SvREFCNT_dec(SvSTASH(sv));	/* possibly of changed persuasion */
 	    SvOBJECT_off(sv);	/* Curse the object. */
-	    if (SvTYPE(sv) != SVt_PVIO)
+	    if (type != SVt_PVIO)
 		--PL_sv_objcount;	/* XXX Might want something more general */
 	}
     }
-    if (SvTYPE(sv) >= SVt_PVMG) {
+    if (type >= SVt_PVMG) {
     	if (SvMAGIC(sv))
 	    mg_free(sv);
-	if (SvTYPE(sv) == SVt_PVMG && SvFLAGS(sv) & SVpad_TYPED)
+	if (type == SVt_PVMG && SvFLAGS(sv) & SVpad_TYPED)
 	    SvREFCNT_dec(SvSTASH(sv));
     }
-    stash = NULL;
-    switch (SvTYPE(sv)) {
+    switch (type) {
     case SVt_PVIO:
 	if (IoIFP(sv) &&
 	    IoIFP(sv) != PerlIO_stdin() &&
@@ -5535,18 +5572,26 @@ Perl_sv_clear(pTHX_ register SV *sv)
 	Safefree(IoTOP_NAME(sv));
 	Safefree(IoFMT_NAME(sv));
 	Safefree(IoBOTTOM_NAME(sv));
-	/* FALL THROUGH */
+	/* PVIOs aren't from arenas  */
+	goto freescalar;
     case SVt_PVBM:
+	old_body_arena = (void **) &PL_xpvbm_root;
 	goto freescalar;
     case SVt_PVCV:
+	old_body_arena = (void **) &PL_xpvcv_root;
     case SVt_PVFM:
+	/* PVFMs aren't from arenas  */
 	cv_undef((CV*)sv);
 	goto freescalar;
     case SVt_PVHV:
 	hv_undef((HV*)sv);
+	old_body_arena = (void **) &PL_xpvhv_root;
+	old_body_offset = STRUCT_OFFSET(XPVHV, xhv_fill);
 	break;
     case SVt_PVAV:
 	av_undef((AV*)sv);
+	old_body_arena = (void **) &PL_xpvav_root;
+	old_body_offset = STRUCT_OFFSET(XPVAV, xav_fill);
 	break;
     case SVt_PVLV:
 	if (LvTYPE(sv) == 'T') { /* for tie: return HE to pool */
@@ -5556,28 +5601,38 @@ Perl_sv_clear(pTHX_ register SV *sv)
 	}
 	else if (LvTYPE(sv) != 't') /* unless tie: unrefcnted fake SV**  */
 	    SvREFCNT_dec(LvTARG(sv));
+	old_body_arena = (void **) &PL_xpvlv_root;
 	goto freescalar;
     case SVt_PVGV:
 	gp_free((GV*)sv);
 	Safefree(GvNAME(sv));
-	/* cannot decrease stash refcount yet, as we might recursively delete
-	   ourselves when the refcnt drops to zero. Delay SvREFCNT_dec
-	   of stash until current sv is completely gone.
-	   -- JohnPC, 27 Mar 1998 */
-	stash = GvSTASH(sv);
-	/* FALL THROUGH */
+	/* If we're in a stash, we don't own a reference to it. However it does
+	   have a back reference to us, which needs to be cleared.  */
+	if (GvSTASH(sv))
+	    sv_del_backref((SV*)GvSTASH(sv), sv);
+	old_body_arena = (void **) &PL_xpvgv_root;
+	goto freescalar;
     case SVt_PVMG:
+	old_body_arena = (void **) &PL_xpvmg_root;
+	goto freescalar;
     case SVt_PVNV:
+	old_body_arena = (void **) &PL_xpvnv_root;
+	goto freescalar;
     case SVt_PVIV:
+	old_body_arena = (void **) &PL_xpviv_root;
+	old_body_offset = STRUCT_OFFSET(XPVIV, xpv_cur);
       freescalar:
 	/* Don't bother with SvOOK_off(sv); as we're only going to free it.  */
 	if (SvOOK(sv)) {
 	    SvPV_set(sv, SvPVX_mutable(sv) - SvIVX(sv));
 	    /* Don't even bother with turning off the OOK flag.  */
 	}
-	/* FALL THROUGH */
+	goto pvrv_common;
     case SVt_PV:
+	old_body_arena = (void **) &PL_xpv_root;
+	old_body_offset = STRUCT_OFFSET(XPV, xpv_cur);
     case SVt_RV:
+    pvrv_common:
 	if (SvROK(sv)) {
 	    SV *target = SvRV(sv);
 	    if (SvWEAKREF(sv))
@@ -5611,69 +5666,23 @@ Perl_sv_clear(pTHX_ register SV *sv)
 	}
 #endif
 	break;
-/*
     case SVt_NV:
-    case SVt_IV:
-    case SVt_NULL:
+	old_body_arena = (void **) &PL_xnv_root;
 	break;
-*/
     }
 
-    switch (SvTYPE(sv)) {
-    case SVt_NULL:
-	break;
-    case SVt_IV:
-	break;
-    case SVt_NV:
-	del_XNV(SvANY(sv));
-	break;
-    case SVt_RV:
-	break;
-    case SVt_PV:
-	del_XPV(SvANY(sv));
-	break;
-    case SVt_PVIV:
-	del_XPVIV(SvANY(sv));
-	break;
-    case SVt_PVNV:
-	del_XPVNV(SvANY(sv));
-	break;
-    case SVt_PVMG:
-	del_XPVMG(SvANY(sv));
-	break;
-    case SVt_PVLV:
-	del_XPVLV(SvANY(sv));
-	break;
-    case SVt_PVAV:
-	del_XPVAV(SvANY(sv));
-	break;
-    case SVt_PVHV:
-	del_XPVHV(SvANY(sv));
-	break;
-    case SVt_PVCV:
-	del_XPVCV(SvANY(sv));
-	break;
-    case SVt_PVGV:
-	del_XPVGV(SvANY(sv));
-	/* code duplication for increased performance. */
-	SvFLAGS(sv) &= SVf_BREAK;
-	SvFLAGS(sv) |= SVTYPEMASK;
-	/* decrease refcount of the stash that owns this GV, if any */
-	if (stash)
-	    sv_del_backref((SV*)stash, sv);
-	return; /* not break, SvFLAGS reset already happened */
-    case SVt_PVBM:
-	del_XPVBM(SvANY(sv));
-	break;
-    case SVt_PVFM:
-	del_XPVFM(SvANY(sv));
-	break;
-    case SVt_PVIO:
-	del_XPVIO(SvANY(sv));
-	break;
-    }
     SvFLAGS(sv) &= SVf_BREAK;
     SvFLAGS(sv) |= SVTYPEMASK;
+
+#ifndef PURIFY
+    if (old_body_arena) {
+	del_body(((char *)SvANY(sv) + old_body_offset), old_body_arena);
+    }
+    else
+#endif
+	if (type > SVt_RV) {
+	    my_safefree(SvANY(sv));
+	}
 }
 
 /*
@@ -5858,7 +5867,7 @@ S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i,
 	if ((*mgp)->mg_ptr)
 	    *cachep = (STRLEN *) (*mgp)->mg_ptr;
 	else {
-	    Newz(0, *cachep, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN);
+	    Newxz(*cachep, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN);
 	    (*mgp)->mg_ptr = (char *) *cachep;
 	}
 	assert(*cachep);
@@ -6180,7 +6189,7 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp)
 	    assert(mg);
 
 	    if (!mg->mg_ptr) {
-		Newz(0, cache, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN);
+		Newxz(cache, PERL_MAGIC_UTF8_CACHESIZE * 2, STRLEN);
 		mg->mg_ptr = (char *) cache;
 	    }
 	    assert(cache);
@@ -6779,7 +6788,7 @@ thats_really_all_folks:
        /*The big, slow, and stupid way. */
 #ifdef USE_HEAP_INSTEAD_OF_STACK	/* Even slower way. */
 	STDCHAR *buf = 0;
-	New(0, buf, 8192, STDCHAR);
+	Newx(buf, 8192, STDCHAR);
 	assert(buf);
 #else
 	STDCHAR buf[8192];
@@ -7057,7 +7066,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)
@@ -7075,10 +7084,10 @@ Perl_sv_dec(pTHX_ register SV *sv)
 	return;
     }
     if (!(flags & SVp_POK)) {
-	if ((flags & SVTYPEMASK) < SVt_PVNV)
-	    sv_upgrade(sv, SVt_NV);
-	SvNV_set(sv, 1.0);
-	(void)SvNOK_only(sv);
+	if ((flags & SVTYPEMASK) < SVt_PVIV)
+	    sv_upgrade(sv, ((flags & SVTYPEMASK) > SVt_IV) ? SVt_PVIV : SVt_IV);
+	SvIV_set(sv, -1);
+	(void)SvIOK_only(sv);
 	return;
     }
 #ifdef PERL_PRESERVE_IVUV
@@ -7267,8 +7276,8 @@ Perl_newSVhek(pTHX_ const HEK *hek)
 	       Andreas would like keys he put in as utf8 to come back as utf8
 	    */
 	    STRLEN utf8_len = HEK_LEN(hek);
-	    U8 *as_utf8 = bytes_to_utf8 ((U8*)HEK_KEY(hek), &utf8_len);
-	    SV *sv = newSVpvn ((char*)as_utf8, utf8_len);
+	    const U8 *as_utf8 = bytes_to_utf8 ((U8*)HEK_KEY(hek), &utf8_len);
+	    SV * const sv = newSVpvn ((const char*)as_utf8, utf8_len);
 
 	    SvUTF8_on (sv);
 	    Safefree (as_utf8); /* bytes_to_utf8() allocates a new string */
@@ -7280,7 +7289,7 @@ Perl_newSVhek(pTHX_ const HEK *hek)
 	       that would contain the (wrong) hash value, and might get passed
 	       into an hv routine with a regular hash  */
 
-	    SV *sv = newSVpvn (HEK_KEY(hek), HEK_LEN(hek));
+	    SV * const sv = newSVpvn (HEK_KEY(hek), HEK_LEN(hek));
 	    if (HEK_UTF8(hek))
 		SvUTF8_on (sv);
 	    return sv;
@@ -7522,7 +7531,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) {
@@ -7562,17 +7571,21 @@ Perl_sv_reset(pTHX_ register const char *s, HV *stash)
 		    continue;
 		gv = (GV*)HeVAL(entry);
 		sv = GvSV(gv);
-		if (SvTHINKFIRST(sv)) {
-		    if (!SvREADONLY(sv) && SvROK(sv))
-			sv_unref(sv);
-		    continue;
-		}
-		SvOK_off(sv);
-		if (SvTYPE(sv) >= SVt_PV) {
-		    SvCUR_set(sv, 0);
-		    if (SvPVX_const(sv) != Nullch)
-			*SvPVX(sv) = '\0';
-		    SvTAINT(sv);
+		if (sv) {
+		    if (SvTHINKFIRST(sv)) {
+			if (!SvREADONLY(sv) && SvROK(sv))
+			    sv_unref(sv);
+			/* XXX Is this continue a bug? Why should THINKFIRST
+			   exempt us from resetting arrays and hashes?  */
+			continue;
+		    }
+		    SvOK_off(sv);
+		    if (SvTYPE(sv) >= SVt_PV) {
+			SvCUR_set(sv, 0);
+			if (SvPVX_const(sv) != Nullch)
+			    *SvPVX(sv) = '\0';
+			SvTAINT(sv);
+		    }
 		}
 		if (GvAV(gv)) {
 		    av_clear(GvAV(gv));
@@ -7907,19 +7920,17 @@ Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags)
 	STRLEN len;
  
 	if (SvREADONLY(sv) && !(flags & SV_MUTABLE_RETURN)) {
+	    const char * const ref = sv_reftype(sv,0);
 	    if (PL_op)
 		Perl_croak(aTHX_ "Can't coerce readonly %s to string in %s",
-			   sv_reftype(sv,0), OP_NAME(PL_op));
+			   ref, OP_NAME(PL_op));
 	    else
-		Perl_croak(aTHX_ "Can't coerce readonly %s to string",
-			   sv_reftype(sv,0));
+		Perl_croak(aTHX_ "Can't coerce readonly %s to string", ref);
 	}
-	if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) {
+	if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM)
 	    Perl_croak(aTHX_ "Can't coerce %s to string in %s", sv_reftype(sv,0),
 		OP_NAME(PL_op));
-	}
-	else
-	    s = sv_2pv_flags(sv, &len, flags);
+	s = sv_2pv_flags(sv, &len, flags);
 	if (lp)
 	    *lp = len;
 
@@ -8400,7 +8411,7 @@ See C<SvROK_off>.
 void
 Perl_sv_unref_flags(pTHX_ SV *ref, U32 flags)
 {
-    SV* target = SvRV(ref);
+    SV* const target = SvRV(ref);
 
     if (SvWEAKREF(ref)) {
     	sv_del_backref(target, ref);
@@ -8459,7 +8470,7 @@ void
 Perl_sv_untaint(pTHX_ SV *sv)
 {
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
-	MAGIC *mg = mg_find(sv, PERL_MAGIC_taint);
+	MAGIC * const mg = mg_find(sv, PERL_MAGIC_taint);
 	if (mg)
 	    mg->mg_len &= ~1;
     }
@@ -8497,7 +8508,7 @@ Perl_sv_setpviv(pTHX_ SV *sv, IV iv)
 {
     char buf[TYPE_CHARS(UV)];
     char *ebuf;
-    char *ptr = uiv_2buf(buf, iv, 0, 0, &ebuf);
+    char * const ptr = uiv_2buf(buf, iv, 0, 0, &ebuf);
 
     sv_setpvn(sv, ptr, ebuf - ptr);
 }
@@ -8515,7 +8526,7 @@ Perl_sv_setpviv_mg(pTHX_ SV *sv, IV iv)
 {
     char buf[TYPE_CHARS(UV)];
     char *ebuf;
-    char *ptr = uiv_2buf(buf, iv, 0, 0, &ebuf);
+    char * const ptr = uiv_2buf(buf, iv, 0, 0, &ebuf);
 
     sv_setpvn(sv, ptr, ebuf - ptr);
     SvSETMAGIC(sv);
@@ -8805,6 +8816,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
@@ -8832,7 +8848,7 @@ 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') {
@@ -8847,15 +8863,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, 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
@@ -8977,8 +8991,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;
@@ -9039,9 +9105,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) {
@@ -9055,9 +9123,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++];
@@ -9241,21 +9307,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);
@@ -9271,6 +9322,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)
@@ -9587,7 +9641,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    if (PL_efloatsize < need) {
 		Safefree(PL_efloatbuf);
 		PL_efloatsize = need + 20; /* more fudge */
-		New(906, PL_efloatbuf, PL_efloatsize, char);
+		Newx(PL_efloatbuf, PL_efloatsize, char);
 		PL_efloatbuf[0] = '\0';
 	    }
 
@@ -9679,8 +9733,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");
@@ -9845,15 +9901,15 @@ Perl_re_dup(pTHX_ const REGEXP *r, CLONE_PARAMS *param)
     len = r->offsets[0];
     npar = r->nparens+1;
 
-    Newc(0, ret, sizeof(regexp) + (len+1)*sizeof(regnode), char, regexp);
+    Newxc(ret, sizeof(regexp) + (len+1)*sizeof(regnode), char, regexp);
     Copy(r->program, ret->program, len+1, regnode);
 
-    New(0, ret->startp, npar, I32);
+    Newx(ret->startp, npar, I32);
     Copy(r->startp, ret->startp, npar, I32);
-    New(0, ret->endp, npar, I32);
+    Newx(ret->endp, npar, I32);
     Copy(r->startp, ret->startp, npar, I32);
 
-    New(0, ret->substrs, 1, struct reg_substr_data);
+    Newx(ret->substrs, 1, struct reg_substr_data);
     for (s = ret->substrs->data, i = 0; i < 3; i++, s++) {
 	s->min_offset = r->substrs->data[i].min_offset;
 	s->max_offset = r->substrs->data[i].max_offset;
@@ -9867,9 +9923,9 @@ Perl_re_dup(pTHX_ const REGEXP *r, CLONE_PARAMS *param)
         const int count = r->data->count;
 	int i;
 
-	Newc(0, d, sizeof(struct reg_data) + count*sizeof(void *),
+	Newxc(d, sizeof(struct reg_data) + count*sizeof(void *),
 		char, struct reg_data);
-	New(0, d->what, count, U8);
+	Newx(d->what, count, U8);
 
 	d->count = count;
 	for (i = 0; i < count; i++) {
@@ -9885,7 +9941,7 @@ Perl_re_dup(pTHX_ const REGEXP *r, CLONE_PARAMS *param)
 		break;
 	    case 'f':
 		/* This is cheating. */
-		New(0, d->data[i], 1, struct regnode_charclass_class);
+		Newx(d->data[i], 1, struct regnode_charclass_class);
 		StructCopy(r->data->data[i], d->data[i],
 			    struct regnode_charclass_class);
 		ret->regstclass = (regnode*)d->data[i];
@@ -9916,7 +9972,7 @@ Perl_re_dup(pTHX_ const REGEXP *r, CLONE_PARAMS *param)
     else
 	ret->data = NULL;
 
-    New(0, ret->offsets, 2*len+1, U32);
+    Newx(ret->offsets, 2*len+1, U32);
     Copy(r->offsets, ret->offsets, 2*len+1, U32);
 
     ret->precomp        = SAVEPVN(r->precomp, r->prelen);
@@ -9990,7 +10046,7 @@ Perl_gp_dup(pTHX_ GP *gp, CLONE_PARAMS* param)
 	return ret;
 
     /* create anew and remember what it is */
-    Newz(0, ret, 1, GP);
+    Newxz(ret, 1, GP);
     ptr_table_store(PL_ptr_table, gp, ret);
 
     /* clone */
@@ -10003,7 +10059,6 @@ Perl_gp_dup(pTHX_ GP *gp, CLONE_PARAMS* param)
     ret->gp_egv	= gv_dup(gp->gp_egv, param);/* GvEGV is not refcounted */
     ret->gp_cv		= cv_dup_inc(gp->gp_cv, param);
     ret->gp_cvgen	= gp->gp_cvgen;
-    ret->gp_flags	= gp->gp_flags;
     ret->gp_line	= gp->gp_line;
     ret->gp_file	= gp->gp_file;		/* points to COP.cop_file */
     return ret;
@@ -10025,7 +10080,7 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS* param)
 
     for (; mg; mg = mg->mg_moremagic) {
 	MAGIC *nmg;
-	Newz(0, nmg, 1, MAGIC);
+	Newxz(nmg, 1, MAGIC);
 	if (mgprev)
 	    mgprev->mg_moremagic = nmg;
 	else
@@ -10089,10 +10144,10 @@ PTR_TBL_t *
 Perl_ptr_table_new(pTHX)
 {
     PTR_TBL_t *tbl;
-    Newz(0, tbl, 1, PTR_TBL_t);
+    Newxz(tbl, 1, PTR_TBL_t);
     tbl->tbl_max	= 511;
     tbl->tbl_items	= 0;
-    Newz(0, tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
+    Newxz(tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
     return tbl;
 }
 
@@ -10102,7 +10157,6 @@ Perl_ptr_table_new(pTHX)
 #  define PTR_TABLE_HASH(ptr) (PTR2UV(ptr) >> 2)
 #endif
 
-#define new_pte()	new_body(struct ptr_tbl_ent, pte)
 #define del_pte(p)	del_body_type(p, struct ptr_tbl_ent, pte)
 
 /* map an existing pointer using a table */
@@ -10141,7 +10195,8 @@ Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, const void *oldv, void *newv)
 	    return;
 	}
     }
-    tblent = new_pte();
+    new_body_inline(tblent, (void**)&PL_pte_arenaroot, (void**)&PL_pte_root,
+		    sizeof(struct ptr_tbl_ent));
     tblent->oldval = oldv;
     tblent->newval = newv;
     tblent->next = *otblent;
@@ -10446,10 +10501,9 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
 	    new_body:
 		assert(new_body_length);
 #ifndef PURIFY
-		new_body = (void*)((char*)S_new_body(aTHX_ new_body_arenaroot,
-						     new_body_arena,
-						     new_body_length)
-				   - new_body_offset);
+		new_body_inline(new_body, new_body_arenaroot, new_body_arena,
+				new_body_length);
+		new_body = (void*)((char*)new_body - new_body_offset);
 #else
 		/* We always allocated the full length item with PURIFY */
 		new_body_length += new_body_offset;
@@ -10538,7 +10592,7 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
 		    SSize_t items = AvFILLp((AV*)sstr) + 1;
 
 		    src_ary = AvARRAY((AV*)sstr);
-		    Newz(0, dst_ary, AvMAX((AV*)sstr)+1, SV*);
+		    Newxz(dst_ary, AvMAX((AV*)sstr)+1, SV*);
 		    ptr_table_store(PL_ptr_table, src_ary, dst_ary);
 		    SvPV_set(dstr, (char*)dst_ary);
 		    AvALLOC((AV*)dstr) = dst_ary;
@@ -10570,8 +10624,7 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
 			XPVHV * const dxhv = (XPVHV*)SvANY(dstr);
 			XPVHV * const sxhv = (XPVHV*)SvANY(sstr);
 			char *darray;
-			New(0, darray,
-			    PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1)
+			Newx(darray, PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1)
 			    + (SvOOK(sstr) ? sizeof(struct xpvhv_aux) : 0),
 			    char);
 			HvARRAY(dstr) = (HE**)darray;
@@ -10659,7 +10712,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
 	return ncxs;
 
     /* create anew and remember what it is */
-    Newz(56, ncxs, max + 1, PERL_CONTEXT);
+    Newxz(ncxs, max + 1, PERL_CONTEXT);
     ptr_table_store(PL_ptr_table, cxs, ncxs);
 
     while (ix >= 0) {
@@ -10749,7 +10802,7 @@ Perl_si_dup(pTHX_ PERL_SI *si, CLONE_PARAMS* param)
 	return nsi;
 
     /* create anew and remember what it is */
-    Newz(56, nsi, 1, PERL_SI);
+    Newxz(nsi, 1, PERL_SI);
     ptr_table_store(PL_ptr_table, si, nsi);
 
     nsi->si_stack	= av_dup_inc(si->si_stack, param);
@@ -10833,7 +10886,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
     void (*dptr) (void*);
     void (*dxptr) (pTHX_ void*);
 
-    Newz(54, nss, max, ANY);
+    Newxz(nss, max, ANY);
 
     while (ix > 0) {
 	I32 i = POPINT(ss,ix);
@@ -11365,6 +11418,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);
@@ -11486,8 +11543,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);
@@ -11523,7 +11578,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     /* interpreter atexit processing */
     PL_exitlistlen	= proto_perl->Iexitlistlen;
     if (PL_exitlistlen) {
-	New(0, PL_exitlist, PL_exitlistlen, PerlExitListEntry);
+	Newx(PL_exitlist, PL_exitlistlen, PerlExitListEntry);
 	Copy(proto_perl->Iexitlist, PL_exitlist, PL_exitlistlen, PerlExitListEntry);
     }
     else
@@ -11563,10 +11618,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_origalen		= proto_perl->Iorigalen;
     PL_pidstatus	= newHV();			/* XXX flag for cloning? */
     PL_osname		= SAVEPV(proto_perl->Iosname);
-    PL_sh_path_compat	= proto_perl->Ish_path_compat; /* XXX never deallocated */
     PL_sighandlerp	= proto_perl->Isighandlerp;
 
-
     PL_runops		= proto_perl->Irunops;
 
     Copy(proto_perl->Itokenbuf, PL_tokenbuf, 256, char);
@@ -11742,15 +11795,15 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_bitcount		= Nullch;	/* reinits on demand */
 
     if (proto_perl->Ipsig_pend) {
-	Newz(0, PL_psig_pend, SIG_SIZE, int);
+	Newxz(PL_psig_pend, SIG_SIZE, int);
     }
     else {
 	PL_psig_pend	= (int*)NULL;
     }
 
     if (proto_perl->Ipsig_ptr) {
-	Newz(0, PL_psig_ptr,  SIG_SIZE, SV*);
-	Newz(0, PL_psig_name, SIG_SIZE, SV*);
+	Newxz(PL_psig_ptr,  SIG_SIZE, SV*);
+	Newxz(PL_psig_name, SIG_SIZE, SV*);
 	for (i = 1; i < SIG_SIZE; i++) {
 	    PL_psig_ptr[i]  = sv_dup_inc(proto_perl->Ipsig_ptr[i], param);
 	    PL_psig_name[i] = sv_dup_inc(proto_perl->Ipsig_name[i], param);
@@ -11768,7 +11821,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 	PL_tmps_ix		= proto_perl->Ttmps_ix;
 	PL_tmps_max		= proto_perl->Ttmps_max;
 	PL_tmps_floor		= proto_perl->Ttmps_floor;
-	Newz(50, PL_tmps_stack, PL_tmps_max, SV*);
+	Newxz(PL_tmps_stack, PL_tmps_max, SV*);
 	i = 0;
 	while (i <= PL_tmps_ix) {
 	    PL_tmps_stack[i]	= sv_dup_inc(proto_perl->Ttmps_stack[i], param);
@@ -11777,7 +11830,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
 	/* next PUSHMARK() sets *(PL_markstack_ptr+1) */
 	i = proto_perl->Tmarkstack_max - proto_perl->Tmarkstack;
-	Newz(54, PL_markstack, i, I32);
+	Newxz(PL_markstack, i, I32);
 	PL_markstack_max	= PL_markstack + (proto_perl->Tmarkstack_max
 						  - proto_perl->Tmarkstack);
 	PL_markstack_ptr	= PL_markstack + (proto_perl->Tmarkstack_ptr
@@ -11789,7 +11842,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 	 * NOTE: unlike the others! */
 	PL_scopestack_ix	= proto_perl->Tscopestack_ix;
 	PL_scopestack_max	= proto_perl->Tscopestack_max;
-	Newz(54, PL_scopestack, PL_scopestack_max, I32);
+	Newxz(PL_scopestack, PL_scopestack_max, I32);
 	Copy(proto_perl->Tscopestack, PL_scopestack, PL_scopestack_ix, I32);
 
 	/* NOTE: si_dup() looks at PL_markstack */
@@ -11809,7 +11862,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 	 * NOTE: unlike the others! */
 	PL_savestack_ix		= proto_perl->Tsavestack_ix;
 	PL_savestack_max	= proto_perl->Tsavestack_max;
-	/*Newz(54, PL_savestack, PL_savestack_max, ANY);*/
+	/*Newxz(PL_savestack, PL_savestack_max, ANY);*/
 	PL_savestack		= ss_dup(proto_perl, param);
     }
     else {