X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/2b260de0f3727bc62519897f69d6f752c97d8502..a4b82a6f432d8ee296977d1ecd6955ece52324d0:/sv.c

diff --git a/sv.c b/sv.c
index 8707d60..11e1b11 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..."
  */
@@ -186,7 +87,8 @@ S_del_sv(pTHX_ SV *p)
 	if (!ok) {
 	    if (ckWARN_d(WARN_INTERNAL))	
 	        Perl_warner(aTHX_ WARN_INTERNAL,
-		       "Attempt to free non-arena SV: 0x%lx", (unsigned long)p);
+			    "Attempt to free non-arena SV: 0x%"UVxf,
+			    PTR2UV(p));
 	    return;
 	}
     }
@@ -205,7 +107,7 @@ Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags)
     SV* sva = (SV*)ptr;
     register SV* sv;
     register SV* svend;
-    Zero(sva, size, char);
+    Zero(ptr, size, char);
 
     /* The first SV in an arena isn't an SV. */
     SvANY(sva) = (void *) PL_sv_arenaroot;		/* ptr to next arena */
@@ -261,8 +163,6 @@ S_visit(pTHX_ SVFUNC_t f)
     }
 }
 
-#endif /* PURIFY */
-
 void
 Perl_sv_report_used(pTHX)
 {
@@ -315,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)
 {
@@ -790,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)
@@ -1199,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)
 {
@@ -1206,7 +1110,8 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
 
 #ifdef HAS_64K_LIMIT
     if (newlen >= 0x10000) {
-	PerlIO_printf(Perl_debug_log, "Allocation too large: %lx\n", newlen);
+	PerlIO_printf(Perl_debug_log,
+		      "Allocation too large: %"UVxf"\n", (UV)newlen);
 	my_exit(1);
     }
 #endif /* HAS_64K_LIMIT */
@@ -1230,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);
@@ -1247,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)
 {
@@ -1280,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)
 {
@@ -1287,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)
 {
@@ -1295,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)
 {
@@ -1302,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)
 {
@@ -1334,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)
 {
@@ -1425,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;
 	}
@@ -1440,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;
 	}
     }
@@ -1500,11 +1456,11 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 	    (void)SvNOK_on(sv);
 	    (void)SvIOK_on(sv);
 #if defined(USE_LONG_DOUBLE)
-	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIgldbl ")\n",
-				  (unsigned long)sv, SvNVX(sv)));
+	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2nv(%" PERL_PRIgldbl ")\n",
+				  PTR2UV(sv), SvNVX(sv)));
 #else
-	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n",
-				  (unsigned long)sv, SvNVX(sv)));
+	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2nv(%g)\n",
+				  PTR2UV(sv), SvNVX(sv)));
 #endif
 	    if (SvNVX(sv) < (NV)IV_MAX + 0.5)
 		SvIVX(sv) = I_V(SvNVX(sv));
@@ -1536,14 +1492,14 @@ 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);
 	return 0;
     }
-    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2iv(%ld)\n",
-	(unsigned long)sv,(long)SvIVX(sv)));
+    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%"IVdf")\n",
+	PTR2UV(sv),SvIVX(sv)));
     return SvIsUV(sv) ? (IV)SvUVX(sv) : SvIVX(sv);
 }
 
@@ -1564,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;
 	}
@@ -1579,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;
 	}
     }
@@ -1638,11 +1594,13 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	    (void)SvNOK_on(sv);
 	    (void)SvIOK_on(sv);
 #if defined(USE_LONG_DOUBLE)
-	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIgldbl ")\n",
-				  (unsigned long)sv, SvNVX(sv)));
+	    DEBUG_c(PerlIO_printf(Perl_debug_log,
+				  "0x%"UVxf" 2nv(%" PERL_PRIgldbl ")\n",
+				  PTR2UV(sv), SvNVX(sv)));
 #else
-	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n",
-				  (unsigned long)sv, SvNVX(sv)));
+	    DEBUG_c(PerlIO_printf(Perl_debug_log,
+				  "0x%"UVxf" 2nv(%g)\n",
+				  PTR2UV(sv), SvNVX(sv)));
 #endif
 	    if (SvNVX(sv) < -0.5) {
 		SvIVX(sv) = I_V(SvNVX(sv));
@@ -1691,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.  */
@@ -1699,8 +1657,8 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	return 0;
     }
 
-    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2uv(%lu)\n",
-	(unsigned long)sv,SvUVX(sv)));
+    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%"UVuf")\n",
+			  PTR2UV(sv),SvUVX(sv)));
     return SvIsUV(sv) ? SvUVX(sv) : (UV)SvIVX(sv);
 }
 
@@ -1729,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;
         }
@@ -1744,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;
 	}
     }
@@ -1756,15 +1714,16 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 #if defined(USE_LONG_DOUBLE)
 	DEBUG_c({
 	    RESTORE_NUMERIC_STANDARD();
-	    PerlIO_printf(Perl_debug_log, "0x%lx num(%" PERL_PRIgldbl ")\n",
-			  (unsigned long)sv, SvNVX(sv));
+	    PerlIO_printf(Perl_debug_log,
+			  "0x%"UVxf" num(%" PERL_PRIgldbl ")\n",
+			  PTR2UV(sv), SvNVX(sv));
 	    RESTORE_NUMERIC_LOCAL();
 	});
 #else
 	DEBUG_c({
 	    RESTORE_NUMERIC_STANDARD();
-	    PerlIO_printf(Perl_debug_log, "0x%lx num(%g)\n",
-			  (unsigned long)sv, SvNVX(sv));
+	    PerlIO_printf(Perl_debug_log, "0x%"UVxf" num(%g)\n",
+			  PTR2UV(sv), SvNVX(sv));
 	    RESTORE_NUMERIC_LOCAL();
 	});
 #endif
@@ -1785,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);
@@ -1795,15 +1754,15 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 #if defined(USE_LONG_DOUBLE)
     DEBUG_c({
 	RESTORE_NUMERIC_STANDARD();
-	PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIgldbl ")\n",
-		      (unsigned long)sv, SvNVX(sv));
+	PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2nv(%" PERL_PRIgldbl ")\n",
+		      PTR2UV(sv), SvNVX(sv));
 	RESTORE_NUMERIC_LOCAL();
     });
 #else
     DEBUG_c({
 	RESTORE_NUMERIC_STANDARD();
-	PerlIO_printf(Perl_debug_log, "0x%lx 1nv(%g)\n",
-		      (unsigned long)sv, SvNVX(sv));
+	PerlIO_printf(Perl_debug_log, "0x%"UVxf" 1nv(%g)\n",
+		      PTR2UV(sv), SvNVX(sv));
 	RESTORE_NUMERIC_LOCAL();
     });
 #endif
@@ -1857,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)
 {
@@ -1970,11 +1938,9 @@ Perl_sv_2pv_nolen(pTHX_ register SV *sv)
 static char *
 uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob)
 {
-    STRLEN len;
     char *ptr = buf + TYPE_CHARS(UV);
     char *ebuf = ptr;
     int sign;
-    char *p;
 
     if (is_uv)
 	sign = 0;
@@ -2030,7 +1996,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 "";
@@ -2065,7 +2031,7 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 			    int right = 4;
  			    U16 reganch = (re->reganch & PMf_COMPILETIME) >> 12;
 
- 			    while(ch = *fptr++) {
+ 			    while((ch = *fptr++)) {
  				if(reganch & 1) {
  				    reflags[left++] = ch;
  				}
@@ -2124,7 +2090,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 "";
 	}
@@ -2188,7 +2154,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)
@@ -2199,8 +2165,8 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
     *lp = s - SvPVX(sv);
     SvCUR_set(sv, *lp);
     SvPOK_on(sv);
-    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n",
-			  (unsigned long)sv,SvPVX(sv)));
+    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2pv(%s)\n",
+			  PTR2UV(sv),SvPVX(sv)));
     return SvPVX(sv);
 
   tokensave:
@@ -2243,6 +2209,33 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
     }
 }
 
+char *
+Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv)
+{
+    STRLEN n_a;
+    return sv_2pvbyte(sv, &n_a);
+}
+
+char *
+Perl_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
+{
+    return sv_2pv(sv,lp);
+}
+
+char *
+Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv)
+{
+    STRLEN n_a;
+    return sv_2pvutf8(sv, &n_a);
+}
+
+char *
+Perl_sv_2pvutf8(pTHX_ register SV *sv, STRLEN *lp)
+{
+    sv_utf8_upgrade(sv);
+    return sv_2pv(sv,lp);
+}
+ 
 /* This function is only called on magical items */
 bool
 Perl_sv_2bool(pTHX_ register SV *sv)
@@ -2281,11 +2274,155 @@ Perl_sv_2bool(pTHX_ register SV *sv)
     }
 }
 
+void
+Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
+{
+    int hicount;
+    char *c;
+
+    if (!sv || !SvPOK(sv) || SvUTF8(sv))
+	return;
+
+    /* This function could be much more efficient if we had a FLAG
+     * to signal if there are any hibit chars in the string
+     */
+    hicount = 0;
+    for (c = SvPVX(sv); c < SvEND(sv); c++) {
+	if (*c & 0x80)
+	    hicount++;
+    }
+
+    if (hicount) {
+	char *src, *dst;
+	SvGROW(sv, SvCUR(sv) + hicount + 1);
+
+	src = SvEND(sv) - 1;
+	SvCUR_set(sv, SvCUR(sv) + hicount);
+	dst = SvEND(sv) - 1;
+
+	while (src < dst) {
+	    if (*src & 0x80) {
+		dst--;
+		uv_to_utf8((U8*)dst, (U8)*src--);
+		dst--;
+	    }
+	    else {
+		*dst-- = *src--;
+	    }
+	}
+
+	SvUTF8_on(sv);
+    }
+}
+
+bool
+Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok)
+{
+    if (SvPOK(sv) && SvUTF8(sv)) {
+        char *c = SvPVX(sv);
+        char *first_hi = 0;
+        /* need to figure out if this is possible at all first */
+        while (c < SvEND(sv)) {
+            if (*c & 0x80) {
+                I32 len;
+                UV uv = utf8_to_uv((U8*)c, &len);
+                if (uv >= 256) {
+		    if (fail_ok)
+			return FALSE;
+		    else {
+			/* XXX might want to make a callback here instead */
+			Perl_croak(aTHX_ "Big byte");
+		    }
+		}
+                if (!first_hi)
+                    first_hi = c;
+                c += len;
+            }
+            else {
+                c++;
+            }
+        }
+
+        if (first_hi) {
+            char *src = first_hi;
+            char *dst = first_hi;
+            while (src < SvEND(sv)) {
+                if (*src & 0x80) {
+                    I32 len;
+                    U8 u = (U8)utf8_to_uv((U8*)src, &len);
+                    *dst++ = u;
+                    src += len;
+                }
+                else {
+                    *dst++ = *src++;
+                }
+            }
+            SvCUR_set(sv, dst - SvPVX(sv));
+        }
+        SvUTF8_off(sv);
+    }
+    return TRUE;
+}
+
+void
+Perl_sv_utf8_encode(pTHX_ register SV *sv)
+{
+    sv_utf8_upgrade(sv);
+    SvUTF8_off(sv);
+}
+
+bool
+Perl_sv_utf8_decode(pTHX_ register SV *sv)
+{
+    if (SvPOK(sv)) {
+        char *c;
+        bool has_utf = FALSE;
+        if (!sv_utf8_downgrade(sv, TRUE))
+	    return FALSE;
+
+        /* it is actually just a matter of turning the utf8 flag on, but
+         * we want to make sure everything inside is valid utf8 first.
+         */
+        c = SvPVX(sv);
+        while (c < SvEND(sv)) {
+            if (*c & 0x80) {
+                I32 len;
+                (void)utf8_to_uv((U8*)c, &len);
+                if (len == 1) {
+                    /* bad utf8 */
+                    return FALSE;
+                }
+                c += len;
+                has_utf = TRUE;
+            }
+            else {
+                c++;
+            }
+        }
+
+        if (has_utf)
+            SvUTF8_on(sv);
+    }
+    return TRUE;
+}
+
+
 /* Note: sv_setsv() should not be called with a source string that needs
  * to be reused, since it may destroy the source string if it is marked
  * as temporary.
  */
 
+/*
+=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)
 {
@@ -2364,8 +2501,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 		 SvTYPE(SvRV(sstr)) == SVt_PVGV) {
 	    sstr = SvRV(sstr);
 	    if (sstr == dstr) {
-		if (PL_curcop->cop_stash != GvSTASH(dstr))
+		if (GvIMPORTED(dstr) != GVf_IMPORTED
+		    && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+		{
 		    GvIMPORTED_on(dstr);
+		}
 		GvMULTI_on(dstr);
 		return;
 	    }
@@ -2419,8 +2559,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	    gp_free((GV*)dstr);
 	    GvGP(dstr) = gp_ref(GvGP(sstr));
 	    SvTAINT(dstr);
-	    if (PL_curcop->cop_stash != GvSTASH(dstr))
+	    if (GvIMPORTED(dstr) != GVf_IMPORTED
+		&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+	    {
 		GvIMPORTED_on(dstr);
+	    }
 	    GvMULTI_on(dstr);
 	    return;
 	}
@@ -2452,12 +2595,12 @@ 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);
 		    GvSV(dstr) = NEWSV(72,0);
-		    GvLINE(dstr) = PL_curcop->cop_line;
+		    GvLINE(dstr) = CopLINE(PL_curcop);
 		    GvEGV(dstr) = (GV*)dstr;
 		}
 		GvMULTI_on(dstr);
@@ -2468,8 +2611,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 		    else
 			dref = (SV*)GvAV(dstr);
 		    GvAV(dstr) = (AV*)sref;
-		    if (PL_curcop->cop_stash != GvSTASH(dstr))
+		    if (!GvIMPORTED_AV(dstr)
+			&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+		    {
 			GvIMPORTED_AV_on(dstr);
+		    }
 		    break;
 		case SVt_PVHV:
 		    if (intro)
@@ -2477,8 +2623,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 		    else
 			dref = (SV*)GvHV(dstr);
 		    GvHV(dstr) = (HV*)sref;
-		    if (PL_curcop->cop_stash != GvSTASH(dstr))
+		    if (!GvIMPORTED_HV(dstr)
+			&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+		    {
 			GvIMPORTED_HV_on(dstr);
+		    }
 		    break;
 		case SVt_PVCV:
 		    if (intro) {
@@ -2511,16 +2660,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 				    Perl_croak(aTHX_ 
 				    "Can't redefine active sort subroutine %s",
 					  GvENAME((GV*)dstr));
-				if (ckWARN(WARN_REDEFINE) || (const_changed && const_sv)) {
-				    if (!(CvGV(cv) && GvSTASH(CvGV(cv))
-					  && HvNAME(GvSTASH(CvGV(cv)))
-					  && strEQ(HvNAME(GvSTASH(CvGV(cv))),
-						   "autouse")))
-					Perl_warner(aTHX_ WARN_REDEFINE, const_sv ? 
+				if ((const_changed || const_sv) && ckWARN(WARN_REDEFINE))
+				    Perl_warner(aTHX_ WARN_REDEFINE, const_sv ? 
 					     "Constant subroutine %s redefined"
 					     : "Subroutine %s redefined", 
 					     GvENAME((GV*)dstr));
-				}
 			    }
 			    cv_ckproto(cv, (GV*)dstr,
 				       SvPOK(sref) ? SvPVX(sref) : Nullch);
@@ -2530,8 +2674,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 			GvASSUMECV_on(dstr);
 			PL_sub_generation++;
 		    }
-		    if (PL_curcop->cop_stash != GvSTASH(dstr))
+		    if (!GvIMPORTED_CV(dstr)
+			&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+		    {
 			GvIMPORTED_CV_on(dstr);
+		    }
 		    break;
 		case SVt_PVIO:
 		    if (intro)
@@ -2546,8 +2693,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 		    else
 			dref = (SV*)GvSV(dstr);
 		    GvSV(dstr) = sref;
-		    if (PL_curcop->cop_stash != GvSTASH(dstr))
+		    if (!GvIMPORTED_SV(dstr)
+			&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
+		    {
 			GvIMPORTED_SV_on(dstr);
+		    }
 		    break;
 		}
 		if (dref)
@@ -2606,6 +2756,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	    SvPV_set(dstr, SvPVX(sstr));
 	    SvLEN_set(dstr, SvLEN(sstr));
 	    SvCUR_set(dstr, SvCUR(sstr));
+	    if (SvUTF8(sstr))
+		SvUTF8_on(dstr);
+	    else
+		SvUTF8_off(dstr);
+
 	    SvTEMP_off(dstr);
 	    (void)SvOK_off(sstr);
 	    SvPV_set(sstr, Nullch);
@@ -2622,6 +2777,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);
@@ -2653,8 +2810,8 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
     }
     else {
 	if (dtype == SVt_PVGV) {
-	    if (ckWARN(WARN_UNSAFE))
-		Perl_warner(aTHX_ WARN_UNSAFE, "Undefined value assigned to typeglob");
+	    if (ckWARN(WARN_MISC))
+		Perl_warner(aTHX_ WARN_MISC, "Undefined value assigned to typeglob");
 	}
 	else
 	    (void)SvOK_off(dstr);
@@ -2662,6 +2819,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)
 {
@@ -2669,6 +2834,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)
 {
@@ -2691,6 +2865,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)
 {
@@ -2698,6 +2880,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)
 {
@@ -2718,6 +2909,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)
 {
@@ -2725,6 +2924,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)
 {
@@ -2746,6 +2959,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)
 {
@@ -2767,6 +2988,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 */
                 
@@ -2799,6 +3031,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)
 {
@@ -2812,10 +3054,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)
 {
@@ -2823,6 +3073,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)
 {
@@ -2830,10 +3089,23 @@ Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
     STRLEN len;
     if (!sstr)
 	return;
-    if (s = SvPV(sstr, len))
+    if ((s = SvPV(sstr, len))) {
+	if (SvUTF8(sstr))
+	    sv_utf8_upgrade(dstr);
 	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)
 {
@@ -2841,6 +3113,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)
 {
@@ -2857,10 +3138,18 @@ 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);
 }
 
+/*
+=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)
 {
@@ -2883,6 +3172,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)
 {
@@ -3131,6 +3428,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)
 {
@@ -3151,6 +3457,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);
@@ -3193,7 +3500,7 @@ Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN
 	SvCUR_set(bigstr, mid - big);
     }
     /*SUPPRESS 560*/
-    else if (i = mid - big) {	/* faster from front */
+    else if ((i = mid - big)) {	/* faster from front */
 	midend -= littlelen;
 	mid = midend;
 	sv_chop(bigstr,midend-i);
@@ -3313,10 +3620,9 @@ Perl_sv_clear(pTHX_ register SV *sv)
 	{
 	    io_close((IO*)sv, FALSE);
 	}
-	if (IoDIRP(sv)) {
+	if (IoDIRP(sv) && !(IoFLAGS(sv) & IOf_FAKE_DIRP))
 	    PerlDir_close(IoDIRP(sv));
-	    IoDIRP(sv) = 0;
-	}
+	IoDIRP(sv) = (DIR*)NULL;
 	Safefree(IoTOP_NAME(sv));
 	Safefree(IoFMT_NAME(sv));
 	Safefree(IoBOTTOM_NAME(sv));
@@ -3466,7 +3772,8 @@ Perl_sv_free(pTHX_ SV *sv)
     if (SvTEMP(sv)) {
 	if (ckWARN_d(WARN_DEBUGGING))
 	    Perl_warner(aTHX_ WARN_DEBUGGING,
-			"Attempt to free temp prematurely: SV 0x%lx", (unsigned long)sv);
+			"Attempt to free temp prematurely: SV 0x%"UVxf,
+			PTR2UV(sv));
 	return;
     }
 #endif
@@ -3480,6 +3787,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)
 {
@@ -3581,6 +3896,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)
 {
@@ -3607,15 +3931,55 @@ 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)
 {
-    STRLEN cur1 = 0;
-    char *pv1 = str1 ? SvPV(str1, cur1) : (char *) NULL;
-    STRLEN cur2 = 0;
-    char *pv2 = str2 ? SvPV(str2, cur2) : (char *) NULL;
+    STRLEN cur1, cur2;
+    char *pv1, *pv2;
     I32 retval;
 
+    if (str1) {
+        pv1 = SvPV(str1, cur1);
+    }
+    else {
+	cur1 = 0;
+    }
+
+    if (str2) {
+	if (SvPOK(str2)) {
+	    if (SvPOK(str1) && SvUTF8(str1) != SvUTF8(str2) && !IN_BYTE) {
+		/* must upgrade other to UTF8 first */
+		if (SvUTF8(str1)) {
+		    sv_utf8_upgrade(str2);
+		}
+		else {
+		    sv_utf8_upgrade(str1);
+		    /* refresh pointer and length */
+		    pv1  = SvPVX(str1);
+		    cur1 = SvCUR(str1);
+		}
+	    }
+	    pv2  = SvPVX(str2);
+	    cur2 = SvCUR(str2);
+    	}
+	else {
+	    pv2 = sv_2pv(str2, &cur2);
+	}
+    }
+    else {
+	cur2 = 0;
+    }
+
     if (!cur1)
 	return cur2 ? -1 : 0;
 
@@ -3845,11 +4209,11 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
     bp = (STDCHAR*)SvPVX(sv) + append;  /* move these two too to registers */
     ptr = (STDCHAR*)PerlIO_get_ptr(fp);
     DEBUG_P(PerlIO_printf(Perl_debug_log,
-	"Screamer: entering, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt));
+	"Screamer: entering, ptr=%"UVuf", cnt=%ld\n",PTR2UV(ptr),(long)cnt));
     DEBUG_P(PerlIO_printf(Perl_debug_log,
-	"Screamer: entering: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n",
-	       (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp), 
-	       (long)(PerlIO_has_base(fp) ? PerlIO_get_base(fp) : 0)));
+	"Screamer: entering: FILE * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n",
+	       PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp), 
+	       PTR2UV(PerlIO_has_base(fp) ? PerlIO_get_base(fp) : 0)));
     for (;;) {
       screamer:
 	if (cnt > 0) {
@@ -3879,24 +4243,25 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
 	}
 
 	DEBUG_P(PerlIO_printf(Perl_debug_log,
-	    "Screamer: going to getc, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt));
+			      "Screamer: going to getc, ptr=%"UVuf", cnt=%ld\n",
+			      PTR2UV(ptr),(long)cnt));
 	PerlIO_set_ptrcnt(fp, ptr, cnt); /* deregisterize cnt and ptr */
 	DEBUG_P(PerlIO_printf(Perl_debug_log,
-	    "Screamer: pre: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n",
-	    (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp), 
-	    (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
+	    "Screamer: pre: FILE * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n",
+	    PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp), 
+	    PTR2UV(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
 	/* This used to call 'filbuf' in stdio form, but as that behaves like 
 	   getc when cnt <= 0 we use PerlIO_getc here to avoid introducing
 	   another abstraction.  */
 	i   = PerlIO_getc(fp);		/* get more characters */
 	DEBUG_P(PerlIO_printf(Perl_debug_log,
-	    "Screamer: post: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n",
-	    (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp), 
-	    (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
+	    "Screamer: post: FILE * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n",
+	    PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp), 
+	    PTR2UV(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
 	cnt = PerlIO_get_cnt(fp);
 	ptr = (STDCHAR*)PerlIO_get_ptr(fp);	/* reregisterize cnt and ptr */
 	DEBUG_P(PerlIO_printf(Perl_debug_log,
-	    "Screamer: after getc, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt));
+	    "Screamer: after getc, ptr=%"UVuf", cnt=%ld\n",PTR2UV(ptr),(long)cnt));
 
 	if (i == EOF)			/* all done for ever? */
 	    goto thats_really_all_folks;
@@ -3920,12 +4285,12 @@ thats_really_all_folks:
     if (shortbuffered)
 	cnt += shortbuffered;
 	DEBUG_P(PerlIO_printf(Perl_debug_log,
-	    "Screamer: quitting, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt));
+	    "Screamer: quitting, ptr=%"UVuf", cnt=%ld\n",PTR2UV(ptr),(long)cnt));
     PerlIO_set_ptrcnt(fp, ptr, cnt);	/* put these back or we're in trouble */
     DEBUG_P(PerlIO_printf(Perl_debug_log,
-	"Screamer: end: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n",
-	(long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp), 
-	(long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
+	"Screamer: end: FILE * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n",
+	PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp), 
+	PTR2UV(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
     *bp = '\0';
     SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv));	/* set length */
     DEBUG_P(PerlIO_printf(Perl_debug_log,
@@ -3998,14 +4363,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)
 {
@@ -4107,6 +4476,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)
 {
@@ -4167,6 +4544,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
@@ -4186,6 +4572,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)
 {
@@ -4199,6 +4593,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 *
@@ -4215,6 +4618,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)
 {
@@ -4227,6 +4640,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)
 {
@@ -4251,6 +4675,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, ...)
 {
@@ -4271,6 +4704,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)
 {
@@ -4281,6 +4723,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)
 {
@@ -4291,6 +4742,34 @@ Perl_newSViv(pTHX_ IV i)
     return sv;
 }
 
+/*
+=for apidoc newSVuv
+
+Creates a new SV and copies an unsigned integer into it.
+The reference count for the SV is set to 1.
+
+=cut
+*/
+
+SV *
+Perl_newSVuv(pTHX_ UV u)
+{
+    register SV *sv;
+
+    new_SV(sv);
+    sv_setuv(sv,u);
+    return sv;
+}
+
+/*
+=for apidoc newRV_noinc
+
+Creates an RV wrapper for an SV.  The reference count for the original
+SV is B<not> incremented.
+
+=cut
+*/
+
 SV *
 Perl_newRV_noinc(pTHX_ SV *tmpRef)
 {
@@ -4305,12 +4784,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 *
@@ -4525,8 +5013,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
@@ -4628,14 +5115,53 @@ Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
 	if (!SvPOK(sv)) {
 	    SvPOK_on(sv);		/* validate pointer */
 	    SvTAINT(sv);
-	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n",
-		(unsigned long)sv,SvPVX(sv)));
+	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2pv(%s)\n",
+				  PTR2UV(sv),SvPVX(sv)));
 	}
     }
     return SvPVX(sv);
 }
 
 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)
+{
+    sv_utf8_upgrade(sv);
+    return sv_pv(sv);
+}
+
+char *
+Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp)
+{
+    sv_utf8_upgrade(sv);
+    return sv_pvn(sv,lp);
+}
+
+char *
+Perl_sv_pvutf8n_force(pTHX_ SV *sv, STRLEN *lp)
+{
+    sv_utf8_upgrade(sv);
+    return sv_pvn_force(sv,lp);
+}
+
+char *
 Perl_sv_reftype(pTHX_ SV *sv, int ob)
 {
     if (ob && SvOBJECT(sv))
@@ -4661,11 +5187,22 @@ Perl_sv_reftype(pTHX_ SV *sv, int ob)
 	case SVt_PVCV:		return "CODE";
 	case SVt_PVGV:		return "GLOB";
 	case SVt_PVFM:		return "FORMAT";
+	case SVt_PVIO:		return "IO";
 	default:		return "UNKNOWN";
 	}
     }
 }
 
+/*
+=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)
 {
@@ -4681,6 +5218,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)
 {
@@ -4697,6 +5244,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)
 {
@@ -4722,6 +5280,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)
 {
@@ -4734,6 +5310,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)
 {
@@ -4741,6 +5329,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)
 {
@@ -4748,6 +5348,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)
 {
@@ -4755,6 +5370,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)
 {
@@ -4789,6 +5414,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))
@@ -4800,10 +5427,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)
 {
@@ -4844,12 +5488,21 @@ Perl_sv_tainted(pTHX_ SV *sv)
 {
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
 	MAGIC *mg = mg_find(sv, 't');
-	if (mg && ((mg->mg_len & 1) || (mg->mg_len & 2) && mg->mg_obj == sv))
+	if (mg && ((mg->mg_len & 1) || ((mg->mg_len & 2) && mg->mg_obj == sv)))
 	    return TRUE;
     }
     return FALSE;
 }
 
+/*
+=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)
 {
@@ -4861,6 +5514,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)
 {
@@ -4895,6 +5556,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, ...)
 {
@@ -4910,6 +5580,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, ...)
 {
@@ -4948,6 +5626,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, ...)
 {
@@ -4963,6 +5651,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, ...)
 {
@@ -4979,6 +5675,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)
 {
@@ -4986,6 +5691,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)
 {
@@ -4996,6 +5713,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);
@@ -5010,12 +5728,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 */
@@ -5027,6 +5751,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
     for (p = (char*)pat; p < patend; p = q) {
 	bool alt = FALSE;
 	bool left = FALSE;
+	bool vectorize = FALSE;
+	bool utf = FALSE;
 	char fill = ' ';
 	char plus = 0;
 	char intsize = 0;
@@ -5034,9 +5760,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	STRLEN zeros = 0;
 	bool has_precis = FALSE;
 	STRLEN precis = 0;
+	bool is_utf = FALSE;
 
 	char esignbuf[4];
-	U8 utf8buf[10];
+	U8 utf8buf[UTF8_MAXLEN];
 	STRLEN esignlen = 0;
 
 	char *eptr = Nullch;
@@ -5047,6 +5774,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	char ebuf[IV_DIG * 4 + NV_DIG + 32];
         /* large enough for "%#.#f" --chip */
 	/* what about long double NVs? --jhi */
+
+	SV *vecsv;
+	U8 *vecstr = Null(U8*);
+	STRLEN veclen = 0;
 	char c;
 	int i;
 	unsigned base;
@@ -5056,6 +5787,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	STRLEN have;
 	STRLEN need;
 	STRLEN gap;
+	char *dotstr = ".";
+	STRLEN dotstrlen = 1;
 
 	for (q = p; q < patend && *q != '%'; ++q) ;
 	if (q > p) {
@@ -5088,6 +5821,37 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		q++;
 		continue;
 
+	    case '*':			/* printf("%*vX",":",$ipv6addr) */
+		if (q[1] != 'v')
+		    break;
+		q++;
+		if (args)
+		    vecsv = va_arg(*args, SV*);
+		else if (svix < svmax)
+		    vecsv = svargs[svix++];
+		else
+		    continue;
+		dotstr = SvPVx(vecsv,dotstrlen);
+		if (DO_UTF8(vecsv))
+		    is_utf = TRUE;
+		/* FALL THROUGH */
+
+	    case 'v':
+		vectorize = TRUE;
+		q++;
+		if (args)
+		    vecsv = va_arg(*args, SV*);
+		else if (svix < svmax)
+		    vecsv = svargs[svix++];
+		else {
+		    vecstr = (U8*)"";
+		    veclen = 0;
+		    continue;
+		}
+		vecstr = (U8*)SvPVx(vecsv,veclen);
+		utf = DO_UTF8(vecsv);
+		continue;
+
 	    default:
 		break;
 	    }
@@ -5174,28 +5938,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;
@@ -5203,16 +5971,18 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		}
 	    }
 	    else if (svix < svmax) {
-		eptr = SvPVx(svargs[svix++], elen);
-		if (IN_UTF8) {
+		argsv = svargs[svix++];
+		eptr = SvPVx(argsv, elen);
+		if (DO_UTF8(argsv)) {
 		    if (has_precis && precis < elen) {
 			I32 p = precis;
-			sv_pos_u2b(svargs[svix - 1], &p, 0); /* sticks at end */
+			sv_pos_u2b(argsv, &p, 0); /* sticks at end */
 			precis = p;
 		    }
 		    if (width) { /* fudge width (can't fudge elen) */
-			width += elen - sv_len_utf8(svargs[svix - 1]);
+			width += elen - sv_len_utf8(argsv);
 		    }
+		    is_utf = TRUE;
 		}
 	    }
 	    goto string;
@@ -5225,9 +5995,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	     */
 	    if (!args)
 		goto unknown;
-	    eptr = SvPVx(va_arg(*args, SV*), elen);
+	    argsv = va_arg(*args,SV*);
+	    eptr = SvPVx(argsv, elen);
+	    if (DO_UTF8(argsv))
+		is_utf = TRUE;
 
 	string:
+	    vectorize = FALSE;
 	    if (has_precis && elen > precis)
 		elen = precis;
 	    break;
@@ -5251,7 +6025,22 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    /* FALL THROUGH */
 	case 'd':
 	case 'i':
-	    if (args) {
+	    if (vectorize) {
+		I32 ulen;
+		if (!veclen) {
+		    vectorize = FALSE;
+		    break;
+		}
+		if (utf)
+		    iv = (IV)utf8_to_uv(vecstr, &ulen);
+		else {
+		    iv = *vecstr;
+		    ulen = 1;
+		}
+		vecstr += ulen;
+		veclen -= ulen;
+	    }
+	    else if (args) {
 		switch (intsize) {
 		case 'h':	iv = (short)va_arg(*args, int); break;
 		default:	iv = va_arg(*args, int); break;
@@ -5317,7 +6106,23 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    base = 16;
 
 	uns_integer:
-	    if (args) {
+	    if (vectorize) {
+		I32 ulen;
+	vector:
+		if (!veclen) {
+		    vectorize = FALSE;
+		    break;
+		}
+		if (utf)
+		    uv = utf8_to_uv(vecstr, &ulen);
+		else {
+		    uv = *vecstr;
+		    ulen = 1;
+		}
+		vecstr += ulen;
+		veclen -= ulen;
+	    }
+	    else if (args) {
 		switch (intsize) {
 		case 'h':  uv = (unsigned short)va_arg(*args, unsigned); break;
 		default:   uv = va_arg(*args, unsigned); break;
@@ -5379,13 +6184,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		break;
 	    default:		/* it had better be ten or less */
 #if defined(PERL_Y2KWARN)
-		if (ckWARN(WARN_MISC)) {
+		if (ckWARN(WARN_Y2K)) {
 		    STRLEN n;
 		    char *s = SvPV(sv,n);
 		    if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
 			&& (n == 2 || !isDIGIT(s[n-3])))
 		    {
-			Perl_warner(aTHX_ WARN_MISC,
+			Perl_warner(aTHX_ WARN_Y2K,
 				    "Possible Y2K bug: %%%c %s",
 				    c, "format string following '19'");
 		    }
@@ -5417,6 +6222,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 
 	    /* This is evil, but floating point is even more evil */
 
+	    vectorize = FALSE;
 	    if (args)
 		nv = va_arg(*args, NV);
 	    else
@@ -5425,7 +6231,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    need = 0;
 	    if (c != 'e' && c != 'E') {
 		i = PERL_INT_MIN;
-		(void)frexp(nv, &i);
+		(void)Perl_frexp(nv, &i);
 		if (i == PERL_INT_MIN)
 		    Perl_die(aTHX_ "panic: frexp");
 		if (i > 0)
@@ -5448,8 +6254,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    *--eptr = c;
 #ifdef USE_LONG_DOUBLE
 	    {
-		char* p = PERL_PRIfldbl + sizeof(PERL_PRIfldbl) - 3;
-		while (p >= PERL_PRIfldbl) { *--eptr = *p--; }
+		static char const my_prifldbl[] = PERL_PRIfldbl;
+		char const *p = my_prifldbl + sizeof my_prifldbl - 3;
+		while (p >= my_prifldbl) { *--eptr = *p--; }
 	    }
 #endif
 	    if (has_precis) {
@@ -5484,6 +6291,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    /* SPECIAL */
 
 	case 'n':
+	    vectorize = FALSE;
 	    i = SvCUR(sv) - origlen;
 	    if (args) {
 		switch (intsize) {
@@ -5504,6 +6312,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 
 	default:
       unknown:
+	    vectorize = FALSE;
 	    if (!args && ckWARN(WARN_PRINTF) &&
 		  (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)) {
 		SV *msg = sv_newmortal();
@@ -5519,7 +6328,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 ... */
@@ -5542,7 +6351,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	need = (have > width ? have : width);
 	gap = need - have;
 
-	SvGROW(sv, SvCUR(sv) + need + 1);
+	SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1);
 	p = SvEND(sv);
 	if (esignlen && fill == '0') {
 	    for (i = 0; i < esignlen; i++)
@@ -5568,17 +6377,1625 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    memset(p, ' ', gap);
 	    p += gap;
 	}
+	if (vectorize) {
+	    if (veclen) {
+		memcpy(p, dotstr, dotstrlen);
+		p += dotstrlen;
+	    }
+	    else
+		vectorize = FALSE;		/* done iterating over vecstr */
+	}
+	if (is_utf)
+	    SvUTF8_on(sv);
 	*p = '\0';
 	SvCUR(sv) = p - SvPVX(sv);
+	if (vectorize) {
+	    esignlen = 0;
+	    goto vector;
+	}
     }
 }
 
+#if defined(USE_ITHREADS)
+
+#if defined(USE_THREADS)
+#  include "error: USE_THREADS and USE_ITHREADS are incompatible"
+#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))
+#define hv_dup(s)	(HV*)sv_dup((SV*)s)
+#define hv_dup_inc(s)	(HV*)SvREFCNT_inc(sv_dup((SV*)s))
+#define cv_dup(s)	(CV*)sv_dup((SV*)s)
+#define cv_dup_inc(s)	(CV*)SvREFCNT_inc(sv_dup((SV*)s))
+#define io_dup(s)	(IO*)sv_dup((SV*)s)
+#define io_dup_inc(s)	(IO*)SvREFCNT_inc(sv_dup((SV*)s))
+#define gv_dup(s)	(GV*)sv_dup((SV*)s)
+#define gv_dup_inc(s)	(GV*)SvREFCNT_inc(sv_dup((SV*)s))
+#define SAVEPV(p)	(p ? savepv(p) : Nullch)
+#define SAVEPVN(p,n)	(p ? savepvn(p,n) : Nullch)
+
+REGEXP *
+Perl_re_dup(pTHX_ REGEXP *r)
+{
+    /* XXX fix when pmop->op_pmregexp becomes shared */
+    return ReREFCNT_inc(r);
+}
+
+PerlIO *
+Perl_fp_dup(pTHX_ PerlIO *fp, char type)
+{
+    PerlIO *ret;
+    if (!fp)
+	return (PerlIO*)NULL;
+
+    /* 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 *
+Perl_dirp_dup(pTHX_ DIR *dp)
+{
+    if (!dp)
+	return (DIR*)NULL;
+    /* XXX TODO */
+    return dp;
+}
+
+GP *
+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(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 */
+    return ret;
+}
+
+MAGIC *
+Perl_mg_dup(pTHX_ MAGIC *mg)
+{
+    MAGIC *mgret = (MAGIC*)NULL;
+    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);
+	if (!mgret)
+	    mgret = nmg;
+	else
+	    mgprev->mg_moremagic = nmg;
+	nmg->mg_virtual	= mg->mg_virtual;	/* XXX copy dynamic vtable? */
+	nmg->mg_private	= mg->mg_private;
+	nmg->mg_type	= mg->mg_type;
+	nmg->mg_flags	= mg->mg_flags;
+	if (mg->mg_type == 'r') {
+	    nmg->mg_obj	= (SV*)re_dup((REGEXP*)mg->mg_obj);
+	}
+	else {
+	    nmg->mg_obj	= (mg->mg_flags & MGf_REFCOUNTED)
+			      ? sv_dup_inc(mg->mg_obj)
+			      : sv_dup(mg->mg_obj);
+	}
+	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) {
+		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);
+	}
+	mgprev = nmg;
+    }
+    return mgret;
+}
+
+PTR_TBL_t *
+Perl_ptr_table_new(pTHX)
+{
+    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, PTR_TBL_ENT_t*);
+    return tbl;
+}
+
+void *
+Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *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 (void*)NULL;
+}
+
+void
+Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldv, void *newv)
+{
+    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 == oldv) {
+	    tblent->newval = newv;
+	    tbl->tbl_items++;
+	    return;
+	}
+    }
+    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)
+	ptr_table_split(tbl);
+}
+
+void
+Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl)
+{
+    PTR_TBL_ENT_t **ary = tbl->tbl_ary;
+    UV oldsize = tbl->tbl_max + 1;
+    UV newsize = oldsize * 2;
+    UV i;
+
+    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++) {
+	PTR_TBL_ENT_t **curentp, **entp, *ent;
+	if (!*ary)
+	    continue;
+	curentp = ary + oldsize;
+	for (entp = ary, ent = *ary; ent; ent = *entp) {
+	    if ((newsize & PTR2UV(ent->oldval)) != i) {
+		*entp = ent->next;
+		ent->next = *curentp;
+		*curentp = ent;
+		continue;
+	    }
+	    else
+		entp = &ent->next;
+	}
+    }
+}
+
+#ifdef DEBUGGING
+char *PL_watch_pvx;
+#endif
+
+SV *
+Perl_sv_dup(pTHX_ SV *sstr)
+{
+    SV *dstr;
+
+    if (!sstr || SvTYPE(sstr) == SVTYPEMASK)
+	return Nullsv;
+    /* look for it in the table first */
+    dstr = (SV*)ptr_table_fetch(PL_ptr_table, sstr);
+    if (dstr)
+	return dstr;
+
+    /* create anew and remember what it is */
+    new_SV(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;			/* 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:
+	SvANY(dstr)	= NULL;
+	break;
+    case SVt_IV:
+	SvANY(dstr)	= new_XIV();
+	SvIVX(dstr)	= SvIVX(sstr);
+	break;
+    case SVt_NV:
+	SvANY(dstr)	= new_XNV();
+	SvNVX(dstr)	= SvNVX(sstr);
+	break;
+    case SVt_RV:
+	SvANY(dstr)	= new_XRV();
+	SvRV(dstr)	= sv_dup_inc(SvRV(sstr));
+	break;
+    case SVt_PV:
+	SvANY(dstr)	= new_XPV();
+	SvCUR(dstr)	= SvCUR(sstr);
+	SvLEN(dstr)	= SvLEN(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;
+    case SVt_PVIV:
+	SvANY(dstr)	= new_XPVIV();
+	SvCUR(dstr)	= SvCUR(sstr);
+	SvLEN(dstr)	= SvLEN(sstr);
+	SvIVX(dstr)	= SvIVX(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;
+    case SVt_PVNV:
+	SvANY(dstr)	= new_XPVNV();
+	SvCUR(dstr)	= SvCUR(sstr);
+	SvLEN(dstr)	= SvLEN(sstr);
+	SvIVX(dstr)	= SvIVX(sstr);
+	SvNVX(dstr)	= SvNVX(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;
+    case SVt_PVMG:
+	SvANY(dstr)	= new_XPVMG();
+	SvCUR(dstr)	= SvCUR(sstr);
+	SvLEN(dstr)	= SvLEN(sstr);
+	SvIVX(dstr)	= SvIVX(sstr);
+	SvNVX(dstr)	= SvNVX(sstr);
+	SvMAGIC(dstr)	= mg_dup(SvMAGIC(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;
+    case SVt_PVBM:
+	SvANY(dstr)	= new_XPVBM();
+	SvCUR(dstr)	= SvCUR(sstr);
+	SvLEN(dstr)	= SvLEN(sstr);
+	SvIVX(dstr)	= SvIVX(sstr);
+	SvNVX(dstr)	= SvNVX(sstr);
+	SvMAGIC(dstr)	= mg_dup(SvMAGIC(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? */
+	BmRARE(dstr)	= BmRARE(sstr);
+	BmUSEFUL(dstr)	= BmUSEFUL(sstr);
+	BmPREVIOUS(dstr)= BmPREVIOUS(sstr);
+	break;
+    case SVt_PVLV:
+	SvANY(dstr)	= new_XPVLV();
+	SvCUR(dstr)	= SvCUR(sstr);
+	SvLEN(dstr)	= SvLEN(sstr);
+	SvIVX(dstr)	= SvIVX(sstr);
+	SvNVX(dstr)	= SvNVX(sstr);
+	SvMAGIC(dstr)	= mg_dup(SvMAGIC(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 */
+	LvTARGLEN(dstr)	= LvTARGLEN(sstr);
+	LvTARG(dstr)	= sv_dup_inc(LvTARG(sstr));
+	LvTYPE(dstr)	= LvTYPE(sstr);
+	break;
+    case SVt_PVGV:
+	SvANY(dstr)	= new_XPVGV();
+	SvCUR(dstr)	= SvCUR(sstr);
+	SvLEN(dstr)	= SvLEN(sstr);
+	SvIVX(dstr)	= SvIVX(sstr);
+	SvNVX(dstr)	= SvNVX(sstr);
+	SvMAGIC(dstr)	= mg_dup(SvMAGIC(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);
+	GvNAME(dstr)	= SAVEPVN(GvNAME(sstr), GvNAMELEN(sstr));
+	GvSTASH(dstr)	= hv_dup_inc(GvSTASH(sstr));
+	GvFLAGS(dstr)	= GvFLAGS(sstr);
+	GvGP(dstr)	= gp_dup(GvGP(sstr));
+	(void)GpREFCNT_inc(GvGP(dstr));
+	break;
+    case SVt_PVIO:
+	SvANY(dstr)	= new_XPVIO();
+	SvCUR(dstr)	= SvCUR(sstr);
+	SvLEN(dstr)	= SvLEN(sstr);
+	SvIVX(dstr)	= SvIVX(sstr);
+	SvNVX(dstr)	= SvNVX(sstr);
+	SvMAGIC(dstr)	= mg_dup(SvMAGIC(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));
+	if (IoOFP(sstr) == IoIFP(sstr))
+	    IoOFP(dstr) = IoIFP(dstr);
+	else
+	    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));
+	else
+	    IoDIRP(dstr)	= IoDIRP(sstr);
+	IoLINES(dstr)		= IoLINES(sstr);
+	IoPAGE(dstr)		= IoPAGE(sstr);
+	IoPAGE_LEN(dstr)	= IoPAGE_LEN(sstr);
+	IoLINES_LEFT(dstr)	= IoLINES_LEFT(sstr);
+	IoTOP_NAME(dstr)	= SAVEPV(IoTOP_NAME(sstr));
+	IoTOP_GV(dstr)		= gv_dup(IoTOP_GV(sstr));
+	IoFMT_NAME(dstr)	= SAVEPV(IoFMT_NAME(sstr));
+	IoFMT_GV(dstr)		= gv_dup(IoFMT_GV(sstr));
+	IoBOTTOM_NAME(dstr)	= SAVEPV(IoBOTTOM_NAME(sstr));
+	IoBOTTOM_GV(dstr)	= gv_dup(IoBOTTOM_GV(sstr));
+	IoSUBPROCESS(dstr)	= IoSUBPROCESS(sstr);
+	IoTYPE(dstr)		= IoTYPE(sstr);
+	IoFLAGS(dstr)		= IoFLAGS(sstr);
+	break;
+    case SVt_PVAV:
+	SvANY(dstr)	= new_XPVAV();
+	SvCUR(dstr)	= SvCUR(sstr);
+	SvLEN(dstr)	= SvLEN(sstr);
+	SvIVX(dstr)	= SvIVX(sstr);
+	SvNVX(dstr)	= SvNVX(sstr);
+	SvMAGIC(dstr)	= mg_dup(SvMAGIC(sstr));
+	SvSTASH(dstr)	= hv_dup_inc(SvSTASH(sstr));
+	AvARYLEN((AV*)dstr) = sv_dup_inc(AvARYLEN((AV*)sstr));
+	AvFLAGS((AV*)dstr) = AvFLAGS((AV*)sstr);
+	if (AvARRAY((AV*)sstr)) {
+	    SV **dst_ary, **src_ary;
+	    SSize_t items = AvFILLp((AV*)sstr) + 1;
+
+	    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)) {
+		while (items-- > 0)
+		    *dst_ary++ = sv_dup_inc(*src_ary++);
+	    }
+	    else {
+		while (items-- > 0)
+		    *dst_ary++ = sv_dup(*src_ary++);
+	    }
+	    items = AvMAX((AV*)sstr) - AvFILLp((AV*)sstr);
+	    while (items-- > 0) {
+		*dst_ary++ = &PL_sv_undef;
+	    }
+	}
+	else {
+	    SvPVX(dstr)		= Nullch;
+	    AvALLOC((AV*)dstr)	= (SV**)NULL;
+	}
+	break;
+    case SVt_PVHV:
+	SvANY(dstr)	= new_XPVHV();
+	SvCUR(dstr)	= SvCUR(sstr);
+	SvLEN(dstr)	= SvLEN(sstr);
+	SvIVX(dstr)	= SvIVX(sstr);
+	SvNVX(dstr)	= SvNVX(sstr);
+	SvMAGIC(dstr)	= mg_dup(SvMAGIC(sstr));
+	SvSTASH(dstr)	= hv_dup_inc(SvSTASH(sstr));
+	HvRITER((HV*)dstr)	= HvRITER((HV*)sstr);
+	if (HvARRAY((HV*)sstr)) {
+	    STRLEN i = 0;
+	    XPVHV *dxhv = (XPVHV*)SvANY(dstr);
+	    XPVHV *sxhv = (XPVHV*)SvANY(sstr);
+	    Newz(0, dxhv->xhv_array,
+		 PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1), char);
+	    while (i <= sxhv->xhv_max) {
+		((HE**)dxhv->xhv_array)[i] = he_dup(((HE**)sxhv->xhv_array)[i],
+						    !!HvSHAREKEYS(sstr));
+		++i;
+	    }
+	    dxhv->xhv_eiter = he_dup(sxhv->xhv_eiter, !!HvSHAREKEYS(sstr));
+	}
+	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:
+	SvANY(dstr)	= new_XPVCV();
+dup_pvcv:
+	SvCUR(dstr)	= SvCUR(sstr);
+	SvLEN(dstr)	= SvLEN(sstr);
+	SvIVX(dstr)	= SvIVX(sstr);
+	SvNVX(dstr)	= SvNVX(sstr);
+	SvMAGIC(dstr)	= mg_dup(SvMAGIC(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 */
+	CvSTART(dstr)	= CvSTART(sstr);
+	CvROOT(dstr)	= OpREFCNT_inc(CvROOT(sstr));
+	CvXSUB(dstr)	= CvXSUB(sstr);
+	CvXSUBANY(dstr)	= CvXSUBANY(sstr);
+	CvGV(dstr)	= gv_dup_inc(CvGV(sstr));
+	CvDEPTH(dstr)	= CvDEPTH(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;
+    default:
+	Perl_croak(aTHX_ "Bizarre SvTYPE [%d]", SvTYPE(sstr));
+	break;
+    }
+
+    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.oldcurpad
+		    = (SV**)ptr_table_fetch(PL_ptr_table,
+					    cx->blk_loop.oldcurpad);
+		ncx->blk_loop.itersave	= sv_dup_inc(cx->blk_loop.itersave);
+		ncx->blk_loop.iterlval	= sv_dup_inc(cx->blk_loop.iterlval);
+		ncx->blk_loop.iterary	= av_dup_inc(cx->blk_loop.iterary);
+		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((void *)dptr, proto_perl);
+	    break;
+	case SAVEt_DESTRUCTOR_X:
+	    ptr = POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);	/* XXX quite arbitrary */
+	    dxptr = POPDXPTR(ss,ix);
+	    TOPDXPTR(nss,ix) = (void (*)(pTHXo_ void*))any_dup((void *)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
-#define NO_XSLOCKS
 #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, 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;
+#  ifdef PERL_OBJECT
+    CPerlObj *pPerl = new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd, ipLIO,
+					ipD, ipS, ipP);
+    PERL_SET_THX(pPerl);
+#  else		/* !PERL_OBJECT */
+    PerlInterpreter *my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
+    PERL_SET_THX(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 */
+
+    /* 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;
+    PerlInterpreter *my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
+    PERL_SET_THX(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;
+    PL_xiv_root		= NULL;
+    PL_xnv_root		= NULL;
+    PL_xrv_root		= NULL;
+    PL_xpv_root		= NULL;
+    PL_xpviv_root	= NULL;
+    PL_xpvnv_root	= NULL;
+    PL_xpvcv_root	= NULL;
+    PL_xpvav_root	= NULL;
+    PL_xpvhv_root	= NULL;
+    PL_xpvmg_root	= NULL;
+    PL_xpvlv_root	= NULL;
+    PL_xpvbm_root	= NULL;
+    PL_he_root		= NULL;
+    PL_nice_chunk	= NULL;
+    PL_nice_chunk_size	= 0;
+    PL_sv_count		= 0;
+    PL_sv_objcount	= 0;
+    PL_sv_root		= Nullsv;
+    PL_sv_arenaroot	= Nullsv;
+
+    PL_debug		= proto_perl->Idebug;
+
+    /* create SV map for pointer relocation */
+    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;
+    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;
+    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;
+    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);
+    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);
+    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;
+    i = PL_origargc;
+    New(0, PL_origargv, i+1, char*);
+    PL_origargv[i] = '\0';
+    while (i-- > 0) {
+	PL_origargv[i]	= SAVEPV(proto_perl->Iorigargv[i]);
+    }
+    PL_envgv		= gv_dup(proto_perl->Ienvgv);
+    PL_incgv		= gv_dup(proto_perl->Iincgv);
+    PL_hintgv		= gv_dup(proto_perl->Ihintgv);
+    PL_origfilename	= SAVEPV(proto_perl->Iorigfilename);
+    PL_diehook		= sv_dup_inc(proto_perl->Idiehook);
+    PL_warnhook		= sv_dup_inc(proto_perl->Iwarnhook);
+
+    /* switches */
+    PL_minus_c		= proto_perl->Iminus_c;
+    PL_patchlevel	= sv_dup_inc(proto_perl->Ipatchlevel);
+    PL_localpatches	= proto_perl->Ilocalpatches;
+    PL_splitstr		= proto_perl->Isplitstr;
+    PL_preprocess	= proto_perl->Ipreprocess;
+    PL_minus_n		= proto_perl->Iminus_n;
+    PL_minus_p		= proto_perl->Iminus_p;
+    PL_minus_l		= proto_perl->Iminus_l;
+    PL_minus_a		= proto_perl->Iminus_a;
+    PL_minus_F		= proto_perl->Iminus_F;
+    PL_doswitches	= proto_perl->Idoswitches;
+    PL_dowarn		= proto_perl->Idowarn;
+    PL_doextract	= proto_perl->Idoextract;
+    PL_sawampersand	= proto_perl->Isawampersand;
+    PL_unsafe		= proto_perl->Iunsafe;
+    PL_inplace		= SAVEPV(proto_perl->Iinplace);
+    PL_e_script		= sv_dup_inc(proto_perl->Ie_script);
+    PL_perldb		= proto_perl->Iperldb;
+    PL_perl_destruct_level = proto_perl->Iperl_destruct_level;
+
+    /* magical thingies */
+    /* XXX time(&PL_basetime) when asked for? */
+    PL_basetime		= proto_perl->Ibasetime;
+    PL_formfeed		= sv_dup(proto_perl->Iformfeed);
+
+    PL_maxsysfd		= proto_perl->Imaxsysfd;
+    PL_multiline	= proto_perl->Imultiline;
+    PL_statusvalue	= proto_perl->Istatusvalue;
+#ifdef VMS
+    PL_statusvalue_vms	= proto_perl->Istatusvalue_vms;
+#endif
+
+    /* shortcuts to various I/O objects */
+    PL_stdingv		= gv_dup(proto_perl->Istdingv);
+    PL_stderrgv		= gv_dup(proto_perl->Istderrgv);
+    PL_defgv		= gv_dup(proto_perl->Idefgv);
+    PL_argvgv		= gv_dup(proto_perl->Iargvgv);
+    PL_argvoutgv	= gv_dup(proto_perl->Iargvoutgv);
+    PL_argvout_stack	= av_dup(proto_perl->Iargvout_stack);
+
+    /* shortcuts to regexp stuff */
+    PL_replgv		= gv_dup(proto_perl->Ireplgv);
+
+    /* shortcuts to misc objects */
+    PL_errgv		= gv_dup(proto_perl->Ierrgv);
+
+    /* shortcuts to debugging objects */
+    PL_DBgv		= gv_dup(proto_perl->IDBgv);
+    PL_DBline		= gv_dup(proto_perl->IDBline);
+    PL_DBsub		= gv_dup(proto_perl->IDBsub);
+    PL_DBsingle		= sv_dup(proto_perl->IDBsingle);
+    PL_DBtrace		= sv_dup(proto_perl->IDBtrace);
+    PL_DBsignal		= sv_dup(proto_perl->IDBsignal);
+    PL_lineary		= av_dup(proto_perl->Ilineary);
+    PL_dbargs		= av_dup(proto_perl->Idbargs);
+
+    /* symbol tables */
+    PL_defstash		= hv_dup_inc(proto_perl->Tdefstash);
+    PL_curstash		= hv_dup(proto_perl->Tcurstash);
+    PL_debstash		= hv_dup(proto_perl->Idebstash);
+    PL_globalstash	= hv_dup(proto_perl->Iglobalstash);
+    PL_curstname	= sv_dup_inc(proto_perl->Icurstname);
+
+    PL_beginav		= av_dup_inc(proto_perl->Ibeginav);
+    PL_endav		= av_dup_inc(proto_perl->Iendav);
+    PL_checkav		= av_dup_inc(proto_perl->Icheckav);
+    PL_initav		= av_dup_inc(proto_perl->Iinitav);
+
+    PL_sub_generation	= proto_perl->Isub_generation;
+
+    /* funky return mechanisms */
+    PL_forkprocess	= proto_perl->Iforkprocess;
+
+    /* subprocess state */
+    PL_fdpid		= av_dup_inc(proto_perl->Ifdpid);
+
+    /* internal state */
+    PL_tainting		= proto_perl->Itainting;
+    PL_maxo		= proto_perl->Imaxo;
+    if (proto_perl->Iop_mask)
+	PL_op_mask	= SAVEPVN(proto_perl->Iop_mask, PL_maxo);
+    else
+	PL_op_mask 	= Nullch;
+
+    /* current interpreter roots */
+    PL_main_cv		= cv_dup_inc(proto_perl->Imain_cv);
+    PL_main_root	= OpREFCNT_inc(proto_perl->Imain_root);
+    PL_main_start	= proto_perl->Imain_start;
+    PL_eval_root	= OpREFCNT_inc(proto_perl->Ieval_root);
+    PL_eval_start	= proto_perl->Ieval_start;
+
+    /* runtime control stuff */
+    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 not quite right */
+    PL_Argv		= NULL;
+    PL_Cmd		= Nullch;
+    PL_gensym		= proto_perl->Igensym;
+    PL_preambled	= proto_perl->Ipreambled;
+    PL_preambleav	= av_dup_inc(proto_perl->Ipreambleav);
+    PL_laststatval	= proto_perl->Ilaststatval;
+    PL_laststype	= proto_perl->Ilaststype;
+    PL_mess_sv		= Nullsv;
+
+    PL_orslen		= proto_perl->Iorslen;
+    PL_ors		= SAVEPVN(proto_perl->Iors, PL_orslen);
+    PL_ofmt		= SAVEPV(proto_perl->Iofmt);
+
+    /* interpreter atexit processing */
+    PL_exitlistlen	= proto_perl->Iexitlistlen;
+    if (PL_exitlistlen) {
+	New(0, PL_exitlist, PL_exitlistlen, PerlExitListEntry);
+	Copy(proto_perl->Iexitlist, PL_exitlist, PL_exitlistlen, PerlExitListEntry);
+    }
+    else
+	PL_exitlist	= (PerlExitListEntry*)NULL;
+    PL_modglobal	= hv_dup_inc(proto_perl->Imodglobal);
+
+    PL_profiledata	= NULL;
+    PL_rsfp		= fp_dup(proto_perl->Irsfp, '<');
+    /* 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			= (SV**)ptr_table_fetch(PL_ptr_table,
+							proto_perl->Tcurpad);
+
+#ifdef HAVE_INTERP_INTERN
+    sys_intern_dup(&proto_perl->Isys_intern, &PL_sys_intern);
+#endif
+
+    /* more statics moved here */
+    PL_generation	= proto_perl->Igeneration;
+    PL_DBcv		= cv_dup(proto_perl->IDBcv);
+
+    PL_in_clean_objs	= proto_perl->Iin_clean_objs;
+    PL_in_clean_all	= proto_perl->Iin_clean_all;
+
+    PL_uid		= proto_perl->Iuid;
+    PL_euid		= proto_perl->Ieuid;
+    PL_gid		= proto_perl->Igid;
+    PL_egid		= proto_perl->Iegid;
+    PL_nomemok		= proto_perl->Inomemok;
+    PL_an		= proto_perl->Ian;
+    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 not quite right */
+    PL_origalen		= proto_perl->Iorigalen;
+    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;
+
+
+    PL_runops		= proto_perl->Irunops;
+
+    Copy(proto_perl->Itokenbuf, PL_tokenbuf, 256, char);
+
+#ifdef CSH
+    PL_cshlen		= proto_perl->Icshlen;
+    PL_cshname		= SAVEPVN(proto_perl->Icshname, PL_cshlen);
+#endif
+
+    PL_lex_state	= proto_perl->Ilex_state;
+    PL_lex_defer	= proto_perl->Ilex_defer;
+    PL_lex_expect	= proto_perl->Ilex_expect;
+    PL_lex_formbrack	= proto_perl->Ilex_formbrack;
+    PL_lex_dojoin	= proto_perl->Ilex_dojoin;
+    PL_lex_starts	= proto_perl->Ilex_starts;
+    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;
+    PL_lex_brackets	= proto_perl->Ilex_brackets;
+    i = (PL_lex_brackets < 120 ? 120 : PL_lex_brackets);
+    PL_lex_brackstack	= SAVEPVN(proto_perl->Ilex_brackstack,i);
+    PL_lex_casemods	= proto_perl->Ilex_casemods;
+    i = (PL_lex_casemods < 12 ? 12 : PL_lex_casemods);
+    PL_lex_casestack	= SAVEPVN(proto_perl->Ilex_casestack,i);
+
+    Copy(proto_perl->Inextval, PL_nextval, 5, YYSTYPE);
+    Copy(proto_perl->Inexttype, PL_nexttype, 5,	I32);
+    PL_nexttoke		= proto_perl->Inexttoke;
+
+    PL_linestr		= sv_dup_inc(proto_perl->Ilinestr);
+    i = proto_perl->Ibufptr - SvPVX(proto_perl->Ilinestr);
+    PL_bufptr		= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+    i = proto_perl->Ioldbufptr - SvPVX(proto_perl->Ilinestr);
+    PL_oldbufptr	= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+    i = proto_perl->Ioldoldbufptr - SvPVX(proto_perl->Ilinestr);
+    PL_oldoldbufptr	= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+    PL_bufend		= SvPVX(PL_linestr) + SvCUR(PL_linestr);
+    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 not quite right */
+
+    PL_expect		= proto_perl->Iexpect;
+
+    PL_multi_start	= proto_perl->Imulti_start;
+    PL_multi_end	= proto_perl->Imulti_end;
+    PL_multi_open	= proto_perl->Imulti_open;
+    PL_multi_close	= proto_perl->Imulti_close;
+
+    PL_error_count	= proto_perl->Ierror_count;
+    PL_subline		= proto_perl->Isubline;
+    PL_subname		= sv_dup_inc(proto_perl->Isubname);
+
+    PL_min_intro_pending	= proto_perl->Imin_intro_pending;
+    PL_max_intro_pending	= proto_perl->Imax_intro_pending;
+    PL_padix			= proto_perl->Ipadix;
+    PL_padix_floor		= proto_perl->Ipadix_floor;
+    PL_pad_reset_pending	= proto_perl->Ipad_reset_pending;
+
+    i = proto_perl->Ilast_uni - SvPVX(proto_perl->Ilinestr);
+    PL_last_uni		= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+    i = proto_perl->Ilast_lop - SvPVX(proto_perl->Ilinestr);
+    PL_last_lop		= SvPVX(PL_linestr) + (i < 0 ? 0 : i);
+    PL_last_lop_op	= proto_perl->Ilast_lop_op;
+    PL_in_my		= proto_perl->Iin_my;
+    PL_in_my_stash	= hv_dup(proto_perl->Iin_my_stash);
+#ifdef FCRYPT
+    PL_cryptseen	= proto_perl->Icryptseen;
+#endif
+
+    PL_hints		= proto_perl->Ihints;
+
+    PL_amagic_generation	= proto_perl->Iamagic_generation;
+
+#ifdef USE_LOCALE_COLLATE
+    PL_collation_ix	= proto_perl->Icollation_ix;
+    PL_collation_name	= SAVEPV(proto_perl->Icollation_name);
+    PL_collation_standard	= proto_perl->Icollation_standard;
+    PL_collxfrm_base	= proto_perl->Icollxfrm_base;
+    PL_collxfrm_mult	= proto_perl->Icollxfrm_mult;
+#endif /* USE_LOCALE_COLLATE */
+
+#ifdef USE_LOCALE_NUMERIC
+    PL_numeric_name	= SAVEPV(proto_perl->Inumeric_name);
+    PL_numeric_standard	= proto_perl->Inumeric_standard;
+    PL_numeric_local	= proto_perl->Inumeric_local;
+    PL_numeric_radix	= proto_perl->Inumeric_radix;
+#endif /* !USE_LOCALE_NUMERIC */
+
+    /* utf8 character classes */
+    PL_utf8_alnum	= sv_dup_inc(proto_perl->Iutf8_alnum);
+    PL_utf8_alnumc	= sv_dup_inc(proto_perl->Iutf8_alnumc);
+    PL_utf8_ascii	= sv_dup_inc(proto_perl->Iutf8_ascii);
+    PL_utf8_alpha	= sv_dup_inc(proto_perl->Iutf8_alpha);
+    PL_utf8_space	= sv_dup_inc(proto_perl->Iutf8_space);
+    PL_utf8_cntrl	= sv_dup_inc(proto_perl->Iutf8_cntrl);
+    PL_utf8_graph	= sv_dup_inc(proto_perl->Iutf8_graph);
+    PL_utf8_digit	= sv_dup_inc(proto_perl->Iutf8_digit);
+    PL_utf8_upper	= sv_dup_inc(proto_perl->Iutf8_upper);
+    PL_utf8_lower	= sv_dup_inc(proto_perl->Iutf8_lower);
+    PL_utf8_print	= sv_dup_inc(proto_perl->Iutf8_print);
+    PL_utf8_punct	= sv_dup_inc(proto_perl->Iutf8_punct);
+    PL_utf8_xdigit	= sv_dup_inc(proto_perl->Iutf8_xdigit);
+    PL_utf8_mark	= sv_dup_inc(proto_perl->Iutf8_mark);
+    PL_utf8_toupper	= sv_dup_inc(proto_perl->Iutf8_toupper);
+    PL_utf8_totitle	= sv_dup_inc(proto_perl->Iutf8_totitle);
+    PL_utf8_tolower	= sv_dup_inc(proto_perl->Iutf8_tolower);
+
+    /* 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	= (U8*)NULL;
+    PL_last_swash_slen	= 0;
+
+    /* perly.c globals */
+    PL_yydebug		= proto_perl->Iyydebug;
+    PL_yynerrs		= proto_perl->Iyynerrs;
+    PL_yyerrflag	= proto_perl->Iyyerrflag;
+    PL_yychar		= proto_perl->Iyychar;
+    PL_yyval		= proto_perl->Iyyval;
+    PL_yylval		= proto_perl->Iyylval;
+
+    PL_glob_index	= proto_perl->Iglob_index;
+    PL_srand_called	= proto_perl->Isrand_called;
+    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 */
+
+    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_inc(proto_perl->Tstatname);
+#ifdef HAS_TIMES
+    PL_timesbuf		= proto_perl->Ttimesbuf;
+#endif
+
+    PL_tainted		= proto_perl->Ttainted;
+    PL_curpm		= proto_perl->Tcurpm;	/* XXX No PMOP ref count */
+    PL_nrs		= sv_dup_inc(proto_perl->Tnrs);
+    PL_rs		= sv_dup_inc(proto_perl->Trs);
+    PL_last_in_gv	= gv_dup(proto_perl->Tlast_in_gv);
+    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 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);
+
+    PL_restartop	= proto_perl->Trestartop;
+    PL_in_eval		= proto_perl->Tin_eval;
+    PL_delaymagic	= proto_perl->Tdelaymagic;
+    PL_dirty		= proto_perl->Tdirty;
+    PL_localizing	= proto_perl->Tlocalizing;
+
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
+    PL_protect		= proto_perl->Tprotect;
+#endif
+    PL_errors		= sv_dup_inc(proto_perl->Terrors);
+    PL_av_fetch_sv	= Nullsv;
+    PL_hv_fetch_sv	= Nullsv;
+    Zero(&PL_hv_fetch_ent_mh, 1, HE);			/* XXX */
+    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;		/* reinits on demand */
+    PL_efloatsize	= 0;			/* reinits on demand */
+
+    /* regex stuff */
+
+    PL_screamfirst	= NULL;
+    PL_screamnext	= NULL;
+    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;
+    PL_regint_start	= proto_perl->Tregint_start;
+    PL_regint_string	= proto_perl->Tregint_string;
+    PL_regfree		= proto_perl->Tregfree;
+
+    PL_reginterp_cnt	= 0;
+    PL_reg_starttry	= 0;
+
+#ifdef PERL_OBJECT
+    return (PerlInterpreter*)pPerl;
+#else
+    return my_perl;
+#endif
+}
+
+#else	/* !USE_ITHREADS */
+
+#ifdef PERL_OBJECT
+#include "XSUB.h"
+#endif
+
+#endif /* USE_ITHREADS */
+
 static void
 do_report_used(pTHXo_ SV *sv)
 {
@@ -5607,12 +8024,12 @@ 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)) ||
-	     GvIO(sv) && SvOBJECT(GvIO(sv)) ||
-	     GvCV(sv) && SvOBJECT(GvCV(sv)) )
+	     (GvAV(sv) && SvOBJECT(GvAV(sv))) ||
+	     (GvHV(sv) && SvOBJECT(GvHV(sv))) ||
+	     (GvIO(sv) && SvOBJECT(GvIO(sv))) ||
+	     (GvCV(sv) && SvOBJECT(GvCV(sv))) )
 	{
 	    DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv));)
 	    SvREFCNT_dec(sv);
@@ -5624,7 +8041,7 @@ do_clean_named_objs(pTHXo_ SV *sv)
 static void
 do_clean_all(pTHXo_ SV *sv)
 {
-    DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%lx\n", sv) );)
+    DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) );)
     SvFLAGS(sv) |= SVf_BREAK;
     SvREFCNT_dec(sv);
 }