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

diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index c20011e..24de05f 100644
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -18,20 +18,16 @@
 #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
 
-#ifndef NETWARE
 #if 0
 #define DEBUGME /* Debug mode, turns assertions on as well */
 #define DASSERT /* Assertion mode */
 #endif
-#else	/* NETWARE */
-#if 0	/* On NetWare USE_PERLIO is not used */
-#define DEBUGME /* Debug mode, turns assertions on as well */
-#define DASSERT /* Assertion mode */
-#endif
-#endif
 
 /*
  * Pre PerlIO time when none of USE_PERLIO and PERLIO_IS_STDIO is defined
@@ -93,6 +89,56 @@ typedef double NV;			/* Older perls lack the NV type */
 #endif
 #endif
 
+#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
+#  endif
+#endif
+
+#ifndef dNOOP
+#define dNOOP extern int Perl___notused PERL_UNUSED_DECL
+#endif
+
+#ifndef dVAR
+#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
@@ -283,16 +329,30 @@ 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
  * perl to remap such common words.	-- RAM, 29/09/00
  */
 
+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 */
@@ -322,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)();	/* 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;
@@ -331,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;								\
@@ -599,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)				\
@@ -929,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,
@@ -969,10 +1050,10 @@ 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(ref) = 0;							\
+	SvRV_set(ref, NULL);						\
 	SvREFCNT_dec(ref);						\
   } STMT_END
 /*
@@ -1007,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.
@@ -1023,15 +1104,17 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv);
 static int store_other(pTHX_ stcxt_t *cxt, SV *sv);
 static int store_blessed(pTHX_ stcxt_t *cxt, SV *sv, int type, HV *pkg);
 
-static int (*sv_store[])(pTHX_ stcxt_t *cxt, SV *sv) = {
-	store_ref,										/* svis_REF */
-	store_scalar,									/* svis_SCALAR */
-	(int (*)(pTHX_ stcxt_t *cxt, SV *sv)) store_array,	/* svis_ARRAY */
-	(int (*)(pTHX_ stcxt_t *cxt, SV *sv)) store_hash,		/* svis_HASH */
-	store_tied,										/* svis_TIED */
-	store_tied_item,								/* svis_TIED_ITEM */
-	(int (*)(pTHX_ stcxt_t *cxt, SV *sv)) store_code,		/* svis_CODE */
-	store_other,									/* svis_OTHER */
+typedef int (*sv_store_t)(pTHX_ stcxt_t *cxt, SV *sv);
+
+static const sv_store_t sv_store[] = {
+	(sv_store_t)store_ref,		/* svis_REF */
+	(sv_store_t)store_scalar,	/* svis_SCALAR */
+	(sv_store_t)store_array,	/* svis_ARRAY */
+	(sv_store_t)store_hash,		/* svis_HASH */
+	(sv_store_t)store_tied,		/* svis_TIED */
+	(sv_store_t)store_tied_item,	/* svis_TIED_ITEM */
+	(sv_store_t)store_code,		/* svis_CODE */
+	(sv_store_t)store_other,	/* svis_OTHER */
 };
 
 #define SV_STORE(x)	(*sv_store[x])
@@ -1040,103 +1123,105 @@ static int (*sv_store[])(pTHX_ stcxt_t *cxt, SV *sv) = {
  * 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);
-
-static SV *(*sv_old_retrieve[])(pTHX_ stcxt_t *cxt, char *cname) = {
+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 */
-	retrieve_lscalar,		/* SX_LSCALAR */
-	old_retrieve_array,		/* SX_ARRAY -- for pre-0.6 binaries */
-	old_retrieve_hash,		/* SX_HASH -- for pre-0.6 binaries */
-	retrieve_ref,			/* SX_REF */
-	retrieve_undef,			/* SX_UNDEF */
-	retrieve_integer,		/* SX_INTEGER */
-	retrieve_double,		/* SX_DOUBLE */
-	retrieve_byte,			/* SX_BYTE */
-	retrieve_netint,		/* SX_NETINT */
-	retrieve_scalar,		/* SX_SCALAR */
-	retrieve_tied_array,	/* SX_ARRAY */
-	retrieve_tied_hash,		/* SX_HASH */
-	retrieve_tied_scalar,	/* SX_SCALAR */
-	retrieve_other,			/* SX_SV_UNDEF not supported */
-	retrieve_other,			/* SX_SV_YES not supported */
-	retrieve_other,			/* SX_SV_NO not supported */
-	retrieve_other,			/* SX_BLESS not supported */
-	retrieve_other,			/* SX_IX_BLESS not supported */
-	retrieve_other,			/* SX_HOOK not supported */
-	retrieve_other,			/* SX_OVERLOADED not supported */
-	retrieve_other,			/* SX_TIED_KEY not supported */
-	retrieve_other,			/* SX_TIED_IDX not supported */
-	retrieve_other,			/* SX_UTF8STR not supported */
-	retrieve_other,			/* SX_LUTF8STR not supported */
-	retrieve_other,			/* SX_FLAG_HASH not supported */
-	retrieve_other,			/* SX_CODE not supported */
-	retrieve_other,			/* SX_WEAKREF not supported */
-	retrieve_other,			/* SX_WEAKOVERLOAD not supported */
-	retrieve_other,			/* SX_ERROR */
+	(sv_retrieve_t)retrieve_lscalar,	/* SX_LSCALAR */
+	(sv_retrieve_t)old_retrieve_array,	/* SX_ARRAY -- for pre-0.6 binaries */
+	(sv_retrieve_t)old_retrieve_hash,	/* SX_HASH -- for pre-0.6 binaries */
+	(sv_retrieve_t)retrieve_ref,		/* SX_REF */
+	(sv_retrieve_t)retrieve_undef,		/* SX_UNDEF */
+	(sv_retrieve_t)retrieve_integer,	/* SX_INTEGER */
+	(sv_retrieve_t)retrieve_double,		/* SX_DOUBLE */
+	(sv_retrieve_t)retrieve_byte,		/* SX_BYTE */
+	(sv_retrieve_t)retrieve_netint,		/* SX_NETINT */
+	(sv_retrieve_t)retrieve_scalar,		/* SX_SCALAR */
+	(sv_retrieve_t)retrieve_tied_array,	/* SX_ARRAY */
+	(sv_retrieve_t)retrieve_tied_hash,	/* SX_HASH */
+	(sv_retrieve_t)retrieve_tied_scalar,	/* SX_SCALAR */
+	(sv_retrieve_t)retrieve_other,	/* SX_SV_UNDEF not supported */
+	(sv_retrieve_t)retrieve_other,	/* SX_SV_YES not supported */
+	(sv_retrieve_t)retrieve_other,	/* SX_SV_NO not supported */
+	(sv_retrieve_t)retrieve_other,	/* SX_BLESS not supported */
+	(sv_retrieve_t)retrieve_other,	/* SX_IX_BLESS not supported */
+	(sv_retrieve_t)retrieve_other,	/* SX_HOOK not supported */
+	(sv_retrieve_t)retrieve_other,	/* SX_OVERLOADED not supported */
+	(sv_retrieve_t)retrieve_other,	/* SX_TIED_KEY not supported */
+	(sv_retrieve_t)retrieve_other,	/* SX_TIED_IDX not supported */
+	(sv_retrieve_t)retrieve_other,	/* SX_UTF8STR not supported */
+	(sv_retrieve_t)retrieve_other,	/* SX_LUTF8STR not supported */
+	(sv_retrieve_t)retrieve_other,	/* SX_FLAG_HASH not supported */
+	(sv_retrieve_t)retrieve_other,	/* SX_CODE not supported */
+	(sv_retrieve_t)retrieve_other,	/* SX_WEAKREF not supported */
+	(sv_retrieve_t)retrieve_other,	/* SX_WEAKOVERLOAD not supported */
+	(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 *(*sv_retrieve[])(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 */
-	retrieve_lscalar,		/* SX_LSCALAR */
-	retrieve_array,			/* SX_ARRAY */
-	retrieve_hash,			/* SX_HASH */
-	retrieve_ref,			/* SX_REF */
-	retrieve_undef,			/* SX_UNDEF */
-	retrieve_integer,		/* SX_INTEGER */
-	retrieve_double,		/* SX_DOUBLE */
-	retrieve_byte,			/* SX_BYTE */
-	retrieve_netint,		/* SX_NETINT */
-	retrieve_scalar,		/* SX_SCALAR */
-	retrieve_tied_array,	/* SX_ARRAY */
-	retrieve_tied_hash,		/* SX_HASH */
-	retrieve_tied_scalar,	/* SX_SCALAR */
-	retrieve_sv_undef,		/* SX_SV_UNDEF */
-	retrieve_sv_yes,		/* SX_SV_YES */
-	retrieve_sv_no,			/* SX_SV_NO */
-	retrieve_blessed,		/* SX_BLESS */
-	retrieve_idx_blessed,	/* SX_IX_BLESS */
-	retrieve_hook,			/* SX_HOOK */
-	retrieve_overloaded,	/* SX_OVERLOAD */
-	retrieve_tied_key,		/* SX_TIED_KEY */
-	retrieve_tied_idx,		/* SX_TIED_IDX */
-	retrieve_utf8str,		/* SX_UTF8STR  */
-	retrieve_lutf8str,		/* SX_LUTF8STR */
-	retrieve_flag_hash,		/* SX_HASH */
-	retrieve_code,			/* SX_CODE */
-	retrieve_weakref,		/* SX_WEAKREF */
-	retrieve_weakoverloaded,	/* SX_WEAKOVERLOAD */
-	retrieve_other,			/* SX_ERROR */
+	(sv_retrieve_t)retrieve_lscalar,	/* SX_LSCALAR */
+	(sv_retrieve_t)retrieve_array,		/* SX_ARRAY */
+	(sv_retrieve_t)retrieve_hash,		/* SX_HASH */
+	(sv_retrieve_t)retrieve_ref,		/* SX_REF */
+	(sv_retrieve_t)retrieve_undef,		/* SX_UNDEF */
+	(sv_retrieve_t)retrieve_integer,	/* SX_INTEGER */
+	(sv_retrieve_t)retrieve_double,		/* SX_DOUBLE */
+	(sv_retrieve_t)retrieve_byte,		/* SX_BYTE */
+	(sv_retrieve_t)retrieve_netint,		/* SX_NETINT */
+	(sv_retrieve_t)retrieve_scalar,		/* SX_SCALAR */
+	(sv_retrieve_t)retrieve_tied_array,	/* SX_ARRAY */
+	(sv_retrieve_t)retrieve_tied_hash,	/* SX_HASH */
+	(sv_retrieve_t)retrieve_tied_scalar,	/* SX_SCALAR */
+	(sv_retrieve_t)retrieve_sv_undef,	/* SX_SV_UNDEF */
+	(sv_retrieve_t)retrieve_sv_yes,		/* SX_SV_YES */
+	(sv_retrieve_t)retrieve_sv_no,		/* SX_SV_NO */
+	(sv_retrieve_t)retrieve_blessed,	/* SX_BLESS */
+	(sv_retrieve_t)retrieve_idx_blessed,	/* SX_IX_BLESS */
+	(sv_retrieve_t)retrieve_hook,		/* SX_HOOK */
+	(sv_retrieve_t)retrieve_overloaded,	/* SX_OVERLOAD */
+	(sv_retrieve_t)retrieve_tied_key,	/* SX_TIED_KEY */
+	(sv_retrieve_t)retrieve_tied_idx,	/* SX_TIED_IDX */
+	(sv_retrieve_t)retrieve_utf8str,	/* SX_UTF8STR  */
+	(sv_retrieve_t)retrieve_lutf8str,	/* SX_LUTF8STR */
+	(sv_retrieve_t)retrieve_flag_hash,	/* SX_HASH */
+	(sv_retrieve_t)retrieve_code,		/* SX_CODE */
+	(sv_retrieve_t)retrieve_weakref,	/* SX_WEAKREF */
+	(sv_retrieve_t)retrieve_weakoverloaded,	/* SX_WEAKOVERLOAD */
+	(sv_retrieve_t)retrieve_other,		/* SX_ERROR */
 };
 
 #define RETRIEVE(c,x) (*(c)->retrieve_vtbl[(x) >= SX_ERROR ? SX_ERROR : (x)])
@@ -1211,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
@@ -1232,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
@@ -1287,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);
@@ -1309,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;
@@ -1368,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
@@ -1526,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;
 
@@ -1538,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;
 
@@ -1553,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;
 
@@ -1576,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
@@ -1589,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));
 	}
 
 	/*
@@ -1600,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;
 }
@@ -1614,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);
 }
 
 /*
@@ -1629,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);
 }
 
 /*
@@ -1646,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
@@ -1661,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;
 		}
 	}
@@ -2160,6 +2271,7 @@ sortcmp(const void *a, const void *b)
  */
 static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
 {
+	dVAR;
 	I32 len = 
 #ifdef HAS_RESTRICTED_HASHES
             HvTOTALKEYS(hv);
@@ -2202,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);
 
 	/*
@@ -2241,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 */
 		}
 			
@@ -2249,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 = HvPLACEHOLDERS(hv);
+			int placeholders = (int)HvPLACEHOLDERS_get(hv);
 #endif
                         unsigned char flags = 0;
 			char *keyval;
@@ -2379,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
@@ -2471,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;
 }
@@ -2514,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;
@@ -2545,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));
 
 	/*
@@ -2760,7 +2877,7 @@ static int store_hook(
 	SV *hook)
 {
 	I32 len;
-	char *class;
+	char *classname;
 	STRLEN len2;
 	SV *ref;
 	AV *av;
@@ -2777,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, class \"%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.
@@ -2828,8 +2945,8 @@ static int store_hook(
 	}
 	flags = SHF_NEED_RECURSE | obj_type;
 
-	class = HvNAME(pkg);
-	len = strlen(class);
+	classname = HvNAME_get(pkg);
+	len = strlen(classname);
 
 	/*
 	 * To call the hook, we need to fake a call like:
@@ -2844,11 +2961,11 @@ static int store_hook(
 	 * make the call on that reference.
 	 */
 
-	TRACEME(("about to call STORABLE_freeze on class %s", class));
+	TRACEME(("about to call STORABLE_freeze on class %s", classname));
 
 	ref = newRV_noinc(sv);				/* Temporary reference */
 	av = array_call(aTHX_ ref, hook, clone);	/* @a = $object->STORABLE_freeze($c) */
-	SvRV(ref) = 0;
+	SvRV_set(ref, NULL);
 	SvREFCNT_dec(ref);					/* Reclaim temporary reference */
 
 	count = AvFILLp(av) + 1;
@@ -2868,14 +2985,14 @@ static int store_hook(
 		 * They must not change their mind in the middle of a serialization.
 		 */
 
-		if (hv_fetch(cxt->hclass, class, len, FALSE))
+		if (hv_fetch(cxt->hclass, classname, len, FALSE))
 			CROAK(("Too late to ignore hooks for %s class \"%s\"",
-				(cxt->optype & ST_CLONE) ? "cloning" : "storing", class));
+				(cxt->optype & ST_CLONE) ? "cloning" : "storing", classname));
 	
 		pkg_hide(aTHX_ cxt->hook, pkg, "STORABLE_freeze");
 
 		ASSERT(!pkg_can(aTHX_ cxt->hook, pkg, "STORABLE_freeze"), ("hook invisible"));
-		TRACEME(("ignoring STORABLE_freeze in class \"%s\"", class));
+		TRACEME(("ignoring STORABLE_freeze in class \"%s\"", classname));
 
 		return store_blessed(aTHX_ cxt, sv, type, pkg);
 	}
@@ -2886,6 +3003,16 @@ static int store_hook(
 
 	ary = AvARRAY(av);
 	pv = SvPV(ary[0], len2);
+	/* We can't use pkg_can here because it only caches one method per
+	 * package */
+	{ 
+	    GV* gv = gv_fetchmethod_autoload(pkg, "STORABLE_attach", FALSE);
+	    if (gv && isGV(gv)) {
+	        if (count > 1)
+	            CROAK(("Freeze cannot return references if %s class is using STORABLE_attach", classname));
+	        goto check_done;
+	    }
+	}
 
 	/*
 	 * If they returned more than one item, we need to serialize some
@@ -2901,23 +3028,37 @@ 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))
 			CROAK(("Item #%d returned by STORABLE_freeze "
-				"for %s is not a reference", i, class));
+				"for %s is not a reference", i, classname));
 		xsv = SvRV(rsv);		/* Follow ref to know what to look for */
 
 		/*
 		 * 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)));
 
@@ -2944,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, class));
-
+			CROAK(("Could not serialize item #%d from hook in %s", i, classname));
+#endif
 		/*
 		 * It was the first time we serialized `xsv'.
 		 *
@@ -2977,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)));
 	}
 
 	/*
@@ -2991,11 +3142,12 @@ static int store_hook(
 	 * proposed the right fix.  -- RAM, 15/09/2000
 	 */
 
-	if (!known_class(aTHX_ cxt, class, len, &classnum)) {
-		TRACEME(("first time we see class %s, ID = %d", class, classnum));
+check_done:
+	if (!known_class(aTHX_ cxt, classname, len, &classnum)) {
+		TRACEME(("first time we see class %s, ID = %d", classname, classnum));
 		classnum = -1;				/* Mark: we must store classname */
 	} else {
-		TRACEME(("already seen class %s, ID = %d", class, classnum));
+		TRACEME(("already seen class %s, ID = %d", classname, classnum));
 	}
 
 	/*
@@ -3051,7 +3203,7 @@ static int store_hook(
 			unsigned char clen = (unsigned char) len;
 			PUTMARK(clen);
 		}
-		WRITE(class, len);		/* Final \0 is omitted */
+		WRITE(classname, len);		/* Final \0 is omitted */
 	}
 
 	/* <len2> <frozen-str> */
@@ -3158,10 +3310,10 @@ static int store_blessed(
 {
 	SV *hook;
 	I32 len;
-	char *class;
+	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()
@@ -3176,11 +3328,11 @@ static int store_blessed(
 	 * This is a blessed SV without any serialization hook.
 	 */
 
-	class = HvNAME(pkg);
-	len = strlen(class);
+	classname = HvNAME_get(pkg);
+	len = strlen(classname);
 
 	TRACEME(("blessed 0x%"UVxf" in %s, no hook: tagged #%d",
-		 PTR2UV(sv), class, cxt->tagnum));
+		 PTR2UV(sv), classname, cxt->tagnum));
 
 	/*
 	 * Determine whether it is the first time we see that class name (in which
@@ -3189,8 +3341,8 @@ static int store_blessed(
 	 * used).
 	 */
 
-	if (known_class(aTHX_ cxt, class, len, &classnum)) {
-		TRACEME(("already seen class %s, ID = %d", class, classnum));
+	if (known_class(aTHX_ cxt, classname, len, &classnum)) {
+		TRACEME(("already seen class %s, ID = %d", classname, classnum));
 		PUTMARK(SX_IX_BLESS);
 		if (classnum <= LG_BLESS) {
 			unsigned char cnum = (unsigned char) classnum;
@@ -3201,7 +3353,7 @@ static int store_blessed(
 			WLEN(classnum);
 		}
 	} else {
-		TRACEME(("first time we see class %s, ID = %d", class, classnum));
+		TRACEME(("first time we see class %s, ID = %d", classname, classnum));
 		PUTMARK(SX_BLESS);
 		if (len <= LG_BLESS) {
 			unsigned char clen = (unsigned char) len;
@@ -3211,7 +3363,7 @@ static int store_blessed(
 			PUTMARK(flag);
 			WLEN(len);					/* Don't BER-encode, this should be rare */
 		}
-		WRITE(class, len);				/* Final \0 is omitted */
+		WRITE(classname, len);				/* Final \0 is omitted */
 	}
 
 	/*
@@ -3234,7 +3386,7 @@ static int store_blessed(
 static int store_other(pTHX_ stcxt_t *cxt, SV *sv)
 {
 	I32 len;
-	static char buf[80];
+	char buf[80];
 
 	TRACEME(("store_other"));
 
@@ -3282,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
@@ -3290,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:
 		/*
@@ -3308,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;
@@ -3322,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;
 	}
@@ -3343,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)));
 
@@ -3359,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;
 
@@ -3393,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)));
 
@@ -3414,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.
@@ -3620,7 +3799,7 @@ static int do_store(
 	 * Recursively store object...
 	 */
 
-	ASSERT(is_storing(), ("within store operation"));
+	ASSERT(is_storing(aTHX), ("within store operation"));
 
 	status = store(aTHX_ cxt, sv);		/* Just do it! */
 
@@ -3667,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);
@@ -3680,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);
@@ -3708,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;
 
@@ -3726,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;
 
@@ -3748,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 &&
@@ -3773,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 *class;
+	const char *classname;
 	SV **sva;
 	SV *sv;
 
@@ -3795,15 +3974,15 @@ static SV *retrieve_idx_blessed(pTHX_ stcxt_t *cxt, char *cname)
 	if (!sva)
 		CROAK(("Class name #%"IVdf" should have been seen already", (IV) idx));
 
-	class = SvPVX(*sva);	/* We know it's a PV, by construction */
+	classname = SvPVX(*sva);	/* We know it's a PV, by construction */
 
-	TRACEME(("class ID %d => %s", idx, class));
+	TRACEME(("class ID %d => %s", idx, classname));
 
 	/*
 	 * Retrieve object and bless it.
 	 */
 
-	sv = retrieve(aTHX_ cxt, class);	/* First SV which is SEEN will be blessed */
+	sv = retrieve(aTHX_ cxt, classname);	/* First SV which is SEEN will be blessed */
 
 	return sv;
 }
@@ -3814,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 *class = buf;
+	char *classname = buf;
+	char *malloced_classname = NULL;
 
 	TRACEME(("retrieve_blessed (#%d)", cxt->tagnum));
 	ASSERT(!cname, ("no bless-into class given here, got %s", cname));
@@ -3835,27 +4015,30 @@ static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, char *cname)
 	if (len & 0x80) {
 		RLEN(len);
 		TRACEME(("** allocating %d bytes for class name", len+1));
-		New(10003, class, len+1, char);
+		New(10003, classname, len+1, char);
+		malloced_classname = classname;
 	}
-	READ(class, len);
-	class[len] = '\0';		/* Mark string end */
+	SAFEPVREAD(classname, len, malloced_classname);
+	classname[len] = '\0';		/* Mark string end */
 
 	/*
 	 * It's a new classname, otherwise it would have been an SX_IX_BLESS.
 	 */
 
-	TRACEME(("new class name \"%s\" will bear ID = %d", class, cxt->classnum));
+	TRACEME(("new class name \"%s\" will bear ID = %d", classname, cxt->classnum));
 
-	if (!av_store(cxt->aclass, cxt->classnum++, newSVpvn(class, 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, class);	/* First SV which is SEEN will be blessed */
-	if (class != buf)
-		Safefree(class);
+	sv = retrieve(aTHX_ cxt, classname);	/* First SV which is SEEN will be blessed */
+	if (malloced_classname)
+		Safefree(malloced_classname);
 
 	return sv;
 }
@@ -3880,11 +4063,11 @@ 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 */
-	char *class = buf;
+	char *classname = buf;
 	unsigned int flags;
 	I32 len2;
 	SV *frozen;
@@ -3893,6 +4076,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, char *cname)
 	SV *hook;
 	SV *sv;
 	SV *rv;
+	GV *attach;
 	int obj_type;
 	int clone = cxt->optype & ST_CLONE;
 	char mtype = '\0';
@@ -3995,8 +4179,8 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, char *cname)
 			CROAK(("Class name #%"IVdf" should have been seen already",
 				(IV) idx));
 
-		class = SvPVX(*sva);	/* We know it's a PV, by construction */
-		TRACEME(("class ID %d => %s", idx, class));
+		classname = SvPVX(*sva);	/* We know it's a PV, by construction */
+		TRACEME(("class ID %d => %s", idx, classname));
 
 	} else {
 		/*
@@ -4006,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);
@@ -4014,21 +4199,24 @@ 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, class, len+1, char);
+			New(10003, classname, len+1, char);
+			malloced_classname = classname;
 		}
 
-		READ(class, len);
-		class[len] = '\0';		/* Mark string end */
+		SAFEPVREAD(classname, len, malloced_classname);
+		classname[len] = '\0';		/* Mark string end */
 
 		/*
 		 * Record new classname.
 		 */
 
-		if (!av_store(cxt->aclass, cxt->classnum++, newSVpvn(class, len)))
+		if (!av_store(cxt->aclass, cxt->classnum++, newSVpvn(classname, len))) {
+			Safefree(malloced_classname);
 			return (SV *) 0;
+		}
 	}
 
-	TRACEME(("class name: %s", class));
+	TRACEME(("class name: %s", classname));
 
 	/*
 	 * Decode user-frozen string length and read it in an SV.
@@ -4113,26 +4301,44 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, char *cname)
 	 * Bless the object and look up the STORABLE_thaw hook.
 	 */
 
-	BLESS(sv, class);
+	BLESS(sv, classname);
+
+	/* Handle attach case; again can't use pkg_can because it only
+	 * caches one method */
+	attach = gv_fetchmethod_autoload(SvSTASH(sv), "STORABLE_attach", FALSE);
+	if (attach && isGV(attach)) {
+	    SV* attached;
+	    SV* attach_hook = newRV((SV*) GvCV(attach));
+
+	    if (av)
+	        CROAK(("STORABLE_attach called with unexpected references"));
+	    av = newAV();
+	    av_extend(av, 1);
+	    AvFILLp(av) = 0;
+	    AvARRAY(av)[0] = SvREFCNT_inc(frozen);
+	    rv = newSVpv(classname, 0);
+	    attached = scalar_call(aTHX_ rv, attach_hook, clone, av, G_SCALAR);
+	    if (attached &&
+	        SvROK(attached) && 
+	        sv_derived_from(attached, classname))
+	        return SvRV(attached);
+	    CROAK(("STORABLE_attach did not return a %s object", classname));
+	}
+
 	hook = pkg_can(aTHX_ cxt->hook, SvSTASH(sv), "STORABLE_thaw");
 	if (!hook) {
 		/*
 		 * 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, class);
-
-		TRACEME(("No STORABLE_thaw defined for objects of class %s", class));
-		TRACEME(("Going to require module '%s' with '%s'", class, SvPVX(psv)));
-
-		perl_eval_sv(psv, G_DISCARD);
-		sv_free(psv);
+		TRACEME(("No STORABLE_thaw defined for objects of class %s", classname));
+		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
@@ -4144,7 +4350,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, char *cname)
 
 		if (!hook)
 			CROAK(("No STORABLE_thaw defined for objects of class %s "
-					"(even after a \"require %s;\")", class, class));
+					"(even after a \"require %s;\")", classname, classname));
 	}
 
 	/*
@@ -4175,7 +4381,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, char *cname)
 	 */
 
 	TRACEME(("calling STORABLE_thaw on %s at 0x%"UVxf" (%"IVdf" args)",
-		 class, PTR2UV(sv), (IV) AvFILLp(av) + 1));
+		 classname, PTR2UV(sv), (IV) AvFILLp(av) + 1));
 
 	rv = newRV(sv);
 	(void) scalar_call(aTHX_ rv, hook, clone, av, G_SCALAR|G_DISCARD);
@@ -4188,8 +4394,8 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, char *cname)
 	SvREFCNT_dec(frozen);
 	av_undef(av);
 	sv_free((SV *) av);
-	if (!(flags & SHF_IDX_CLASSNAME) && class != buf)
-		Safefree(class);
+	if (!(flags & SHF_IDX_CLASSNAME) && classname != buf)
+		Safefree(classname);
 
 	/*
 	 * If we had an <extra> type, then the object was not as simple, and
@@ -4244,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;
@@ -4256,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;
@@ -4297,12 +4503,12 @@ 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);
 	}
 
-	SvRV(rv) = sv;				/* $rv = \$sv */
+	SvRV_set(rv, sv);				/* $rv = \$sv */
 	SvROK_on(rv);
 
 	TRACEME(("ok (retrieve_ref at 0x%"UVxf")", PTR2UV(rv)));
@@ -4316,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;
 
@@ -4339,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;
@@ -4361,8 +4567,8 @@ static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, char *cname)
 	 * WARNING: breaks RV encapsulation.
 	 */
 
-	sv_upgrade(rv, SVt_RV);
-	SvRV(rv) = sv;				/* $rv = \$sv */
+	SvUPGRADE(rv, SVt_RV);
+	SvRV_set(rv, sv);				/* $rv = \$sv */
 	SvROK_on(rv);
 
 	/*
@@ -4377,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;\")",
@@ -4408,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;
 
@@ -4431,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;
@@ -4446,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)));
@@ -4460,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;
@@ -4474,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)));
@@ -4488,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;
@@ -4506,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() */
@@ -4524,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;
@@ -4556,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;
@@ -4573,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;
@@ -4589,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;
@@ -4604,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.
 	 *
@@ -4635,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;
@@ -4694,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;
 
@@ -4723,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;
 
@@ -4751,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;
@@ -4774,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;
@@ -4802,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;
@@ -4825,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;
@@ -4850,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;
 
@@ -4867,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;
 
@@ -4888,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;
 
@@ -4903,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;
 
@@ -4922,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;
@@ -4973,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;
@@ -5047,8 +5253,9 @@ 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;
     I32 size;
     I32 i;
@@ -5183,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"));
@@ -5259,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;
@@ -5304,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;
@@ -5364,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;
@@ -5372,7 +5579,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, char *cname)
 	HV *hv;
 	SV *sv = (SV *) 0;
 	int c;
-	static SV *sv_h_undef = (SV *) 0;		/* hv_store() bug */
+	SV *sv_h_undef = (SV *) 0;		/* hv_store() bug */
 
 	TRACEME(("old_retrieve_hash (#%d)", cxt->tagnum));
 
@@ -5477,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;
 
@@ -5510,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;
@@ -5521,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 = 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));
 
@@ -5586,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 */
 
@@ -5636,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;
@@ -5884,9 +6103,9 @@ static SV *do_retrieve(
 				   bytes_from_utf8 returned us.  */
 				SvUPGRADE(in, SVt_PV);
 				SvPOK_on(in);
-				SvPVX(in) = asbytes;
-				SvLEN(in) = klen_tmp;
-				SvCUR(in) = klen_tmp - 1;
+				SvPV_set(in, asbytes);
+				SvLEN_set(in, klen_tmp);
+				SvCUR_set(in, klen_tmp - 1);
 			}
 		}
 #endif
@@ -5924,7 +6143,7 @@ static SV *do_retrieve(
 	TRACEME(("input source is %s", is_tainted ? "tainted" : "trusted"));
 	init_retrieve_context(aTHX_ cxt, optype, is_tainted);
 
-	ASSERT(is_retrieving(), ("within retrieve operation"));
+	ASSERT(is_retrieving(aTHX), ("within retrieve operation"));
 
 	sv = retrieve(aTHX_ cxt, 0);		/* Recursively retrieve object, get root SV */
 
@@ -6028,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);
@@ -6039,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);
@@ -6058,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;
@@ -6076,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.
 	 */
@@ -6158,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
@@ -6167,6 +6404,7 @@ BOOT:
 #ifdef USE_56_INTERWORK_KLUDGE
     gv_fetchpv("Storable::interwork_56_64bit",   GV_ADDMULTI, SVt_PV);
 #endif
+}
 
 void
 init_perinterp()