X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FStorable%2FStorable.xs;h=24de05f88d24be8cf321a33f33c6a66b8c5ff543;hb=5e137bc214f9c21ed33df8110b67005fb915c4e7;hp=09992f2ae563552b0eaae240d05c9d14aeb6f0a8;hpb=dcbd05f23a28591fee1fda39542198585adc0e3a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index 09992f2..24de05f 100644
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -18,6 +18,9 @@
 #endif
 
 #if !defined(PERL_VERSION) || PERL_VERSION < 8
+#define NEED_load_module
+#define NEED_vload_module
+#define NEED_newCONSTSUB
 #include "ppport.h"             /* handle old perls */
 #endif
 
@@ -86,14 +89,24 @@ typedef double NV;			/* Older perls lack the NV type */
 #endif
 #endif
 
-#ifdef HASATTRIBUTE
-#  if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
-#    define PERL_UNUSED_DECL
+#ifndef SvRV_set
+#define SvRV_set(sv, val) \
+    STMT_START { \
+        assert(SvTYPE(sv) >=  SVt_RV); \
+        (((XRV*)SvANY(sv))->xrv_rv = (val)); \
+    } STMT_END
+#endif
+
+#ifndef PERL_UNUSED_DECL
+#  ifdef HASATTRIBUTE
+#    if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
+#      define PERL_UNUSED_DECL
+#    else
+#      define PERL_UNUSED_DECL __attribute__((unused))
+#    endif
 #  else
-#    define PERL_UNUSED_DECL __attribute__((unused))
+#    define PERL_UNUSED_DECL
 #  endif
-#else
-#  define PERL_UNUSED_DECL
 #endif
 
 #ifndef dNOOP
@@ -104,6 +117,28 @@ typedef double NV;			/* Older perls lack the NV type */
 #define dVAR dNOOP
 #endif
 
+#ifndef HvRITER_set
+#  define HvRITER_set(hv,r)	(HvRITER(hv) = r)
+#endif
+#ifndef HvEITER_set
+#  define HvEITER_set(hv,r)	(HvEITER(hv) = r)
+#endif
+
+#ifndef HvRITER_get
+#  define HvRITER_get HvRITER
+#endif
+#ifndef HvEITER_get
+#  define HvEITER_get HvEITER
+#endif
+
+#ifndef HvNAME_get
+#define HvNAME_get HvNAME
+#endif
+
+#ifndef HvPLACEHOLDERS_get
+#  define HvPLACEHOLDERS_get HvPLACEHOLDERS
+#endif
+
 #ifdef DEBUGME
 
 #ifndef DASSERT
@@ -294,6 +329,10 @@ typedef unsigned long stag_t;	/* Used by pre-0.6 binary format */
 #define HAS_HASH_KEY_FLAGS
 #endif
 
+#ifdef ptr_table_new
+#define USE_PTR_TABLE
+#endif
+
 /*
  * Fields s_tainted and s_dirty are prefixed with s_ because Perl's include
  * files remap tainted and dirty when threading is enabled.  That's bad for
@@ -304,7 +343,16 @@ struct stcxt;
 typedef struct stcxt {
 	int entry;			/* flags recursion */
 	int optype;			/* type of traversal operation */
-	HV *hseen;			/* which objects have been seen, store time */
+	/* which objects have been seen, store time.
+	   tags are numbers, which are cast to (SV *) and stored directly */
+#ifdef USE_PTR_TABLE
+	/* use pseen if we have ptr_tables. We have to store tag+1, because
+	   tag numbers start at 0, and we can't store (SV *) 0 in a ptr_table
+	   without it being confused for a fetch lookup failure.  */
+	struct ptr_tbl *pseen;
+	/* Still need hseen for the 0.6 file format code. */
+#endif
+	HV *hseen;			
 	AV *hook_seen;		/* which SVs were returned by STORABLE_freeze() */
 	AV *aseen;			/* which objects have been seen, retrieve time */
 	IV where_is_undef;		/* index in aseen of PL_sv_undef */
@@ -334,7 +382,7 @@ typedef struct stcxt {
 	PerlIO *fio;		/* where I/O are performed, NULL for memory */
 	int ver_major;		/* major of version for retrieved object */
 	int ver_minor;		/* minor of version for retrieved object */
-	SV *(**retrieve_vtbl)(pTHX_ struct stcxt *, char *);	/* retrieve dispatch table */
+	SV *(**retrieve_vtbl)(pTHX_ struct stcxt *, const char *);	/* retrieve dispatch table */
 	SV *prev;		/* contexts chained backwards in real recursion */
 	SV *my_sv;		/* the blessed scalar who's SvPVX() I am */
 } stcxt_t;
@@ -343,7 +391,7 @@ typedef struct stcxt {
   STMT_START {										\
 	SV *self = newSV(sizeof(stcxt_t) - 1);			\
 	SV *my_sv = newRV_noinc(self);					\
-	sv_bless(my_sv, gv_stashpv("Storable::Cxt", TRUE));	\
+	sv_bless(my_sv, gv_stashpv("Storable::Cxt", GV_ADD));	\
 	cxt = (stcxt_t *)SvPVX(self);					\
 	Zero(cxt, 1, stcxt_t);							\
 	cxt->my_sv = my_sv;								\
@@ -611,6 +659,17 @@ static stcxt_t *Context_ptr = NULL;
 	}								\
   } STMT_END
 
+#define MBUF_SAFEPVREAD(x,s,z)			\
+  STMT_START {					\
+	if ((mptr + (s)) <= mend) {		\
+		memcpy(x, mptr, s);		\
+		mptr += s;			\
+	} else {				\
+		Safefree(z);			\
+		return (SV *) 0;		\
+	}					\
+  } STMT_END
+
 #define MBUF_PUTC(c) 				\
   STMT_START {						\
 	if (mptr < mend)				\
@@ -941,6 +1000,16 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
 	}											\
   } STMT_END
 
+#define SAFEPVREAD(x,y,z)					\
+  STMT_START {							\
+	if (!cxt->fio)						\
+		MBUF_SAFEPVREAD(x,y,z);				\
+	else if (PerlIO_read(cxt->fio, x, y) != y)	 {	\
+		Safefree(z);					\
+		return (SV *) 0;				\
+	}							\
+  } STMT_END
+
 /*
  * This macro is used at retrieve time, to remember where object 'y', bearing a
  * given tag 'tagnum', has been retrieved. Next time we see an SX_OBJECT marker,
@@ -981,7 +1050,7 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
 	SV *ref;								\
 	HV *stash;								\
 	TRACEME(("blessing 0x%"UVxf" in %s", PTR2UV(s), (p))); \
-	stash = gv_stashpv((p), TRUE);			\
+	stash = gv_stashpv((p), GV_ADD);			\
 	ref = newRV_noinc(s);					\
 	(void) sv_bless(ref, stash);			\
 	SvRV_set(ref, NULL);						\
@@ -1019,7 +1088,7 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
 #endif /* PATCHLEVEL <= 6 */
 
 static int store(pTHX_ stcxt_t *cxt, SV *sv);
-static SV *retrieve(pTHX_ stcxt_t *cxt, char *cname);
+static SV *retrieve(pTHX_ stcxt_t *cxt, const char *cname);
 
 /*
  * Dynamic dispatching table for SV store.
@@ -1054,24 +1123,24 @@ static const sv_store_t sv_store[] = {
  * Dynamic dispatching tables for SV retrieval.
  */
 
-static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_lutf8str(pTHX_ stcxt_t *cxt, char *cname);
-static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, char *cname);
-static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_ref(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_undef(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_integer(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_double(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_byte(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_netint(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_scalar(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_utf8str(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_tied_array(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_other(pTHX_ stcxt_t *cxt, char *cname);
-
-typedef SV* (*sv_retrieve_t)(pTHX_ stcxt_t *cxt, char *name);
+static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_lutf8str(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_ref(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_undef(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_integer(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_double(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_byte(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_netint(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_scalar(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_utf8str(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_tied_array(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_other(pTHX_ stcxt_t *cxt, const char *cname);
+
+typedef SV* (*sv_retrieve_t)(pTHX_ stcxt_t *cxt, const char *name);
 
 static const sv_retrieve_t sv_old_retrieve[] = {
 	0,			/* SX_OBJECT -- entry unused dynamically */
@@ -1106,21 +1175,21 @@ static const sv_retrieve_t sv_old_retrieve[] = {
 	(sv_retrieve_t)retrieve_other,	/* SX_ERROR */
 };
 
-static SV *retrieve_array(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_hash(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_sv_undef(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_sv_yes(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_sv_no(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_idx_blessed(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_hook(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_tied_key(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_tied_idx(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_code(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_weakref(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_weakoverloaded(pTHX_ stcxt_t *cxt, char *cname);
+static SV *retrieve_array(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_sv_undef(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_sv_yes(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_sv_no(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_idx_blessed(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_tied_key(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_tied_idx(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_weakref(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_weakoverloaded(pTHX_ stcxt_t *cxt, const char *cname);
 
 static const sv_retrieve_t sv_retrieve[] = {
 	0,			/* SX_OBJECT -- entry unused dynamically */
@@ -1227,9 +1296,13 @@ static void init_store_context(
 	 * those optimizations increase the throughput by 12%.
 	 */
 
+#ifdef USE_PTR_TABLE
+	cxt->pseen = ptr_table_new();
+	cxt->hseen = 0;
+#else
 	cxt->hseen = newHV();			/* Table where seen objects are stored */
 	HvSHAREKEYS_off(cxt->hseen);
-
+#endif
 	/*
 	 * The following does not work well with perl5.004_04, and causes
 	 * a core dump later on, in a completely unrelated spot, which
@@ -1248,8 +1321,10 @@ static void init_store_context(
 	 */
 #if PERL_VERSION >= 5
 #define HBUCKETS	4096				/* Buckets for %hseen */
+#ifndef USE_PTR_TABLE
 	HvMAX(cxt->hseen) = HBUCKETS - 1;	/* keys %hseen = $HBUCKETS; */
 #endif
+#endif
 
 	/*
 	 * The `hclass' hash uses the same settings as `hseen' above, but it is
@@ -1303,11 +1378,13 @@ static void clean_store_context(pTHX_ stcxt_t *cxt)
 	 * Insert real values into hashes where we stored faked pointers.
 	 */
 
+#ifndef USE_PTR_TABLE
 	if (cxt->hseen) {
 		hv_iterinit(cxt->hseen);
 		while ((he = hv_iternext(cxt->hseen)))	/* Extra () for -Wall, grr.. */
 			HeVAL(he) = &PL_sv_undef;
 	}
+#endif
 
 	if (cxt->hclass) {
 		hv_iterinit(cxt->hclass);
@@ -1325,12 +1402,21 @@ static void clean_store_context(pTHX_ stcxt_t *cxt)
 	 * 		-- RAM, 20/12/2000
 	 */
 
+#ifdef USE_PTR_TABLE
+	if (cxt->pseen) {
+		struct ptr_tbl *pseen = cxt->pseen;
+		cxt->pseen = 0;
+		ptr_table_free(pseen);
+	}
+	assert(!cxt->hseen);
+#else
 	if (cxt->hseen) {
 		HV *hseen = cxt->hseen;
 		cxt->hseen = 0;
 		hv_undef(hseen);
 		sv_free((SV *) hseen);
 	}
+#endif
 
 	if (cxt->hclass) {
 		HV *hclass = cxt->hclass;
@@ -1384,6 +1470,10 @@ static void init_retrieve_context(pTHX_ stcxt_t *cxt, int optype, int is_tainted
 
 	cxt->hook  = newHV();			/* Caches STORABLE_thaw */
 
+#ifdef USE_PTR_TABLE
+	cxt->pseen = 0;
+#endif
+
 	/*
 	 * If retrieving an old binary version, the cxt->retrieve_vtbl variable
 	 * was set to sv_old_retrieve. We'll need a hash table to keep track of
@@ -1542,7 +1632,7 @@ static void free_context(pTHX_ stcxt_t *cxt)
  *
  * Tells whether we're in the middle of a store operation.
  */
-int is_storing(pTHX)
+static int is_storing(pTHX)
 {
 	dSTCXT;
 
@@ -1554,7 +1644,7 @@ int is_storing(pTHX)
  *
  * Tells whether we're in the middle of a retrieve operation.
  */
-int is_retrieving(pTHX)
+static int is_retrieving(pTHX)
 {
 	dSTCXT;
 
@@ -1569,7 +1659,7 @@ int is_retrieving(pTHX)
  * This is typically out-of-band information that might prove useful
  * to people wishing to convert native to network order data when used.
  */
-int last_op_in_netorder(pTHX)
+static int last_op_in_netorder(pTHX)
 {
 	dSTCXT;
 
@@ -1592,10 +1682,12 @@ static SV *pkg_fetchmeth(
         pTHX_
 	HV *cache,
 	HV *pkg,
-	char *method)
+	const char *method)
 {
 	GV *gv;
 	SV *sv;
+	const char *hvname = HvNAME_get(pkg);
+
 
 	/*
 	 * The following code is the same as the one performed by UNIVERSAL::can
@@ -1605,10 +1697,10 @@ static SV *pkg_fetchmeth(
 	gv = gv_fetchmethod_autoload(pkg, method, FALSE);
 	if (gv && isGV(gv)) {
 		sv = newRV((SV*) GvCV(gv));
-		TRACEME(("%s->%s: 0x%"UVxf, HvNAME(pkg), method, PTR2UV(sv)));
+		TRACEME(("%s->%s: 0x%"UVxf, hvname, method, PTR2UV(sv)));
 	} else {
 		sv = newSVsv(&PL_sv_undef);
-		TRACEME(("%s->%s: not found", HvNAME(pkg), method));
+		TRACEME(("%s->%s: not found", hvname, method));
 	}
 
 	/*
@@ -1616,7 +1708,7 @@ static SV *pkg_fetchmeth(
 	 * it just won't be cached.
 	 */
 
-	(void) hv_store(cache, HvNAME(pkg), strlen(HvNAME(pkg)), sv, 0);
+	(void) hv_store(cache, hvname, strlen(hvname), sv, 0);
 
 	return SvOK(sv) ? sv : (SV *) 0;
 }
@@ -1630,10 +1722,11 @@ static void pkg_hide(
         pTHX_
 	HV *cache,
 	HV *pkg,
-	char *method)
+	const char *method)
 {
+	const char *hvname = HvNAME_get(pkg);
 	(void) hv_store(cache,
-		HvNAME(pkg), strlen(HvNAME(pkg)), newSVsv(&PL_sv_undef), 0);
+		hvname, strlen(hvname), newSVsv(&PL_sv_undef), 0);
 }
 
 /*
@@ -1645,9 +1738,10 @@ static void pkg_uncache(
         pTHX_
 	HV *cache,
 	HV *pkg,
-	char *method)
+	const char *method)
 {
-	(void) hv_delete(cache, HvNAME(pkg), strlen(HvNAME(pkg)), G_DISCARD);
+	const char *hvname = HvNAME_get(pkg);
+	(void) hv_delete(cache, hvname, strlen(hvname), G_DISCARD);
 }
 
 /*
@@ -1662,12 +1756,13 @@ static SV *pkg_can(
         pTHX_
 	HV *cache,
 	HV *pkg,
-	char *method)
+	const char *method)
 {
 	SV **svh;
 	SV *sv;
+	const char *hvname = HvNAME_get(pkg);
 
-	TRACEME(("pkg_can for %s->%s", HvNAME(pkg), method));
+	TRACEME(("pkg_can for %s->%s", hvname, method));
 
 	/*
 	 * Look into the cache to see whether we already have determined
@@ -1677,15 +1772,15 @@ static SV *pkg_can(
 	 * that only one hook (i.e. always the same) is cached in a given cache.
 	 */
 
-	svh = hv_fetch(cache, HvNAME(pkg), strlen(HvNAME(pkg)), FALSE);
+	svh = hv_fetch(cache, hvname, strlen(hvname), FALSE);
 	if (svh) {
 		sv = *svh;
 		if (!SvOK(sv)) {
-			TRACEME(("cached %s->%s: not found", HvNAME(pkg), method));
+			TRACEME(("cached %s->%s: not found", hvname, method));
 			return (SV *) 0;
 		} else {
 			TRACEME(("cached %s->%s: 0x%"UVxf,
-				HvNAME(pkg), method, PTR2UV(sv)));
+				hvname, method, PTR2UV(sv)));
 			return sv;
 		}
 	}
@@ -2219,8 +2314,8 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
 	 * Save possible iteration state via each() on that table.
 	 */
 
-	riter = HvRITER(hv);
-	eiter = HvEITER(hv);
+	riter = HvRITER_get(hv);
+	eiter = HvEITER_get(hv);
 	hv_iterinit(hv);
 
 	/*
@@ -2258,7 +2353,11 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
 #else
 			HE *he = hv_iternext(hv);
 #endif
-			SV *key = hv_iterkeysv(he);
+			SV *key;
+
+			if (!he)
+				CROAK(("Hash %p inconsistent - expected %d keys, %dth is NULL", hv, len, i));
+			key = hv_iterkeysv(he);
 			av_store(av, AvFILLp(av)+1, key);	/* av_push(), really */
 		}
 			
@@ -2266,7 +2365,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
 
 		for (i = 0; i < len; i++) {
 #ifdef HAS_RESTRICTED_HASHES
-			int placeholders = (int)HvPLACEHOLDERS(hv);
+			int placeholders = (int)HvPLACEHOLDERS_get(hv);
 #endif
                         unsigned char flags = 0;
 			char *keyval;
@@ -2396,7 +2495,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
 		 */
   
 		for (i = 0; i < len; i++) {
-			char *key;
+			char *key = 0;
 			I32 len;
                         unsigned char flags;
 #ifdef HV_ITERNEXT_WANTPLACEHOLDERS
@@ -2488,8 +2587,8 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
 	TRACEME(("ok (hash 0x%"UVxf")", PTR2UV(hv)));
 
 out:
-	HvRITER(hv) = riter;		/* Restore hash iterator state */
-	HvEITER(hv) = eiter;
+	HvRITER_set(hv, riter);		/* Restore hash iterator state */
+	HvEITER_set(hv, eiter);
 
 	return ret;
 }
@@ -2531,6 +2630,7 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
 	 */
 	/* Ownership of both SVs is passed to load_module, which frees them. */
 	load_module(PERL_LOADMOD_NOIMPORT, newSVpvn("B::Deparse",10), newSVnv(0.61));
+        SPAGAIN;
 
 	ENTER;
 	SAVETMPS;
@@ -2562,7 +2662,7 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
 		CROAK(("Unexpected return value from B::Deparse::coderef2text\n"));
 
 	text = POPs;
-	len = SvLEN(text);
+	len = SvCUR(text);
 	reallen = strlen(SvPV_nolen(text));
 
 	/*
@@ -2794,7 +2894,7 @@ static int store_hook(
 	char mtype = '\0';				/* for blessed ref to tied structures */
 	unsigned char eflags = '\0';	/* used when object type is SHT_EXTRA */
 
-	TRACEME(("store_hook, classname \"%s\", tagged #%d", HvNAME(pkg), cxt->tagnum));
+	TRACEME(("store_hook, classname \"%s\", tagged #%d", HvNAME_get(pkg), cxt->tagnum));
 
 	/*
 	 * Determine object type on 2 bits.
@@ -2845,7 +2945,7 @@ static int store_hook(
 	}
 	flags = SHF_NEED_RECURSE | obj_type;
 
-	classname = HvNAME(pkg);
+	classname = HvNAME_get(pkg);
 	len = strlen(classname);
 
 	/*
@@ -2928,9 +3028,14 @@ static int store_hook(
 	 */
 
 	for (i = 1; i < count; i++) {
+#ifdef USE_PTR_TABLE
+		char *fake_tag;
+#else
 		SV **svh;
+#endif
 		SV *rsv = ary[i];
 		SV *xsv;
+		SV *tag;
 		AV *av_hook = cxt->hook_seen;
 
 		if (!SvROK(rsv))
@@ -2942,9 +3047,18 @@ static int store_hook(
 		 * Look in hseen and see if we have a tag already.
 		 * Serialize entry if not done already, and get its tag.
 		 */
-
+	
+#ifdef USE_PTR_TABLE
+		/* Fakery needed because ptr_table_fetch returns zero for a
+		   failure, whereas the existing code assumes that it can
+		   safely store a tag zero. So for ptr_tables we store tag+1
+		*/
+		if ((fake_tag = (char *)ptr_table_fetch(cxt->pseen, xsv)))
+			goto sv_seen;		/* Avoid moving code too far to the right */
+#else
 		if ((svh = hv_fetch(cxt->hseen, (char *) &xsv, sizeof(xsv), FALSE)))
 			goto sv_seen;		/* Avoid moving code too far to the right */
+#endif
 
 		TRACEME(("listed object %d at 0x%"UVxf" is unknown", i-1, PTR2UV(xsv)));
 
@@ -2971,10 +3085,15 @@ static int store_hook(
 		if ((ret = store(aTHX_ cxt, xsv)))	/* Given by hook for us to store */
 			return ret;
 
+#ifdef USE_PTR_TABLE
+		fake_tag = (char *)ptr_table_fetch(cxt->pseen, xsv);
+		if (!sv)
+			CROAK(("Could not serialize item #%d from hook in %s", i, classname));
+#else
 		svh = hv_fetch(cxt->hseen, (char *) &xsv, sizeof(xsv), FALSE);
 		if (!svh)
 			CROAK(("Could not serialize item #%d from hook in %s", i, classname));
-
+#endif
 		/*
 		 * It was the first time we serialized `xsv'.
 		 *
@@ -3004,9 +3123,14 @@ static int store_hook(
 		 * Replace entry with its tag (not a real SV, so no refcnt increment)
 		 */
 
-		ary[i] = *svh;
+#ifdef USE_PTR_TABLE
+		tag = (SV *)--fake_tag;
+#else
+		tag = *svh;
+#endif
+		ary[i] = tag;
 		TRACEME(("listed object %d at 0x%"UVxf" is tag #%"UVuf,
-			 i-1, PTR2UV(xsv), PTR2UV(*svh)));
+			 i-1, PTR2UV(xsv), PTR2UV(tag)));
 	}
 
 	/*
@@ -3189,7 +3313,7 @@ static int store_blessed(
 	char *classname;
 	I32 classnum;
 
-	TRACEME(("store_blessed, type %d, class \"%s\"", type, HvNAME(pkg)));
+	TRACEME(("store_blessed, type %d, class \"%s\"", type, HvNAME_get(pkg)));
 
 	/*
 	 * Look for a hook for this blessed SV and redirect to store_hook()
@@ -3204,7 +3328,7 @@ static int store_blessed(
 	 * This is a blessed SV without any serialization hook.
 	 */
 
-	classname = HvNAME(pkg);
+	classname = HvNAME_get(pkg);
 	len = strlen(classname);
 
 	TRACEME(("blessed 0x%"UVxf" in %s, no hook: tagged #%d",
@@ -3310,7 +3434,9 @@ static int sv_type(pTHX_ SV *sv)
 {
 	switch (SvTYPE(sv)) {
 	case SVt_NULL:
+#if PERL_VERSION <= 10
 	case SVt_IV:
+#endif
 	case SVt_NV:
 		/*
 		 * No need to check for ROK, that can't be set here since there
@@ -3318,7 +3444,11 @@ static int sv_type(pTHX_ SV *sv)
 		 */
 		return svis_SCALAR;
 	case SVt_PV:
+#if PERL_VERSION <= 10
 	case SVt_RV:
+#else
+	case SVt_IV:
+#endif
 	case SVt_PVIV:
 	case SVt_PVNV:
 		/*
@@ -3336,7 +3466,9 @@ static int sv_type(pTHX_ SV *sv)
 		if (SvRMAGICAL(sv) && (mg_find(sv, 'p')))
 			return svis_TIED_ITEM;
 		/* FALL THROUGH */
+#if PERL_VERSION < 9
 	case SVt_PVBM:
+#endif
 		if (SvRMAGICAL(sv) && (mg_find(sv, 'q')))
 			return svis_TIED;
 		return SvROK(sv) ? svis_REF : svis_SCALAR;
@@ -3350,6 +3482,9 @@ static int sv_type(pTHX_ SV *sv)
 		return svis_HASH;
 	case SVt_PVCV:
 		return svis_CODE;
+#if PERL_VERSION > 8
+	/* case SVt_BIND: */
+#endif
 	default:
 		break;
 	}
@@ -3371,7 +3506,11 @@ static int store(pTHX_ stcxt_t *cxt, SV *sv)
 	SV **svh;
 	int ret;
 	int type;
+#ifdef USE_PTR_TABLE
+	struct ptr_tbl *pseen = cxt->pseen;
+#else
 	HV *hseen = cxt->hseen;
+#endif
 
 	TRACEME(("store (0x%"UVxf")", PTR2UV(sv)));
 
@@ -3387,7 +3526,11 @@ static int store(pTHX_ stcxt_t *cxt, SV *sv)
 	 *		-- RAM, 14/09/1999
 	 */
 
+#ifdef USE_PTR_TABLE
+	svh = (SV **)ptr_table_fetch(pseen, sv);
+#else
 	svh = hv_fetch(hseen, (char *) &sv, sizeof(sv), FALSE);
+#endif
 	if (svh) {
 		I32 tagval;
 
@@ -3421,7 +3564,11 @@ static int store(pTHX_ stcxt_t *cxt, SV *sv)
 			goto undef_special_case;
 		}
 		
+#ifdef USE_PTR_TABLE
+		tagval = htonl(LOW_32BITS(((char *)svh)-1));
+#else
 		tagval = htonl(LOW_32BITS(*svh));
+#endif
 
 		TRACEME(("object 0x%"UVxf" seen as #%d", PTR2UV(sv), ntohl(tagval)));
 
@@ -3442,9 +3589,13 @@ static int store(pTHX_ stcxt_t *cxt, SV *sv)
 	 */
 
 	cxt->tagnum++;
+#ifdef USE_PTR_TABLE
+	ptr_table_store(pseen, sv, INT2PTR(SV*, 1 + cxt->tagnum));
+#else
 	if (!hv_store(hseen,
 			(char *) &sv, sizeof(sv), INT2PTR(SV*, cxt->tagnum), 0))
 		return -1;
+#endif
 
 	/*
 	 * Store `sv' and everything beneath it, using appropriate routine.
@@ -3695,7 +3846,7 @@ static int do_store(
  * Store the transitive data closure of given object to disk.
  * Returns 0 on error, a true value otherwise.
  */
-int pstore(pTHX_ PerlIO *f, SV *sv)
+static int pstore(pTHX_ PerlIO *f, SV *sv)
 {
 	TRACEME(("pstore"));
 	return do_store(aTHX_ f, sv, 0, FALSE, (SV**) 0);
@@ -3708,7 +3859,7 @@ int pstore(pTHX_ PerlIO *f, SV *sv)
  * Same as pstore(), but network order is used for integers and doubles are
  * emitted as strings.
  */
-int net_pstore(pTHX_ PerlIO *f, SV *sv)
+static int net_pstore(pTHX_ PerlIO *f, SV *sv)
 {
 	TRACEME(("net_pstore"));
 	return do_store(aTHX_ f, sv, 0, TRUE, (SV**) 0);
@@ -3736,7 +3887,7 @@ static SV *mbuf2sv(pTHX)
  * Store the transitive data closure of given object to memory.
  * Returns undef on error, a scalar value containing the data otherwise.
  */
-SV *mstore(pTHX_ SV *sv)
+static SV *mstore(pTHX_ SV *sv)
 {
 	SV *out;
 
@@ -3754,7 +3905,7 @@ SV *mstore(pTHX_ SV *sv)
  * Same as mstore(), but network order is used for integers and doubles are
  * emitted as strings.
  */
-SV *net_mstore(pTHX_ SV *sv)
+static SV *net_mstore(pTHX_ SV *sv)
 {
 	SV *out;
 
@@ -3776,7 +3927,7 @@ SV *net_mstore(pTHX_ SV *sv)
  * Return an error via croak, since it is not possible that we get here
  * under normal conditions, when facing a file produced via pstore().
  */
-static SV *retrieve_other(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_other(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	if (
 		cxt->ver_major != STORABLE_BIN_MAJOR &&
@@ -3801,10 +3952,10 @@ static SV *retrieve_other(pTHX_ stcxt_t *cxt, char *cname)
  * Layout is SX_IX_BLESS <index> <object> with SX_IX_BLESS already read.
  * <index> can be coded on either 1 or 5 bytes.
  */
-static SV *retrieve_idx_blessed(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_idx_blessed(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	I32 idx;
-	char *classname;
+	const char *classname;
 	SV **sva;
 	SV *sv;
 
@@ -3842,12 +3993,13 @@ static SV *retrieve_idx_blessed(pTHX_ stcxt_t *cxt, char *cname)
  * Layout is SX_BLESS <len> <classname> <object> with SX_BLESS already read.
  * <len> can be coded on either 1 or 5 bytes.
  */
-static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	I32 len;
 	SV *sv;
 	char buf[LG_BLESS + 1];		/* Avoid malloc() if possible */
 	char *classname = buf;
+	char *malloced_classname = NULL;
 
 	TRACEME(("retrieve_blessed (#%d)", cxt->tagnum));
 	ASSERT(!cname, ("no bless-into class given here, got %s", cname));
@@ -3864,8 +4016,9 @@ static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, char *cname)
 		RLEN(len);
 		TRACEME(("** allocating %d bytes for class name", len+1));
 		New(10003, classname, len+1, char);
+		malloced_classname = classname;
 	}
-	READ(classname, len);
+	SAFEPVREAD(classname, len, malloced_classname);
 	classname[len] = '\0';		/* Mark string end */
 
 	/*
@@ -3874,16 +4027,18 @@ static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, char *cname)
 
 	TRACEME(("new class name \"%s\" will bear ID = %d", classname, cxt->classnum));
 
-	if (!av_store(cxt->aclass, cxt->classnum++, newSVpvn(classname, len)))
+	if (!av_store(cxt->aclass, cxt->classnum++, newSVpvn(classname, len))) {
+		Safefree(malloced_classname);
 		return (SV *) 0;
+	}
 
 	/*
 	 * Retrieve object and bless it.
 	 */
 
 	sv = retrieve(aTHX_ cxt, classname);	/* First SV which is SEEN will be blessed */
-	if (classname != buf)
-		Safefree(classname);
+	if (malloced_classname)
+		Safefree(malloced_classname);
 
 	return sv;
 }
@@ -3908,7 +4063,7 @@ static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, char *cname)
  * processing (since we won't have seen the magic object by the time the hook
  * is called).  See comments below for why it was done that way.
  */
-static SV *retrieve_hook(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	I32 len;
 	char buf[LG_BLESS + 1];		/* Avoid malloc() if possible */
@@ -4035,6 +4190,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, char *cname)
 		 * on the stack.  Just like retrieve_blessed(), we limit the name to
 		 * LG_BLESS bytes.  This is an arbitrary decision.
 		 */
+		char *malloced_classname = NULL;
 
 		if (flags & SHF_LARGE_CLASSLEN)
 			RLEN(len);
@@ -4044,17 +4200,20 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, char *cname)
 		if (len > LG_BLESS) {
 			TRACEME(("** allocating %d bytes for class name", len+1));
 			New(10003, classname, len+1, char);
+			malloced_classname = classname;
 		}
 
-		READ(classname, len);
+		SAFEPVREAD(classname, len, malloced_classname);
 		classname[len] = '\0';		/* Mark string end */
 
 		/*
 		 * Record new classname.
 		 */
 
-		if (!av_store(cxt->aclass, cxt->classnum++, newSVpvn(classname, len)))
+		if (!av_store(cxt->aclass, cxt->classnum++, newSVpvn(classname, len))) {
+			Safefree(malloced_classname);
 			return (SV *) 0;
+		}
 	}
 
 	TRACEME(("class name: %s", classname));
@@ -4172,19 +4331,14 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, char *cname)
 		 * Hook not found.  Maybe they did not require the module where this
 		 * hook is defined yet?
 		 *
-		 * If the require below succeeds, we'll be able to find the hook.
+		 * If the load below succeeds, we'll be able to find the hook.
 		 * Still, it only works reliably when each class is defined in a
 		 * file of its own.
 		 */
 
-		SV *psv = newSVpvn("require ", 8);
-		sv_catpv(psv, classname);
-
 		TRACEME(("No STORABLE_thaw defined for objects of class %s", classname));
-		TRACEME(("Going to require module '%s' with '%s'", classname, SvPVX(psv)));
-
-		perl_eval_sv(psv, G_DISCARD);
-		sv_free(psv);
+		TRACEME(("Going to load module '%s'", classname));
+	        load_module(PERL_LOADMOD_NOIMPORT, newSVpv(classname, 0), Nullsv);
 
 		/*
 		 * We cache results of pkg_can, so we need to uncache before attempting
@@ -4296,7 +4450,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, char *cname)
 	 * into the existing design.  -- RAM, 17/02/2001
 	 */
 
-	sv_magic(sv, rv, mtype, Nullch, 0);
+	sv_magic(sv, rv, mtype, (char *)NULL, 0);
 	SvREFCNT_dec(rv);			/* Undo refcnt inc from sv_magic() */
 
 	return sv;
@@ -4308,7 +4462,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, char *cname)
  * Retrieve reference to some other scalar.
  * Layout is SX_REF <object>, with SX_REF already read.
  */
-static SV *retrieve_ref(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_ref(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV *rv;
 	SV *sv;
@@ -4349,7 +4503,7 @@ static SV *retrieve_ref(pTHX_ stcxt_t *cxt, char *cname)
 
 	if (cname) {
 		/* No need to do anything, as rv will already be PVMG.  */
-		assert (SvTYPE(rv) >= SVt_RV);
+		assert (SvTYPE(rv) == SVt_RV || SvTYPE(rv) >= SVt_PV);
 	} else {
 		sv_upgrade(rv, SVt_RV);
 	}
@@ -4368,7 +4522,7 @@ static SV *retrieve_ref(pTHX_ stcxt_t *cxt, char *cname)
  * Retrieve weak reference to some other scalar.
  * Layout is SX_WEAKREF <object>, with SX_WEAKREF already read.
  */
-static SV *retrieve_weakref(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_weakref(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV *sv;
 
@@ -4391,7 +4545,7 @@ static SV *retrieve_weakref(pTHX_ stcxt_t *cxt, char *cname)
  * Retrieve reference to some other scalar with overloading.
  * Layout is SX_OVERLOAD <object>, with SX_OVERLOAD already read.
  */
-static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV *rv;
 	SV *sv;
@@ -4413,7 +4567,7 @@ static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, char *cname)
 	 * WARNING: breaks RV encapsulation.
 	 */
 
-	sv_upgrade(rv, SVt_RV);
+	SvUPGRADE(rv, SVt_RV);
 	SvRV_set(rv, sv);				/* $rv = \$sv */
 	SvROK_on(rv);
 
@@ -4429,15 +4583,10 @@ static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, char *cname)
 		       PTR2UV(sv)));
 	}
 	if (!Gv_AMG(stash)) {
-		SV *psv = newSVpvn("require ", 8);
-		const char *package = HvNAME(stash);
-		sv_catpv(psv, package);
-
+	        const char *package = HvNAME_get(stash);
 		TRACEME(("No overloading defined for package %s", package));
-		TRACEME(("Going to require module '%s' with '%s'", package, SvPVX(psv)));
-
-		perl_eval_sv(psv, G_DISCARD);
-		sv_free(psv);
+		TRACEME(("Going to load module '%s'", package));
+		load_module(PERL_LOADMOD_NOIMPORT, newSVpv(package, 0), Nullsv);
 		if (!Gv_AMG(stash)) {
 			CROAK(("Cannot restore overloading on %s(0x%"UVxf
 			       ") (package %s) (even after a \"require %s;\")",
@@ -4460,7 +4609,7 @@ static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, char *cname)
  * Retrieve weak overloaded reference to some other scalar.
  * Layout is SX_WEAKOVERLOADED <object>, with SX_WEAKOVERLOADED already read.
  */
-static SV *retrieve_weakoverloaded(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_weakoverloaded(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV *sv;
 
@@ -4483,7 +4632,7 @@ static SV *retrieve_weakoverloaded(pTHX_ stcxt_t *cxt, char *cname)
  * Retrieve tied array
  * Layout is SX_TIED_ARRAY <object>, with SX_TIED_ARRAY already read.
  */
-static SV *retrieve_tied_array(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_tied_array(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV *tv;
 	SV *sv;
@@ -4498,7 +4647,7 @@ static SV *retrieve_tied_array(pTHX_ stcxt_t *cxt, char *cname)
 
 	sv_upgrade(tv, SVt_PVAV);
 	AvREAL_off((AV *)tv);
-	sv_magic(tv, sv, 'P', Nullch, 0);
+	sv_magic(tv, sv, 'P', (char *)NULL, 0);
 	SvREFCNT_dec(sv);			/* Undo refcnt inc from sv_magic() */
 
 	TRACEME(("ok (retrieve_tied_array at 0x%"UVxf")", PTR2UV(tv)));
@@ -4512,7 +4661,7 @@ static SV *retrieve_tied_array(pTHX_ stcxt_t *cxt, char *cname)
  * Retrieve tied hash
  * Layout is SX_TIED_HASH <object>, with SX_TIED_HASH already read.
  */
-static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV *tv;
 	SV *sv;
@@ -4526,7 +4675,7 @@ static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, char *cname)
 		return (SV *) 0;		/* Failed */
 
 	sv_upgrade(tv, SVt_PVHV);
-	sv_magic(tv, sv, 'P', Nullch, 0);
+	sv_magic(tv, sv, 'P', (char *)NULL, 0);
 	SvREFCNT_dec(sv);			/* Undo refcnt inc from sv_magic() */
 
 	TRACEME(("ok (retrieve_tied_hash at 0x%"UVxf")", PTR2UV(tv)));
@@ -4540,7 +4689,7 @@ static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, char *cname)
  * Retrieve tied scalar
  * Layout is SX_TIED_SCALAR <object>, with SX_TIED_SCALAR already read.
  */
-static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV *tv;
 	SV *sv, *obj = NULL;
@@ -4558,7 +4707,7 @@ static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, char *cname)
 	}
 
 	sv_upgrade(tv, SVt_PVMG);
-	sv_magic(tv, obj, 'q', Nullch, 0);
+	sv_magic(tv, obj, 'q', (char *)NULL, 0);
 
 	if (obj) {
 		/* Undo refcnt inc from sv_magic() */
@@ -4576,7 +4725,7 @@ static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, char *cname)
  * Retrieve reference to value in a tied hash.
  * Layout is SX_TIED_KEY <object> <key>, with SX_TIED_KEY already read.
  */
-static SV *retrieve_tied_key(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_tied_key(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV *tv;
 	SV *sv;
@@ -4608,7 +4757,7 @@ static SV *retrieve_tied_key(pTHX_ stcxt_t *cxt, char *cname)
  * Retrieve reference to value in a tied array.
  * Layout is SX_TIED_IDX <object> <idx>, with SX_TIED_IDX already read.
  */
-static SV *retrieve_tied_idx(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_tied_idx(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV *tv;
 	SV *sv;
@@ -4625,7 +4774,7 @@ static SV *retrieve_tied_idx(pTHX_ stcxt_t *cxt, char *cname)
 	RLEN(idx);					/* Retrieve <idx> */
 
 	sv_upgrade(tv, SVt_PVMG);
-	sv_magic(tv, sv, 'p', Nullch, idx);
+	sv_magic(tv, sv, 'p', (char *)NULL, idx);
 	SvREFCNT_dec(sv);			/* Undo refcnt inc from sv_magic() */
 
 	return tv;
@@ -4641,7 +4790,7 @@ static SV *retrieve_tied_idx(pTHX_ stcxt_t *cxt, char *cname)
  * The scalar is "long" in that <length> is larger than LG_SCALAR so it
  * was not stored on a single byte.
  */
-static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	I32 len;
 	SV *sv;
@@ -4656,6 +4805,11 @@ static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, char *cname)
 	sv = NEWSV(10002, len);
 	SEEN(sv, cname, 0);	/* Associate this new scalar with tag "tagnum" */
 
+	if (len ==  0) {
+	    sv_setpvn(sv, "", 0);
+	    return sv;
+	}
+
 	/*
 	 * WARNING: duplicates parts of sv_setpv and breaks SV data encapsulation.
 	 *
@@ -4687,7 +4841,7 @@ static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, char *cname)
  * The scalar is "short" so <length> is single byte. If it is 0, there
  * is no <data> section.
  */
-static SV *retrieve_scalar(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_scalar(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	int len;
 	SV *sv;
@@ -4746,7 +4900,7 @@ static SV *retrieve_scalar(pTHX_ stcxt_t *cxt, char *cname)
  * Like retrieve_scalar(), but tag result as utf8.
  * If we're retrieving UTF8 data in a non-UTF8 perl, croaks.
  */
-static SV *retrieve_utf8str(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_utf8str(pTHX_ stcxt_t *cxt, const char *cname)
 {
     SV *sv;
 
@@ -4775,7 +4929,7 @@ static SV *retrieve_utf8str(pTHX_ stcxt_t *cxt, char *cname)
  * Like retrieve_lscalar(), but tag result as utf8.
  * If we're retrieving UTF8 data in a non-UTF8 perl, croaks.
  */
-static SV *retrieve_lutf8str(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_lutf8str(pTHX_ stcxt_t *cxt, const char *cname)
 {
     SV *sv;
 
@@ -4803,7 +4957,7 @@ static SV *retrieve_lutf8str(pTHX_ stcxt_t *cxt, char *cname)
  * Retrieve defined integer.
  * Layout is SX_INTEGER <data>, whith SX_INTEGER already read.
  */
-static SV *retrieve_integer(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_integer(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV *sv;
 	IV iv;
@@ -4826,7 +4980,7 @@ static SV *retrieve_integer(pTHX_ stcxt_t *cxt, char *cname)
  * Retrieve defined integer in network order.
  * Layout is SX_NETINT <data>, whith SX_NETINT already read.
  */
-static SV *retrieve_netint(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_netint(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV *sv;
 	I32 iv;
@@ -4854,7 +5008,7 @@ static SV *retrieve_netint(pTHX_ stcxt_t *cxt, char *cname)
  * Retrieve defined double.
  * Layout is SX_DOUBLE <data>, whith SX_DOUBLE already read.
  */
-static SV *retrieve_double(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_double(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV *sv;
 	NV nv;
@@ -4877,7 +5031,7 @@ static SV *retrieve_double(pTHX_ stcxt_t *cxt, char *cname)
  * Retrieve defined byte (small integer within the [-128, +127] range).
  * Layout is SX_BYTE <data>, whith SX_BYTE already read.
  */
-static SV *retrieve_byte(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_byte(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV *sv;
 	int siv;
@@ -4902,7 +5056,7 @@ static SV *retrieve_byte(pTHX_ stcxt_t *cxt, char *cname)
  *
  * Return the undefined value.
  */
-static SV *retrieve_undef(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_undef(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV* sv;
 
@@ -4919,7 +5073,7 @@ static SV *retrieve_undef(pTHX_ stcxt_t *cxt, char *cname)
  *
  * Return the immortal undefined value.
  */
-static SV *retrieve_sv_undef(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_sv_undef(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV *sv = &PL_sv_undef;
 
@@ -4940,7 +5094,7 @@ static SV *retrieve_sv_undef(pTHX_ stcxt_t *cxt, char *cname)
  *
  * Return the immortal yes value.
  */
-static SV *retrieve_sv_yes(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_sv_yes(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV *sv = &PL_sv_yes;
 
@@ -4955,7 +5109,7 @@ static SV *retrieve_sv_yes(pTHX_ stcxt_t *cxt, char *cname)
  *
  * Return the immortal no value.
  */
-static SV *retrieve_sv_no(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_sv_no(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	SV *sv = &PL_sv_no;
 
@@ -4974,7 +5128,7 @@ static SV *retrieve_sv_no(pTHX_ stcxt_t *cxt, char *cname)
  *
  * When we come here, SX_ARRAY has been read already.
  */
-static SV *retrieve_array(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_array(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	I32 len;
 	I32 i;
@@ -5025,7 +5179,7 @@ static SV *retrieve_array(pTHX_ stcxt_t *cxt, char *cname)
  *
  * When we come here, SX_HASH has been read already.
  */
-static SV *retrieve_hash(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	I32 len;
 	I32 size;
@@ -5099,7 +5253,7 @@ static SV *retrieve_hash(pTHX_ stcxt_t *cxt, char *cname)
  *
  * When we come here, SX_HASH has been read already.
  */
-static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const char *cname)
 {
     dVAR;
     I32 len;
@@ -5236,7 +5390,7 @@ static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, char *cname)
  *
  * Return a code reference.
  */
-static SV *retrieve_code(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
 {
 #if PERL_VERSION < 6
     CROAK(("retrieve_code does not work with perl 5.005 or less\n"));
@@ -5312,7 +5466,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, char *cname)
 
 	if (SvROK(cxt->eval) && SvTYPE(SvRV(cxt->eval)) == SVt_PVCV) {
 		SV* errsv = get_sv("@", TRUE);
-		sv_setpv(errsv, "");					/* clear $@ */
+		sv_setpvn(errsv, "", 0);	/* clear $@ */
 		PUSHMARK(sp);
 		XPUSHs(sv_2mortal(newSVsv(sub)));
 		PUTBACK;
@@ -5357,7 +5511,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, char *cname)
  *
  * When we come here, SX_ARRAY has been read already.
  */
-static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, char *cname)
+static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	I32 len;
 	I32 i;
@@ -5417,7 +5571,7 @@ static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, char *cname)
  *
  * When we come here, SX_HASH has been read already.
  */
-static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, char *cname)
+static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	I32 len;
 	I32 size;
@@ -5530,6 +5684,7 @@ static SV *magic_check(pTHX_ stcxt_t *cxt)
     int length;
     int use_network_order;
     int use_NV_size;
+    int old_magic = 0;
     int version_major;
     int version_minor = 0;
 
@@ -5563,6 +5718,7 @@ static SV *magic_check(pTHX_ stcxt_t *cxt)
             
             if (memNE(buf, old_magicstr, old_len))
                 CROAK(("File is not a perl storable"));
+	    old_magic++;
             current = buf + old_len;
         }
         use_network_order = *current;
@@ -5574,9 +5730,14 @@ static SV *magic_check(pTHX_ stcxt_t *cxt)
      * indicate the version number of the binary, and therefore governs the
      * setting of sv_retrieve_vtbl. See magic_write().
      */
-
-    version_major = use_network_order >> 1;
-    cxt->retrieve_vtbl = (SV*(**)(pTHX_ stcxt_t *cxt, char *cname)) (version_major ? sv_retrieve : sv_old_retrieve);
+    if (old_magic && use_network_order > 1) {
+	/*  0.1 dump - use_network_order is really byte order length */
+	version_major = -1;
+    }
+    else {
+        version_major = use_network_order >> 1;
+    }
+    cxt->retrieve_vtbl = (SV*(**)(pTHX_ stcxt_t *cxt, const char *cname)) (version_major > 0 ? sv_retrieve : sv_old_retrieve);
 
     TRACEME(("magic_check: netorder = 0x%x", use_network_order));
 
@@ -5639,7 +5800,12 @@ static SV *magic_check(pTHX_ stcxt_t *cxt)
     /* In C truth is 1, falsehood is 0. Very convienient.  */
     use_NV_size = version_major >= 2 && version_minor >= 2;
 
-    GETMARK(c);
+    if (version_major >= 0) {
+        GETMARK(c);
+    }
+    else {
+	c = use_network_order;
+    }
     length = c + 3 + use_NV_size;
     READ(buf, length);	/* Not null-terminated */
 
@@ -5689,7 +5855,7 @@ static SV *magic_check(pTHX_ stcxt_t *cxt)
  * root SV (which may be an AV or an HV for what we care).
  * Returns null if there is a problem.
  */
-static SV *retrieve(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve(pTHX_ stcxt_t *cxt, const char *cname)
 {
 	int type;
 	SV **svh;
@@ -6081,7 +6247,7 @@ static SV *do_retrieve(
  *
  * Retrieve data held in file and return the root object, undef on error.
  */
-SV *pretrieve(pTHX_ PerlIO *f)
+static SV *pretrieve(pTHX_ PerlIO *f)
 {
 	TRACEME(("pretrieve"));
 	return do_retrieve(aTHX_ f, Nullsv, 0);
@@ -6092,7 +6258,7 @@ SV *pretrieve(pTHX_ PerlIO *f)
  *
  * Retrieve data held in scalar and return the root object, undef on error.
  */
-SV *mretrieve(pTHX_ SV *sv)
+static SV *mretrieve(pTHX_ SV *sv)
 {
 	TRACEME(("mretrieve"));
 	return do_retrieve(aTHX_ (PerlIO*) 0, sv, 0);
@@ -6111,7 +6277,7 @@ SV *mretrieve(pTHX_ SV *sv)
  * there. Not that efficient, but it should be faster than doing it from
  * pure perl anyway.
  */
-SV *dclone(pTHX_ SV *sv)
+static SV *dclone(pTHX_ SV *sv)
 {
 	dSTCXT;
 	int size;
@@ -6129,6 +6295,18 @@ SV *dclone(pTHX_ SV *sv)
 		clean_context(aTHX_ cxt);
 
 	/*
+	 * Tied elements seem to need special handling.
+	 */
+
+	if ((SvTYPE(sv) == SVt_PVLV
+#if PERL_VERSION < 8
+	     || SvTYPE(sv) == SVt_PVMG
+#endif
+	     ) && SvRMAGICAL(sv) && mg_find(sv, 'p')) {
+		mg_get(sv);
+	}
+
+	/*
 	 * do_store() optimizes for dclone by not freeing its context, should
 	 * we need to allocate one because we're deep cloning from a hook.
 	 */
@@ -6211,6 +6389,12 @@ MODULE = Storable	PACKAGE = Storable
 PROTOTYPES: ENABLE
 
 BOOT:
+{
+    HV *stash = gv_stashpvn("Storable", 8, GV_ADD);
+    newCONSTSUB(stash, "BIN_MAJOR", newSViv(STORABLE_BIN_MAJOR));
+    newCONSTSUB(stash, "BIN_MINOR", newSViv(STORABLE_BIN_MINOR));
+    newCONSTSUB(stash, "BIN_WRITE_MINOR", newSViv(STORABLE_BIN_WRITE_MINOR));
+
     init_perinterp(aTHX);
     gv_fetchpv("Storable::drop_utf8",   GV_ADDMULTI, SVt_PV);
 #ifdef DEBUGME
@@ -6220,6 +6404,7 @@ BOOT:
 #ifdef USE_56_INTERWORK_KLUDGE
     gv_fetchpv("Storable::interwork_56_64bit",   GV_ADDMULTI, SVt_PV);
 #endif
+}
 
 void
 init_perinterp()