X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/954c1994944eafa74aaac1bab94e820b6e447da9..884335e889637310f0c4472f3de03b5fcbc6d983:/sv.c

diff --git a/sv.c b/sv.c
index 834dac3..ab4d6d5 100644
--- a/sv.c
+++ b/sv.c
@@ -1,6 +1,6 @@
 /*    sv.c
  *
- *    Copyright (c) 1991-1999, Larry Wall
+ *    Copyright (c) 1991-2000, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -25,105 +25,6 @@ static void do_clean_named_objs(pTHXo_ SV *sv);
 #endif
 static void do_clean_all(pTHXo_ SV *sv);
 
-
-#ifdef PURIFY
-
-#define new_SV(p) \
-    STMT_START {					\
-	LOCK_SV_MUTEX;					\
-	(p) = (SV*)safemalloc(sizeof(SV));		\
-	reg_add(p);					\
-	UNLOCK_SV_MUTEX;				\
-	SvANY(p) = 0;					\
-	SvREFCNT(p) = 1;				\
-	SvFLAGS(p) = 0;					\
-    } STMT_END
-
-#define del_SV(p) \
-    STMT_START {					\
-	LOCK_SV_MUTEX;					\
-	reg_remove(p);					\
-        Safefree((char*)(p));				\
-	UNLOCK_SV_MUTEX;				\
-    } STMT_END
-
-static SV **registry;
-static I32 registry_size;
-
-#define REGHASH(sv,size)  ((((U32)(sv)) >> 2) % (size))
-
-#define REG_REPLACE(sv,a,b) \
-    STMT_START {					\
-	void* p = sv->sv_any;				\
-	I32 h = REGHASH(sv, registry_size);		\
-	I32 i = h;					\
-	while (registry[i] != (a)) {			\
-	    if (++i >= registry_size)			\
-		i = 0;					\
-	    if (i == h)					\
-		Perl_die(aTHX_ "SV registry bug");			\
-	}						\
-	registry[i] = (b);				\
-    } STMT_END
-
-#define REG_ADD(sv)	REG_REPLACE(sv,Nullsv,sv)
-#define REG_REMOVE(sv)	REG_REPLACE(sv,sv,Nullsv)
-
-STATIC void
-S_reg_add(pTHX_ SV *sv)
-{
-    if (PL_sv_count >= (registry_size >> 1))
-    {
-	SV **oldreg = registry;
-	I32 oldsize = registry_size;
-
-	registry_size = registry_size ? ((registry_size << 2) + 1) : 2037;
-	Newz(707, registry, registry_size, SV*);
-
-	if (oldreg) {
-	    I32 i;
-
-	    for (i = 0; i < oldsize; ++i) {
-		SV* oldsv = oldreg[i];
-		if (oldsv)
-		    REG_ADD(oldsv);
-	    }
-	    Safefree(oldreg);
-	}
-    }
-
-    REG_ADD(sv);
-    ++PL_sv_count;
-}
-
-STATIC void
-S_reg_remove(pTHX_ SV *sv)
-{
-    REG_REMOVE(sv);
-    --PL_sv_count;
-}
-
-STATIC void
-S_visit(pTHX_ SVFUNC_t f)
-{
-    I32 i;
-
-    for (i = 0; i < registry_size; ++i) {
-	SV* sv = registry[i];
-	if (sv && SvTYPE(sv) != SVTYPEMASK)
-	    (*f)(sv);
-    }
-}
-
-void
-Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags)
-{
-    if (!(flags & SVf_FAKE))
-	Safefree(ptr);
-}
-
-#else /* ! PURIFY */
-
 /*
  * "A time to plant, and a time to uproot what was planted..."
  */
@@ -206,7 +107,7 @@ Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags)
     SV* sva = (SV*)ptr;
     register SV* sv;
     register SV* svend;
-    Zero(sva, size, char);
+    Zero(ptr, size, char);
 
     /* The first SV in an arena isn't an SV. */
     SvANY(sva) = (void *) PL_sv_arenaroot;		/* ptr to next arena */
@@ -262,8 +163,6 @@ S_visit(pTHX_ SVFUNC_t f)
     }
 }
 
-#endif /* PURIFY */
-
 void
 Perl_sv_report_used(pTHX)
 {
@@ -295,6 +194,7 @@ Perl_sv_free_arenas(pTHX)
 {
     SV* sva;
     SV* svanext;
+    XPV *arena, *arenanext;
 
     /* Free arenas here, but be careful about fake ones.  (We assume
        contiguity of the fake ones with the corresponding real ones.) */
@@ -308,6 +208,84 @@ Perl_sv_free_arenas(pTHX)
 	    Safefree((void *)sva);
     }
 
+    for (arena = PL_xiv_arenaroot; arena; arena = arenanext) {
+	arenanext = (XPV*)arena->xpv_pv;
+	Safefree(arena);
+    }
+    PL_xiv_arenaroot = 0;
+
+    for (arena = PL_xnv_arenaroot; arena; arena = arenanext) {
+	arenanext = (XPV*)arena->xpv_pv;
+	Safefree(arena);
+    }
+    PL_xnv_arenaroot = 0;
+
+    for (arena = PL_xrv_arenaroot; arena; arena = arenanext) {
+	arenanext = (XPV*)arena->xpv_pv;
+	Safefree(arena);
+    }
+    PL_xrv_arenaroot = 0;
+
+    for (arena = PL_xpv_arenaroot; arena; arena = arenanext) {
+	arenanext = (XPV*)arena->xpv_pv;
+	Safefree(arena);
+    }
+    PL_xpv_arenaroot = 0;
+
+    for (arena = (XPV*)PL_xpviv_arenaroot; arena; arena = arenanext) {
+	arenanext = (XPV*)arena->xpv_pv;
+	Safefree(arena);
+    }
+    PL_xpviv_arenaroot = 0;
+
+    for (arena = (XPV*)PL_xpvnv_arenaroot; arena; arena = arenanext) {
+	arenanext = (XPV*)arena->xpv_pv;
+	Safefree(arena);
+    }
+    PL_xpvnv_arenaroot = 0;
+
+    for (arena = (XPV*)PL_xpvcv_arenaroot; arena; arena = arenanext) {
+	arenanext = (XPV*)arena->xpv_pv;
+	Safefree(arena);
+    }
+    PL_xpvcv_arenaroot = 0;
+
+    for (arena = (XPV*)PL_xpvav_arenaroot; arena; arena = arenanext) {
+	arenanext = (XPV*)arena->xpv_pv;
+	Safefree(arena);
+    }
+    PL_xpvav_arenaroot = 0;
+
+    for (arena = (XPV*)PL_xpvhv_arenaroot; arena; arena = arenanext) {
+	arenanext = (XPV*)arena->xpv_pv;
+	Safefree(arena);
+    }
+    PL_xpvhv_arenaroot = 0;
+
+    for (arena = (XPV*)PL_xpvmg_arenaroot; arena; arena = arenanext) {
+	arenanext = (XPV*)arena->xpv_pv;
+	Safefree(arena);
+    }
+    PL_xpvmg_arenaroot = 0;
+
+    for (arena = (XPV*)PL_xpvlv_arenaroot; arena; arena = arenanext) {
+	arenanext = (XPV*)arena->xpv_pv;
+	Safefree(arena);
+    }
+    PL_xpvlv_arenaroot = 0;
+
+    for (arena = (XPV*)PL_xpvbm_arenaroot; arena; arena = arenanext) {
+	arenanext = (XPV*)arena->xpv_pv;
+	Safefree(arena);
+    }
+    PL_xpvbm_arenaroot = 0;
+
+    for (arena = (XPV*)PL_he_arenaroot; arena; arena = arenanext) {
+	arenanext = (XPV*)arena->xpv_pv;
+	Safefree(arena);
+    }
+    PL_he_arenaroot = 0;
+
     if (PL_nice_chunk)
 	Safefree(PL_nice_chunk);
     PL_nice_chunk = Nullch;
@@ -401,7 +379,12 @@ S_more_xnv(pTHX)
 {
     register NV* xnv;
     register NV* xnvend;
-    New(711, xnv, 1008/sizeof(NV), NV);
+    XPV *ptr;
+    New(711, ptr, 1008/sizeof(XPV), XPV);
+    ptr->xpv_pv = (char*)PL_xnv_arenaroot;
+    PL_xnv_arenaroot = ptr;
+
+    xnv = (NV*) ptr;
     xnvend = &xnv[1008 / sizeof(NV) - 1];
     xnv += (sizeof(XPVIV) - 1) / sizeof(NV) + 1; /* fudge by sizeof XPVIV */
     PL_xnv_root = xnv;
@@ -439,9 +422,15 @@ S_more_xrv(pTHX)
 {
     register XRV* xrv;
     register XRV* xrvend;
-    New(712, PL_xrv_root, 1008/sizeof(XRV), XRV);
-    xrv = PL_xrv_root;
+    XPV *ptr;
+    New(712, ptr, 1008/sizeof(XPV), XPV);
+    ptr->xpv_pv = (char*)PL_xrv_arenaroot;
+    PL_xrv_arenaroot = ptr;
+
+    xrv = (XRV*) ptr;
     xrvend = &xrv[1008 / sizeof(XRV) - 1];
+    xrv += (sizeof(XPV) - 1) / sizeof(XRV) + 1;
+    PL_xrv_root = xrv;
     while (xrv < xrvend) {
 	xrv->xrv_rv = (SV*)(xrv + 1);
 	xrv++;
@@ -476,9 +465,12 @@ S_more_xpv(pTHX)
 {
     register XPV* xpv;
     register XPV* xpvend;
-    New(713, PL_xpv_root, 1008/sizeof(XPV), XPV);
-    xpv = PL_xpv_root;
+    New(713, xpv, 1008/sizeof(XPV), XPV);
+    xpv->xpv_pv = (char*)PL_xpv_arenaroot;
+    PL_xpv_arenaroot = xpv;
+
     xpvend = &xpv[1008 / sizeof(XPV) - 1];
+    PL_xpv_root = ++xpv;
     while (xpv < xpvend) {
 	xpv->xpv_pv = (char*)(xpv + 1);
 	xpv++;
@@ -508,15 +500,17 @@ S_del_xpviv(pTHX_ XPVIV *p)
     UNLOCK_SV_MUTEX;
 }
 
-
 STATIC void
 S_more_xpviv(pTHX)
 {
     register XPVIV* xpviv;
     register XPVIV* xpvivend;
-    New(714, PL_xpviv_root, 1008/sizeof(XPVIV), XPVIV);
-    xpviv = PL_xpviv_root;
+    New(714, xpviv, 1008/sizeof(XPVIV), XPVIV);
+    xpviv->xpv_pv = (char*)PL_xpviv_arenaroot;
+    PL_xpviv_arenaroot = xpviv;
+
     xpvivend = &xpviv[1008 / sizeof(XPVIV) - 1];
+    PL_xpviv_root = ++xpviv;
     while (xpviv < xpvivend) {
 	xpviv->xpv_pv = (char*)(xpviv + 1);
 	xpviv++;
@@ -524,7 +518,6 @@ S_more_xpviv(pTHX)
     xpviv->xpv_pv = 0;
 }
 
-
 STATIC XPVNV*
 S_new_xpvnv(pTHX)
 {
@@ -547,15 +540,17 @@ S_del_xpvnv(pTHX_ XPVNV *p)
     UNLOCK_SV_MUTEX;
 }
 
-
 STATIC void
 S_more_xpvnv(pTHX)
 {
     register XPVNV* xpvnv;
     register XPVNV* xpvnvend;
-    New(715, PL_xpvnv_root, 1008/sizeof(XPVNV), XPVNV);
-    xpvnv = PL_xpvnv_root;
+    New(715, xpvnv, 1008/sizeof(XPVNV), XPVNV);
+    xpvnv->xpv_pv = (char*)PL_xpvnv_arenaroot;
+    PL_xpvnv_arenaroot = xpvnv;
+
     xpvnvend = &xpvnv[1008 / sizeof(XPVNV) - 1];
+    PL_xpvnv_root = ++xpvnv;
     while (xpvnv < xpvnvend) {
 	xpvnv->xpv_pv = (char*)(xpvnv + 1);
 	xpvnv++;
@@ -563,8 +558,6 @@ S_more_xpvnv(pTHX)
     xpvnv->xpv_pv = 0;
 }
 
-
-
 STATIC XPVCV*
 S_new_xpvcv(pTHX)
 {
@@ -587,15 +580,17 @@ S_del_xpvcv(pTHX_ XPVCV *p)
     UNLOCK_SV_MUTEX;
 }
 
-
 STATIC void
 S_more_xpvcv(pTHX)
 {
     register XPVCV* xpvcv;
     register XPVCV* xpvcvend;
-    New(716, PL_xpvcv_root, 1008/sizeof(XPVCV), XPVCV);
-    xpvcv = PL_xpvcv_root;
+    New(716, xpvcv, 1008/sizeof(XPVCV), XPVCV);
+    xpvcv->xpv_pv = (char*)PL_xpvcv_arenaroot;
+    PL_xpvcv_arenaroot = xpvcv;
+
     xpvcvend = &xpvcv[1008 / sizeof(XPVCV) - 1];
+    PL_xpvcv_root = ++xpvcv;
     while (xpvcv < xpvcvend) {
 	xpvcv->xpv_pv = (char*)(xpvcv + 1);
 	xpvcv++;
@@ -603,8 +598,6 @@ S_more_xpvcv(pTHX)
     xpvcv->xpv_pv = 0;
 }
 
-
-
 STATIC XPVAV*
 S_new_xpvav(pTHX)
 {
@@ -627,15 +620,17 @@ S_del_xpvav(pTHX_ XPVAV *p)
     UNLOCK_SV_MUTEX;
 }
 
-
 STATIC void
 S_more_xpvav(pTHX)
 {
     register XPVAV* xpvav;
     register XPVAV* xpvavend;
-    New(717, PL_xpvav_root, 1008/sizeof(XPVAV), XPVAV);
-    xpvav = PL_xpvav_root;
+    New(717, xpvav, 1008/sizeof(XPVAV), XPVAV);
+    xpvav->xav_array = (char*)PL_xpvav_arenaroot;
+    PL_xpvav_arenaroot = xpvav;
+
     xpvavend = &xpvav[1008 / sizeof(XPVAV) - 1];
+    PL_xpvav_root = ++xpvav;
     while (xpvav < xpvavend) {
 	xpvav->xav_array = (char*)(xpvav + 1);
 	xpvav++;
@@ -643,8 +638,6 @@ S_more_xpvav(pTHX)
     xpvav->xav_array = 0;
 }
 
-
-
 STATIC XPVHV*
 S_new_xpvhv(pTHX)
 {
@@ -667,15 +660,17 @@ S_del_xpvhv(pTHX_ XPVHV *p)
     UNLOCK_SV_MUTEX;
 }
 
-
 STATIC void
 S_more_xpvhv(pTHX)
 {
     register XPVHV* xpvhv;
     register XPVHV* xpvhvend;
-    New(718, PL_xpvhv_root, 1008/sizeof(XPVHV), XPVHV);
-    xpvhv = PL_xpvhv_root;
+    New(718, xpvhv, 1008/sizeof(XPVHV), XPVHV);
+    xpvhv->xhv_array = (char*)PL_xpvhv_arenaroot;
+    PL_xpvhv_arenaroot = xpvhv;
+
     xpvhvend = &xpvhv[1008 / sizeof(XPVHV) - 1];
+    PL_xpvhv_root = ++xpvhv;
     while (xpvhv < xpvhvend) {
 	xpvhv->xhv_array = (char*)(xpvhv + 1);
 	xpvhv++;
@@ -683,7 +678,6 @@ S_more_xpvhv(pTHX)
     xpvhv->xhv_array = 0;
 }
 
-
 STATIC XPVMG*
 S_new_xpvmg(pTHX)
 {
@@ -706,15 +700,17 @@ S_del_xpvmg(pTHX_ XPVMG *p)
     UNLOCK_SV_MUTEX;
 }
 
-
 STATIC void
 S_more_xpvmg(pTHX)
 {
     register XPVMG* xpvmg;
     register XPVMG* xpvmgend;
-    New(719, PL_xpvmg_root, 1008/sizeof(XPVMG), XPVMG);
-    xpvmg = PL_xpvmg_root;
+    New(719, xpvmg, 1008/sizeof(XPVMG), XPVMG);
+    xpvmg->xpv_pv = (char*)PL_xpvmg_arenaroot;
+    PL_xpvmg_arenaroot = xpvmg;
+
     xpvmgend = &xpvmg[1008 / sizeof(XPVMG) - 1];
+    PL_xpvmg_root = ++xpvmg;
     while (xpvmg < xpvmgend) {
 	xpvmg->xpv_pv = (char*)(xpvmg + 1);
 	xpvmg++;
@@ -722,8 +718,6 @@ S_more_xpvmg(pTHX)
     xpvmg->xpv_pv = 0;
 }
 
-
-
 STATIC XPVLV*
 S_new_xpvlv(pTHX)
 {
@@ -746,15 +740,17 @@ S_del_xpvlv(pTHX_ XPVLV *p)
     UNLOCK_SV_MUTEX;
 }
 
-
 STATIC void
 S_more_xpvlv(pTHX)
 {
     register XPVLV* xpvlv;
     register XPVLV* xpvlvend;
-    New(720, PL_xpvlv_root, 1008/sizeof(XPVLV), XPVLV);
-    xpvlv = PL_xpvlv_root;
+    New(720, xpvlv, 1008/sizeof(XPVLV), XPVLV);
+    xpvlv->xpv_pv = (char*)PL_xpvlv_arenaroot;
+    PL_xpvlv_arenaroot = xpvlv;
+
     xpvlvend = &xpvlv[1008 / sizeof(XPVLV) - 1];
+    PL_xpvlv_root = ++xpvlv;
     while (xpvlv < xpvlvend) {
 	xpvlv->xpv_pv = (char*)(xpvlv + 1);
 	xpvlv++;
@@ -762,7 +758,6 @@ S_more_xpvlv(pTHX)
     xpvlv->xpv_pv = 0;
 }
 
-
 STATIC XPVBM*
 S_new_xpvbm(pTHX)
 {
@@ -785,15 +780,17 @@ S_del_xpvbm(pTHX_ XPVBM *p)
     UNLOCK_SV_MUTEX;
 }
 
-
 STATIC void
 S_more_xpvbm(pTHX)
 {
     register XPVBM* xpvbm;
     register XPVBM* xpvbmend;
-    New(721, PL_xpvbm_root, 1008/sizeof(XPVBM), XPVBM);
-    xpvbm = PL_xpvbm_root;
+    New(721, xpvbm, 1008/sizeof(XPVBM), XPVBM);
+    xpvbm->xpv_pv = (char*)PL_xpvbm_arenaroot;
+    PL_xpvbm_arenaroot = xpvbm;
+
     xpvbmend = &xpvbm[1008 / sizeof(XPVBM) - 1];
+    PL_xpvbm_root = ++xpvbm;
     while (xpvbm < xpvbmend) {
 	xpvbm->xpv_pv = (char*)(xpvbm + 1);
 	xpvbm++;
@@ -801,125 +798,100 @@ S_more_xpvbm(pTHX)
     xpvbm->xpv_pv = 0;
 }
 
-#ifdef PURIFY
-#define new_XIV() (void*)safemalloc(sizeof(XPVIV))
-#define del_XIV(p) Safefree((char*)p)
+#ifdef LEAKTEST
+#  define my_safemalloc(s)	(void*)safexmalloc(717,s)
+#  define my_safefree(p)	safexfree((char*)p)
 #else
-#define new_XIV() (void*)new_xiv()
-#define del_XIV(p) del_xiv((XPVIV*) p)
+#  define my_safemalloc(s)	(void*)safemalloc(s)
+#  define my_safefree(p)	safefree((char*)p)
 #endif
 
 #ifdef PURIFY
-#define new_XNV() (void*)safemalloc(sizeof(XPVNV))
-#define del_XNV(p) Safefree((char*)p)
-#else
-#define new_XNV() (void*)new_xnv()
-#define del_XNV(p) del_xnv((XPVNV*) p)
-#endif
 
-#ifdef PURIFY
-#define new_XRV() (void*)safemalloc(sizeof(XRV))
-#define del_XRV(p) Safefree((char*)p)
-#else
-#define new_XRV() (void*)new_xrv()
-#define del_XRV(p) del_xrv((XRV*) p)
-#endif
+#define new_XIV()	my_safemalloc(sizeof(XPVIV))
+#define del_XIV(p)	my_safefree(p)
 
-#ifdef PURIFY
-#define new_XPV() (void*)safemalloc(sizeof(XPV))
-#define del_XPV(p) Safefree((char*)p)
-#else
-#define new_XPV() (void*)new_xpv()
-#define del_XPV(p) del_xpv((XPV *)p)
-#endif
+#define new_XNV()	my_safemalloc(sizeof(XPVNV))
+#define del_XNV(p)	my_safefree(p)
 
-#ifdef PURIFY
-#  define my_safemalloc(s) safemalloc(s)
-#  define my_safefree(s) safefree(s)
-#else
-STATIC void* 
-S_my_safemalloc(MEM_SIZE size)
-{
-    char *p;
-    New(717, p, size, char);
-    return (void*)p;
-}
-#  define my_safefree(s) Safefree(s)
-#endif 
+#define new_XRV()	my_safemalloc(sizeof(XRV))
+#define del_XRV(p)	my_safefree(p)
 
-#ifdef PURIFY
-#define new_XPVIV() (void*)safemalloc(sizeof(XPVIV))
-#define del_XPVIV(p) Safefree((char*)p)
-#else
-#define new_XPVIV() (void*)new_xpviv()
-#define del_XPVIV(p) del_xpviv((XPVIV *)p)
-#endif
-  
-#ifdef PURIFY
-#define new_XPVNV() (void*)safemalloc(sizeof(XPVNV))
-#define del_XPVNV(p) Safefree((char*)p)
-#else
-#define new_XPVNV() (void*)new_xpvnv()
-#define del_XPVNV(p) del_xpvnv((XPVNV *)p)
-#endif
+#define new_XPV()	my_safemalloc(sizeof(XPV))
+#define del_XPV(p)	my_safefree(p)
 
+#define new_XPVIV()	my_safemalloc(sizeof(XPVIV))
+#define del_XPVIV(p)	my_safefree(p)
 
-#ifdef PURIFY
-#define new_XPVCV() (void*)safemalloc(sizeof(XPVCV))
-#define del_XPVCV(p) Safefree((char*)p)
-#else
-#define new_XPVCV() (void*)new_xpvcv()
-#define del_XPVCV(p) del_xpvcv((XPVCV *)p)
-#endif
+#define new_XPVNV()	my_safemalloc(sizeof(XPVNV))
+#define del_XPVNV(p)	my_safefree(p)
 
-#ifdef PURIFY
-#define new_XPVAV() (void*)safemalloc(sizeof(XPVAV))
-#define del_XPVAV(p) Safefree((char*)p)
-#else
-#define new_XPVAV() (void*)new_xpvav()
-#define del_XPVAV(p) del_xpvav((XPVAV *)p)
-#endif
+#define new_XPVCV()	my_safemalloc(sizeof(XPVCV))
+#define del_XPVCV(p)	my_safefree(p)
 
-#ifdef PURIFY
-#define new_XPVHV() (void*)safemalloc(sizeof(XPVHV))
-#define del_XPVHV(p) Safefree((char*)p)
-#else
-#define new_XPVHV() (void*)new_xpvhv()
-#define del_XPVHV(p) del_xpvhv((XPVHV *)p)
-#endif
-  
-#ifdef PURIFY
-#define new_XPVMG() (void*)safemalloc(sizeof(XPVMG))
-#define del_XPVMG(p) Safefree((char*)p)
-#else
-#define new_XPVMG() (void*)new_xpvmg()
-#define del_XPVMG(p) del_xpvmg((XPVMG *)p)
-#endif
-  
-#ifdef PURIFY
-#define new_XPVLV() (void*)safemalloc(sizeof(XPVLV))
-#define del_XPVLV(p) Safefree((char*)p)
-#else
-#define new_XPVLV() (void*)new_xpvlv()
-#define del_XPVLV(p) del_xpvlv((XPVLV *)p)
-#endif
-  
-#define new_XPVGV() (void*)my_safemalloc(sizeof(XPVGV))
-#define del_XPVGV(p) my_safefree((char*)p)
+#define new_XPVAV()	my_safemalloc(sizeof(XPVAV))
+#define del_XPVAV(p)	my_safefree(p)
+
+#define new_XPVHV()	my_safemalloc(sizeof(XPVHV))
+#define del_XPVHV(p)	my_safefree(p)
   
-#ifdef PURIFY
-#define new_XPVBM() (void*)safemalloc(sizeof(XPVBM))
-#define del_XPVBM(p) Safefree((char*)p)
-#else
-#define new_XPVBM() (void*)new_xpvbm()
-#define del_XPVBM(p) del_xpvbm((XPVBM *)p)
-#endif
+#define new_XPVMG()	my_safemalloc(sizeof(XPVMG))
+#define del_XPVMG(p)	my_safefree(p)
+
+#define new_XPVLV()	my_safemalloc(sizeof(XPVLV))
+#define del_XPVLV(p)	my_safefree(p)
+
+#define new_XPVBM()	my_safemalloc(sizeof(XPVBM))
+#define del_XPVBM(p)	my_safefree(p)
+
+#else /* !PURIFY */
+
+#define new_XIV()	(void*)new_xiv()
+#define del_XIV(p)	del_xiv((XPVIV*) p)
+
+#define new_XNV()	(void*)new_xnv()
+#define del_XNV(p)	del_xnv((XPVNV*) p)
+
+#define new_XRV()	(void*)new_xrv()
+#define del_XRV(p)	del_xrv((XRV*) p)
+
+#define new_XPV()	(void*)new_xpv()
+#define del_XPV(p)	del_xpv((XPV *)p)
+
+#define new_XPVIV()	(void*)new_xpviv()
+#define del_XPVIV(p)	del_xpviv((XPVIV *)p)
+
+#define new_XPVNV()	(void*)new_xpvnv()
+#define del_XPVNV(p)	del_xpvnv((XPVNV *)p)
+
+#define new_XPVCV()	(void*)new_xpvcv()
+#define del_XPVCV(p)	del_xpvcv((XPVCV *)p)
+
+#define new_XPVAV()	(void*)new_xpvav()
+#define del_XPVAV(p)	del_xpvav((XPVAV *)p)
+
+#define new_XPVHV()	(void*)new_xpvhv()
+#define del_XPVHV(p)	del_xpvhv((XPVHV *)p)
   
-#define new_XPVFM() (void*)my_safemalloc(sizeof(XPVFM))
-#define del_XPVFM(p) my_safefree((char*)p)
+#define new_XPVMG()	(void*)new_xpvmg()
+#define del_XPVMG(p)	del_xpvmg((XPVMG *)p)
+
+#define new_XPVLV()	(void*)new_xpvlv()
+#define del_XPVLV(p)	del_xpvlv((XPVLV *)p)
+
+#define new_XPVBM()	(void*)new_xpvbm()
+#define del_XPVBM(p)	del_xpvbm((XPVBM *)p)
+
+#endif /* PURIFY */
+
+#define new_XPVGV()	my_safemalloc(sizeof(XPVGV))
+#define del_XPVGV(p)	my_safefree(p)
+ 
+#define new_XPVFM()	my_safemalloc(sizeof(XPVFM))
+#define del_XPVFM(p)	my_safefree(p)
   
-#define new_XPVIO() (void*)my_safemalloc(sizeof(XPVIO))
-#define del_XPVIO(p) my_safefree((char*)p)
+#define new_XPVIO()	my_safemalloc(sizeof(XPVIO))
+#define del_XPVIO(p)	my_safefree(p)
 
 /*
 =for apidoc sv_upgrade
@@ -1261,7 +1233,7 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
 	s = SvPVX(sv);
     if (newlen > SvLEN(sv)) {		/* need more room? */
 	if (SvLEN(sv) && s) {
-#if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST)
+#if defined(MYMALLOC) && !defined(LEAKTEST)
 	    STRLEN l = malloced_size((void*)SvPVX(sv));
 	    if (newlen <= l) {
 		SvLEN_set(sv, l);
@@ -1485,6 +1457,7 @@ S_not_a_number(pTHX_ SV *sv)
 #define IS_NUMBER_TO_INT_BY_ATOF 0x02 /* atol() may be != atof() */
 #define IS_NUMBER_NOT_IV	 0x04 /* (IV)atof() may be != atof() */
 #define IS_NUMBER_NEG		 0x08 /* not good to cache UV */
+#define IS_NUMBER_INFINITY	 0x10 /* this is big */
 
 /* Actually, ISO C leaves conversion of UV to IV undefined, but
    until proven guilty, assume that things are not that bad... */
@@ -1596,22 +1569,13 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 		goto ret_iv_max;
 	    }
 	}
-	else if (numtype) {
-	    /* The NV may be reconstructed from IV - safe to cache IV,
-	       which may be calculated by atol(). */
-	    if (SvTYPE(sv) == SVt_PV)
-		sv_upgrade(sv, SVt_PVIV);
-	    (void)SvIOK_on(sv);
-	    SvIVX(sv) = Atol(SvPVX(sv));
-	}
-	else {				/* Not a number.  Cache 0. */
-	    dTHR;
-
+	else {	/* The NV may be reconstructed from IV - safe to cache IV,
+		   which may be calculated by atol(). */
 	    if (SvTYPE(sv) < SVt_PVIV)
 		sv_upgrade(sv, SVt_PVIV);
-	    SvIVX(sv) = 0;
 	    (void)SvIOK_on(sv);
-	    if (ckWARN(WARN_NUMERIC))
+	    SvIVX(sv) = Atol(SvPVX(sv));
+	    if (! numtype && ckWARN(WARN_NUMERIC))
 		not_a_number(sv);
 	}
     }
@@ -1763,10 +1727,10 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 
 	    if (SvTYPE(sv) < SVt_PVIV)
 		sv_upgrade(sv, SVt_PVIV);
-	    SvUVX(sv) = 0;		/* We assume that 0s have the
-					   same bitmap in IV and UV. */
 	    (void)SvIOK_on(sv);
 	    (void)SvIsUV_on(sv);
+	    SvUVX(sv) = 0;		/* We assume that 0s have the
+					   same bitmap in IV and UV. */
 	    if (ckWARN(WARN_NUMERIC))
 		not_a_number(sv);
 	}
@@ -1939,6 +1903,7 @@ S_asUV(pTHX_ SV *sv)
  * IS_NUMBER_TO_INT_BY_ATOL				123
  * IS_NUMBER_TO_INT_BY_ATOL | IS_NUMBER_NOT_IV		123.1
  * IS_NUMBER_TO_INT_BY_ATOF | IS_NUMBER_NOT_IV		123e0
+ * IS_NUMBER_INFINITY
  * with a possible addition of IS_NUMBER_NEG.
  */
 
@@ -1959,6 +1924,7 @@ Perl_looks_like_number(pTHX_ SV *sv)
     register char *sbegin;
     register char *nbegin;
     I32 numtype = 0;
+    I32 sawinf  = 0;
     STRLEN len;
 
     if (SvPOK(sv)) {
@@ -1988,7 +1954,7 @@ Perl_looks_like_number(pTHX_ SV *sv)
      * (int)atof().
      */
 
-    /* next must be digit or the radix separator */
+    /* next must be digit or the radix separator or beginning of infinity */
     if (isDIGIT(*s)) {
         do {
 	    s++;
@@ -2026,23 +1992,38 @@ Perl_looks_like_number(pTHX_ SV *sv)
         else
 	    return 0;
     }
+    else if (*s == 'I' || *s == 'i') {
+	s++; if (*s != 'N' && *s != 'n') return 0;
+	s++; if (*s != 'F' && *s != 'f') return 0;
+	s++; if (*s == 'I' || *s == 'i') {
+	    s++; if (*s != 'N' && *s != 'n') return 0;
+	    s++; if (*s != 'I' && *s != 'i') return 0;
+	    s++; if (*s != 'T' && *s != 't') return 0;
+	    s++; if (*s != 'Y' && *s != 'y') return 0;
+	}
+	sawinf = 1;
+    }
     else
         return 0;
 
-    /* we can have an optional exponent part */
-    if (*s == 'e' || *s == 'E') {
-	numtype &= ~IS_NUMBER_NEG;
-	numtype |= IS_NUMBER_TO_INT_BY_ATOF | IS_NUMBER_NOT_IV;
-	s++;
-	if (*s == '+' || *s == '-')
+    if (sawinf)
+	numtype = IS_NUMBER_INFINITY;
+    else {
+	/* we can have an optional exponent part */
+	if (*s == 'e' || *s == 'E') {
+	    numtype &= ~IS_NUMBER_NEG;
+	    numtype |= IS_NUMBER_TO_INT_BY_ATOF | IS_NUMBER_NOT_IV;
 	    s++;
-        if (isDIGIT(*s)) {
-            do {
-                s++;
-            } while (isDIGIT(*s));
-        }
-        else
-            return 0;
+	    if (*s == '+' || *s == '-')
+		s++;
+	    if (isDIGIT(*s)) {
+		do {
+		    s++;
+		} while (isDIGIT(*s));
+	    }
+	    else
+		return 0;
+	}
     }
     while (isSPACE(*s))
 	s++;
@@ -2064,11 +2045,9 @@ Perl_sv_2pv_nolen(pTHX_ register SV *sv)
 static char *
 uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob)
 {
-    STRLEN len;
     char *ptr = buf + TYPE_CHARS(UV);
     char *ebuf = ptr;
     int sign;
-    char *p;
 
     if (is_uv)
 	sign = 0;
@@ -2159,7 +2138,7 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 			    int right = 4;
  			    U16 reganch = (re->reganch & PMf_COMPILETIME) >> 12;
 
- 			    while(ch = *fptr++) {
+ 			    while((ch = *fptr++)) {
  				if(reganch & 1) {
  				    reflags[left++] = ch;
  				}
@@ -2194,7 +2173,10 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 		case SVt_PV:
 		case SVt_PVIV:
 		case SVt_PVNV:
-		case SVt_PVBM:	s = "SCALAR";			break;
+		case SVt_PVBM:	if (SvROK(sv))
+				    s = "REF";
+				else
+				    s = "SCALAR";		break;
 		case SVt_PVLV:	s = "LVALUE";			break;
 		case SVt_PVAV:	s = "ARRAY";			break;
 		case SVt_PVHV:	s = "HASH";			break;
@@ -2340,7 +2322,8 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 char *
 Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv)
 {
-    return sv_2pv_nolen(sv);
+    STRLEN n_a;
+    return sv_2pvbyte(sv, &n_a);
 }
 
 char *
@@ -2352,12 +2335,14 @@ Perl_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
 char *
 Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv)
 {
-    return sv_2pv_nolen(sv);
+    STRLEN n_a;
+    return sv_2pvutf8(sv, &n_a);
 }
 
 char *
 Perl_sv_2pvutf8(pTHX_ register SV *sv, STRLEN *lp)
 {
+    sv_utf8_upgrade(sv);
     return sv_2pv(sv,lp);
 }
  
@@ -2399,6 +2384,167 @@ Perl_sv_2bool(pTHX_ register SV *sv)
     }
 }
 
+/*
+=for apidoc sv_utf8_upgrade
+
+Convert the PV of an SV to its UTF8-encoded form.
+
+=cut
+*/
+
+void
+Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
+{
+    int hicount;
+    char *c;
+
+    if (!sv || !SvPOK(sv) || SvUTF8(sv))
+	return;
+
+    /* This function could be much more efficient if we had a FLAG
+     * to signal if there are any hibit chars in the string
+     */
+    hicount = 0;
+    for (c = SvPVX(sv); c < SvEND(sv); c++) {
+	if (*c & 0x80)
+	    hicount++;
+    }
+
+    if (hicount) {
+	char *src, *dst;
+	SvGROW(sv, SvCUR(sv) + hicount + 1);
+
+	src = SvEND(sv) - 1;
+	SvCUR_set(sv, SvCUR(sv) + hicount);
+	dst = SvEND(sv) - 1;
+
+	while (src < dst) {
+	    if (*src & 0x80) {
+		dst--;
+		uv_to_utf8((U8*)dst, (U8)*src--);
+		dst--;
+	    }
+	    else {
+		*dst-- = *src--;
+	    }
+	}
+
+	SvUTF8_on(sv);
+    }
+}
+
+/*
+=for apidoc sv_utf8_downgrade
+
+Attempt to convert the PV of an SV from UTF8-encoded to byte encoding.
+This may not be possible if the PV contains non-byte encoding characters;
+if this is the case, either returns false or, if C<fail_ok> is not
+true, croaks.
+
+=cut
+*/
+
+bool
+Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok)
+{
+    if (SvPOK(sv) && SvUTF8(sv)) {
+        char *c = SvPVX(sv);
+        char *first_hi = 0;
+        /* need to figure out if this is possible at all first */
+        while (c < SvEND(sv)) {
+            if (*c & 0x80) {
+                I32 len;
+                UV uv = utf8_to_uv((U8*)c, &len);
+                if (uv >= 256) {
+		    if (fail_ok)
+			return FALSE;
+		    else {
+			/* XXX might want to make a callback here instead */
+			Perl_croak(aTHX_ "Big byte");
+		    }
+		}
+                if (!first_hi)
+                    first_hi = c;
+                c += len;
+            }
+            else {
+                c++;
+            }
+        }
+
+        if (first_hi) {
+            char *src = first_hi;
+            char *dst = first_hi;
+            while (src < SvEND(sv)) {
+                if (*src & 0x80) {
+                    I32 len;
+                    U8 u = (U8)utf8_to_uv((U8*)src, &len);
+                    *dst++ = u;
+                    src += len;
+                }
+                else {
+                    *dst++ = *src++;
+                }
+            }
+            SvCUR_set(sv, dst - SvPVX(sv));
+        }
+        SvUTF8_off(sv);
+    }
+    return TRUE;
+}
+
+/*
+=for apidoc sv_utf8_encode
+
+Convert the PV of an SV to UTF8-encoded, but then turn off the C<SvUTF8>
+flag so that it looks like bytes again. Nothing calls this. 
+
+=cut
+*/
+
+void
+Perl_sv_utf8_encode(pTHX_ register SV *sv)
+{
+    sv_utf8_upgrade(sv);
+    SvUTF8_off(sv);
+}
+
+bool
+Perl_sv_utf8_decode(pTHX_ register SV *sv)
+{
+    if (SvPOK(sv)) {
+        char *c;
+        bool has_utf = FALSE;
+        if (!sv_utf8_downgrade(sv, TRUE))
+	    return FALSE;
+
+        /* it is actually just a matter of turning the utf8 flag on, but
+         * we want to make sure everything inside is valid utf8 first.
+         */
+        c = SvPVX(sv);
+        while (c < SvEND(sv)) {
+            if (*c & 0x80) {
+                I32 len;
+                (void)utf8_to_uv((U8*)c, &len);
+                if (len == 1) {
+                    /* bad utf8 */
+                    return FALSE;
+                }
+                c += len;
+                has_utf = TRUE;
+            }
+            else {
+                c++;
+            }
+        }
+
+        if (has_utf)
+            SvUTF8_on(sv);
+    }
+    return TRUE;
+}
+
+
 /* Note: sv_setsv() should not be called with a source string that needs
  * to be reused, since it may destroy the source string if it is marked
  * as temporary.
@@ -2535,7 +2681,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 		char *name = GvNAME(sstr);
 		STRLEN len = GvNAMELEN(sstr);
 		sv_upgrade(dstr, SVt_PVGV);
-		sv_magic(dstr, dstr, '*', name, len);
+		sv_magic(dstr, dstr, '*', Nullch, 0);
 		GvSTASH(dstr) = (HV*)SvREFCNT_inc(GvSTASH(sstr));
 		GvNAME(dstr) = savepvn(name, len);
 		GvNAMELEN(dstr) = len;
@@ -2603,7 +2749,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 		    else
 			dref = (SV*)GvAV(dstr);
 		    GvAV(dstr) = (AV*)sref;
-		    if (GvIMPORTED_AV_off(dstr)
+		    if (!GvIMPORTED_AV(dstr)
 			&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
 		    {
 			GvIMPORTED_AV_on(dstr);
@@ -2615,7 +2761,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 		    else
 			dref = (SV*)GvHV(dstr);
 		    GvHV(dstr) = (HV*)sref;
-		    if (GvIMPORTED_HV_off(dstr)
+		    if (!GvIMPORTED_HV(dstr)
 			&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
 		    {
 			GvIMPORTED_HV_on(dstr);
@@ -2644,7 +2790,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 				if(const_sv)
 				    const_changed = sv_cmp(const_sv, 
 					   op_const_sv(CvSTART((CV*)sref), 
-						       Nullcv));
+						       (CV*)sref));
 				/* ahem, death to those who redefine
 				 * active sort subs */
 				if (PL_curstackinfo->si_type == PERLSI_SORT &&
@@ -2652,16 +2798,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 				    Perl_croak(aTHX_ 
 				    "Can't redefine active sort subroutine %s",
 					  GvENAME((GV*)dstr));
-				if (ckWARN(WARN_REDEFINE) || (const_changed && const_sv)) {
-				    if (!(CvGV(cv) && GvSTASH(CvGV(cv))
-					  && HvNAME(GvSTASH(CvGV(cv)))
-					  && strEQ(HvNAME(GvSTASH(CvGV(cv))),
-						   "autouse")))
-					Perl_warner(aTHX_ WARN_REDEFINE, const_sv ? 
+				if ((const_changed && const_sv) || ckWARN(WARN_REDEFINE))
+				    Perl_warner(aTHX_ WARN_REDEFINE, const_sv ? 
 					     "Constant subroutine %s redefined"
 					     : "Subroutine %s redefined", 
 					     GvENAME((GV*)dstr));
-				}
 			    }
 			    cv_ckproto(cv, (GV*)dstr,
 				       SvPOK(sref) ? SvPVX(sref) : Nullch);
@@ -2671,7 +2812,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 			GvASSUMECV_on(dstr);
 			PL_sub_generation++;
 		    }
-		    if (GvIMPORTED_CV_off(dstr)
+		    if (!GvIMPORTED_CV(dstr)
 			&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
 		    {
 			GvIMPORTED_CV_on(dstr);
@@ -2684,13 +2825,20 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 			dref = (SV*)GvIOp(dstr);
 		    GvIOp(dstr) = (IO*)sref;
 		    break;
+		case SVt_PVFM:
+		    if (intro)
+			SAVESPTR(GvFORM(dstr));
+		    else
+			dref = (SV*)GvFORM(dstr);
+		    GvFORM(dstr) = (CV*)sref;
+		    break;
 		default:
 		    if (intro)
 			SAVESPTR(GvSV(dstr));
 		    else
 			dref = (SV*)GvSV(dstr);
 		    GvSV(dstr) = sref;
-		    if (GvIMPORTED_SV_off(dstr)
+		    if (!GvIMPORTED_SV(dstr)
 			&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
 		    {
 			GvIMPORTED_SV_on(dstr);
@@ -2721,7 +2869,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	if (sflags & SVp_IOK) {
 	    (void)SvIOK_on(dstr);
 	    SvIVX(dstr) = SvIVX(sstr);
-	    if (SvIsUV(sstr))
+	    if (sflags & SVf_IVisUV)
 		SvIsUV_on(dstr);
 	}
 	if (SvAMAGIC(sstr)) {
@@ -2753,8 +2901,9 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	    SvPV_set(dstr, SvPVX(sstr));
 	    SvLEN_set(dstr, SvLEN(sstr));
 	    SvCUR_set(dstr, SvCUR(sstr));
+
 	    SvTEMP_off(dstr);
-	    (void)SvOK_off(sstr);
+	    (void)SvOK_off(sstr);		/* NOTE: nukes most SvFLAGS on sstr */
 	    SvPV_set(sstr, Nullch);
 	    SvLEN_set(sstr, 0);
 	    SvCUR_set(sstr, 0);
@@ -2769,7 +2918,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	    *SvEND(dstr) = '\0';
 	    (void)SvPOK_only(dstr);
 	}
-	if (SvUTF8(sstr))
+	if ((sflags & SVf_UTF8) && !IN_BYTE)
 	    SvUTF8_on(dstr);
 	/*SUPPRESS 560*/
 	if (sflags & SVp_NOK) {
@@ -2779,31 +2928,31 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	if (sflags & SVp_IOK) {
 	    (void)SvIOK_on(dstr);
 	    SvIVX(dstr) = SvIVX(sstr);
-	    if (SvIsUV(sstr))
+	    if (sflags & SVf_IVisUV)
 		SvIsUV_on(dstr);
 	}
     }
     else if (sflags & SVp_NOK) {
 	SvNVX(dstr) = SvNVX(sstr);
 	(void)SvNOK_only(dstr);
-	if (SvIOK(sstr)) {
+	if (sflags & SVf_IOK) {
 	    (void)SvIOK_on(dstr);
 	    SvIVX(dstr) = SvIVX(sstr);
 	    /* XXXX Do we want to set IsUV for IV(ROK)?  Be extra safe... */
-	    if (SvIsUV(sstr))
+	    if (sflags & SVf_IVisUV)
 		SvIsUV_on(dstr);
 	}
     }
     else if (sflags & SVp_IOK) {
 	(void)SvIOK_only(dstr);
 	SvIVX(dstr) = SvIVX(sstr);
-	if (SvIsUV(sstr))
+	if (sflags & SVf_IVisUV)
 	    SvIsUV_on(dstr);
     }
     else {
 	if (dtype == SVt_PVGV) {
-	    if (ckWARN(WARN_UNSAFE))
-		Perl_warner(aTHX_ WARN_UNSAFE, "Undefined value assigned to typeglob");
+	    if (ckWARN(WARN_MISC))
+		Perl_warner(aTHX_ WARN_MISC, "Undefined value assigned to typeglob");
 	}
 	else
 	    (void)SvOK_off(dstr);
@@ -3046,7 +3195,7 @@ Perl_sv_catpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN
     Move(ptr,SvPVX(sv)+tlen,len,char);
     SvCUR(sv) += len;
     *SvEND(sv) = '\0';
-    (void)SvPOK_only(sv);		/* validate pointer */
+    (void)SvPOK_only_UTF8(sv);		/* validate pointer */
     SvTAINT(sv);
 }
 
@@ -3081,8 +3230,15 @@ Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
     STRLEN len;
     if (!sstr)
 	return;
-    if (s = SvPV(sstr, len))
-	sv_catpvn(dstr,s,len);
+    if ((s = SvPV(sstr, len))) {
+	if (DO_UTF8(sstr)) {
+	    sv_utf8_upgrade(dstr);
+	    sv_catpvn(dstr,s,len);
+	    SvUTF8_on(dstr);
+	}
+	else
+	    sv_catpvn(dstr,s,len);
+    }
 }
 
 /*
@@ -3125,7 +3281,7 @@ Perl_sv_catpv(pTHX_ register SV *sv, register const char *ptr)
 	ptr = SvPVX(sv);
     Move(ptr,SvPVX(sv)+tlen,len+1,char);
     SvCUR(sv) += len;
-    (void)SvPOK_only(sv);		/* validate pointer */
+    (void)SvPOK_only_UTF8(sv);		/* validate pointer */
     SvTAINT(sv);
 }
 
@@ -3324,6 +3480,14 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
 	SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
 }
 
+/*
+=for apidoc sv_unmagic
+
+Removes magic from an SV.
+
+=cut
+*/
+
 int
 Perl_sv_unmagic(pTHX_ SV *sv, int type)
 {
@@ -3358,6 +3522,14 @@ Perl_sv_unmagic(pTHX_ SV *sv, int type)
     return 0;
 }
 
+/*
+=for apidoc sv_rvweaken
+
+Weaken a reference.
+
+=cut
+*/
+
 SV *
 Perl_sv_rvweaken(pTHX_ SV *sv)
 {
@@ -3438,6 +3610,7 @@ Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN
     if (!bigstr)
 	Perl_croak(aTHX_ "Can't modify non-existent substring");
     SvPV_force(bigstr, curlen);
+    (void)SvPOK_only_UTF8(bigstr);
     if (offset + len > curlen) {
 	SvGROW(bigstr, offset+len+1);
 	Zero(SvPVX(bigstr)+curlen, offset+len-curlen, char);
@@ -3487,7 +3660,7 @@ Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN
 	SvCUR_set(bigstr, mid - big);
     }
     /*SUPPRESS 560*/
-    else if (i = mid - big) {	/* faster from front */
+    else if ((i = mid - big)) {	/* faster from front */
 	midend -= littlelen;
 	mid = midend;
 	sv_chop(bigstr,midend-i);
@@ -3508,7 +3681,13 @@ Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN
     SvSETMAGIC(bigstr);
 }
 
-/* make sv point to what nstr did */
+/*
+=for apidoc sv_replace
+
+Make the first argument a copy of the second, then delete the original.
+
+=cut
+*/
 
 void
 Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv)
@@ -3537,6 +3716,15 @@ Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv)
     del_SV(nsv);
 }
 
+/*
+=for apidoc sv_clear
+
+Clear an SV, making it empty. Does not free the memory used by the SV
+itself.
+
+=cut
+*/
+
 void
 Perl_sv_clear(pTHX_ register SV *sv)
 {
@@ -3730,6 +3918,14 @@ Perl_sv_newref(pTHX_ SV *sv)
     return sv;
 }
 
+/*
+=for apidoc sv_free
+
+Free the memory used by an SV.
+
+=cut
+*/
+
 void
 Perl_sv_free(pTHX_ SV *sv)
 {
@@ -3798,6 +3994,15 @@ Perl_sv_len(pTHX_ register SV *sv)
     return len;
 }
 
+/*
+=for apidoc sv_len_utf8
+
+Returns the number of characters in the string in an SV, counting wide
+UTF8 bytes as a single character.
+
+=cut
+*/
+
 STRLEN
 Perl_sv_len_utf8(pTHX_ register SV *sv)
 {
@@ -3893,29 +4098,51 @@ identical.
 */
 
 I32
-Perl_sv_eq(pTHX_ register SV *str1, register SV *str2)
+Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
 {
     char *pv1;
     STRLEN cur1;
     char *pv2;
     STRLEN cur2;
+    I32  eq     = 0;
+    bool pv1tmp = FALSE;
+    bool pv2tmp = FALSE;
 
-    if (!str1) {
+    if (!sv1) {
 	pv1 = "";
 	cur1 = 0;
     }
     else
-	pv1 = SvPV(str1, cur1);
+	pv1 = SvPV(sv1, cur1);
 
-    if (!str2)
-	return !cur1;
+    if (!sv2){
+	pv2 = "";
+	cur2 = 0;
+    }
     else
-	pv2 = SvPV(str2, cur2);
+	pv2 = SvPV(sv2, cur2);
 
-    if (cur1 != cur2)
-	return 0;
+    /* do not utf8ize the comparands as a side-effect */
+    if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTE && 0) {
+	if (SvUTF8(sv1)) {
+	    pv2 = (char*)bytes_to_utf8((U8*)pv2, &cur2);
+	    pv2tmp = TRUE;
+	}
+	else {
+	    pv1 = (char*)bytes_to_utf8((U8*)pv1, &cur1);
+	    pv1tmp = TRUE;
+	}
+    }
+
+    if (cur1 == cur2)
+	eq = memEQ(pv1, pv2, cur1);
+	
+    if (pv1tmp)
+	Safefree(pv1);
+    if (pv2tmp)
+	Safefree(pv2);
 
-    return memEQ(pv1, pv2, cur1);
+    return eq;
 }
 
 /*
@@ -3929,31 +4156,73 @@ C<sv2>.
 */
 
 I32
-Perl_sv_cmp(pTHX_ register SV *str1, register SV *str2)
+Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
 {
-    STRLEN cur1 = 0;
-    char *pv1 = str1 ? SvPV(str1, cur1) : (char *) NULL;
-    STRLEN cur2 = 0;
-    char *pv2 = str2 ? SvPV(str2, cur2) : (char *) NULL;
-    I32 retval;
+    STRLEN cur1, cur2;
+    char *pv1, *pv2;
+    I32  cmp; 
+    bool pv1tmp = FALSE;
+    bool pv2tmp = FALSE;
 
-    if (!cur1)
-	return cur2 ? -1 : 0;
+    if (!sv1) {
+	pv1 = "";
+	cur1 = 0;
+    }
+    else
+	pv1 = SvPV(sv1, cur1);
 
-    if (!cur2)
-	return 1;
+    if (!sv2){
+	pv2 = "";
+	cur2 = 0;
+    }
+    else
+	pv2 = SvPV(sv2, cur2);
 
-    retval = memcmp((void*)pv1, (void*)pv2, cur1 < cur2 ? cur1 : cur2);
+    /* do not utf8ize the comparands as a side-effect */
+    if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTE) {
+	if (SvUTF8(sv1)) {
+	    pv2 = (char*)bytes_to_utf8((U8*)pv2, &cur2);
+	    pv2tmp = TRUE;
+	}
+	else {
+	    pv1 = (char*)bytes_to_utf8((U8*)pv1, &cur1);
+	    pv1tmp = TRUE;
+	}
+    }
 
-    if (retval)
-	return retval < 0 ? -1 : 1;
+    if (!cur1) {
+	cmp = cur2 ? -1 : 0;
+    } else if (!cur2) {
+	cmp = 1;
+    } else {
+	I32 retval = memcmp((void*)pv1, (void*)pv2, cur1 < cur2 ? cur1 : cur2);
 
-    if (cur1 == cur2)
-	return 0;
-    else
-	return cur1 < cur2 ? -1 : 1;
+	if (retval) {
+	    cmp = retval < 0 ? -1 : 1;
+	} else if (cur1 == cur2) {
+	    cmp = 0;
+        } else {
+	    cmp = cur1 < cur2 ? -1 : 1;
+	}
+    }
+
+    if (pv1tmp)
+	Safefree(pv1);
+    if (pv2tmp)
+	Safefree(pv2);
+
+    return cmp;
 }
 
+/*
+=for apidoc sv_cmp_locale
+
+Compares the strings in two SVs in a locale-aware manner. See
+L</sv_cmp_locale>
+
+=cut
+*/
+
 I32
 Perl_sv_cmp_locale(pTHX_ register SV *sv1, register SV *sv2)
 {
@@ -4055,6 +4324,15 @@ Perl_sv_collxfrm(pTHX_ SV *sv, STRLEN *nxp)
 
 #endif /* USE_LOCALE_COLLATE */
 
+/*
+=for apidoc sv_gets
+
+Get a line from the filehandle and store it into the SV, optionally
+appending to the currently-stored string.
+
+=cut
+*/
+
 char *
 Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
 {
@@ -4700,6 +4978,25 @@ Perl_newSViv(pTHX_ IV i)
 }
 
 /*
+=for apidoc newSVuv
+
+Creates a new SV and copies an unsigned integer into it.
+The reference count for the SV is set to 1.
+
+=cut
+*/
+
+SV *
+Perl_newSVuv(pTHX_ UV u)
+{
+    register SV *sv;
+
+    new_SV(sv);
+    sv_setuv(sv,u);
+    return sv;
+}
+
+/*
 =for apidoc newRV_noinc
 
 Creates an RV wrapper for an SV.  The reference count for the original
@@ -4942,6 +5239,14 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
     }
 }
 
+/*
+=for apidoc sv_true
+
+Returns true if the SV has a true value by Perl's rules.
+
+=cut
+*/
+
 I32
 Perl_sv_true(pTHX_ register SV *sv)
 {
@@ -5020,6 +5325,14 @@ Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp)
     return sv_2pv(sv, lp);
 }
 
+/*
+=for apidoc sv_pvn_force
+
+Get a sensible string out of the SV somehow.
+
+=cut
+*/
+
 char *
 Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
 {
@@ -5081,21 +5394,41 @@ Perl_sv_pvbyten_force(pTHX_ SV *sv, STRLEN *lp)
 char *
 Perl_sv_pvutf8(pTHX_ SV *sv)
 {
+    sv_utf8_upgrade(sv);
     return sv_pv(sv);
 }
 
 char *
 Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp)
 {
+    sv_utf8_upgrade(sv);
     return sv_pvn(sv,lp);
 }
 
+/*
+=for apidoc sv_pvutf8n_force
+
+Get a sensible UTF8-encoded string out of the SV somehow. See
+L</sv_pvn_force>.
+
+=cut
+*/
+
 char *
 Perl_sv_pvutf8n_force(pTHX_ SV *sv, STRLEN *lp)
 {
+    sv_utf8_upgrade(sv);
     return sv_pvn_force(sv,lp);
 }
 
+/*
+=for apidoc sv_reftype
+
+Returns a string describing what the SV is a reference to.
+
+=cut
+*/
+
 char *
 Perl_sv_reftype(pTHX_ SV *sv, int ob)
 {
@@ -5122,6 +5455,7 @@ Perl_sv_reftype(pTHX_ SV *sv, int ob)
 	case SVt_PVCV:		return "CODE";
 	case SVt_PVGV:		return "GLOB";
 	case SVt_PVFM:		return "FORMAT";
+	case SVt_PVIO:		return "IO";
 	default:		return "UNKNOWN";
 	}
     }
@@ -5348,6 +5682,8 @@ Perl_sv_bless(pTHX_ SV *sv, HV *stash)
 STATIC void
 S_sv_unglob(pTHX_ SV *sv)
 {
+    void *xpvmg;
+
     assert(SvTYPE(sv) == SVt_PVGV);
     SvFAKE_off(sv);
     if (GvGP(sv))
@@ -5359,6 +5695,13 @@ S_sv_unglob(pTHX_ SV *sv)
     sv_unmagic(sv, '*');
     Safefree(GvNAME(sv));
     GvMULTI_off(sv);
+
+    /* need to keep SvANY(sv) in the right arena */
+    xpvmg = new_XPVMG();
+    StructCopy(SvANY(sv), xpvmg, XPVMG);
+    del_XPVGV(SvANY(sv));
+    SvANY(sv) = xpvmg;
+
     SvFLAGS(sv) &= ~SVTYPEMASK;
     SvFLAGS(sv) |= SVt_PVMG;
 }
@@ -5413,7 +5756,7 @@ Perl_sv_tainted(pTHX_ SV *sv)
 {
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
 	MAGIC *mg = mg_find(sv, 't');
-	if (mg && ((mg->mg_len & 1) || (mg->mg_len & 2) && mg->mg_obj == sv))
+	if (mg && ((mg->mg_len & 1) || ((mg->mg_len & 2) && mg->mg_obj == sv)))
 	    return TRUE;
     }
     return FALSE;
@@ -5638,6 +5981,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
     STRLEN origlen;
     I32 svix = 0;
     static char nullstr[] = "(null)";
+    SV *argsv;
 
     /* no matter what, this is a string now */
     (void)SvPV_force(sv, origlen);
@@ -5652,12 +5996,18 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		char *s = va_arg(*args, char*);
 		sv_catpv(sv, s ? s : nullstr);
 	    }
-	    else if (svix < svmax)
+	    else if (svix < svmax) {
 		sv_catsv(sv, *svargs);
+		if (DO_UTF8(*svargs))
+		    SvUTF8_on(sv);
+	    }
 	    return;
 	case '_':
 	    if (args) {
-		sv_catsv(sv, va_arg(*args, SV*));
+		argsv = va_arg(*args, SV*);
+		sv_catsv(sv, argsv);
+		if (DO_UTF8(argsv))
+		    SvUTF8_on(sv);
 		return;
 	    }
 	    /* See comment on '_' below */
@@ -5669,6 +6019,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
     for (p = (char*)pat; p < patend; p = q) {
 	bool alt = FALSE;
 	bool left = FALSE;
+	bool vectorize = FALSE;
+	bool utf = FALSE;
 	char fill = ' ';
 	char plus = 0;
 	char intsize = 0;
@@ -5676,9 +6028,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	STRLEN zeros = 0;
 	bool has_precis = FALSE;
 	STRLEN precis = 0;
+	bool is_utf = FALSE;
 
 	char esignbuf[4];
-	U8 utf8buf[10];
+	U8 utf8buf[UTF8_MAXLEN];
 	STRLEN esignlen = 0;
 
 	char *eptr = Nullch;
@@ -5689,6 +6042,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	char ebuf[IV_DIG * 4 + NV_DIG + 32];
         /* large enough for "%#.#f" --chip */
 	/* what about long double NVs? --jhi */
+
+	SV *vecsv;
+	U8 *vecstr = Null(U8*);
+	STRLEN veclen = 0;
 	char c;
 	int i;
 	unsigned base;
@@ -5698,6 +6055,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	STRLEN have;
 	STRLEN need;
 	STRLEN gap;
+	char *dotstr = ".";
+	STRLEN dotstrlen = 1;
 
 	for (q = p; q < patend && *q != '%'; ++q) ;
 	if (q > p) {
@@ -5730,6 +6089,26 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		q++;
 		continue;
 
+	    case '*':			/* printf("%*vX",":",$ipv6addr) */
+		if (q[1] != 'v')
+		    break;
+		q++;
+		if (args)
+		    vecsv = va_arg(*args, SV*);
+		else if (svix < svmax)
+		    vecsv = svargs[svix++];
+		else
+		    continue;
+		dotstr = SvPVx(vecsv,dotstrlen);
+		if (DO_UTF8(vecsv))
+		    is_utf = TRUE;
+		/* FALL THROUGH */
+
+	    case 'v':
+		vectorize = TRUE;
+		q++;
+		continue;
+
 	    default:
 		break;
 	    }
@@ -5778,6 +6157,23 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    has_precis = TRUE;
 	}
 
+	if (vectorize) {
+	    if (args) {
+		vecsv = va_arg(*args, SV*);
+		vecstr = (U8*)SvPVx(vecsv,veclen);
+		utf = DO_UTF8(vecsv);
+	    }
+	    else if (svix < svmax) {
+		vecsv = svargs[svix++];
+		vecstr = (U8*)SvPVx(vecsv,veclen);
+		utf = DO_UTF8(vecsv);
+	    }
+	    else {
+		vecstr = (U8*)"";
+		veclen = 0;
+	    }
+	}
+
 	/* SIZE */
 
 	switch (*q) {
@@ -5816,22 +6212,20 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    goto string;
 
 	case 'c':
-	    if (IN_UTF8) {
-		if (args)
-		    uv = va_arg(*args, int);
-		else
-		    uv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
-
+	    if (args)
+		uv = va_arg(*args, int);
+	    else
+		uv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
+	    if ((uv > 255 || (uv > 127 && SvUTF8(sv))) && !IN_BYTE) {
 		eptr = (char*)utf8buf;
 		elen = uv_to_utf8((U8*)eptr, uv) - utf8buf;
-		goto string;
+		is_utf = TRUE;
+	    }
+	    else {
+		c = (char)uv;
+		eptr = &c;
+		elen = 1;
 	    }
-	    if (args)
-		c = va_arg(*args, int);
-	    else
-		c = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
-	    eptr = &c;
-	    elen = 1;
 	    goto string;
 
 	case 's':
@@ -5851,16 +6245,18 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		}
 	    }
 	    else if (svix < svmax) {
-		eptr = SvPVx(svargs[svix++], elen);
-		if (IN_UTF8) {
+		argsv = svargs[svix++];
+		eptr = SvPVx(argsv, elen);
+		if (DO_UTF8(argsv)) {
 		    if (has_precis && precis < elen) {
 			I32 p = precis;
-			sv_pos_u2b(svargs[svix - 1], &p, 0); /* sticks at end */
+			sv_pos_u2b(argsv, &p, 0); /* sticks at end */
 			precis = p;
 		    }
 		    if (width) { /* fudge width (can't fudge elen) */
-			width += elen - sv_len_utf8(svargs[svix - 1]);
+			width += elen - sv_len_utf8(argsv);
 		    }
+		    is_utf = TRUE;
 		}
 	    }
 	    goto string;
@@ -5873,9 +6269,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	     */
 	    if (!args)
 		goto unknown;
-	    eptr = SvPVx(va_arg(*args, SV*), elen);
+	    argsv = va_arg(*args,SV*);
+	    eptr = SvPVx(argsv, elen);
+	    if (DO_UTF8(argsv))
+		is_utf = TRUE;
 
 	string:
+	    vectorize = FALSE;
 	    if (has_precis && elen > precis)
 		elen = precis;
 	    break;
@@ -5883,6 +6283,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    /* INTEGERS */
 
 	case 'p':
+	    if (alt)
+		goto unknown;
 	    if (args)
 		uv = PTR2UV(va_arg(*args, void*));
 	    else
@@ -5899,7 +6301,22 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    /* FALL THROUGH */
 	case 'd':
 	case 'i':
-	    if (args) {
+	    if (vectorize) {
+		I32 ulen;
+		if (!veclen) {
+		    vectorize = FALSE;
+		    break;
+		}
+		if (utf)
+		    iv = (IV)utf8_to_uv(vecstr, &ulen);
+		else {
+		    iv = *vecstr;
+		    ulen = 1;
+		}
+		vecstr += ulen;
+		veclen -= ulen;
+	    }
+	    else if (args) {
 		switch (intsize) {
 		case 'h':	iv = (short)va_arg(*args, int); break;
 		default:	iv = va_arg(*args, int); break;
@@ -5914,7 +6331,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		iv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
 		switch (intsize) {
 		case 'h':	iv = (short)iv; break;
-		default:	iv = (int)iv; break;
+		default:	break;
 		case 'l':	iv = (long)iv; break;
 		case 'V':	break;
 #ifdef HAS_QUAD
@@ -5965,7 +6382,23 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    base = 16;
 
 	uns_integer:
-	    if (args) {
+	    if (vectorize) {
+		I32 ulen;
+	vector:
+		if (!veclen) {
+		    vectorize = FALSE;
+		    break;
+		}
+		if (utf)
+		    uv = utf8_to_uv(vecstr, &ulen);
+		else {
+		    uv = *vecstr;
+		    ulen = 1;
+		}
+		vecstr += ulen;
+		veclen -= ulen;
+	    }
+	    else if (args) {
 		switch (intsize) {
 		case 'h':  uv = (unsigned short)va_arg(*args, unsigned); break;
 		default:   uv = va_arg(*args, unsigned); break;
@@ -5980,7 +6413,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		uv = (svix < svmax) ? SvUVx(svargs[svix++]) : 0;
 		switch (intsize) {
 		case 'h':	uv = (unsigned short)uv; break;
-		default:	uv = (unsigned)uv; break;
+		default:	break;
 		case 'l':	uv = (unsigned long)uv; break;
 		case 'V':	break;
 #ifdef HAS_QUAD
@@ -6027,13 +6460,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		break;
 	    default:		/* it had better be ten or less */
 #if defined(PERL_Y2KWARN)
-		if (ckWARN(WARN_MISC)) {
+		if (ckWARN(WARN_Y2K)) {
 		    STRLEN n;
 		    char *s = SvPV(sv,n);
 		    if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
 			&& (n == 2 || !isDIGIT(s[n-3])))
 		    {
-			Perl_warner(aTHX_ WARN_MISC,
+			Perl_warner(aTHX_ WARN_Y2K,
 				    "Possible Y2K bug: %%%c %s",
 				    c, "format string following '19'");
 		    }
@@ -6065,6 +6498,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 
 	    /* This is evil, but floating point is even more evil */
 
+	    vectorize = FALSE;
 	    if (args)
 		nv = va_arg(*args, NV);
 	    else
@@ -6073,7 +6507,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    need = 0;
 	    if (c != 'e' && c != 'E') {
 		i = PERL_INT_MIN;
-		(void)frexp(nv, &i);
+		(void)Perl_frexp(nv, &i);
 		if (i == PERL_INT_MIN)
 		    Perl_die(aTHX_ "panic: frexp");
 		if (i > 0)
@@ -6096,8 +6530,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    *--eptr = c;
 #ifdef USE_LONG_DOUBLE
 	    {
-		char* p = PERL_PRIfldbl + sizeof(PERL_PRIfldbl) - 3;
-		while (p >= PERL_PRIfldbl) { *--eptr = *p--; }
+		static char const my_prifldbl[] = PERL_PRIfldbl;
+		char const *p = my_prifldbl + sizeof my_prifldbl - 3;
+		while (p >= my_prifldbl) { *--eptr = *p--; }
 	    }
 #endif
 	    if (has_precis) {
@@ -6132,6 +6567,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    /* SPECIAL */
 
 	case 'n':
+	    vectorize = FALSE;
 	    i = SvCUR(sv) - origlen;
 	    if (args) {
 		switch (intsize) {
@@ -6145,13 +6581,14 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		}
 	    }
 	    else if (svix < svmax)
-		sv_setuv(svargs[svix++], (UV)i);
+		sv_setuv_mg(svargs[svix++], (UV)i);
 	    continue;	/* not "break" */
 
 	    /* UNKNOWN */
 
 	default:
       unknown:
+	    vectorize = FALSE;
 	    if (!args && ckWARN(WARN_PRINTF) &&
 		  (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)) {
 		SV *msg = sv_newmortal();
@@ -6190,7 +6627,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	need = (have > width ? have : width);
 	gap = need - have;
 
-	SvGROW(sv, SvCUR(sv) + need + 1);
+	SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1);
 	p = SvEND(sv);
 	if (esignlen && fill == '0') {
 	    for (i = 0; i < esignlen; i++)
@@ -6216,8 +6653,22 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    memset(p, ' ', gap);
 	    p += gap;
 	}
+	if (vectorize) {
+	    if (veclen) {
+		memcpy(p, dotstr, dotstrlen);
+		p += dotstrlen;
+	    }
+	    else
+		vectorize = FALSE;		/* done iterating over vecstr */
+	}
+	if (is_utf)
+	    SvUTF8_on(sv);
 	*p = '\0';
 	SvCUR(sv) = p - SvPVX(sv);
+	if (vectorize) {
+	    esignlen = 0;
+	    goto vector;
+	}
     }
 }
 
@@ -6227,10 +6678,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 #  include "error: USE_THREADS and USE_ITHREADS are incompatible"
 #endif
 
-#ifndef OpREFCNT_inc
-#  define OpREFCNT_inc(o)	((o) ? (++(o)->op_targ, (o)) : Nullop)
-#endif
-
 #ifndef GpREFCNT_inc
 #  define GpREFCNT_inc(gp)	((gp) ? (++(gp)->gp_refcnt, (gp)) : (GP*)NULL)
 #endif
@@ -6383,7 +6830,7 @@ void *
 Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *sv)
 {
     PTR_TBL_ENT_t *tblent;
-    UV hash = (UV)sv;
+    UV hash = PTR2UV(sv);
     assert(tbl);
     tblent = tbl->tbl_ary[hash & tbl->tbl_max];
     for (; tblent; tblent = tblent->next) {
@@ -6400,7 +6847,7 @@ Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldv, void *newv)
     /* 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 */
-    UV hash = (UV)oldv;
+    UV hash = PTR2UV(oldv);
     bool i = 1;
 
     assert(tbl);
@@ -6440,7 +6887,7 @@ Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl)
 	    continue;
 	curentp = ary + oldsize;
 	for (entp = ary, ent = *ary; ent; ent = *entp) {
-	    if ((newsize & (UV)ent->oldval) != i) {
+	    if ((newsize & PTR2UV(ent->oldval)) != i) {
 		*entp = ent->next;
 		ent->next = *curentp;
 		*curentp = ent;
@@ -6459,9 +6906,6 @@ char *PL_watch_pvx;
 SV *
 Perl_sv_dup(pTHX_ SV *sstr)
 {
-    U32 sflags;
-    int dtype;
-    int stype;
     SV *dstr;
 
     if (!sstr || SvTYPE(sstr) == SVTYPEMASK)
@@ -6696,7 +7140,6 @@ Perl_sv_dup(pTHX_ SV *sstr)
 	SvSTASH(dstr)	= hv_dup_inc(SvSTASH(sstr));
 	HvRITER((HV*)dstr)	= HvRITER((HV*)sstr);
 	if (HvARRAY((HV*)sstr)) {
-	    HE *entry;
 	    STRLEN i = 0;
 	    XPVHV *dxhv = (XPVHV*)SvANY(dstr);
 	    XPVHV *sxhv = (XPVHV*)SvANY(sstr);
@@ -6812,7 +7255,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max)
 	    case CXt_EVAL:
 		ncx->blk_eval.old_in_eval = cx->blk_eval.old_in_eval;
 		ncx->blk_eval.old_op_type = cx->blk_eval.old_op_type;
-		ncx->blk_eval.old_name	= SAVEPV(cx->blk_eval.old_name);
+		ncx->blk_eval.old_namesv = sv_dup_inc(cx->blk_eval.old_namesv);
 		ncx->blk_eval.old_eval_root = cx->blk_eval.old_eval_root;
 		ncx->blk_eval.cur_text	= sv_dup(cx->blk_eval.cur_text);
 		break;
@@ -6825,6 +7268,9 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max)
 		ncx->blk_loop.iterdata	= (CxPADLOOP(cx)
 					   ? cx->blk_loop.iterdata
 					   : gv_dup((GV*)cx->blk_loop.iterdata));
+		ncx->blk_loop.oldcurpad
+		    = (SV**)ptr_table_fetch(PL_ptr_table,
+					    cx->blk_loop.oldcurpad);
 		ncx->blk_loop.itersave	= sv_dup_inc(cx->blk_loop.itersave);
 		ncx->blk_loop.iterlval	= sv_dup_inc(cx->blk_loop.iterlval);
 		ncx->blk_loop.iterary	= av_dup_inc(cx->blk_loop.iterary);
@@ -6936,6 +7382,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl)
     char *c;
     void (*dptr) (void*);
     void (*dxptr) (pTHXo_ void*);
+    OP *o;
 
     Newz(54, nss, max, ANY);
 
@@ -6955,6 +7402,12 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl)
 	    gv = (GV*)POPPTR(ss,ix);
 	    TOPPTR(nss,ix) = gv_dup_inc(gv);
 	    break;
+	case SAVEt_GENERIC_PVREF:		/* generic char* */
+	    c = (char*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = pv_dup(c);
+	    ptr = POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+	    break;
         case SAVEt_GENERIC_SVREF:		/* generic sv */
         case SAVEt_SVREF:			/* scalar reference */
 	    sv = (SV*)POPPTR(ss,ix);
@@ -7062,7 +7515,9 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl)
 		case OP_LEAVE:
 		case OP_SCOPE:
 		case OP_LEAVEWRITE:
-		    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+		    TOPPTR(nss,ix) = ptr;
+		    o = (OP*)ptr;
+		    OpREFCNT_inc(o);
 		    break;
 		default:
 		    TOPPTR(nss,ix) = Nullop;
@@ -7092,13 +7547,13 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl)
 	    ptr = POPPTR(ss,ix);
 	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);	/* XXX quite arbitrary */
 	    dptr = POPDPTR(ss,ix);
-	    TOPDPTR(nss,ix) = (void (*)(void*))any_dup(dptr, proto_perl);
+	    TOPDPTR(nss,ix) = (void (*)(void*))any_dup((void *)dptr, proto_perl);
 	    break;
 	case SAVEt_DESTRUCTOR_X:
 	    ptr = POPPTR(ss,ix);
 	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);	/* XXX quite arbitrary */
 	    dxptr = POPDXPTR(ss,ix);
-	    TOPDXPTR(nss,ix) = (void (*)(pTHXo_ void*))any_dup(dxptr, proto_perl);
+	    TOPDXPTR(nss,ix) = (void (*)(pTHXo_ void*))any_dup((void *)dxptr, proto_perl);
 	    break;
 	case SAVEt_REGCONTEXT:
 	case SAVEt_ALLOC:
@@ -7134,6 +7589,10 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl)
 	    i = POPINT(ss,ix);
 	    TOPINT(nss,ix) = i;
 	    break;
+	case SAVEt_COMPPAD:
+	    av = (AV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = av_dup(av);
+	    break;
 	default:
 	    Perl_croak(aTHX_ "panic: ss_dup inconsistency");
 	}
@@ -7179,15 +7638,13 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
      * their pointers copied. */
 
     IV i;
-    SV *sv;
-    SV **svp;
 #  ifdef PERL_OBJECT
     CPerlObj *pPerl = new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd, ipLIO,
 					ipD, ipS, ipP);
-    PERL_SET_INTERP(pPerl);
+    PERL_SET_THX(pPerl);
 #  else		/* !PERL_OBJECT */
     PerlInterpreter *my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
-    PERL_SET_INTERP(my_perl);
+    PERL_SET_THX(my_perl);
 
 #    ifdef DEBUGGING
     memset(my_perl, 0xab, sizeof(PerlInterpreter));
@@ -7212,10 +7669,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 #  endif	/* PERL_OBJECT */
 #else		/* !PERL_IMPLICIT_SYS */
     IV i;
-    SV *sv;
-    SV **svp;
     PerlInterpreter *my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
-    PERL_SET_INTERP(my_perl);
+    PERL_SET_THX(my_perl);
 
 #    ifdef DEBUGGING
     memset(my_perl, 0xab, sizeof(PerlInterpreter));
@@ -7231,17 +7686,29 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     /* arena roots */
     PL_xiv_arenaroot	= NULL;
     PL_xiv_root		= NULL;
+    PL_xnv_arenaroot	= NULL;
     PL_xnv_root		= NULL;
+    PL_xrv_arenaroot	= NULL;
     PL_xrv_root		= NULL;
+    PL_xpv_arenaroot	= NULL;
     PL_xpv_root		= NULL;
+    PL_xpviv_arenaroot	= NULL;
     PL_xpviv_root	= NULL;
+    PL_xpvnv_arenaroot	= NULL;
     PL_xpvnv_root	= NULL;
+    PL_xpvcv_arenaroot	= NULL;
     PL_xpvcv_root	= NULL;
+    PL_xpvav_arenaroot	= NULL;
     PL_xpvav_root	= NULL;
+    PL_xpvhv_arenaroot	= NULL;
     PL_xpvhv_root	= NULL;
+    PL_xpvmg_arenaroot	= NULL;
     PL_xpvmg_root	= NULL;
+    PL_xpvlv_arenaroot	= NULL;
     PL_xpvlv_root	= NULL;
+    PL_xpvbm_arenaroot	= NULL;
     PL_xpvbm_root	= NULL;
+    PL_he_arenaroot	= NULL;
     PL_he_root		= NULL;
     PL_nice_chunk	= NULL;
     PL_nice_chunk_size	= 0;
@@ -7405,7 +7872,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_main_cv		= cv_dup_inc(proto_perl->Imain_cv);
     PL_main_root	= OpREFCNT_inc(proto_perl->Imain_root);
     PL_main_start	= proto_perl->Imain_start;
-    PL_eval_root	= OpREFCNT_inc(proto_perl->Ieval_root);
+    PL_eval_root	= proto_perl->Ieval_root;
     PL_eval_start	= proto_perl->Ieval_start;
 
     /* runtime control stuff */
@@ -7683,6 +8150,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     }
     else {
 	init_stacks();
+	ENTER;			/* perl_destruct() wants to LEAVE; */
     }
 
     PL_start_env	= proto_perl->Tstart_env;	/* XXXXXX */
@@ -7721,7 +8189,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_dirty		= proto_perl->Tdirty;
     PL_localizing	= proto_perl->Tlocalizing;
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
     PL_protect		= proto_perl->Tprotect;
+#endif
     PL_errors		= sv_dup_inc(proto_perl->Terrors);
     PL_av_fetch_sv	= Nullsv;
     PL_hv_fetch_sv	= Nullsv;
@@ -7854,10 +8324,10 @@ do_clean_named_objs(pTHXo_ SV *sv)
 {
     if (SvTYPE(sv) == SVt_PVGV && GvGP(sv)) {
 	if ( SvOBJECT(GvSV(sv)) ||
-	     GvAV(sv) && SvOBJECT(GvAV(sv)) ||
-	     GvHV(sv) && SvOBJECT(GvHV(sv)) ||
-	     GvIO(sv) && SvOBJECT(GvIO(sv)) ||
-	     GvCV(sv) && SvOBJECT(GvCV(sv)) )
+	     (GvAV(sv) && SvOBJECT(GvAV(sv))) ||
+	     (GvHV(sv) && SvOBJECT(GvHV(sv))) ||
+	     (GvIO(sv) && SvOBJECT(GvIO(sv))) ||
+	     (GvCV(sv) && SvOBJECT(GvCV(sv))) )
 	{
 	    DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv));)
 	    SvREFCNT_dec(sv);