X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=616344b33d4ef10b9faa564da5d5f117f16404e5;hb=2ef256fcc9c788003ff3d458ced8f78234e5a628;hp=6e96590ed173154a7363b0b423aef7cb9a51f9fa;hpb=11faa288e292c27cb2ddc4ccdc483b523d26ce19;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/sv.c b/sv.c
index 6e96590..616344b 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..."
  */
@@ -262,8 +163,6 @@ S_visit(pTHX_ SVFUNC_t f)
     }
 }
 
-#endif /* PURIFY */
-
 void
 Perl_sv_report_used(pTHX)
 {
@@ -316,6 +215,16 @@ Perl_sv_free_arenas(pTHX)
     PL_sv_root = 0;
 }
 
+void
+Perl_report_uninit(pTHX)
+{
+    if (PL_op)
+	Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit,
+		    " in ", PL_op_desc[PL_op->op_type]);
+    else
+	Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit, "", "");
+}
+
 STATIC XPVIV*
 S_new_xiv(pTHX)
 {
@@ -791,125 +700,109 @@ 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
+
+Upgrade an SV to a more complex form.  Use C<SvUPGRADE>.  See
+C<svtype>.
+
+=cut
+*/
 
 bool
 Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
@@ -1200,6 +1093,16 @@ Perl_sv_backoff(pTHX_ register SV *sv)
     return 0;
 }
 
+/*
+=for apidoc sv_grow
+
+Expands the character buffer in the SV.  This will use C<sv_unref> and will
+upgrade the SV to C<SVt_PV>.  Returns a pointer to the character buffer.
+Use C<SvGROW>.
+
+=cut
+*/
+
 char *
 Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
 {
@@ -1232,7 +1135,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);
@@ -1249,6 +1152,15 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
     return s;
 }
 
+/*
+=for apidoc sv_setiv
+
+Copies an integer into the given SV.  Does not handle 'set' magic.  See
+C<sv_setiv_mg>.
+
+=cut
+*/
+
 void
 Perl_sv_setiv(pTHX_ register SV *sv, IV i)
 {
@@ -1282,6 +1194,14 @@ Perl_sv_setiv(pTHX_ register SV *sv, IV i)
     SvTAINT(sv);
 }
 
+/*
+=for apidoc sv_setiv_mg
+
+Like C<sv_setiv>, but also handles 'set' magic.
+
+=cut
+*/
+
 void
 Perl_sv_setiv_mg(pTHX_ register SV *sv, IV i)
 {
@@ -1289,6 +1209,15 @@ Perl_sv_setiv_mg(pTHX_ register SV *sv, IV i)
     SvSETMAGIC(sv);
 }
 
+/*
+=for apidoc sv_setuv
+
+Copies an unsigned integer into the given SV.  Does not handle 'set' magic.
+See C<sv_setuv_mg>.
+
+=cut
+*/
+
 void
 Perl_sv_setuv(pTHX_ register SV *sv, UV u)
 {
@@ -1297,6 +1226,14 @@ Perl_sv_setuv(pTHX_ register SV *sv, UV u)
     SvUVX(sv) = u;
 }
 
+/*
+=for apidoc sv_setuv_mg
+
+Like C<sv_setuv>, but also handles 'set' magic.
+
+=cut
+*/
+
 void
 Perl_sv_setuv_mg(pTHX_ register SV *sv, UV u)
 {
@@ -1304,6 +1241,15 @@ Perl_sv_setuv_mg(pTHX_ register SV *sv, UV u)
     SvSETMAGIC(sv);
 }
 
+/*
+=for apidoc sv_setnv
+
+Copies a double into the given SV.  Does not handle 'set' magic.  See
+C<sv_setnv_mg>.
+
+=cut
+*/
+
 void
 Perl_sv_setnv(pTHX_ register SV *sv, NV num)
 {
@@ -1336,6 +1282,14 @@ Perl_sv_setnv(pTHX_ register SV *sv, NV num)
     SvTAINT(sv);
 }
 
+/*
+=for apidoc sv_setnv_mg
+
+Like C<sv_setnv>, but also handles 'set' magic.
+
+=cut
+*/
+
 void
 Perl_sv_setnv_mg(pTHX_ register SV *sv, NV num)
 {
@@ -1427,7 +1381,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
 		dTHR;
 		if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
-		    Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+		    report_uninit();
 	    }
 	    return 0;
 	}
@@ -1442,7 +1396,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 	if (SvREADONLY(sv) && !SvOK(sv)) {
 	    dTHR;
 	    if (ckWARN(WARN_UNINITIALIZED))
-		Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+		report_uninit();
 	    return 0;
 	}
     }
@@ -1538,7 +1492,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
     else  {
 	dTHR;
 	if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
-	    Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+	    report_uninit();
 	if (SvTYPE(sv) < SVt_IV)
 	    /* Typically the caller expects that sv_any is not NULL now.  */
 	    sv_upgrade(sv, SVt_IV);
@@ -1566,7 +1520,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
 		dTHR;
 		if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
-		    Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+		    report_uninit();
 	    }
 	    return 0;
 	}
@@ -1581,7 +1535,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	if (SvREADONLY(sv) && !SvOK(sv)) {
 	    dTHR;
 	    if (ckWARN(WARN_UNINITIALIZED))
-		Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+		report_uninit();
 	    return 0;
 	}
     }
@@ -1695,7 +1649,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	if (!(SvFLAGS(sv) & SVs_PADTMP)) {
 	    dTHR;
 	    if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
-		Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+		report_uninit();
 	}
 	if (SvTYPE(sv) < SVt_IV)
 	    /* Typically the caller expects that sv_any is not NULL now.  */
@@ -1704,7 +1658,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
     }
 
     DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%"UVuf")\n",
-	(UV)sv,SvUVX(sv)));
+			  PTR2UV(sv),SvUVX(sv)));
     return SvIsUV(sv) ? SvUVX(sv) : (UV)SvIVX(sv);
 }
 
@@ -1733,7 +1687,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
 		dTHR;
 		if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
-		    Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+		    report_uninit();
 	    }
             return 0;
         }
@@ -1748,7 +1702,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	if (SvREADONLY(sv) && !SvOK(sv)) {
 	    dTHR;
 	    if (ckWARN(WARN_UNINITIALIZED))
-		Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+		report_uninit();
 	    return 0.0;
 	}
     }
@@ -1790,7 +1744,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
     else  {
 	dTHR;
 	if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
-	    Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+	    report_uninit();
 	if (SvTYPE(sv) < SVt_NV)
 	    /* Typically the caller expects that sv_any is not NULL now.  */
 	    sv_upgrade(sv, SVt_NV);
@@ -1862,6 +1816,15 @@ S_asUV(pTHX_ SV *sv)
  * with a possible addition of IS_NUMBER_NEG.
  */
 
+/*
+=for apidoc looks_like_number
+
+Test if an the content of an SV looks like a number (or is a
+number).
+
+=cut
+*/
+
 I32
 Perl_looks_like_number(pTHX_ SV *sv)
 {
@@ -2035,7 +1998,7 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 	    if (!(SvFLAGS(sv) & SVs_PADTMP)) {
 		dTHR;
 		if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing)
-		    Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+		    report_uninit();
 	    }
             *lp = 0;
             return "";
@@ -2129,7 +2092,7 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 	if (SvREADONLY(sv) && !SvOK(sv)) {
 	    dTHR;
 	    if (ckWARN(WARN_UNINITIALIZED))
-		Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+		report_uninit();
 	    *lp = 0;
 	    return "";
 	}
@@ -2193,7 +2156,7 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 	if (ckWARN(WARN_UNINITIALIZED)
 	    && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
 	{
-	    Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+	    report_uninit();
 	}
 	*lp = 0;
 	if (SvTYPE(sv) < SVt_PV)
@@ -2248,6 +2211,30 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
     }
 }
 
+char *
+Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv)
+{
+    return sv_2pv_nolen(sv);
+}
+
+char *
+Perl_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
+{
+    return sv_2pv(sv,lp);
+}
+
+char *
+Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv)
+{
+    return sv_2pv_nolen(sv);
+}
+
+char *
+Perl_sv_2pvutf8(pTHX_ register SV *sv, STRLEN *lp)
+{
+    return sv_2pv(sv,lp);
+}
+ 
 /* This function is only called on magical items */
 bool
 Perl_sv_2bool(pTHX_ register SV *sv)
@@ -2291,6 +2278,17 @@ Perl_sv_2bool(pTHX_ register SV *sv)
  * as temporary.
  */
 
+/*
+=for apidoc sv_setsv
+
+Copies the contents of the source SV C<ssv> into the destination SV C<dsv>.
+The source SV may be destroyed if it is mortal.  Does not handle 'set'
+magic.  See the macro forms C<SvSetSV>, C<SvSetSV_nosteal> and
+C<sv_setsv_mg>.
+
+=cut
+*/
+
 void
 Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 {
@@ -2370,7 +2368,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	    sstr = SvRV(sstr);
 	    if (sstr == dstr) {
 		if (GvIMPORTED(dstr) != GVf_IMPORTED
-		    && CopSTASH(PL_curcop) != GvSTASH(dstr))
+		    && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
 		{
 		    GvIMPORTED_on(dstr);
 		}
@@ -2428,7 +2426,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	    GvGP(dstr) = gp_ref(GvGP(sstr));
 	    SvTAINT(dstr);
 	    if (GvIMPORTED(dstr) != GVf_IMPORTED
-		&& CopSTASH(PL_curcop) != GvSTASH(dstr))
+		&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
 	    {
 		GvIMPORTED_on(dstr);
 	    }
@@ -2463,7 +2461,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 
 		if (intro) {
 		    GP *gp;
-		    GvGP(dstr)->gp_refcnt--;
+		    gp_free((GV*)dstr);
 		    GvINTRO_off(dstr);	/* one-shot flag */
 		    Newz(602,gp, 1, GP);
 		    GvGP(dstr) = gp_ref(gp);
@@ -2480,7 +2478,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 			dref = (SV*)GvAV(dstr);
 		    GvAV(dstr) = (AV*)sref;
 		    if (GvIMPORTED_AV_off(dstr)
-			&& CopSTASH(PL_curcop) != GvSTASH(dstr))
+			&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
 		    {
 			GvIMPORTED_AV_on(dstr);
 		    }
@@ -2492,7 +2490,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 			dref = (SV*)GvHV(dstr);
 		    GvHV(dstr) = (HV*)sref;
 		    if (GvIMPORTED_HV_off(dstr)
-			&& CopSTASH(PL_curcop) != GvSTASH(dstr))
+			&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
 		    {
 			GvIMPORTED_HV_on(dstr);
 		    }
@@ -2548,7 +2546,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 			PL_sub_generation++;
 		    }
 		    if (GvIMPORTED_CV_off(dstr)
-			&& CopSTASH(PL_curcop) != GvSTASH(dstr))
+			&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
 		    {
 			GvIMPORTED_CV_on(dstr);
 		    }
@@ -2567,7 +2565,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 			dref = (SV*)GvSV(dstr);
 		    GvSV(dstr) = sref;
 		    if (GvIMPORTED_SV_off(dstr)
-			&& CopSTASH(PL_curcop) != GvSTASH(dstr))
+			&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
 		    {
 			GvIMPORTED_SV_on(dstr);
 		    }
@@ -2645,6 +2643,8 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	    *SvEND(dstr) = '\0';
 	    (void)SvPOK_only(dstr);
 	}
+	if (DO_UTF8(sstr))
+	    SvUTF8_on(dstr);
 	/*SUPPRESS 560*/
 	if (sflags & SVp_NOK) {
 	    SvNOK_on(dstr);
@@ -2685,6 +2685,14 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
     SvTAINT(dstr);
 }
 
+/*
+=for apidoc sv_setsv_mg
+
+Like C<sv_setsv>, but also handles 'set' magic.
+
+=cut
+*/
+
 void
 Perl_sv_setsv_mg(pTHX_ SV *dstr, register SV *sstr)
 {
@@ -2692,6 +2700,15 @@ Perl_sv_setsv_mg(pTHX_ SV *dstr, register SV *sstr)
     SvSETMAGIC(dstr);
 }
 
+/*
+=for apidoc sv_setpvn
+
+Copies a string into an SV.  The C<len> parameter indicates the number of
+bytes to be copied.  Does not handle 'set' magic.  See C<sv_setpvn_mg>.
+
+=cut
+*/
+
 void
 Perl_sv_setpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
 {
@@ -2714,6 +2731,14 @@ Perl_sv_setpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN
     SvTAINT(sv);
 }
 
+/*
+=for apidoc sv_setpvn_mg
+
+Like C<sv_setpvn>, but also handles 'set' magic.
+
+=cut
+*/
+
 void
 Perl_sv_setpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
 {
@@ -2721,6 +2746,15 @@ Perl_sv_setpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRL
     SvSETMAGIC(sv);
 }
 
+/*
+=for apidoc sv_setpv
+
+Copies a string into an SV.  The string must be null-terminated.  Does not
+handle 'set' magic.  See C<sv_setpv_mg>.
+
+=cut
+*/
+
 void
 Perl_sv_setpv(pTHX_ register SV *sv, register const char *ptr)
 {
@@ -2741,6 +2775,14 @@ Perl_sv_setpv(pTHX_ register SV *sv, register const char *ptr)
     SvTAINT(sv);
 }
 
+/*
+=for apidoc sv_setpv_mg
+
+Like C<sv_setpv>, but also handles 'set' magic.
+
+=cut
+*/
+
 void
 Perl_sv_setpv_mg(pTHX_ register SV *sv, register const char *ptr)
 {
@@ -2748,6 +2790,20 @@ Perl_sv_setpv_mg(pTHX_ register SV *sv, register const char *ptr)
     SvSETMAGIC(sv);
 }
 
+/*
+=for apidoc sv_usepvn
+
+Tells an SV to use C<ptr> to find its string value.  Normally the string is
+stored inside the SV but sv_usepvn allows the SV to use an outside string. 
+The C<ptr> should point to memory that was allocated by C<malloc>.  The
+string length, C<len>, must be supplied.  This function will realloc the
+memory pointed to by C<ptr>, so that pointer should not be freed or used by
+the programmer after giving it to sv_usepvn.  Does not handle 'set' magic.
+See C<sv_usepvn_mg>.
+
+=cut
+*/
+
 void
 Perl_sv_usepvn(pTHX_ register SV *sv, register char *ptr, register STRLEN len)
 {
@@ -2769,6 +2825,14 @@ Perl_sv_usepvn(pTHX_ register SV *sv, register char *ptr, register STRLEN len)
     SvTAINT(sv);
 }
 
+/*
+=for apidoc sv_usepvn_mg
+
+Like C<sv_usepvn>, but also handles 'set' magic.
+
+=cut
+*/
+
 void
 Perl_sv_usepvn_mg(pTHX_ register SV *sv, register char *ptr, register STRLEN len)
 {
@@ -2790,6 +2854,17 @@ Perl_sv_force_normal(pTHX_ register SV *sv)
 	sv_unglob(sv);
 }
     
+/*
+=for apidoc sv_chop
+
+Efficient removal of characters from the beginning of the string buffer. 
+SvPOK(sv) must be true and the C<ptr> must be a pointer to somewhere inside
+the string buffer.  The C<ptr> becomes the first character of the adjusted
+string.
+
+=cut
+*/
+
 void
 Perl_sv_chop(pTHX_ register SV *sv, register char *ptr)	/* like set but assuming ptr is in sv */
                 
@@ -2822,6 +2897,16 @@ Perl_sv_chop(pTHX_ register SV *sv, register char *ptr)	/* like set but assuming
     SvIVX(sv) += delta;
 }
 
+/*
+=for apidoc sv_catpvn
+
+Concatenates the string onto the end of the string which is in the SV.  The
+C<len> indicates number of bytes to copy.  Handles 'get' magic, but not
+'set' magic.  See C<sv_catpvn_mg>.
+
+=cut
+*/
+
 void
 Perl_sv_catpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
 {
@@ -2835,10 +2920,18 @@ 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);
 }
 
+/*
+=for apidoc sv_catpvn_mg
+
+Like C<sv_catpvn>, but also handles 'set' magic.
+
+=cut
+*/
+
 void
 Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
 {
@@ -2846,6 +2939,15 @@ Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRL
     SvSETMAGIC(sv);
 }
 
+/*
+=for apidoc sv_catsv
+
+Concatenates the string from SV C<ssv> onto the end of the string in SV
+C<dsv>.  Handles 'get' magic, but not 'set' magic.  See C<sv_catsv_mg>.
+
+=cut
+*/
+
 void
 Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
 {
@@ -2855,8 +2957,18 @@ Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
 	return;
     if (s = SvPV(sstr, len))
 	sv_catpvn(dstr,s,len);
+    if (SvUTF8(sstr))
+	SvUTF8_on(dstr);
 }
 
+/*
+=for apidoc sv_catsv_mg
+
+Like C<sv_catsv>, but also handles 'set' magic.
+
+=cut
+*/
+
 void
 Perl_sv_catsv_mg(pTHX_ SV *dstr, register SV *sstr)
 {
@@ -2864,6 +2976,15 @@ Perl_sv_catsv_mg(pTHX_ SV *dstr, register SV *sstr)
     SvSETMAGIC(dstr);
 }
 
+/*
+=for apidoc sv_catpv
+
+Concatenates the string onto the end of the string which is in the SV.
+Handles 'get' magic, but not 'set' magic.  See C<sv_catpv_mg>.
+
+=cut
+*/
+
 void
 Perl_sv_catpv(pTHX_ register SV *sv, register const char *ptr)
 {
@@ -2880,12 +3001,20 @@ 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);
 }
 
-void
-Perl_sv_catpv_mg(pTHX_ register SV *sv, register const char *ptr)
+/*
+=for apidoc sv_catpv_mg
+
+Like C<sv_catpv>, but also handles 'set' magic.
+
+=cut
+*/
+
+void
+Perl_sv_catpv_mg(pTHX_ register SV *sv, register const char *ptr)
 {
     sv_catpv(sv,ptr);
     SvSETMAGIC(sv);
@@ -2906,6 +3035,14 @@ Perl_newSV(pTHX_ STRLEN len)
 
 /* name is assumed to contain an SV* if (name && namelen == HEf_SVKEY) */
 
+/*
+=for apidoc sv_magic
+
+Adds magic to an SV.
+
+=cut
+*/
+
 void
 Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 namlen)
 {
@@ -3154,6 +3291,15 @@ S_sv_del_backref(pTHX_ SV *sv)
     }
 }
 
+/*
+=for apidoc sv_insert
+
+Inserts a string at the specified offset/length within the SV. Similar to
+the Perl substr() function.
+
+=cut
+*/
+
 void
 Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN littlelen)
 {
@@ -3174,6 +3320,7 @@ Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN
 	SvCUR_set(bigstr, offset+len);
     }
 
+    SvTAINT(bigstr);
     i = littlelen - len;
     if (i > 0) {			/* string might grow */
 	big = SvGROW(bigstr, SvCUR(bigstr) + i + 1);
@@ -3503,6 +3650,14 @@ Perl_sv_free(pTHX_ SV *sv)
 	del_SV(sv);
 }
 
+/*
+=for apidoc sv_len
+
+Returns the length of the string in the SV.  See also C<SvCUR>.
+
+=cut
+*/
+
 STRLEN
 Perl_sv_len(pTHX_ register SV *sv)
 {
@@ -3604,6 +3759,15 @@ Perl_sv_pos_b2u(pTHX_ register SV *sv, I32* offsetp)
     return;
 }
 
+/*
+=for apidoc sv_eq
+
+Returns a boolean indicating whether the strings in the two SVs are
+identical.
+
+=cut
+*/
+
 I32
 Perl_sv_eq(pTHX_ register SV *str1, register SV *str2)
 {
@@ -3630,6 +3794,16 @@ Perl_sv_eq(pTHX_ register SV *str1, register SV *str2)
     return memEQ(pv1, pv2, cur1);
 }
 
+/*
+=for apidoc sv_cmp
+
+Compares the strings in two SVs.  Returns -1, 0, or 1 indicating whether the
+string in C<sv1> is less than, equal to, or greater than the string in
+C<sv2>.
+
+=cut
+*/
+
 I32
 Perl_sv_cmp(pTHX_ register SV *str1, register SV *str2)
 {
@@ -4022,14 +4196,18 @@ screamer2:
 	}
     }
 
-#ifdef WIN32
-    win32_strip_return(sv);
-#endif
-
     return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch;
 }
 
 
+/*
+=for apidoc sv_inc
+
+Auto-increment of the value in the SV.
+
+=cut
+*/
+
 void
 Perl_sv_inc(pTHX_ register SV *sv)
 {
@@ -4131,6 +4309,14 @@ Perl_sv_inc(pTHX_ register SV *sv)
 	*d = d[1];
 }
 
+/*
+=for apidoc sv_dec
+
+Auto-decrement of the value in the SV.
+
+=cut
+*/
+
 void
 Perl_sv_dec(pTHX_ register SV *sv)
 {
@@ -4191,6 +4377,15 @@ Perl_sv_dec(pTHX_ register SV *sv)
     sv_setnv(sv,Atof(SvPVX(sv)) - 1.0);	/* punt */
 }
 
+/*
+=for apidoc sv_mortalcopy
+
+Creates a new SV which is a copy of the original SV.  The new SV is marked
+as mortal.
+
+=cut
+*/
+
 /* Make a string that will exist for the duration of the expression
  * evaluation.  Actually, it may have to last longer than that, but
  * hopefully we won't free it until it has been assigned to a
@@ -4210,6 +4405,14 @@ Perl_sv_mortalcopy(pTHX_ SV *oldstr)
     return sv;
 }
 
+/*
+=for apidoc sv_newmortal
+
+Creates a new SV which is mortal.  The reference count of the SV is set to 1.
+
+=cut
+*/
+
 SV *
 Perl_sv_newmortal(pTHX)
 {
@@ -4223,6 +4426,15 @@ Perl_sv_newmortal(pTHX)
     return sv;
 }
 
+/*
+=for apidoc sv_2mortal
+
+Marks an SV as mortal.  The SV will be destroyed when the current context
+ends.
+
+=cut
+*/
+
 /* same thing without the copying */
 
 SV *
@@ -4239,6 +4451,16 @@ Perl_sv_2mortal(pTHX_ register SV *sv)
     return sv;
 }
 
+/*
+=for apidoc newSVpv
+
+Creates a new SV and copies a string into it.  The reference count for the
+SV is set to 1.  If C<len> is zero, Perl will compute the length using
+strlen().  For efficiency, consider using C<newSVpvn> instead.
+
+=cut
+*/
+
 SV *
 Perl_newSVpv(pTHX_ const char *s, STRLEN len)
 {
@@ -4251,6 +4473,17 @@ Perl_newSVpv(pTHX_ const char *s, STRLEN len)
     return sv;
 }
 
+/*
+=for apidoc newSVpvn
+
+Creates a new SV and copies a string into it.  The reference count for the
+SV is set to 1.  Note that if C<len> is zero, Perl will create a zero length 
+string.  You are responsible for ensuring that the source string is at least
+C<len> bytes long.
+
+=cut
+*/
+
 SV *
 Perl_newSVpvn(pTHX_ const char *s, STRLEN len)
 {
@@ -4275,6 +4508,15 @@ Perl_newSVpvf_nocontext(const char* pat, ...)
 }
 #endif
 
+/*
+=for apidoc newSVpvf
+
+Creates a new SV an initialize it with the string formatted like
+C<sprintf>.
+
+=cut
+*/
+
 SV *
 Perl_newSVpvf(pTHX_ const char* pat, ...)
 {
@@ -4295,6 +4537,15 @@ Perl_vnewSVpvf(pTHX_ const char* pat, va_list* args)
     return sv;
 }
 
+/*
+=for apidoc newSVnv
+
+Creates a new SV and copies a floating point value into it.
+The reference count for the SV is set to 1.
+
+=cut
+*/
+
 SV *
 Perl_newSVnv(pTHX_ NV n)
 {
@@ -4305,6 +4556,15 @@ Perl_newSVnv(pTHX_ NV n)
     return sv;
 }
 
+/*
+=for apidoc newSViv
+
+Creates a new SV and copies an integer into it.  The reference count for the
+SV is set to 1.
+
+=cut
+*/
+
 SV *
 Perl_newSViv(pTHX_ IV i)
 {
@@ -4315,6 +4575,15 @@ Perl_newSViv(pTHX_ IV i)
     return sv;
 }
 
+/*
+=for apidoc newRV_noinc
+
+Creates an RV wrapper for an SV.  The reference count for the original
+SV is B<not> incremented.
+
+=cut
+*/
+
 SV *
 Perl_newRV_noinc(pTHX_ SV *tmpRef)
 {
@@ -4329,12 +4598,21 @@ Perl_newRV_noinc(pTHX_ SV *tmpRef)
     return sv;
 }
 
+/* newRV_inc is #defined to newRV in sv.h */
 SV *
 Perl_newRV(pTHX_ SV *tmpRef)
 {
     return newRV_noinc(SvREFCNT_inc(tmpRef));
 }
 
+/*
+=for apidoc newSVsv
+
+Creates a new SV which is an exact duplicate of the original SV.
+
+=cut
+*/
+
 /* make an exact duplicate of old */
 
 SV *
@@ -4549,8 +4827,7 @@ Perl_sv_true(pTHX_ register SV *sv)
     if (SvPOK(sv)) {
 	register XPV* tXpv;
 	if ((tXpv = (XPV*)SvANY(sv)) &&
-		(*tXpv->xpv_pv > '0' ||
-		tXpv->xpv_cur > 1 ||
+		(tXpv->xpv_cur > 1 ||
 		(tXpv->xpv_cur && *tXpv->xpv_pv != '0')))
 	    return 1;
 	else
@@ -4660,6 +4937,42 @@ Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
 }
 
 char *
+Perl_sv_pvbyte(pTHX_ SV *sv)
+{
+    return sv_pv(sv);
+}
+
+char *
+Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp)
+{
+    return sv_pvn(sv,lp);
+}
+
+char *
+Perl_sv_pvbyten_force(pTHX_ SV *sv, STRLEN *lp)
+{
+    return sv_pvn_force(sv,lp);
+}
+
+char *
+Perl_sv_pvutf8(pTHX_ SV *sv)
+{
+    return sv_pv(sv);
+}
+
+char *
+Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp)
+{
+    return sv_pvn(sv,lp);
+}
+
+char *
+Perl_sv_pvutf8n_force(pTHX_ SV *sv, STRLEN *lp)
+{
+    return sv_pvn_force(sv,lp);
+}
+
+char *
 Perl_sv_reftype(pTHX_ SV *sv, int ob)
 {
     if (ob && SvOBJECT(sv))
@@ -4690,6 +5003,16 @@ Perl_sv_reftype(pTHX_ SV *sv, int ob)
     }
 }
 
+/*
+=for apidoc sv_isobject
+
+Returns a boolean indicating whether the SV is an RV pointing to a blessed
+object.  If the SV is not an RV, or if the object is not blessed, then this
+will return false.
+
+=cut
+*/
+
 int
 Perl_sv_isobject(pTHX_ SV *sv)
 {
@@ -4705,6 +5028,16 @@ Perl_sv_isobject(pTHX_ SV *sv)
     return 1;
 }
 
+/*
+=for apidoc sv_isa
+
+Returns a boolean indicating whether the SV is blessed into the specified
+class.  This does not check for subtypes; use C<sv_derived_from> to verify
+an inheritance relationship.
+
+=cut
+*/
+
 int
 Perl_sv_isa(pTHX_ SV *sv, const char *name)
 {
@@ -4721,6 +5054,17 @@ Perl_sv_isa(pTHX_ SV *sv, const char *name)
     return strEQ(HvNAME(SvSTASH(sv)), name);
 }
 
+/*
+=for apidoc newSVrv
+
+Creates a new SV for the RV, C<rv>, to point to.  If C<rv> is not an RV then
+it will be upgraded to one.  If C<classname> is non-null then the new SV will
+be blessed in the specified package.  The new SV is returned and its
+reference count is 1.
+
+=cut
+*/
+
 SV*
 Perl_newSVrv(pTHX_ SV *rv, const char *classname)
 {
@@ -4746,6 +5090,24 @@ Perl_newSVrv(pTHX_ SV *rv, const char *classname)
     return sv;
 }
 
+/*
+=for apidoc sv_setref_pv
+
+Copies a pointer into a new SV, optionally blessing the SV.  The C<rv>
+argument will be upgraded to an RV.  That RV will be modified to point to
+the new SV.  If the C<pv> argument is NULL then C<PL_sv_undef> will be placed
+into the SV.  The C<classname> argument indicates the package for the
+blessing.  Set C<classname> to C<Nullch> to avoid the blessing.  The new SV
+will be returned and will have a reference count of 1.
+
+Do not use with other Perl types such as HV, AV, SV, CV, because those
+objects will become corrupted by the pointer copy process.
+
+Note that C<sv_setref_pvn> copies the string while this copies the pointer.
+
+=cut
+*/
+
 SV*
 Perl_sv_setref_pv(pTHX_ SV *rv, const char *classname, void *pv)
 {
@@ -4758,6 +5120,18 @@ Perl_sv_setref_pv(pTHX_ SV *rv, const char *classname, void *pv)
     return rv;
 }
 
+/*
+=for apidoc sv_setref_iv
+
+Copies an integer into a new SV, optionally blessing the SV.  The C<rv>
+argument will be upgraded to an RV.  That RV will be modified to point to
+the new SV.  The C<classname> argument indicates the package for the
+blessing.  Set C<classname> to C<Nullch> to avoid the blessing.  The new SV
+will be returned and will have a reference count of 1.
+
+=cut
+*/
+
 SV*
 Perl_sv_setref_iv(pTHX_ SV *rv, const char *classname, IV iv)
 {
@@ -4765,6 +5139,18 @@ Perl_sv_setref_iv(pTHX_ SV *rv, const char *classname, IV iv)
     return rv;
 }
 
+/*
+=for apidoc sv_setref_nv
+
+Copies a double into a new SV, optionally blessing the SV.  The C<rv>
+argument will be upgraded to an RV.  That RV will be modified to point to
+the new SV.  The C<classname> argument indicates the package for the
+blessing.  Set C<classname> to C<Nullch> to avoid the blessing.  The new SV
+will be returned and will have a reference count of 1.
+
+=cut
+*/
+
 SV*
 Perl_sv_setref_nv(pTHX_ SV *rv, const char *classname, NV nv)
 {
@@ -4772,6 +5158,21 @@ Perl_sv_setref_nv(pTHX_ SV *rv, const char *classname, NV nv)
     return rv;
 }
 
+/*
+=for apidoc sv_setref_pvn
+
+Copies a string into a new SV, optionally blessing the SV.  The length of the
+string must be specified with C<n>.  The C<rv> argument will be upgraded to
+an RV.  That RV will be modified to point to the new SV.  The C<classname>
+argument indicates the package for the blessing.  Set C<classname> to
+C<Nullch> to avoid the blessing.  The new SV will be returned and will have
+a reference count of 1.
+
+Note that C<sv_setref_pv> copies the pointer while this copies the string.
+
+=cut
+*/
+
 SV*
 Perl_sv_setref_pvn(pTHX_ SV *rv, const char *classname, char *pv, STRLEN n)
 {
@@ -4779,6 +5180,16 @@ Perl_sv_setref_pvn(pTHX_ SV *rv, const char *classname, char *pv, STRLEN n)
     return rv;
 }
 
+/*
+=for apidoc sv_bless
+
+Blesses an SV into a specified package.  The SV must be an RV.  The package
+must be designated by its stash (see C<gv_stashpv()>).  The reference count
+of the SV is unaffected.
+
+=cut
+*/
+
 SV*
 Perl_sv_bless(pTHX_ SV *sv, HV *stash)
 {
@@ -4813,6 +5224,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))
@@ -4824,10 +5237,27 @@ 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;
 }
 
+/*
+=for apidoc sv_unref
+
+Unsets the RV status of the SV, and decrements the reference count of
+whatever was being referenced by the RV.  This can almost be thought of
+as a reversal of C<newSVrv>.  See C<SvROK_off>.
+
+=cut
+*/
+
 void
 Perl_sv_unref(pTHX_ SV *sv)
 {
@@ -4874,6 +5304,15 @@ Perl_sv_tainted(pTHX_ SV *sv)
     return FALSE;
 }
 
+/*
+=for apidoc sv_setpviv
+
+Copies an integer into the given SV, also updating its string value.
+Does not handle 'set' magic.  See C<sv_setpviv_mg>.
+
+=cut
+*/
+
 void
 Perl_sv_setpviv(pTHX_ SV *sv, IV iv)
 {
@@ -4885,6 +5324,14 @@ Perl_sv_setpviv(pTHX_ SV *sv, IV iv)
 }
 
 
+/*
+=for apidoc sv_setpviv_mg
+
+Like C<sv_setpviv>, but also handles 'set' magic.
+
+=cut
+*/
+
 void
 Perl_sv_setpviv_mg(pTHX_ SV *sv, IV iv)
 {
@@ -4919,6 +5366,15 @@ Perl_sv_setpvf_mg_nocontext(SV *sv, const char* pat, ...)
 }
 #endif
 
+/*
+=for apidoc sv_setpvf
+
+Processes its arguments like C<sprintf> and sets an SV to the formatted
+output.  Does not handle 'set' magic.  See C<sv_setpvf_mg>.
+
+=cut
+*/
+
 void
 Perl_sv_setpvf(pTHX_ SV *sv, const char* pat, ...)
 {
@@ -4934,6 +5390,14 @@ Perl_sv_vsetpvf(pTHX_ SV *sv, const char* pat, va_list* args)
     sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
 }
 
+/*
+=for apidoc sv_setpvf_mg
+
+Like C<sv_setpvf>, but also handles 'set' magic.
+
+=cut
+*/
+
 void
 Perl_sv_setpvf_mg(pTHX_ SV *sv, const char* pat, ...)
 {
@@ -4972,6 +5436,16 @@ Perl_sv_catpvf_mg_nocontext(SV *sv, const char* pat, ...)
 }
 #endif
 
+/*
+=for apidoc sv_catpvf
+
+Processes its arguments like C<sprintf> and appends the formatted output
+to an SV.  Handles 'get' magic, but not 'set' magic.  C<SvSETMAGIC()> must
+typically be called after calling this function to handle 'set' magic.
+
+=cut
+*/
+
 void
 Perl_sv_catpvf(pTHX_ SV *sv, const char* pat, ...)
 {
@@ -4987,6 +5461,14 @@ Perl_sv_vcatpvf(pTHX_ SV *sv, const char* pat, va_list* args)
     sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
 }
 
+/*
+=for apidoc sv_catpvf_mg
+
+Like C<sv_catpvf>, but also handles 'set' magic.
+
+=cut
+*/
+
 void
 Perl_sv_catpvf_mg(pTHX_ SV *sv, const char* pat, ...)
 {
@@ -5003,6 +5485,15 @@ Perl_sv_vcatpvf_mg(pTHX_ SV *sv, const char* pat, va_list* args)
     SvSETMAGIC(sv);
 }
 
+/*
+=for apidoc sv_vsetpvfn
+
+Works like C<vcatpvfn> but copies the text into the SV instead of
+appending it.
+
+=cut
+*/
+
 void
 Perl_sv_vsetpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *maybe_tainted)
 {
@@ -5010,6 +5501,18 @@ Perl_sv_vsetpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
     sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, maybe_tainted);
 }
 
+/*
+=for apidoc sv_vcatpvfn
+
+Processes its arguments like C<vsprintf> and appends the formatted output
+to an SV.  Uses an array of SVs if the C style variable argument list is
+missing (NULL).  When running with taint checks enabled, indicates via
+C<maybe_tainted> if results are untrustworthy (often due to the use of
+locales).
+
+=cut
+*/
+
 void
 Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *maybe_tainted)
 {
@@ -5020,6 +5523,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);
@@ -5034,12 +5538,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 */
@@ -5058,6 +5568,7 @@ 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];
@@ -5163,7 +5674,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	/* SIZE */
 
 	switch (*q) {
-#ifdef Quad_t
+#ifdef HAS_QUAD
 	case 'L':			/* Ld */
 	case 'q':			/* qd */
 	    intsize = 'q';
@@ -5171,7 +5682,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    break;
 #endif
 	case 'l':
-#ifdef Quad_t
+#ifdef HAS_QUAD
              if (*(q + 1) == 'l') {	/* lld */
 		intsize = 'q';
 		q += 2;
@@ -5198,28 +5709,32 @@ 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':
 	    if (args) {
 		eptr = va_arg(*args, char*);
 		if (eptr)
+#ifdef MACOS_TRADITIONAL
+		  /* On MacOS, %#s format is used for Pascal strings */
+		  if (alt)
+		    elen = *eptr++;
+		  else
+#endif
 		    elen = strlen(eptr);
 		else {
 		    eptr = nullstr;
@@ -5227,20 +5742,79 @@ 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;
 
+	case 'v':
+	    if (args)
+		argsv = va_arg(*args, SV*);
+	    else if (svix < svmax)
+		argsv = svargs[svix++];
+	    {
+		STRLEN len;
+		U8 *str = (U8*)SvPVx(argsv,len);
+		I32 vlen = len*3+1;
+		SV *vsv = NEWSV(73,vlen);
+		I32 ulen;
+		I32 vfree = vlen;
+		U8 *vptr = (U8*)SvPVX(vsv);
+		STRLEN vcur = 0;
+		bool utf = DO_UTF8(argsv);
+
+		if (utf)
+		    is_utf = TRUE;
+		while (len) {
+		    UV uv;
+
+		    if (utf)
+			uv = utf8_to_uv(str, &ulen);
+		    else {
+			uv = *str;
+			ulen = 1;
+		    }
+		    str += ulen;
+		    len -= ulen;
+		    eptr = ebuf + sizeof ebuf;
+		    do {
+			*--eptr = '0' + uv % 10;
+		    } while (uv /= 10);
+		    elen = (ebuf + sizeof ebuf) - eptr;
+		    while (elen >= vfree-1) {
+			STRLEN off = vptr - (U8*)SvPVX(vsv);
+			vfree += vlen;
+			vlen *= 2;
+			SvGROW(vsv, vlen);
+			vptr = (U8*)SvPVX(vsv) + off;
+		    }
+		    memcpy(vptr, eptr, elen);
+		    vptr += elen;
+		    *vptr++ = '.';
+		    vfree -= elen + 1;
+		    vcur += elen + 1;
+		}
+		if (vcur) {
+		    vcur--;
+		    vptr[-1] = '\0';
+		}
+		SvCUR_set(vsv,vcur);
+		eptr = SvPVX(vsv);
+		elen = vcur;
+	    }
+	    goto string;
+
 	case '_':
 	    /*
 	     * The "%_" hack might have to be changed someday,
@@ -5249,7 +5823,10 @@ 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:
 	    if (has_precis && elen > precis)
@@ -5281,7 +5858,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		default:	iv = va_arg(*args, int); break;
 		case 'l':	iv = va_arg(*args, long); break;
 		case 'V':	iv = va_arg(*args, IV); break;
-#ifdef Quad_t
+#ifdef HAS_QUAD
 		case 'q':	iv = va_arg(*args, Quad_t); break;
 #endif
 		}
@@ -5293,7 +5870,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		default:	iv = (int)iv; break;
 		case 'l':	iv = (long)iv; break;
 		case 'V':	break;
-#ifdef Quad_t
+#ifdef HAS_QUAD
 		case 'q':	iv = (Quad_t)iv; break;
 #endif
 		}
@@ -5347,7 +5924,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		default:   uv = va_arg(*args, unsigned); break;
 		case 'l':  uv = va_arg(*args, unsigned long); break;
 		case 'V':  uv = va_arg(*args, UV); break;
-#ifdef Quad_t
+#ifdef HAS_QUAD
 		case 'q':  uv = va_arg(*args, Quad_t); break;
 #endif
 		}
@@ -5359,7 +5936,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		default:	uv = (unsigned)uv; break;
 		case 'l':	uv = (unsigned long)uv; break;
 		case 'V':	break;
-#ifdef Quad_t
+#ifdef HAS_QUAD
 		case 'q':	uv = (Quad_t)uv; break;
 #endif
 		}
@@ -5515,7 +6092,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		default:	*(va_arg(*args, int*)) = i; break;
 		case 'l':	*(va_arg(*args, long*)) = i; break;
 		case 'V':	*(va_arg(*args, IV*)) = i; break;
-#ifdef Quad_t
+#ifdef HAS_QUAD
 		case 'q':	*(va_arg(*args, Quad_t*)) = i; break;
 #endif
 		}
@@ -5543,7 +6120,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 				       (UV)c & 0xFF);
 		} else
 		    sv_catpv(msg, "end of string");
-		Perl_warner(aTHX_ WARN_PRINTF, "%_", msg); /* yes, this is reentrant */
+		Perl_warner(aTHX_ WARN_PRINTF, "%"SVf, msg); /* yes, this is reentrant */
 	    }
 
 	    /* output mangled stuff ... */
@@ -5592,6 +6169,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    memset(p, ' ', gap);
 	    p += gap;
 	}
+	if (is_utf)
+	    SvUTF8_on(sv);
 	*p = '\0';
 	SvCUR(sv) = p - SvPVX(sv);
     }
@@ -5604,9 +6183,14 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 #endif
 
 #ifndef OpREFCNT_inc
-#  define OpREFCNT_inc(o)	o
+#  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
+
+
 #define sv_dup_inc(s)	SvREFCNT_inc(sv_dup(s))
 #define av_dup(s)	(AV*)sv_dup((SV*)s)
 #define av_dup_inc(s)	(AV*)SvREFCNT_inc(sv_dup((SV*)s))
@@ -5631,11 +6215,19 @@ Perl_re_dup(pTHX_ REGEXP *r)
 PerlIO *
 Perl_fp_dup(pTHX_ PerlIO *fp, char type)
 {
+    PerlIO *ret;
     if (!fp)
 	return (PerlIO*)NULL;
-    return fp;		/* XXX */
-    /* return PerlIO_fdopen(PerlIO_fileno(fp),
-			 type == '<' ? "r" : type == '>' ? "w" : "rw"); */
+
+    /* look for it in the table first */
+    ret = (PerlIO*)ptr_table_fetch(PL_ptr_table, fp);
+    if (ret)
+	return ret;
+
+    /* create anew and remember what it is */
+    ret = PerlIO_fdupopen(fp);
+    ptr_table_store(PL_ptr_table, fp, ret);
+    return ret;
 }
 
 DIR *
@@ -5653,19 +6245,28 @@ Perl_gp_dup(pTHX_ GP *gp)
     GP *ret;
     if (!gp)
 	return (GP*)NULL;
+    /* look for it in the table first */
+    ret = (GP*)ptr_table_fetch(PL_ptr_table, gp);
+    if (ret)
+	return ret;
+
+    /* create anew and remember what it is */
     Newz(0, ret, 1, GP);
+    ptr_table_store(PL_ptr_table, gp, ret);
+
+    /* clone */
+    ret->gp_refcnt	= 0;			/* must be before any other dups! */
     ret->gp_sv		= sv_dup_inc(gp->gp_sv);
     ret->gp_io		= io_dup_inc(gp->gp_io);
     ret->gp_form	= cv_dup_inc(gp->gp_form);
     ret->gp_av		= av_dup_inc(gp->gp_av);
     ret->gp_hv		= hv_dup_inc(gp->gp_hv);
-    ret->gp_egv		= gv_dup_inc(gp->gp_egv);
+    ret->gp_egv		= gv_dup(gp->gp_egv);	/* GvEGV is not refcounted */
     ret->gp_cv		= cv_dup_inc(gp->gp_cv);
     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 */
-    ret->gp_refcnt	= 0;
     return ret;
 }
 
@@ -5676,6 +6277,11 @@ Perl_mg_dup(pTHX_ MAGIC *mg)
     MAGIC *mgprev;
     if (!mg)
 	return (MAGIC*)NULL;
+    /* look for it in the table first */
+    mgret = (MAGIC*)ptr_table_fetch(PL_ptr_table, mg);
+    if (mgret)
+	return mgret;
+
     for (; mg; mg = mg->mg_moremagic) {
 	MAGIC *nmg;
 	Newz(0, nmg, 1, MAGIC);
@@ -5698,8 +6304,17 @@ Perl_mg_dup(pTHX_ MAGIC *mg)
 	nmg->mg_len	= mg->mg_len;
 	nmg->mg_ptr	= mg->mg_ptr;	/* XXX random ptr? */
 	if (mg->mg_ptr && mg->mg_type != 'g') {
-	    if (mg->mg_len >= 0)
+	    if (mg->mg_len >= 0) {
 		nmg->mg_ptr	= SAVEPVN(mg->mg_ptr, mg->mg_len);
+		if (mg->mg_type == 'c' && AMT_AMAGIC((AMT*)mg->mg_ptr)) {
+		    AMT *amtp = (AMT*)mg->mg_ptr;
+		    AMT *namtp = (AMT*)nmg->mg_ptr;
+		    I32 i;
+		    for (i = 1; i < NofAMmeth; i++) {
+			namtp->table[i] = cv_dup_inc(amtp->table[i]);
+		    }
+		}
+	    }
 	    else if (mg->mg_len == HEf_SVKEY)
 		nmg->mg_ptr	= (char*)sv_dup_inc((SV*)mg->mg_ptr);
 	}
@@ -5708,75 +6323,79 @@ Perl_mg_dup(pTHX_ MAGIC *mg)
     return mgret;
 }
 
-SVTBL *
-Perl_sv_table_new(pTHX)
+PTR_TBL_t *
+Perl_ptr_table_new(pTHX)
 {
-    SVTBL *tbl;
-    Newz(0, tbl, 1, SVTBL);
+    PTR_TBL_t *tbl;
+    Newz(0, tbl, 1, PTR_TBL_t);
     tbl->tbl_max	= 511;
     tbl->tbl_items	= 0;
-    Newz(0, tbl->tbl_ary, tbl->tbl_max + 1, SVTBLENT*);
+    Newz(0, tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
     return tbl;
 }
 
-SV *
-Perl_sv_table_fetch(pTHX_ SVTBL *tbl, SV *sv)
+void *
+Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *sv)
 {
-    SVTBLENT *tblent;
-    UV hash = (UV)sv;
+    PTR_TBL_ENT_t *tblent;
+    UV hash = PTR2UV(sv);
     assert(tbl);
     tblent = tbl->tbl_ary[hash & tbl->tbl_max];
     for (; tblent; tblent = tblent->next) {
 	if (tblent->oldval == sv)
 	    return tblent->newval;
     }
-    return Nullsv;
+    return (void*)NULL;
 }
 
 void
-Perl_sv_table_store(pTHX_ SVTBL *tbl, SV *old, SV *new)
+Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldv, void *newv)
 {
-    SVTBLENT *tblent, **otblent;
-    UV hash = (UV)old;
+    PTR_TBL_ENT_t *tblent, **otblent;
+    /* XXX this may be pessimal on platforms where pointers aren't good
+     * hash values e.g. if they grow faster in the most significant
+     * bits */
+    UV hash = PTR2UV(oldv);
     bool i = 1;
+
     assert(tbl);
     otblent = &tbl->tbl_ary[hash & tbl->tbl_max];
     for (tblent = *otblent; tblent; i=0, tblent = tblent->next) {
-	if (tblent->oldval == old) {
-	    tblent->newval = new;
+	if (tblent->oldval == oldv) {
+	    tblent->newval = newv;
 	    tbl->tbl_items++;
 	    return;
 	}
     }
-    Newz(0, tblent, 1, SVTBLENT);
-    tblent->oldval = old;
-    tblent->newval = new;
+    Newz(0, tblent, 1, PTR_TBL_ENT_t);
+    tblent->oldval = oldv;
+    tblent->newval = newv;
     tblent->next = *otblent;
     *otblent = tblent;
     tbl->tbl_items++;
     if (i && tbl->tbl_items > tbl->tbl_max)
-	sv_table_split(tbl);
+	ptr_table_split(tbl);
 }
 
 void
-Perl_sv_table_split(pTHX_ SVTBL *tbl)
+Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl)
 {
-    SVTBLENT **ary = tbl->tbl_ary;
+    PTR_TBL_ENT_t **ary = tbl->tbl_ary;
     UV oldsize = tbl->tbl_max + 1;
     UV newsize = oldsize * 2;
     UV i;
 
-    Renew(ary, newsize, SVTBLENT*);
-    Zero(&ary[oldsize], newsize-oldsize, SVTBLENT*);
+    Renew(ary, newsize, PTR_TBL_ENT_t*);
+    Zero(&ary[oldsize], newsize-oldsize, PTR_TBL_ENT_t*);
     tbl->tbl_max = --newsize;
     tbl->tbl_ary = ary;
     for (i=0; i < oldsize; i++, ary++) {
-	SVTBLENT **curentp, **entp, *ent;
+	PTR_TBL_ENT_t **curentp, **entp, *ent;
 	if (!*ary)
 	    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;
@@ -5788,6 +6407,10 @@ Perl_sv_table_split(pTHX_ SVTBL *tbl)
     }
 }
 
+#ifdef DEBUGGING
+char *PL_watch_pvx;
+#endif
+
 SV *
 Perl_sv_dup(pTHX_ SV *sstr)
 {
@@ -5796,23 +6419,27 @@ Perl_sv_dup(pTHX_ SV *sstr)
     int stype;
     SV *dstr;
 
-    if (!sstr)
+    if (!sstr || SvTYPE(sstr) == SVTYPEMASK)
 	return Nullsv;
     /* look for it in the table first */
-    dstr = sv_table_fetch(PL_sv_table, sstr);
+    dstr = (SV*)ptr_table_fetch(PL_ptr_table, sstr);
     if (dstr)
 	return dstr;
 
-    /* XXX TODO: sanity-check sv_dup() vs sv_dup_inc() appropriateness */
-
     /* create anew and remember what it is */
     new_SV(dstr);
-    sv_table_store(PL_sv_table, sstr, dstr);
+    ptr_table_store(PL_ptr_table, sstr, dstr);
 
     /* clone */
     SvFLAGS(dstr)	= SvFLAGS(sstr);
     SvFLAGS(dstr)	&= ~SVf_OOK;		/* don't propagate OOK hack */
-    SvREFCNT(dstr)	= 0;
+    SvREFCNT(dstr)	= 0;			/* must be before any other dups! */
+
+#ifdef DEBUGGING
+    if (SvANY(sstr) && PL_watch_pvx && SvPVX(sstr) == PL_watch_pvx)
+	PerlIO_printf(Perl_debug_log, "watch at %p hit, found string \"%s\"\n",
+		      PL_watch_pvx, SvPVX(sstr));
+#endif
 
     switch (SvTYPE(sstr)) {
     case SVt_NULL:
@@ -5834,8 +6461,10 @@ Perl_sv_dup(pTHX_ SV *sstr)
 	SvANY(dstr)	= new_XPV();
 	SvCUR(dstr)	= SvCUR(sstr);
 	SvLEN(dstr)	= SvLEN(sstr);
-	if (SvPOKp(sstr) && SvLEN(sstr))
-	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+	if (SvROK(sstr))
+	    SvRV(dstr)	= sv_dup_inc(SvRV(sstr));
+	else if (SvPVX(sstr) && SvLEN(sstr))
+	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
 	else
 	    SvPVX(dstr)	= SvPVX(sstr);		/* XXX shared string/random ptr? */
 	break;
@@ -5844,8 +6473,10 @@ Perl_sv_dup(pTHX_ SV *sstr)
 	SvCUR(dstr)	= SvCUR(sstr);
 	SvLEN(dstr)	= SvLEN(sstr);
 	SvIVX(dstr)	= SvIVX(sstr);
-	if (SvPOKp(sstr) && SvLEN(sstr))
-	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+	if (SvROK(sstr))
+	    SvRV(dstr)	= sv_dup_inc(SvRV(sstr));
+	else if (SvPVX(sstr) && SvLEN(sstr))
+	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
 	else
 	    SvPVX(dstr)	= SvPVX(sstr);		/* XXX shared string/random ptr? */
 	break;
@@ -5855,8 +6486,10 @@ Perl_sv_dup(pTHX_ SV *sstr)
 	SvLEN(dstr)	= SvLEN(sstr);
 	SvIVX(dstr)	= SvIVX(sstr);
 	SvNVX(dstr)	= SvNVX(sstr);
-	if (SvPOKp(sstr) && SvLEN(sstr))
-	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+	if (SvROK(sstr))
+	    SvRV(dstr)	= sv_dup_inc(SvRV(sstr));
+	else if (SvPVX(sstr) && SvLEN(sstr))
+	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
 	else
 	    SvPVX(dstr)	= SvPVX(sstr);		/* XXX shared string/random ptr? */
 	break;
@@ -5867,12 +6500,11 @@ Perl_sv_dup(pTHX_ SV *sstr)
 	SvIVX(dstr)	= SvIVX(sstr);
 	SvNVX(dstr)	= SvNVX(sstr);
 	SvMAGIC(dstr)	= mg_dup(SvMAGIC(sstr));
-	if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
-	    SvSTASH(dstr)	= SvSTASH(sstr);	/* COP* in disguise */
-	else
-	    SvSTASH(dstr)	= hv_dup_inc(SvSTASH(sstr));
-	if (SvPOKp(sstr) && SvLEN(sstr))
-	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+	SvSTASH(dstr)	= hv_dup_inc(SvSTASH(sstr));
+	if (SvROK(sstr))
+	    SvRV(dstr)	= sv_dup_inc(SvRV(sstr));
+	else if (SvPVX(sstr) && SvLEN(sstr))
+	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
 	else
 	    SvPVX(dstr)	= SvPVX(sstr);		/* XXX shared string/random ptr? */
 	break;
@@ -5883,11 +6515,10 @@ Perl_sv_dup(pTHX_ SV *sstr)
 	SvIVX(dstr)	= SvIVX(sstr);
 	SvNVX(dstr)	= SvNVX(sstr);
 	SvMAGIC(dstr)	= mg_dup(SvMAGIC(sstr));
-	if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
-	    SvSTASH(dstr)	= SvSTASH(sstr);	/* COP* in disguise */
-	else
-	    SvSTASH(dstr)	= hv_dup_inc(SvSTASH(sstr));
-	if (SvPOKp(sstr) && SvLEN(sstr))
+	SvSTASH(dstr)	= hv_dup_inc(SvSTASH(sstr));
+	if (SvROK(sstr))
+	    SvRV(dstr)	= sv_dup_inc(SvRV(sstr));
+	else if (SvPVX(sstr) && SvLEN(sstr))
 	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
 	else
 	    SvPVX(dstr)	= SvPVX(sstr);		/* XXX shared string/random ptr? */
@@ -5902,12 +6533,11 @@ Perl_sv_dup(pTHX_ SV *sstr)
 	SvIVX(dstr)	= SvIVX(sstr);
 	SvNVX(dstr)	= SvNVX(sstr);
 	SvMAGIC(dstr)	= mg_dup(SvMAGIC(sstr));
-	if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
-	    SvSTASH(dstr)	= SvSTASH(sstr);	/* COP* in disguise */
-	else
-	    SvSTASH(dstr)	= hv_dup_inc(SvSTASH(sstr));
-	if (SvPOKp(sstr) && SvLEN(sstr))
-	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+	SvSTASH(dstr)	= hv_dup_inc(SvSTASH(sstr));
+	if (SvROK(sstr))
+	    SvRV(dstr)	= sv_dup_inc(SvRV(sstr));
+	else if (SvPVX(sstr) && SvLEN(sstr))
+	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
 	else
 	    SvPVX(dstr)	= SvPVX(sstr);		/* XXX shared string/random ptr? */
 	LvTARGOFF(dstr)	= LvTARGOFF(sstr);	/* XXX sometimes holds PMOP* when DEBUGGING */
@@ -5922,12 +6552,11 @@ Perl_sv_dup(pTHX_ SV *sstr)
 	SvIVX(dstr)	= SvIVX(sstr);
 	SvNVX(dstr)	= SvNVX(sstr);
 	SvMAGIC(dstr)	= mg_dup(SvMAGIC(sstr));
-	if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
-	    SvSTASH(dstr)	= SvSTASH(sstr);	/* COP* in disguise */
-	else
-	    SvSTASH(dstr)	= hv_dup_inc(SvSTASH(sstr));
-	if (SvPOKp(sstr) && SvLEN(sstr))
-	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+	SvSTASH(dstr)	= hv_dup_inc(SvSTASH(sstr));
+	if (SvROK(sstr))
+	    SvRV(dstr)	= sv_dup_inc(SvRV(sstr));
+	else if (SvPVX(sstr) && SvLEN(sstr))
+	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
 	else
 	    SvPVX(dstr)	= SvPVX(sstr);		/* XXX shared string/random ptr? */
 	GvNAMELEN(dstr)	= GvNAMELEN(sstr);
@@ -5935,7 +6564,7 @@ Perl_sv_dup(pTHX_ SV *sstr)
 	GvSTASH(dstr)	= hv_dup_inc(GvSTASH(sstr));
 	GvFLAGS(dstr)	= GvFLAGS(sstr);
 	GvGP(dstr)	= gp_dup(GvGP(sstr));
-	GvGP(dstr)->gp_refcnt++;
+	(void)GpREFCNT_inc(GvGP(dstr));
 	break;
     case SVt_PVIO:
 	SvANY(dstr)	= new_XPVIO();
@@ -5944,19 +6573,18 @@ Perl_sv_dup(pTHX_ SV *sstr)
 	SvIVX(dstr)	= SvIVX(sstr);
 	SvNVX(dstr)	= SvNVX(sstr);
 	SvMAGIC(dstr)	= mg_dup(SvMAGIC(sstr));
-	if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
-	    SvSTASH(dstr)	= SvSTASH(sstr);	/* COP* in disguise */
-	else
-	    SvSTASH(dstr)	= hv_dup_inc(SvSTASH(sstr));
-	if (SvPOKp(sstr) && SvLEN(sstr))
-	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+	SvSTASH(dstr)	= hv_dup_inc(SvSTASH(sstr));
+	if (SvROK(sstr))
+	    SvRV(dstr)	= sv_dup_inc(SvRV(sstr));
+	else if (SvPVX(sstr) && SvLEN(sstr))
+	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
 	else
 	    SvPVX(dstr)	= SvPVX(sstr);		/* XXX shared string/random ptr? */
-	IoIFP(dstr)		= fp_dup(IoIFP(sstr), IoTYPE(sstr));
+	IoIFP(dstr)	= fp_dup(IoIFP(sstr), IoTYPE(sstr));
 	if (IoOFP(sstr) == IoIFP(sstr))
 	    IoOFP(dstr) = IoIFP(dstr);
 	else
-	    IoOFP(dstr)		= fp_dup(IoOFP(sstr), IoTYPE(sstr));
+	    IoOFP(dstr)	= fp_dup(IoOFP(sstr), IoTYPE(sstr));
 	/* PL_rsfp_filters entries have fake IoDIRP() */
 	if (IoDIRP(sstr) && !(IoFLAGS(sstr) & IOf_FAKE_DIRP))
 	    IoDIRP(dstr)	= dirp_dup(IoDIRP(sstr));
@@ -5986,12 +6614,13 @@ Perl_sv_dup(pTHX_ SV *sstr)
 	SvSTASH(dstr)	= hv_dup_inc(SvSTASH(sstr));
 	AvARYLEN((AV*)dstr) = sv_dup_inc(AvARYLEN((AV*)sstr));
 	AvFLAGS((AV*)dstr) = AvFLAGS((AV*)sstr);
-	if (AvALLOC((AV*)sstr)) {
+	if (AvARRAY((AV*)sstr)) {
 	    SV **dst_ary, **src_ary;
 	    SSize_t items = AvFILLp((AV*)sstr) + 1;
 
-	    src_ary = AvALLOC((AV*)sstr);
+	    src_ary = AvARRAY((AV*)sstr);
 	    Newz(0, dst_ary, AvMAX((AV*)sstr)+1, SV*);
+	    ptr_table_store(PL_ptr_table, src_ary, dst_ary);
 	    SvPVX(dstr)	= (char*)dst_ary;
 	    AvALLOC((AV*)dstr) = dst_ary;
 	    if (AvREAL((AV*)sstr)) {
@@ -6029,34 +6658,22 @@ Perl_sv_dup(pTHX_ SV *sstr)
 	    Newz(0, dxhv->xhv_array,
 		 PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1), char);
 	    while (i <= sxhv->xhv_max) {
-		HE *dentry, *oentry;
-		entry = ((HE**)sxhv->xhv_array)[i];
-		dentry = he_dup(entry, !!HvSHAREKEYS(sstr));
-		((HE**)dxhv->xhv_array)[i] = dentry;
-		while (entry) {
-		    entry = HeNEXT(entry);
-		    oentry = dentry;
-		    dentry = he_dup(entry, !!HvSHAREKEYS(sstr));
-		    HeNEXT(oentry) = dentry;
-		}
+		((HE**)dxhv->xhv_array)[i] = he_dup(((HE**)sxhv->xhv_array)[i],
+						    !!HvSHAREKEYS(sstr));
 		++i;
 	    }
-	    if (sxhv->xhv_riter >= 0 && sxhv->xhv_eiter) {
-		entry = ((HE**)sxhv->xhv_array)[sxhv->xhv_riter];
-		while (entry && entry != sxhv->xhv_eiter)
-		    entry = HeNEXT(entry);
-		dxhv->xhv_eiter = entry;
-	    }
-	    else
-		dxhv->xhv_eiter = (HE*)NULL;
+	    dxhv->xhv_eiter = he_dup(sxhv->xhv_eiter, !!HvSHAREKEYS(sstr));
 	}
-	else
+	else {
 	    SvPVX(dstr)		= Nullch;
+	    HvEITER((HV*)dstr)	= (HE*)NULL;
+	}
 	HvPMROOT((HV*)dstr)	= HvPMROOT((HV*)sstr);		/* XXX */
 	HvNAME((HV*)dstr)	= SAVEPV(HvNAME((HV*)sstr));
 	break;
     case SVt_PVFM:
 	SvANY(dstr)	= new_XPVFM();
+	FmLINES(dstr)	= FmLINES(sstr);
 	goto dup_pvcv;
 	/* NOTREACHED */
     case SVt_PVCV:
@@ -6067,12 +6684,9 @@ dup_pvcv:
 	SvIVX(dstr)	= SvIVX(sstr);
 	SvNVX(dstr)	= SvNVX(sstr);
 	SvMAGIC(dstr)	= mg_dup(SvMAGIC(sstr));
-	if (SvSMAGICAL(sstr) && mg_find(sstr, 'l'))
-	    SvSTASH(dstr)	= SvSTASH(sstr);	/* COP* in disguise */
-	else
-	    SvSTASH(dstr)	= hv_dup_inc(SvSTASH(sstr));
-	if (SvPOKp(sstr) && SvLEN(sstr))
-	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+	SvSTASH(dstr)	= hv_dup_inc(SvSTASH(sstr));
+	if (SvPVX(sstr) && SvLEN(sstr))
+	    SvPVX(dstr)	= SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
 	else
 	    SvPVX(dstr)	= SvPVX(sstr);		/* XXX shared string/random ptr? */
 	CvSTASH(dstr)	= hv_dup(CvSTASH(sstr));/* NOTE: not refcounted */
@@ -6082,7 +6696,15 @@ dup_pvcv:
 	CvXSUBANY(dstr)	= CvXSUBANY(sstr);
 	CvGV(dstr)	= gv_dup_inc(CvGV(sstr));
 	CvDEPTH(dstr)	= CvDEPTH(sstr);
-	CvPADLIST(dstr)	= av_dup_inc(CvPADLIST(sstr));
+	if (CvPADLIST(sstr) && !AvREAL(CvPADLIST(sstr))) {
+	    /* XXX padlists are real, but pretend to be not */
+	    AvREAL_on(CvPADLIST(sstr));
+	    CvPADLIST(dstr)	= av_dup_inc(CvPADLIST(sstr));
+	    AvREAL_off(CvPADLIST(sstr));
+	    AvREAL_off(CvPADLIST(dstr));
+	}
+	else
+	    CvPADLIST(dstr)	= av_dup_inc(CvPADLIST(sstr));
 	CvOUTSIDE(dstr)	= cv_dup_inc(CvOUTSIDE(sstr));
 	CvFLAGS(dstr)	= CvFLAGS(sstr);
 	break;
@@ -6091,49 +6713,479 @@ dup_pvcv:
 	break;
     }
 
-    if (SvOBJECT(dstr))
+    if (SvOBJECT(dstr) && SvTYPE(dstr) != SVt_PVIO)
 	++PL_sv_objcount;
 
     return dstr;
 }
 
+PERL_CONTEXT *
+Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max)
+{
+    PERL_CONTEXT *ncxs;
+
+    if (!cxs)
+	return (PERL_CONTEXT*)NULL;
+
+    /* look for it in the table first */
+    ncxs = (PERL_CONTEXT*)ptr_table_fetch(PL_ptr_table, cxs);
+    if (ncxs)
+	return ncxs;
+
+    /* create anew and remember what it is */
+    Newz(56, ncxs, max + 1, PERL_CONTEXT);
+    ptr_table_store(PL_ptr_table, cxs, ncxs);
+
+    while (ix >= 0) {
+	PERL_CONTEXT *cx = &cxs[ix];
+	PERL_CONTEXT *ncx = &ncxs[ix];
+	ncx->cx_type	= cx->cx_type;
+	if (CxTYPE(cx) == CXt_SUBST) {
+	    Perl_croak(aTHX_ "Cloning substitution context is unimplemented");
+	}
+	else {
+	    ncx->blk_oldsp	= cx->blk_oldsp;
+	    ncx->blk_oldcop	= cx->blk_oldcop;
+	    ncx->blk_oldretsp	= cx->blk_oldretsp;
+	    ncx->blk_oldmarksp	= cx->blk_oldmarksp;
+	    ncx->blk_oldscopesp	= cx->blk_oldscopesp;
+	    ncx->blk_oldpm	= cx->blk_oldpm;
+	    ncx->blk_gimme	= cx->blk_gimme;
+	    switch (CxTYPE(cx)) {
+	    case CXt_SUB:
+		ncx->blk_sub.cv		= (cx->blk_sub.olddepth == 0
+					   ? cv_dup_inc(cx->blk_sub.cv)
+					   : cv_dup(cx->blk_sub.cv));
+		ncx->blk_sub.argarray	= (cx->blk_sub.hasargs
+					   ? av_dup_inc(cx->blk_sub.argarray)
+					   : Nullav);
+		ncx->blk_sub.savearray	= av_dup(cx->blk_sub.savearray);
+		ncx->blk_sub.olddepth	= cx->blk_sub.olddepth;
+		ncx->blk_sub.hasargs	= cx->blk_sub.hasargs;
+		ncx->blk_sub.lval	= cx->blk_sub.lval;
+		break;
+	    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_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;
+	    case CXt_LOOP:
+		ncx->blk_loop.label	= cx->blk_loop.label;
+		ncx->blk_loop.resetsp	= cx->blk_loop.resetsp;
+		ncx->blk_loop.redo_op	= cx->blk_loop.redo_op;
+		ncx->blk_loop.next_op	= cx->blk_loop.next_op;
+		ncx->blk_loop.last_op	= cx->blk_loop.last_op;
+		ncx->blk_loop.iterdata	= (CxPADLOOP(cx)
+					   ? cx->blk_loop.iterdata
+					   : gv_dup((GV*)cx->blk_loop.iterdata));
+		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);
+		ncx->blk_loop.iterix	= cx->blk_loop.iterix;
+		ncx->blk_loop.itermax	= cx->blk_loop.itermax;
+		break;
+	    case CXt_FORMAT:
+		ncx->blk_sub.cv		= cv_dup(cx->blk_sub.cv);
+		ncx->blk_sub.gv		= gv_dup(cx->blk_sub.gv);
+		ncx->blk_sub.dfoutgv	= gv_dup_inc(cx->blk_sub.dfoutgv);
+		ncx->blk_sub.hasargs	= cx->blk_sub.hasargs;
+		break;
+	    case CXt_BLOCK:
+	    case CXt_NULL:
+		break;
+	    }
+	}
+	--ix;
+    }
+    return ncxs;
+}
+
+PERL_SI *
+Perl_si_dup(pTHX_ PERL_SI *si)
+{
+    PERL_SI *nsi;
+
+    if (!si)
+	return (PERL_SI*)NULL;
+
+    /* look for it in the table first */
+    nsi = (PERL_SI*)ptr_table_fetch(PL_ptr_table, si);
+    if (nsi)
+	return nsi;
+
+    /* create anew and remember what it is */
+    Newz(56, nsi, 1, PERL_SI);
+    ptr_table_store(PL_ptr_table, si, nsi);
+
+    nsi->si_stack	= av_dup_inc(si->si_stack);
+    nsi->si_cxix	= si->si_cxix;
+    nsi->si_cxmax	= si->si_cxmax;
+    nsi->si_cxstack	= cx_dup(si->si_cxstack, si->si_cxix, si->si_cxmax);
+    nsi->si_type	= si->si_type;
+    nsi->si_prev	= si_dup(si->si_prev);
+    nsi->si_next	= si_dup(si->si_next);
+    nsi->si_markoff	= si->si_markoff;
+
+    return nsi;
+}
+
+#define POPINT(ss,ix)	((ss)[--(ix)].any_i32)
+#define TOPINT(ss,ix)	((ss)[ix].any_i32)
+#define POPLONG(ss,ix)	((ss)[--(ix)].any_long)
+#define TOPLONG(ss,ix)	((ss)[ix].any_long)
+#define POPIV(ss,ix)	((ss)[--(ix)].any_iv)
+#define TOPIV(ss,ix)	((ss)[ix].any_iv)
+#define POPPTR(ss,ix)	((ss)[--(ix)].any_ptr)
+#define TOPPTR(ss,ix)	((ss)[ix].any_ptr)
+#define POPDPTR(ss,ix)	((ss)[--(ix)].any_dptr)
+#define TOPDPTR(ss,ix)	((ss)[ix].any_dptr)
+#define POPDXPTR(ss,ix)	((ss)[--(ix)].any_dxptr)
+#define TOPDXPTR(ss,ix)	((ss)[ix].any_dxptr)
+
+/* XXXXX todo */
+#define pv_dup_inc(p)	SAVEPV(p)
+#define pv_dup(p)	SAVEPV(p)
+#define svp_dup_inc(p,pp)	any_dup(p,pp)
+
+void *
+Perl_any_dup(pTHX_ void *v, PerlInterpreter *proto_perl)
+{
+    void *ret;
+
+    if (!v)
+	return (void*)NULL;
+
+    /* look for it in the table first */
+    ret = ptr_table_fetch(PL_ptr_table, v);
+    if (ret)
+	return ret;
+
+    /* see if it is part of the interpreter structure */
+    if (v >= (void*)proto_perl && v < (void*)(proto_perl+1))
+	ret = (void*)(((char*)aTHXo) + (((char*)v) - (char*)proto_perl));
+    else
+	ret = v;
+
+    return ret;
+}
+
+ANY *
+Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl)
+{
+    ANY *ss	= proto_perl->Tsavestack;
+    I32 ix	= proto_perl->Tsavestack_ix;
+    I32 max	= proto_perl->Tsavestack_max;
+    ANY *nss;
+    SV *sv;
+    GV *gv;
+    AV *av;
+    HV *hv;
+    void* ptr;
+    int intval;
+    long longval;
+    GP *gp;
+    IV iv;
+    I32 i;
+    char *c;
+    void (*dptr) (void*);
+    void (*dxptr) (pTHXo_ void*);
+
+    Newz(54, nss, max, ANY);
+
+    while (ix > 0) {
+	i = POPINT(ss,ix);
+	TOPINT(nss,ix) = i;
+	switch (i) {
+	case SAVEt_ITEM:			/* normal string */
+	    sv = (SV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = sv_dup_inc(sv);
+	    sv = (SV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = sv_dup_inc(sv);
+	    break;
+        case SAVEt_SV:				/* scalar reference */
+	    sv = (SV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = sv_dup_inc(sv);
+	    gv = (GV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = gv_dup_inc(gv);
+	    break;
+        case SAVEt_GENERIC_SVREF:		/* generic sv */
+        case SAVEt_SVREF:			/* scalar reference */
+	    sv = (SV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = sv_dup_inc(sv);
+	    ptr = POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = svp_dup_inc((SV**)ptr, proto_perl);/* XXXXX */
+	    break;
+        case SAVEt_AV:				/* array reference */
+	    av = (AV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = av_dup_inc(av);
+	    gv = (GV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = gv_dup(gv);
+	    break;
+        case SAVEt_HV:				/* hash reference */
+	    hv = (HV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = hv_dup_inc(hv);
+	    gv = (GV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = gv_dup(gv);
+	    break;
+	case SAVEt_INT:				/* int reference */
+	    ptr = POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+	    intval = (int)POPINT(ss,ix);
+	    TOPINT(nss,ix) = intval;
+	    break;
+	case SAVEt_LONG:			/* long reference */
+	    ptr = POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+	    longval = (long)POPLONG(ss,ix);
+	    TOPLONG(nss,ix) = longval;
+	    break;
+	case SAVEt_I32:				/* I32 reference */
+	case SAVEt_I16:				/* I16 reference */
+	case SAVEt_I8:				/* I8 reference */
+	    ptr = POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+	    i = POPINT(ss,ix);
+	    TOPINT(nss,ix) = i;
+	    break;
+	case SAVEt_IV:				/* IV reference */
+	    ptr = POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+	    iv = POPIV(ss,ix);
+	    TOPIV(nss,ix) = iv;
+	    break;
+	case SAVEt_SPTR:			/* SV* reference */
+	    ptr = POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+	    sv = (SV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = sv_dup(sv);
+	    break;
+	case SAVEt_VPTR:			/* random* reference */
+	    ptr = POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+	    ptr = POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+	    break;
+	case SAVEt_PPTR:			/* char* reference */
+	    ptr = POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+	    c = (char*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = pv_dup(c);
+	    break;
+	case SAVEt_HPTR:			/* HV* reference */
+	    ptr = POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+	    hv = (HV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = hv_dup(hv);
+	    break;
+	case SAVEt_APTR:			/* AV* reference */
+	    ptr = POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+	    av = (AV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = av_dup(av);
+	    break;
+	case SAVEt_NSTAB:
+	    gv = (GV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = gv_dup(gv);
+	    break;
+	case SAVEt_GP:				/* scalar reference */
+	    gp = (GP*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = gp = gp_dup(gp);
+	    (void)GpREFCNT_inc(gp);
+	    gv = (GV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = gv_dup_inc(c);
+            c = (char*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = pv_dup(c);
+	    iv = POPIV(ss,ix);
+	    TOPIV(nss,ix) = iv;
+	    iv = POPIV(ss,ix);
+	    TOPIV(nss,ix) = iv;
+            break;
+	case SAVEt_FREESV:
+	    sv = (SV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = sv_dup_inc(sv);
+	    break;
+	case SAVEt_FREEOP:
+	    ptr = POPPTR(ss,ix);
+	    if (ptr && (((OP*)ptr)->op_private & OPpREFCOUNTED)) {
+		/* these are assumed to be refcounted properly */
+		switch (((OP*)ptr)->op_type) {
+		case OP_LEAVESUB:
+		case OP_LEAVESUBLV:
+		case OP_LEAVEEVAL:
+		case OP_LEAVE:
+		case OP_SCOPE:
+		case OP_LEAVEWRITE:
+		    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+		    break;
+		default:
+		    TOPPTR(nss,ix) = Nullop;
+		    break;
+		}
+	    }
+	    else
+		TOPPTR(nss,ix) = Nullop;
+	    break;
+	case SAVEt_FREEPV:
+	    c = (char*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = pv_dup_inc(c);
+	    break;
+	case SAVEt_CLEARSV:
+	    longval = POPLONG(ss,ix);
+	    TOPLONG(nss,ix) = longval;
+	    break;
+	case SAVEt_DELETE:
+	    hv = (HV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = hv_dup_inc(hv);
+	    c = (char*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = pv_dup_inc(c);
+	    i = POPINT(ss,ix);
+	    TOPINT(nss,ix) = i;
+	    break;
+	case SAVEt_DESTRUCTOR:
+	    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);
+	    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);
+	    break;
+	case SAVEt_REGCONTEXT:
+	case SAVEt_ALLOC:
+	    i = POPINT(ss,ix);
+	    TOPINT(nss,ix) = i;
+	    ix -= i;
+	    break;
+	case SAVEt_STACK_POS:		/* Position on Perl stack */
+	    i = POPINT(ss,ix);
+	    TOPINT(nss,ix) = i;
+	    break;
+	case SAVEt_AELEM:		/* array element */
+	    sv = (SV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = sv_dup_inc(sv);
+	    i = POPINT(ss,ix);
+	    TOPINT(nss,ix) = i;
+	    av = (AV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = av_dup_inc(av);
+	    break;
+	case SAVEt_HELEM:		/* hash element */
+	    sv = (SV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = sv_dup_inc(sv);
+	    sv = (SV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = sv_dup_inc(sv);
+	    hv = (HV*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = hv_dup_inc(hv);
+	    break;
+	case SAVEt_OP:
+	    ptr = POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = ptr;
+	    break;
+	case SAVEt_HINTS:
+	    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");
+	}
+    }
+
+    return nss;
+}
+
+#ifdef PERL_OBJECT
+#include "XSUB.h"
+#endif
+
+PerlInterpreter *
+perl_clone(PerlInterpreter *proto_perl, UV flags)
+{
+#ifdef PERL_OBJECT
+    CPerlObj *pPerl = (CPerlObj*)proto_perl;
+#endif
+
+#ifdef PERL_IMPLICIT_SYS
+    return perl_clone_using(proto_perl, flags,
+			    proto_perl->IMem,
+			    proto_perl->IMemShared,
+			    proto_perl->IMemParse,
+			    proto_perl->IEnv,
+			    proto_perl->IStdIO,
+			    proto_perl->ILIO,
+			    proto_perl->IDir,
+			    proto_perl->ISock,
+			    proto_perl->IProc);
+}
+
 PerlInterpreter *
-perl_clone_using(PerlInterpreter *proto_perl, IV flags,
-		 struct IPerlMem* ipM, struct IPerlEnv* ipE,
+perl_clone_using(PerlInterpreter *proto_perl, UV flags,
+		 struct IPerlMem* ipM, struct IPerlMem* ipMS,
+		 struct IPerlMem* ipMP, struct IPerlEnv* ipE,
 		 struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO,
 		 struct IPerlDir* ipD, struct IPerlSock* ipS,
 		 struct IPerlProc* ipP)
 {
+    /* XXX many of the string copies here can be optimized if they're
+     * constants; they need to be allocated as common memory and just
+     * 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);
+#  else		/* !PERL_OBJECT */
     PerlInterpreter *my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
     PERL_SET_INTERP(my_perl);
 
-#ifdef DEBUGGING
+#    ifdef DEBUGGING
     memset(my_perl, 0xab, sizeof(PerlInterpreter));
     PL_markstack = 0;
     PL_scopestack = 0;
     PL_savestack = 0;
     PL_retstack = 0;
-#else
-#  if 0
-    Copy(proto_perl, my_perl, 1, PerlInterpreter);
-#  endif
-#endif
-
-    /* XXX many of the string copies here can be optimized if they're
-     * constants; they need to be allocated as common memory and just
-     * their pointers copied. */
+#    else	/* !DEBUGGING */
+    Zero(my_perl, 1, PerlInterpreter);
+#    endif	/* DEBUGGING */
 
     /* host pointers */
     PL_Mem		= ipM;
+    PL_MemShared	= ipMS;
+    PL_MemParse		= ipMP;
     PL_Env		= ipE;
     PL_StdIO		= ipStd;
     PL_LIO		= ipLIO;
     PL_Dir		= ipD;
     PL_Sock		= ipS;
     PL_Proc		= ipP;
+#  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);
+
+#    ifdef DEBUGGING
+    memset(my_perl, 0xab, sizeof(PerlInterpreter));
+    PL_markstack = 0;
+    PL_scopestack = 0;
+    PL_savestack = 0;
+    PL_retstack = 0;
+#    else	/* !DEBUGGING */
+    Zero(my_perl, 1, PerlInterpreter);
+#    endif	/* DEBUGGING */
+#endif		/* PERL_IMPLICIT_SYS */
 
     /* arena roots */
     PL_xiv_arenaroot	= NULL;
@@ -6160,46 +7212,53 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
     PL_debug		= proto_perl->Idebug;
 
     /* create SV map for pointer relocation */
-    PL_sv_table = sv_table_new();
+    PL_ptr_table = ptr_table_new();
 
     /* initialize these special pointers as early as possible */
     SvANY(&PL_sv_undef)		= NULL;
     SvREFCNT(&PL_sv_undef)	= (~(U32)0)/2;
     SvFLAGS(&PL_sv_undef)	= SVf_READONLY|SVt_NULL;
-    sv_table_store(PL_sv_table, &proto_perl->Isv_undef, &PL_sv_undef);
+    ptr_table_store(PL_ptr_table, &proto_perl->Isv_undef, &PL_sv_undef);
 
+#ifdef PERL_OBJECT
+    SvUPGRADE(&PL_sv_no, SVt_PVNV);
+#else
     SvANY(&PL_sv_no)		= new_XPVNV();
+#endif
     SvREFCNT(&PL_sv_no)		= (~(U32)0)/2;
     SvFLAGS(&PL_sv_no)		= SVp_NOK|SVf_NOK|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
     SvPVX(&PL_sv_no)		= SAVEPVN(PL_No, 0);
     SvCUR(&PL_sv_no)		= 0;
     SvLEN(&PL_sv_no)		= 1;
     SvNVX(&PL_sv_no)		= 0;
-    sv_table_store(PL_sv_table, &proto_perl->Isv_no, &PL_sv_no);
+    ptr_table_store(PL_ptr_table, &proto_perl->Isv_no, &PL_sv_no);
 
+#ifdef PERL_OBJECT
+    SvUPGRADE(&PL_sv_yes, SVt_PVNV);
+#else
     SvANY(&PL_sv_yes)		= new_XPVNV();
+#endif
     SvREFCNT(&PL_sv_yes)	= (~(U32)0)/2;
     SvFLAGS(&PL_sv_yes)		= SVp_NOK|SVf_NOK|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
     SvPVX(&PL_sv_yes)		= SAVEPVN(PL_Yes, 1);
     SvCUR(&PL_sv_yes)		= 1;
     SvLEN(&PL_sv_yes)		= 2;
     SvNVX(&PL_sv_yes)		= 1;
-    sv_table_store(PL_sv_table, &proto_perl->Isv_yes, &PL_sv_yes);
+    ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
 
     /* create shared string table */
     PL_strtab		= newHV();
     HvSHAREKEYS_off(PL_strtab);
     hv_ksplit(PL_strtab, 512);
-    sv_table_store(PL_sv_table, (SV*)proto_perl->Istrtab, (SV*)PL_strtab);
+    ptr_table_store(PL_ptr_table, proto_perl->Istrtab, PL_strtab);
 
     PL_compiling		= proto_perl->Icompiling;
     PL_compiling.cop_stashpv	= SAVEPV(PL_compiling.cop_stashpv);
     PL_compiling.cop_file	= SAVEPV(PL_compiling.cop_file);
-    PL_compiling.cop_warnings	= sv_dup_inc(PL_compiling.cop_warnings);
-    if (proto_perl->Tcurcop == &proto_perl->Icompiling)
-	PL_curcop	= &PL_compiling;
-    else
-	PL_curcop	= proto_perl->Tcurcop;
+    ptr_table_store(PL_ptr_table, &proto_perl->Icompiling, &PL_compiling);
+    if (!specialWARN(PL_compiling.cop_warnings))
+	PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings);
+    PL_curcop		= (COP*)any_dup(proto_perl->Tcurcop, proto_perl);
 
     /* pseudo environmental stuff */
     PL_origargc		= proto_perl->Iorigargc;
@@ -6218,7 +7277,7 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
 
     /* switches */
     PL_minus_c		= proto_perl->Iminus_c;
-    Copy(proto_perl->Ipatchlevel, PL_patchlevel, 10, char);
+    PL_patchlevel	= sv_dup_inc(proto_perl->Ipatchlevel);
     PL_localpatches	= proto_perl->Ilocalpatches;
     PL_splitstr		= proto_perl->Isplitstr;
     PL_preprocess	= proto_perl->Ipreprocess;
@@ -6238,7 +7297,7 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
     PL_perl_destruct_level = proto_perl->Iperl_destruct_level;
 
     /* magical thingies */
-    /* XXX time(&PL_basetime) instead? */
+    /* XXX time(&PL_basetime) when asked for? */
     PL_basetime		= proto_perl->Ibasetime;
     PL_formfeed		= sv_dup(proto_perl->Iformfeed);
 
@@ -6282,7 +7341,7 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
 
     PL_beginav		= av_dup_inc(proto_perl->Ibeginav);
     PL_endav		= av_dup_inc(proto_perl->Iendav);
-    PL_stopav		= av_dup_inc(proto_perl->Istopav);
+    PL_checkav		= av_dup_inc(proto_perl->Icheckav);
     PL_initav		= av_dup_inc(proto_perl->Iinitav);
 
     PL_sub_generation	= proto_perl->Isub_generation;
@@ -6291,7 +7350,7 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
     PL_forkprocess	= proto_perl->Iforkprocess;
 
     /* subprocess state */
-    PL_fdpid		= av_dup(proto_perl->Ifdpid);
+    PL_fdpid		= av_dup_inc(proto_perl->Ifdpid);
 
     /* internal state */
     PL_tainting		= proto_perl->Itainting;
@@ -6305,16 +7364,16 @@ perl_clone_using(PerlInterpreter *proto_perl, IV 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	= proto_perl->Ieval_root;
+    PL_eval_root	= OpREFCNT_inc(proto_perl->Ieval_root);
     PL_eval_start	= proto_perl->Ieval_start;
 
     /* runtime control stuff */
-    PL_curcopdb		= proto_perl->Icurcopdb;
+    PL_curcopdb		= (COP*)any_dup(proto_perl->Icurcopdb, proto_perl);
     PL_copline		= proto_perl->Icopline;
 
     PL_filemode		= proto_perl->Ifilemode;
     PL_lastfd		= proto_perl->Ilastfd;
-    PL_oldname		= proto_perl->Ioldname;	/* XXX */
+    PL_oldname		= proto_perl->Ioldname;		/* XXX not quite right */
     PL_Argv		= NULL;
     PL_Cmd		= Nullch;
     PL_gensym		= proto_perl->Igensym;
@@ -6336,19 +7395,20 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
     }
     else
 	PL_exitlist	= (PerlExitListEntry*)NULL;
-    PL_modglobal	= hv_dup(proto_perl->Imodglobal);
+    PL_modglobal	= hv_dup_inc(proto_perl->Imodglobal);
 
-    PL_profiledata	= NULL;			/* XXX */
+    PL_profiledata	= NULL;
     PL_rsfp		= fp_dup(proto_perl->Irsfp, '<');
-    /* XXX PL_rsfp_filters entries have fake IoDIRP() */
-    PL_rsfp_filters	= av_dup(proto_perl->Irsfp_filters);
+    /* PL_rsfp_filters entries have fake IoDIRP() */
+    PL_rsfp_filters	= av_dup_inc(proto_perl->Irsfp_filters);
 
     PL_compcv			= cv_dup(proto_perl->Icompcv);
     PL_comppad			= av_dup(proto_perl->Icomppad);
     PL_comppad_name		= av_dup(proto_perl->Icomppad_name);
     PL_comppad_name_fill	= proto_perl->Icomppad_name_fill;
     PL_comppad_name_floor	= proto_perl->Icomppad_name_floor;
-    PL_curpad			= AvARRAY(PL_comppad);	/* XXX */
+    PL_curpad			= (SV**)ptr_table_fetch(PL_ptr_table,
+							proto_perl->Tcurpad);
 
 #ifdef HAVE_INTERP_INTERN
     sys_intern_dup(&proto_perl->Isys_intern, &PL_sys_intern);
@@ -6357,7 +7417,6 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
     /* more statics moved here */
     PL_generation	= proto_perl->Igeneration;
     PL_DBcv		= cv_dup(proto_perl->IDBcv);
-    PL_archpat_auto	= SAVEPV(proto_perl->Iarchpat_auto);
 
     PL_in_clean_objs	= proto_perl->Iin_clean_objs;
     PL_in_clean_all	= proto_perl->Iin_clean_all;
@@ -6371,9 +7430,9 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
     PL_cop_seqmax	= proto_perl->Icop_seqmax;
     PL_op_seqmax	= proto_perl->Iop_seqmax;
     PL_evalseq		= proto_perl->Ievalseq;
-    PL_origenviron	= proto_perl->Iorigenviron;	/* XXX */
+    PL_origenviron	= proto_perl->Iorigenviron;	/* XXX not quite right */
     PL_origalen		= proto_perl->Iorigalen;
-    PL_pidstatus	= newHV();
+    PL_pidstatus	= newHV();			/* XXX flag for cloning? */
     PL_osname		= SAVEPV(proto_perl->Iosname);
     PL_sh_path		= SAVEPV(proto_perl->Ish_path);
     PL_sighandlerp	= proto_perl->Isighandlerp;
@@ -6381,7 +7440,7 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
 
     PL_runops		= proto_perl->Irunops;
 
-    Copy(proto_perl->Itokenbuf, PL_tokenbuf, 256, char);	/* XXX */
+    Copy(proto_perl->Itokenbuf, PL_tokenbuf, 256, char);
 
 #ifdef CSH
     PL_cshlen		= proto_perl->Icshlen;
@@ -6392,11 +7451,10 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
     PL_lex_defer	= proto_perl->Ilex_defer;
     PL_lex_expect	= proto_perl->Ilex_expect;
     PL_lex_formbrack	= proto_perl->Ilex_formbrack;
-    PL_lex_fakebrack	= proto_perl->Ilex_fakebrack;
     PL_lex_dojoin	= proto_perl->Ilex_dojoin;
     PL_lex_starts	= proto_perl->Ilex_starts;
-    PL_lex_stuff	= Nullsv;		/* XXX */
-    PL_lex_repl		= Nullsv;		/* XXX */
+    PL_lex_stuff	= sv_dup_inc(proto_perl->Ilex_stuff);
+    PL_lex_repl		= sv_dup_inc(proto_perl->Ilex_repl);
     PL_lex_op		= proto_perl->Ilex_op;
     PL_lex_inpat	= proto_perl->Ilex_inpat;
     PL_lex_inwhat	= proto_perl->Ilex_inwhat;
@@ -6422,7 +7480,7 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
     i = proto_perl->Ilinestart - SvPVX(proto_perl->Ilinestr);
     PL_linestart	= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
     PL_pending_ident	= proto_perl->Ipending_ident;
-    PL_sublex_info	= proto_perl->Isublex_info;	/* XXX */
+    PL_sublex_info	= proto_perl->Isublex_info;	/* XXX not quite right */
 
     PL_expect		= proto_perl->Iexpect;
 
@@ -6491,10 +7549,10 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
     PL_utf8_tolower	= sv_dup_inc(proto_perl->Iutf8_tolower);
 
     /* swatch cache */
-    PL_last_swash_hv	= Nullhv;	/* XXX recreate swatch cache? */
+    PL_last_swash_hv	= Nullhv;	/* reinits on demand */
     PL_last_swash_klen	= 0;
     PL_last_swash_key[0]= '\0';
-    PL_last_swash_tmps	= Nullch;
+    PL_last_swash_tmps	= (U8*)NULL;
     PL_last_swash_slen	= 0;
 
     /* perly.c globals */
@@ -6507,23 +7565,98 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
 
     PL_glob_index	= proto_perl->Iglob_index;
     PL_srand_called	= proto_perl->Isrand_called;
-    PL_uudmap['M']	= 0;		/* reinit on demand */
-    PL_bitcount		= Nullch;	/* reinit on demand */
+    PL_uudmap['M']	= 0;		/* reinits on demand */
+    PL_bitcount		= Nullch;	/* reinits on demand */
 
+    if (proto_perl->Ipsig_ptr) {
+	int sig_num[] = { SIG_NUM };
+	Newz(0, PL_psig_ptr, sizeof(sig_num)/sizeof(*sig_num), SV*);
+	Newz(0, PL_psig_name, sizeof(sig_num)/sizeof(*sig_num), SV*);
+	for (i = 1; PL_sig_name[i]; i++) {
+	    PL_psig_ptr[i] = sv_dup_inc(proto_perl->Ipsig_ptr[i]);
+	    PL_psig_name[i] = sv_dup_inc(proto_perl->Ipsig_name[i]);
+	}
+    }
+    else {
+	PL_psig_ptr	= (SV**)NULL;
+	PL_psig_name	= (SV**)NULL;
+    }
 
     /* thrdvar.h stuff */
 
-/*    PL_curstackinfo	= clone_stackinfo(proto_perl->Tcurstackinfo);
-    clone_stacks();
-    PL_mainstack	= av_dup(proto_perl->Tmainstack);
-    PL_curstack		= av_dup(proto_perl->Tcurstack);*/	/* XXXXXX */
-    init_stacks();
+    if (flags & 1) {
+	/* next allocation will be PL_tmps_stack[PL_tmps_ix+1] */
+	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*);
+	i = 0;
+	while (i <= PL_tmps_ix) {
+	    PL_tmps_stack[i]	= sv_dup_inc(proto_perl->Ttmps_stack[i]);
+	    ++i;
+	}
+
+	/* next PUSHMARK() sets *(PL_markstack_ptr+1) */
+	i = proto_perl->Tmarkstack_max - proto_perl->Tmarkstack;
+	Newz(54, 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
+						  - proto_perl->Tmarkstack);
+	Copy(proto_perl->Tmarkstack, PL_markstack,
+	     PL_markstack_ptr - PL_markstack + 1, I32);
+
+	/* next push_scope()/ENTER sets PL_scopestack[PL_scopestack_ix]
+	 * 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);
+	Copy(proto_perl->Tscopestack, PL_scopestack, PL_scopestack_ix, I32);
+
+	/* next push_return() sets PL_retstack[PL_retstack_ix]
+	 * NOTE: unlike the others! */
+	PL_retstack_ix		= proto_perl->Tretstack_ix;
+	PL_retstack_max		= proto_perl->Tretstack_max;
+	Newz(54, PL_retstack, PL_retstack_max, OP*);
+	Copy(proto_perl->Tretstack, PL_retstack, PL_retstack_ix, I32);
+
+	/* NOTE: si_dup() looks at PL_markstack */
+	PL_curstackinfo		= si_dup(proto_perl->Tcurstackinfo);
+
+	/* PL_curstack		= PL_curstackinfo->si_stack; */
+	PL_curstack		= av_dup(proto_perl->Tcurstack);
+	PL_mainstack		= av_dup(proto_perl->Tmainstack);
+
+	/* next PUSHs() etc. set *(PL_stack_sp+1) */
+	PL_stack_base		= AvARRAY(PL_curstack);
+	PL_stack_sp		= PL_stack_base + (proto_perl->Tstack_sp
+						   - proto_perl->Tstack_base);
+	PL_stack_max		= PL_stack_base + AvMAX(PL_curstack);
+
+	/* next SSPUSHFOO() sets PL_savestack[PL_savestack_ix]
+	 * 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);*/
+	PL_savestack		= ss_dup(proto_perl);
+    }
+    else {
+	init_stacks();
+    }
+
+    PL_start_env	= proto_perl->Tstart_env;	/* XXXXXX */
+    PL_top_env		= &PL_start_env;
 
     PL_op		= proto_perl->Top;
+
+    PL_Sv		= Nullsv;
+    PL_Xpv		= (XPV*)NULL;
+    PL_na		= proto_perl->Tna;
+
     PL_statbuf		= proto_perl->Tstatbuf;
     PL_statcache	= proto_perl->Tstatcache;
     PL_statgv		= gv_dup(proto_perl->Tstatgv);
-    PL_statname		= sv_dup(proto_perl->Tstatname);
+    PL_statname		= sv_dup_inc(proto_perl->Tstatname);
 #ifdef HAS_TIMES
     PL_timesbuf		= proto_perl->Ttimesbuf;
 #endif
@@ -6536,7 +7669,7 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
     PL_ofslen		= proto_perl->Tofslen;
     PL_ofs		= SAVEPVN(proto_perl->Tofs, PL_ofslen);
     PL_defoutgv		= gv_dup_inc(proto_perl->Tdefoutgv);
-    PL_chopset		= proto_perl->Tchopset;	/* XXX */
+    PL_chopset		= proto_perl->Tchopset;	/* XXX never deallocated */
     PL_toptarget	= sv_dup_inc(proto_perl->Ttoptarget);
     PL_bodytarget	= sv_dup_inc(proto_perl->Tbodytarget);
     PL_formtarget	= sv_dup(proto_perl->Tformtarget);
@@ -6547,8 +7680,6 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
     PL_dirty		= proto_perl->Tdirty;
     PL_localizing	= proto_perl->Tlocalizing;
 
-    PL_start_env	= proto_perl->Tstart_env;	/* XXXXXX */
-    PL_top_env		= &PL_start_env;
     PL_protect		= proto_perl->Tprotect;
     PL_errors		= sv_dup_inc(proto_perl->Terrors);
     PL_av_fetch_sv	= Nullsv;
@@ -6557,18 +7688,76 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
     PL_modcount		= proto_perl->Tmodcount;
     PL_lastgotoprobe	= Nullop;
     PL_dumpindent	= proto_perl->Tdumpindent;
+
+    PL_sortcop		= (OP*)any_dup(proto_perl->Tsortcop, proto_perl);
     PL_sortstash	= hv_dup(proto_perl->Tsortstash);
     PL_firstgv		= gv_dup(proto_perl->Tfirstgv);
     PL_secondgv		= gv_dup(proto_perl->Tsecondgv);
     PL_sortcxix		= proto_perl->Tsortcxix;
-    PL_efloatbuf	= Nullch;
-    PL_efloatsize	= 0;
+    PL_efloatbuf	= Nullch;		/* reinits on demand */
+    PL_efloatsize	= 0;			/* reinits on demand */
+
+    /* regex stuff */
 
     PL_screamfirst	= NULL;
     PL_screamnext	= NULL;
-    PL_maxscream	= -1;
+    PL_maxscream	= -1;			/* reinits on demand */
     PL_lastscream	= Nullsv;
 
+    PL_watchaddr	= NULL;
+    PL_watchok		= Nullch;
+
+    PL_regdummy		= proto_perl->Tregdummy;
+    PL_regcomp_parse	= Nullch;
+    PL_regxend		= Nullch;
+    PL_regcode		= (regnode*)NULL;
+    PL_regnaughty	= 0;
+    PL_regsawback	= 0;
+    PL_regprecomp	= Nullch;
+    PL_regnpar		= 0;
+    PL_regsize		= 0;
+    PL_regflags		= 0;
+    PL_regseen		= 0;
+    PL_seen_zerolen	= 0;
+    PL_seen_evals	= 0;
+    PL_regcomp_rx	= (regexp*)NULL;
+    PL_extralen		= 0;
+    PL_colorset		= 0;		/* reinits PL_colors[] */
+    /*PL_colors[6]	= {0,0,0,0,0,0};*/
+    PL_reg_whilem_seen	= 0;
+    PL_reginput		= Nullch;
+    PL_regbol		= Nullch;
+    PL_regeol		= Nullch;
+    PL_regstartp	= (I32*)NULL;
+    PL_regendp		= (I32*)NULL;
+    PL_reglastparen	= (U32*)NULL;
+    PL_regtill		= Nullch;
+    PL_regprev		= '\n';
+    PL_reg_start_tmp	= (char**)NULL;
+    PL_reg_start_tmpl	= 0;
+    PL_regdata		= (struct reg_data*)NULL;
+    PL_bostr		= Nullch;
+    PL_reg_flags	= 0;
+    PL_reg_eval_set	= 0;
+    PL_regnarrate	= 0;
+    PL_regprogram	= (regnode*)NULL;
+    PL_regindent	= 0;
+    PL_regcc		= (CURCUR*)NULL;
+    PL_reg_call_cc	= (struct re_cc_state*)NULL;
+    PL_reg_re		= (regexp*)NULL;
+    PL_reg_ganch	= Nullch;
+    PL_reg_sv		= Nullsv;
+    PL_reg_magic	= (MAGIC*)NULL;
+    PL_reg_oldpos	= 0;
+    PL_reg_oldcurpm	= (PMOP*)NULL;
+    PL_reg_curpm	= (PMOP*)NULL;
+    PL_reg_oldsaved	= Nullch;
+    PL_reg_oldsavedlen	= 0;
+    PL_reg_maxiter	= 0;
+    PL_reg_leftiter	= 0;
+    PL_reg_poscache	= Nullch;
+    PL_reg_poscache_size= 0;
+
     /* RE engine - function pointers */
     PL_regcompp		= proto_perl->Tregcompp;
     PL_regexecp		= proto_perl->Tregexecp;
@@ -6576,31 +7765,24 @@ perl_clone_using(PerlInterpreter *proto_perl, IV flags,
     PL_regint_string	= proto_perl->Tregint_string;
     PL_regfree		= proto_perl->Tregfree;
 
-    PL_regindent	= 0;
     PL_reginterp_cnt	= 0;
-    PL_reg_start_tmp	= 0;
-    PL_reg_start_tmpl	= 0;
-    PL_reg_poscache	= Nullch;
-
-    PL_watchaddr	= NULL;
-    PL_watchok		= Nullch;
+    PL_reg_starttry	= 0;
 
+#ifdef PERL_OBJECT
+    return (PerlInterpreter*)pPerl;
+#else
     return my_perl;
+#endif
 }
 
-PerlInterpreter *
-perl_clone(pTHXx_ IV flags)
-{
-    return perl_clone_using(aTHXx_ flags, PL_Mem, PL_Env, PL_StdIO, PL_LIO,
-			    PL_Dir, PL_Sock, PL_Proc);
-}
-
-#endif /* USE_ITHREADS */
+#else	/* !USE_ITHREADS */
 
 #ifdef PERL_OBJECT
 #include "XSUB.h"
 #endif
 
+#endif /* USE_ITHREADS */
+
 static void
 do_report_used(pTHXo_ SV *sv)
 {
@@ -6629,7 +7811,7 @@ do_clean_objs(pTHXo_ SV *sv)
 static void
 do_clean_named_objs(pTHXo_ SV *sv)
 {
-    if (SvTYPE(sv) == SVt_PVGV) {
+    if (SvTYPE(sv) == SVt_PVGV && GvGP(sv)) {
 	if ( SvOBJECT(GvSV(sv)) ||
 	     GvAV(sv) && SvOBJECT(GvAV(sv)) ||
 	     GvHV(sv) && SvOBJECT(GvHV(sv)) ||