This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Storable.xs: Add comments to store_scalar concerning utf8
[perl5.git] / dist / Storable / Storable.xs
diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
index 2853657..65428ad 100644 (file)
--- a/dist/Storable/Storable.xs
+++ b/dist/Storable/Storable.xs
@@ -17,11 +17,12 @@
 #include <patchlevel.h>                /* Perl's one, needed since 5.6 */
 #endif
 
 #include <patchlevel.h>                /* Perl's one, needed since 5.6 */
 #endif
 
-#if !defined(PERL_VERSION) || PERL_VERSION < 8 || (PERL_VERSION == 8 && PERL_SUBVERSION < 9) || (PERL_VERSION == 10 && PERL_SUBVERSION < 1)
+#if !defined(PERL_VERSION) || PERL_VERSION < 10 || (PERL_VERSION == 10 && PERL_SUBVERSION < 1)
 #define NEED_load_module
 #define NEED_vload_module
 #define NEED_newCONSTSUB
 #define NEED_newSVpvn_flags
 #define NEED_load_module
 #define NEED_vload_module
 #define NEED_newCONSTSUB
 #define NEED_newSVpvn_flags
+#define NEED_newRV_noinc
 #include "ppport.h"             /* handle old perls */
 #endif
 
 #include "ppport.h"             /* handle old perls */
 #endif
 
@@ -49,73 +50,13 @@
  * Earlier versions of perl might be used, we can't assume they have the latest!
  */
 
  * Earlier versions of perl might be used, we can't assume they have the latest!
  */
 
-#ifndef PERL_VERSION           /* For perls < 5.6 */
-#define PERL_VERSION PATCHLEVEL
-#ifndef newRV_noinc
-#define newRV_noinc(sv)                ((Sv = newRV(sv)), --SvREFCNT(SvRV(Sv)), Sv)
-#endif
-#if (PATCHLEVEL <= 4)          /* Older perls (<= 5.004) lack PL_ namespace */
-#define PL_sv_yes      sv_yes
-#define PL_sv_no       sv_no
-#define PL_sv_undef    sv_undef
-#if (SUBVERSION <= 4)          /* 5.004_04 has been reported to lack newSVpvn */
-#define newSVpvn newSVpv
-#endif
-#endif                                         /* PATCHLEVEL <= 4 */
 #ifndef HvSHAREKEYS_off
 #define HvSHAREKEYS_off(hv)    /* Ignore */
 #endif
 #ifndef HvSHAREKEYS_off
 #define HvSHAREKEYS_off(hv)    /* Ignore */
 #endif
-#ifndef AvFILLp                                /* Older perls (<=5.003) lack AvFILLp */
-#define AvFILLp AvFILL
-#endif
-typedef double NV;                     /* Older perls lack the NV type */
-#define        IVdf            "ld"    /* Various printf formats for Perl types */
-#define        UVuf            "lu"
-#define        UVof            "lo"
-#define        UVxf            "lx"
-#define INT2PTR(t,v) (t)(IV)(v)
-#define PTR2UV(v)    (unsigned long)(v)
-#endif                                         /* PERL_VERSION -- perls < 5.6 */
-
-#ifndef NVef                           /* The following were not part of perl 5.6 */
-#if defined(USE_LONG_DOUBLE) && \
-       defined(HAS_LONG_DOUBLE) && defined(PERL_PRIfldbl)
-#define NVef           PERL_PRIeldbl
-#define NVff           PERL_PRIfldbl
-#define NVgf           PERL_PRIgldbl
-#else
-#define        NVef            "e"
-#define        NVff            "f"
-#define        NVgf            "g"
-#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
+/* perl <= 5.8.2 needs this */
+#ifndef SvIsCOW
+# define SvIsCOW(sv) 0
 #endif
 
 #ifndef HvRITER_set
 #endif
 
 #ifndef HvRITER_set
@@ -132,14 +73,14 @@ typedef double NV;                 /* Older perls lack the NV type */
 #  define HvEITER_get HvEITER
 #endif
 
 #  define HvEITER_get HvEITER
 #endif
 
-#ifndef HvNAME_get
-#define HvNAME_get HvNAME
-#endif
-
 #ifndef HvPLACEHOLDERS_get
 #  define HvPLACEHOLDERS_get HvPLACEHOLDERS
 #endif
 
 #ifndef HvPLACEHOLDERS_get
 #  define HvPLACEHOLDERS_get HvPLACEHOLDERS
 #endif
 
+#ifndef HvTOTALKEYS
+#  define HvTOTALKEYS(hv)      HvKEYS(hv)
+#endif
+
 #ifdef DEBUGME
 
 #ifndef DASSERT
 #ifdef DEBUGME
 
 #ifndef DASSERT
@@ -180,7 +121,7 @@ typedef double NV;                  /* Older perls lack the NV type */
 
 #define SX_OBJECT      C(0)    /* Already stored object */
 #define SX_LSCALAR     C(1)    /* Scalar (large binary) follows (length, data) */
 
 #define SX_OBJECT      C(0)    /* Already stored object */
 #define SX_LSCALAR     C(1)    /* Scalar (large binary) follows (length, data) */
-#define SX_ARRAY       C(2)    /* Array forthcominng (size, item list) */
+#define SX_ARRAY       C(2)    /* Array forthcoming (size, item list) */
 #define SX_HASH                C(3)    /* Hash forthcoming (size, key/value pair list) */
 #define SX_REF         C(4)    /* Reference to object forthcoming */
 #define SX_UNDEF       C(5)    /* Undefined scalar */
 #define SX_HASH                C(3)    /* Hash forthcoming (size, key/value pair list) */
 #define SX_REF         C(4)    /* Reference to object forthcoming */
 #define SX_UNDEF       C(5)    /* Undefined scalar */
@@ -249,12 +190,12 @@ typedef double NV;                        /* Older perls lack the NV type */
  * keys are not enough a motivation to reclaim that space).
  *
  * This structure is also used for memory store/retrieve operations which
  * keys are not enough a motivation to reclaim that space).
  *
  * This structure is also used for memory store/retrieve operations which
- * happen in a fixed place before being malloc'ed elsewhere if persistency
+ * happen in a fixed place before being malloc'ed elsewhere if persistence
  * is required. Hence the aptr pointer.
  */
 struct extendable {
        char *arena;            /* Will hold hash key strings, resized as needed */
  * is required. Hence the aptr pointer.
  */
 struct extendable {
        char *arena;            /* Will hold hash key strings, resized as needed */
-       STRLEN asiz;            /* Size of aforementionned buffer */
+       STRLEN asiz;            /* Size of aforementioned buffer */
        char *aptr;                     /* Arena pointer, for in-place read/write ops */
        char *aend;                     /* First invalid address */
 };
        char *aptr;                     /* Arena pointer, for in-place read/write ops */
        char *aend;                     /* First invalid address */
 };
@@ -267,7 +208,7 @@ struct extendable {
  *
  * At retrieve time:
  * An array table records the objects which have already been retrieved,
  *
  * At retrieve time:
  * An array table records the objects which have already been retrieved,
- * as seen by the tag determind by counting the objects themselves. The
+ * as seen by the tag determined by counting the objects themselves. The
  * reference to that retrieved object is kept in the table, and is returned
  * when an SX_OBJECT is found bearing that same tag.
  *
  * reference to that retrieved object is kept in the table, and is returned
  * when an SX_OBJECT is found bearing that same tag.
  *
@@ -369,7 +310,7 @@ typedef struct stcxt {
        SV *eval;           /* whether to eval source code */
        int canonical;          /* whether to store hashes sorted by key */
 #ifndef HAS_RESTRICTED_HASHES
        SV *eval;           /* whether to eval source code */
        int canonical;          /* whether to store hashes sorted by key */
 #ifndef HAS_RESTRICTED_HASHES
-        int derestrict;         /* whether to downgrade restrcted hashes */
+        int derestrict;         /* whether to downgrade restricted hashes */
 #endif
 #ifndef HAS_UTF8_ALL
         int use_bytes;         /* whether to bytes-ify utf8 */
 #endif
 #ifndef HAS_UTF8_ALL
         int use_bytes;         /* whether to bytes-ify utf8 */
@@ -386,6 +327,7 @@ typedef struct stcxt {
        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 */
        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 */
+       int in_retrieve_overloaded; /* performance hack for retrieving overloaded objects */
 } stcxt_t;
 
 #define NEW_STORABLE_CXT_OBJ(cxt)                                      \
 } stcxt_t;
 
 #define NEW_STORABLE_CXT_OBJ(cxt)                                      \
@@ -790,12 +732,12 @@ static const char magicstr[] = "pst0";             /* Used as a magic number */
 /* 5.6.x introduced the ability to have IVs as long long.
    However, Configure still defined BYTEORDER based on the size of a long.
    Storable uses the BYTEORDER value as part of the header, but doesn't
 /* 5.6.x introduced the ability to have IVs as long long.
    However, Configure still defined BYTEORDER based on the size of a long.
    Storable uses the BYTEORDER value as part of the header, but doesn't
-   explicity store sizeof(IV) anywhere in the header.  Hence on 5.6.x built
+   explicitly store sizeof(IV) anywhere in the header.  Hence on 5.6.x built
    with IV as long long on a platform that uses Configure (ie most things
    except VMS and Windows) headers are identical for the different IV sizes,
    despite the files containing some fields based on sizeof(IV)
    Erk. Broken-ness.
    with IV as long long on a platform that uses Configure (ie most things
    except VMS and Windows) headers are identical for the different IV sizes,
    despite the files containing some fields based on sizeof(IV)
    Erk. Broken-ness.
-   5.8 is consistent - the following redifinition kludge is only needed on
+   5.8 is consistent - the following redefinition kludge is only needed on
    5.6.x, but the interwork is needed on 5.8 while data survives in files
    with the 5.6 header.
 
    5.6.x, but the interwork is needed on 5.8 while data survives in files
    with the 5.6 header.
 
@@ -846,7 +788,7 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
 #endif
 
 #define STORABLE_BIN_MAJOR     2               /* Binary major "version" */
 #endif
 
 #define STORABLE_BIN_MAJOR     2               /* Binary major "version" */
-#define STORABLE_BIN_MINOR     7               /* Binary minor "version" */
+#define STORABLE_BIN_MINOR     8               /* Binary minor "version" */
 
 #if (PATCHLEVEL <= 5)
 #define STORABLE_BIN_WRITE_MINOR       4
 
 #if (PATCHLEVEL <= 5)
 #define STORABLE_BIN_WRITE_MINOR       4
@@ -854,7 +796,7 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
 /*
  * Perl 5.6.0 onwards can do weak references.
 */
 /*
  * Perl 5.6.0 onwards can do weak references.
 */
-#define STORABLE_BIN_WRITE_MINOR       7
+#define STORABLE_BIN_WRITE_MINOR       8
 #endif /* (PATCHLEVEL <= 5) */
 
 #if (PATCHLEVEL < 8 || (PATCHLEVEL == 8 && SUBVERSION < 1))
 #endif /* (PATCHLEVEL <= 5) */
 
 #if (PATCHLEVEL < 8 || (PATCHLEVEL == 8 && SUBVERSION < 1))
@@ -1044,7 +986,9 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
   } STMT_END
 
 /*
   } STMT_END
 
 /*
- * Bless `s' in `p', via a temporary reference, required by sv_bless().
+ * Bless 's' in 'p', via a temporary reference, required by sv_bless().
+ * "A" magic is added before the sv_bless for overloaded classes, this avoids
+ * an expensive call to S_reset_amagic in sv_bless.
  */
 #define BLESS(s,p)                                                     \
   STMT_START {                                                         \
  */
 #define BLESS(s,p)                                                     \
   STMT_START {                                                         \
@@ -1053,6 +997,11 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
        TRACEME(("blessing 0x%"UVxf" in %s", PTR2UV(s), (p))); \
        stash = gv_stashpv((p), GV_ADD);                        \
        ref = newRV_noinc(s);                                   \
        TRACEME(("blessing 0x%"UVxf" in %s", PTR2UV(s), (p))); \
        stash = gv_stashpv((p), GV_ADD);                        \
        ref = newRV_noinc(s);                                   \
+       if (cxt->in_retrieve_overloaded && Gv_AMG(stash)) \
+       { \
+           cxt->in_retrieve_overloaded = 0; \
+               SvAMAGIC_on(ref);                            \
+       } \
        (void) sv_bless(ref, stash);                    \
        SvRV_set(ref, NULL);                                            \
        SvREFCNT_dec(ref);                                              \
        (void) sv_bless(ref, stash);                    \
        SvRV_set(ref, NULL);                                            \
        SvREFCNT_dec(ref);                                              \
@@ -1091,6 +1040,12 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
 static int store(pTHX_ stcxt_t *cxt, SV *sv);
 static SV *retrieve(pTHX_ stcxt_t *cxt, const char *cname);
 
 static int store(pTHX_ stcxt_t *cxt, SV *sv);
 static SV *retrieve(pTHX_ stcxt_t *cxt, const char *cname);
 
+#define UNSEE()                             \
+  STMT_START {                              \
+    av_pop(cxt->aseen);                     \
+    cxt->tagnum--;                          \
+  } STMT_END
+
 /*
  * Dynamic dispatching table for SV store.
  */
 /*
  * Dynamic dispatching table for SV store.
  */
@@ -1286,12 +1241,12 @@ static void init_store_context(
        cxt->entry = 1;                                 /* No recursion yet */
 
        /*
        cxt->entry = 1;                                 /* No recursion yet */
 
        /*
-        * The `hseen' table is used to keep track of each SV stored and their
+        * The 'hseen' table is used to keep track of each SV stored and their
         * associated tag numbers is special. It is "abused" because the
         * values stored are not real SV, just integers cast to (SV *),
         * which explains the freeing below.
         *
         * associated tag numbers is special. It is "abused" because the
         * values stored are not real SV, just integers cast to (SV *),
         * which explains the freeing below.
         *
-        * It is also one possible bottlneck to achieve good storing speed,
+        * It is also one possible bottleneck to achieve good storing speed,
         * so the "shared keys" optimization is turned off (unlikely to be
         * of any use here), and the hash table is "pre-extended". Together,
         * those optimizations increase the throughput by 12%.
         * so the "shared keys" optimization is turned off (unlikely to be
         * of any use here), and the hash table is "pre-extended". Together,
         * those optimizations increase the throughput by 12%.
@@ -1328,7 +1283,7 @@ static void init_store_context(
 #endif
 
        /*
 #endif
 
        /*
-        * The `hclass' hash uses the same settings as `hseen' above, but it is
+        * The 'hclass' hash uses the same settings as 'hseen' above, but it is
         * used to assign sequential tags (numbers) to class names for blessed
         * objects.
         *
         * used to assign sequential tags (numbers) to class names for blessed
         * objects.
         *
@@ -1342,7 +1297,7 @@ static void init_store_context(
 #endif
 
        /*
 #endif
 
        /*
-        * The `hook' hash table is used to keep track of the references on
+        * The 'hook' hash table is used to keep track of the references on
         * the STORABLE_freeze hook routines, when found in some class name.
         *
         * It is assumed that the inheritance tree will not be changed during
         * the STORABLE_freeze hook routines, when found in some class name.
         *
         * It is assumed that the inheritance tree will not be changed during
@@ -1353,7 +1308,7 @@ static void init_store_context(
        cxt->hook = newHV();                    /* Table where hooks are cached */
 
        /*
        cxt->hook = newHV();                    /* Table where hooks are cached */
 
        /*
-        * The `hook_seen' array keeps track of all the SVs returned by
+        * The 'hook_seen' array keeps track of all the SVs returned by
         * STORABLE_freeze hooks for us to serialize, so that they are not
         * reclaimed until the end of the serialization process.  Each SV is
         * only stored once, the first time it is seen.
         * STORABLE_freeze hooks for us to serialize, so that they are not
         * reclaimed until the end of the serialization process.  Each SV is
         * only stored once, the first time it is seen.
@@ -1398,7 +1353,7 @@ static void clean_store_context(pTHX_ stcxt_t *cxt)
         *
         * The surrounding if() protection has been added because there might be
         * some cases where this routine is called more than once, during
         *
         * The surrounding if() protection has been added because there might be
         * some cases where this routine is called more than once, during
-        * exceptionnal events.  This was reported by Marc Lehmann when Storable
+        * exceptional events.  This was reported by Marc Lehmann when Storable
         * is executed from mod_perl, and the fix was suggested by him.
         *              -- RAM, 20/12/2000
         */
         * is executed from mod_perl, and the fix was suggested by him.
         *              -- RAM, 20/12/2000
         */
@@ -1478,7 +1433,7 @@ static void init_retrieve_context(pTHX_ stcxt_t *cxt, int optype, int is_tainted
        /*
         * 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
        /*
         * 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
-        * the correspondance between the tags and the tag number used by the
+        * the correspondence between the tags and the tag number used by the
         * new retrieve routines.
         */
 
         * new retrieve routines.
         */
 
@@ -1500,6 +1455,7 @@ static void init_retrieve_context(pTHX_ stcxt_t *cxt, int optype, int is_tainted
         cxt->use_bytes = -1;           /* Fetched from perl if needed */
 #endif
         cxt->accept_future_minor = -1; /* Fetched from perl if needed */
         cxt->use_bytes = -1;           /* Fetched from perl if needed */
 #endif
         cxt->accept_future_minor = -1; /* Fetched from perl if needed */
+       cxt->in_retrieve_overloaded = 0;
 }
 
 /*
 }
 
 /*
@@ -1550,6 +1506,7 @@ static void clean_retrieve_context(pTHX_ stcxt_t *cxt)
 #endif
         cxt->accept_future_minor = -1; /* Fetched from perl if needed */
 
 #endif
         cxt->accept_future_minor = -1; /* Fetched from perl if needed */
 
+       cxt->in_retrieve_overloaded = 0;
        reset_context(cxt);
 }
 
        reset_context(cxt);
 }
 
@@ -1726,6 +1683,7 @@ static void pkg_hide(
        const char *method)
 {
        const char *hvname = HvNAME_get(pkg);
        const char *method)
 {
        const char *hvname = HvNAME_get(pkg);
+       PERL_UNUSED_ARG(method);
        (void) hv_store(cache,
                hvname, strlen(hvname), newSVsv(&PL_sv_undef), 0);
 }
        (void) hv_store(cache,
                hvname, strlen(hvname), newSVsv(&PL_sv_undef), 0);
 }
@@ -1742,6 +1700,7 @@ static void pkg_uncache(
        const char *method)
 {
        const char *hvname = HvNAME_get(pkg);
        const char *method)
 {
        const char *hvname = HvNAME_get(pkg);
+       PERL_UNUSED_ARG(method);
        (void) hv_delete(cache, hvname, strlen(hvname), G_DISCARD);
 }
 
        (void) hv_delete(cache, hvname, strlen(hvname), G_DISCARD);
 }
 
@@ -1769,7 +1728,7 @@ static SV *pkg_can(
         * Look into the cache to see whether we already have determined
         * where the routine was, if any.
         *
         * Look into the cache to see whether we already have determined
         * where the routine was, if any.
         *
-        * NOTA BENE: we don't use `method' at all in our lookup, since we know
+        * NOTA BENE: we don't use 'method' at all in our lookup, since we know
         * that only one hook (i.e. always the same) is cached in a given cache.
         */
 
         * that only one hook (i.e. always the same) is cached in a given cache.
         */
 
@@ -1894,8 +1853,8 @@ static AV *array_call(
 /*
  * known_class
  *
 /*
  * known_class
  *
- * Lookup the class name in the `hclass' table and either assign it a new ID
- * or return the existing one, by filling in `classnum'.
+ * Lookup the class name in the 'hclass' table and either assign it a new ID
+ * or return the existing one, by filling in 'classnum'.
  *
  * Return true if the class was known, false if the ID was just generated.
  */
  *
  * Return true if the class was known, false if the ID was just generated.
  */
@@ -1935,7 +1894,7 @@ static int known_class(
 }
 
 /***
 }
 
 /***
- *** Sepcific store routines.
+ *** Specific store routines.
  ***/
 
 /*
  ***/
 
 /*
@@ -1979,6 +1938,7 @@ static int store_ref(pTHX_ stcxt_t *cxt, SV *sv)
  * Store a scalar.
  *
  * Layout is SX_LSCALAR <length> <data>, SX_SCALAR <length> <data> or SX_UNDEF.
  * Store a scalar.
  *
  * Layout is SX_LSCALAR <length> <data>, SX_SCALAR <length> <data> or SX_UNDEF.
+ * SX_LUTF8STR and SX_UTF8STR are used for UTF-8 strings.
  * The <data> section is omitted if <length> is 0.
  *
  * If integer or double, the layout is SX_INTEGER <data> or SX_DOUBLE <data>.
  * The <data> section is omitted if <length> is 0.
  *
  * If integer or double, the layout is SX_INTEGER <data> or SX_DOUBLE <data>.
@@ -2105,9 +2065,9 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
                 if (
 #ifdef SVf_IVisUV
                     /* Sorry. This isn't in 5.005_56 (IIRC) or earlier.  */
                 if (
 #ifdef SVf_IVisUV
                     /* Sorry. This isn't in 5.005_56 (IIRC) or earlier.  */
-                    ((flags & SVf_IVisUV) && SvUV(sv) > 0x7FFFFFFF) ||
+                    ((flags & SVf_IVisUV) && SvUV(sv) > (UV)0x7FFFFFFF) ||
 #endif
 #endif
-                    (iv > 0x7FFFFFFF) || (iv < -0x80000000)) {
+                    (iv > (IV)0x7FFFFFFF) || (iv < -(IV)0x80000000)) {
                     /* Bigger than 32 bits.  */
                     TRACEME(("large network order integer as string, value = %"IVdf, iv));
                     goto string_readlen;
                     /* Bigger than 32 bits.  */
                     TRACEME(("large network order integer as string, value = %"IVdf, iv));
                     goto string_readlen;
@@ -2187,7 +2147,7 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
  *
  * Store an array.
  *
  *
  * Store an array.
  *
- * Layout is SX_ARRAY <size> followed by each item, in increading index order.
+ * Layout is SX_ARRAY <size> followed by each item, in increasing index order.
  * Each item is stored as <object>.
  */
 static int store_array(pTHX_ stcxt_t *cxt, AV *av)
  * Each item is stored as <object>.
  */
 static int store_array(pTHX_ stcxt_t *cxt, AV *av)
@@ -2267,18 +2227,13 @@ sortcmp(const void *a, const void *b)
  * Values are stored as <object>.
  * Keys are stored as <flags> <length> <data>, the <data> section being omitted
  * if length is 0.
  * Values are stored as <object>.
  * Keys are stored as <flags> <length> <data>, the <data> section being omitted
  * if length is 0.
- * Currently the only hash flag is "restriced"
+ * Currently the only hash flag is "restricted"
  * Key flags are as for hv.h
  */
 static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
 {
        dVAR;
  * Key flags are as for hv.h
  */
 static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
 {
        dVAR;
-       I32 len = 
-#ifdef HAS_RESTRICTED_HASHES
-            HvTOTALKEYS(hv);
-#else
-            HvKEYS(hv);
-#endif
+       I32 len = HvTOTALKEYS(hv);
        I32 i;
        int ret = 0;
        I32 riter;
        I32 i;
        int ret = 0;
        I32 riter;
@@ -2357,7 +2312,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
                        SV *key;
 
                        if (!he)
                        SV *key;
 
                        if (!he)
-                               CROAK(("Hash %p inconsistent - expected %d keys, %dth is NULL", hv, len, i));
+                               CROAK(("Hash %p inconsistent - expected %d keys, %dth is NULL", hv, (int)len, (int)i));
                        key = hv_iterkeysv(he);
                        av_store(av, AvFILLp(av)+1, key);       /* av_push(), really */
                }
                        key = hv_iterkeysv(he);
                        av_store(av, AvFILLp(av)+1, key);       /* av_push(), really */
                }
@@ -2423,7 +2378,8 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
                         
                         /* Implementation of restricted hashes isn't nicely
                            abstracted:  */
                         
                         /* Implementation of restricted hashes isn't nicely
                            abstracted:  */
-                       if ((hash_flags & SHV_RESTRICTED) && SvREADONLY(val)) {
+                       if ((hash_flags & SHV_RESTRICTED)
+                        && SvREADONLY(val) && !SvIsCOW(val)) {
                                flags |= SHV_K_LOCKED;
                        }
 
                                flags |= SHV_K_LOCKED;
                        }
 
@@ -2515,7 +2471,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
                            abstracted:  */
                         flags
                             = (((hash_flags & SHV_RESTRICTED)
                            abstracted:  */
                         flags
                             = (((hash_flags & SHV_RESTRICTED)
-                                && SvREADONLY(val))
+                                && SvREADONLY(val) && !SvIsCOW(val))
                                              ? SHV_K_LOCKED : 0);
 
                         if (val == &PL_sv_placeholder) {
                                              ? SHV_K_LOCKED : 0);
 
                         if (val == &PL_sv_placeholder) {
@@ -2688,7 +2644,10 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
         * Now store the source code.
         */
 
         * Now store the source code.
         */
 
-       STORE_SCALAR(SvPV_nolen(text), len);
+       if(SvUTF8 (text))
+               STORE_UTF8STR(SvPV_nolen(text), len);
+       else
+               STORE_SCALAR(SvPV_nolen(text), len);
 
        FREETMPS;
        LEAVE;
 
        FREETMPS;
        LEAVE;
@@ -2752,7 +2711,7 @@ static int store_tied(pTHX_ stcxt_t *cxt, SV *sv)
         * Note that we store the Perl object as-is. We don't call its FETCH
         * method along the way. At retrieval time, we won't call its STORE
         * method either, but the tieing magic will be re-installed. In itself,
         * Note that we store the Perl object as-is. We don't call its FETCH
         * method along the way. At retrieval time, we won't call its STORE
         * method either, but the tieing magic will be re-installed. In itself,
-        * that ensures that the tieing semantics are preserved since futher
+        * that ensures that the tieing semantics are preserved since further
         * accesses on the retrieved object will indeed call the magic methods...
         */
 
         * accesses on the retrieved object will indeed call the magic methods...
         */
 
@@ -2902,6 +2861,7 @@ static int store_hook(
         */
 
        switch (type) {
         */
 
        switch (type) {
+        case svis_REF:
        case svis_SCALAR:
                obj_type = SHT_SCALAR;
                break;
        case svis_SCALAR:
                obj_type = SHT_SCALAR;
                break;
@@ -2923,7 +2883,7 @@ static int store_hook(
                 * Signal the tie-ing magic by setting the object type as SHT_EXTRA
                 * (since we have only 2 bits in <flags> to store the type), and an
                 * <extra> byte flag will be emitted after the FIRST <flags> in the
                 * Signal the tie-ing magic by setting the object type as SHT_EXTRA
                 * (since we have only 2 bits in <flags> to store the type), and an
                 * <extra> byte flag will be emitted after the FIRST <flags> in the
-                * stream, carrying what we put in `eflags'.
+                * stream, carrying what we put in 'eflags'.
                 */
                obj_type = SHT_EXTRA;
                switch (SvTYPE(sv)) {
                 */
                obj_type = SHT_EXTRA;
                switch (SvTYPE(sv)) {
@@ -2955,7 +2915,7 @@ static int store_hook(
         *    $object->STORABLE_freeze($cloning);
         *
         * but we don't have the $object here.  For instance, if $object is
         *    $object->STORABLE_freeze($cloning);
         *
         * but we don't have the $object here.  For instance, if $object is
-        * a blessed array, what we have in `sv' is the array, and we can't
+        * a blessed array, what we have in 'sv' is the array, and we can't
         * call a method on those.
         *
         * Therefore, we need to create a temporary reference to the object and
         * call a method on those.
         *
         * Therefore, we need to create a temporary reference to the object and
@@ -2964,9 +2924,8 @@ static int store_hook(
 
        TRACEME(("about to call STORABLE_freeze on class %s", classname));
 
 
        TRACEME(("about to call STORABLE_freeze on class %s", classname));
 
-       ref = newRV_noinc(sv);                          /* Temporary reference */
+       ref = newRV_inc(sv);                            /* Temporary reference */
        av = array_call(aTHX_ ref, hook, clone);        /* @a = $object->STORABLE_freeze($c) */
        av = array_call(aTHX_ ref, hook, clone);        /* @a = $object->STORABLE_freeze($c) */
-       SvRV_set(ref, NULL);
        SvREFCNT_dec(ref);                                      /* Reclaim temporary reference */
 
        count = AvFILLp(av) + 1;
        SvREFCNT_dec(ref);                                      /* Reclaim temporary reference */
 
        count = AvFILLp(av) + 1;
@@ -3096,7 +3055,7 @@ static int store_hook(
                        CROAK(("Could not serialize item #%d from hook in %s", i, classname));
 #endif
                /*
                        CROAK(("Could not serialize item #%d from hook in %s", i, classname));
 #endif
                /*
-                * It was the first time we serialized `xsv'.
+                * It was the first time we serialized 'xsv'.
                 *
                 * Keep this SV alive until the end of the serialization: if we
                 * disposed of it right now by decrementing its refcount, and it was
                 *
                 * Keep this SV alive until the end of the serialization: if we
                 * disposed of it right now by decrementing its refcount, and it was
@@ -3112,7 +3071,7 @@ static int store_hook(
 
        sv_seen:
                /*
 
        sv_seen:
                /*
-                * Dispose of the REF they returned.  If we saved the `xsv' away
+                * Dispose of the REF they returned.  If we saved the 'xsv' away
                 * in the array of returned SVs, that will not cause the underlying
                 * referenced SV to be reclaimed.
                 */
                 * in the array of returned SVs, that will not cause the underlying
                 * referenced SV to be reclaimed.
                 */
@@ -3380,7 +3339,7 @@ static int store_blessed(
  * We don't know how to store the item we reached, so return an error condition.
  * (it's probably a GLOB, some CODE reference, etc...)
  *
  * We don't know how to store the item we reached, so return an error condition.
  * (it's probably a GLOB, some CODE reference, etc...)
  *
- * If they defined the `forgive_me' variable at the Perl level to some
+ * If they defined the 'forgive_me' variable at the Perl level to some
  * true value, then don't croak, just warn, and store a placeholder string
  * instead.
  */
  * true value, then don't croak, just warn, and store a placeholder string
  * instead.
  */
@@ -3599,7 +3558,7 @@ static int store(pTHX_ stcxt_t *cxt, SV *sv)
 #endif
 
        /*
 #endif
 
        /*
-        * Store `sv' and everything beneath it, using appropriate routine.
+        * Store 'sv' and everything beneath it, using appropriate routine.
         * Abort immediately if we get a non-zero status back.
         */
 
         * Abort immediately if we get a non-zero status back.
         */
 
@@ -3724,9 +3683,9 @@ static int magic_write(pTHX_ stcxt_t *cxt)
  * Common code for store operations.
  *
  * When memory store is requested (f = NULL) and a non null SV* is given in
  * Common code for store operations.
  *
  * When memory store is requested (f = NULL) and a non null SV* is given in
- * `res', it is filled with a new SV created out of the memory buffer.
+ * 'res', it is filled with a new SV created out of the memory buffer.
  *
  *
- * It is required to provide a non-null `res' when the operation type is not
+ * It is required to provide a non-null 'res' when the operation type is not
  * dclone() and store() is performed to memory.
  */
 static int do_store(
  * dclone() and store() is performed to memory.
  */
 static int do_store(
@@ -3773,7 +3732,7 @@ static int do_store(
         * Ensure sv is actually a reference. From perl, we called something
         * like:
         *       pstore(aTHX_ FILE, \@array);
         * Ensure sv is actually a reference. From perl, we called something
         * like:
         *       pstore(aTHX_ FILE, \@array);
-        * so we must get the scalar value behing that reference.
+        * so we must get the scalar value behind that reference.
         */
 
        if (!SvROK(sv))
         */
 
        if (!SvROK(sv))
@@ -3869,6 +3828,7 @@ static SV *mbuf2sv(pTHX)
  */
 static SV *retrieve_other(pTHX_ stcxt_t *cxt, const char *cname)
 {
  */
 static SV *retrieve_other(pTHX_ stcxt_t *cxt, const char *cname)
 {
+       PERL_UNUSED_ARG(cname);
        if (
                cxt->ver_major != STORABLE_BIN_MAJOR &&
                cxt->ver_minor != STORABLE_BIN_MINOR
        if (
                cxt->ver_major != STORABLE_BIN_MAJOR &&
                cxt->ver_minor != STORABLE_BIN_MINOR
@@ -3899,6 +3859,7 @@ static SV *retrieve_idx_blessed(pTHX_ stcxt_t *cxt, const char *cname)
        SV **sva;
        SV *sv;
 
        SV **sva;
        SV *sv;
 
+       PERL_UNUSED_ARG(cname);
        TRACEME(("retrieve_idx_blessed (#%d)", cxt->tagnum));
        ASSERT(!cname, ("no bless-into class given here, got %s", cname));
 
        TRACEME(("retrieve_idx_blessed (#%d)", cxt->tagnum));
        ASSERT(!cname, ("no bless-into class given here, got %s", cname));
 
@@ -3907,7 +3868,7 @@ static SV *retrieve_idx_blessed(pTHX_ stcxt_t *cxt, const char *cname)
                RLEN(idx);
 
        /*
                RLEN(idx);
 
        /*
-        * Fetch classname in `aclass'
+        * Fetch classname in 'aclass'
         */
 
        sva = av_fetch(cxt->aclass, idx, FALSE);
         */
 
        sva = av_fetch(cxt->aclass, idx, FALSE);
@@ -3941,6 +3902,7 @@ static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, const char *cname)
        char *classname = buf;
        char *malloced_classname = NULL;
 
        char *classname = buf;
        char *malloced_classname = NULL;
 
+       PERL_UNUSED_ARG(cname);
        TRACEME(("retrieve_blessed (#%d)", cxt->tagnum));
        ASSERT(!cname, ("no bless-into class given here, got %s", cname));
 
        TRACEME(("retrieve_blessed (#%d)", cxt->tagnum));
        ASSERT(!cname, ("no bless-into class given here, got %s", cname));
 
@@ -4022,6 +3984,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname)
        char mtype = '\0';
        unsigned int extra_type = 0;
 
        char mtype = '\0';
        unsigned int extra_type = 0;
 
+       PERL_UNUSED_ARG(cname);
        TRACEME(("retrieve_hook (#%d)", cxt->tagnum));
        ASSERT(!cname, ("no bless-into class given here, got %s", cname));
 
        TRACEME(("retrieve_hook (#%d)", cxt->tagnum));
        ASSERT(!cname, ("no bless-into class given here, got %s", cname));
 
@@ -4106,7 +4069,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname)
                I32 idx;
 
                /*
                I32 idx;
 
                /*
-                * Fetch index from `aclass'
+                * Fetch index from 'aclass'
                 */
 
                if (flags & SHF_LARGE_CLASSLEN)
                 */
 
                if (flags & SHF_LARGE_CLASSLEN)
@@ -4206,7 +4169,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname)
         *
         * We read object tags and we can convert them into SV* on the fly
         * because we know all the references listed in there (as tags)
         *
         * We read object tags and we can convert them into SV* on the fly
         * because we know all the references listed in there (as tags)
-        * have been already serialized, hence we have a valid correspondance
+        * have been already serialized, hence we have a valid correspondence
         * between each of those tags and the recreated SV.
         */
 
         * between each of those tags and the recreated SV.
         */
 
@@ -4260,8 +4223,12 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname)
            attached = scalar_call(aTHX_ rv, attach_hook, clone, av, G_SCALAR);
            if (attached &&
                SvROK(attached) && 
            attached = scalar_call(aTHX_ rv, attach_hook, clone, av, G_SCALAR);
            if (attached &&
                SvROK(attached) && 
-               sv_derived_from(attached, classname))
+               sv_derived_from(attached, classname)
+        ) {
+               UNSEE();
+               SEEN(SvRV(attached), 0, 0);
                return SvRV(attached);
                return SvRV(attached);
+        }
            CROAK(("STORABLE_attach did not return a %s object", classname));
        }
 
            CROAK(("STORABLE_attach did not return a %s object", classname));
        }
 
@@ -4294,7 +4261,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname)
        }
 
        /*
        }
 
        /*
-        * If we don't have an `av' yet, prepare one.
+        * If we don't have an 'av' yet, prepare one.
         * Then insert the frozen string as item [0].
         */
 
         * Then insert the frozen string as item [0].
         */
 
@@ -4499,7 +4466,9 @@ static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, const char *cname)
 
        rv = NEWSV(10002, 0);
        SEEN(rv, cname, 0);             /* Will return if rv is null */
 
        rv = NEWSV(10002, 0);
        SEEN(rv, cname, 0);             /* Will return if rv is null */
+       cxt->in_retrieve_overloaded = 1; /* so sv_bless doesn't call S_reset_amagic */
        sv = retrieve(aTHX_ cxt, 0);    /* Retrieve <object> */
        sv = retrieve(aTHX_ cxt, 0);    /* Retrieve <object> */
+       cxt->in_retrieve_overloaded = 0;
        if (!sv)
                return (SV *) 0;        /* Failed */
 
        if (!sv)
                return (SV *) 0;        /* Failed */
 
@@ -5063,7 +5032,7 @@ static SV *retrieve_sv_no(pTHX_ stcxt_t *cxt, const char *cname)
  * retrieve_array
  *
  * Retrieve a whole array.
  * retrieve_array
  *
  * Retrieve a whole array.
- * Layout is SX_ARRAY <size> followed by each item, in increading index order.
+ * Layout is SX_ARRAY <size> followed by each item, in increasing index order.
  * Each item is stored as <object>.
  *
  * When we come here, SX_ARRAY has been read already.
  * Each item is stored as <object>.
  *
  * When we come here, SX_ARRAY has been read already.
@@ -5139,7 +5108,7 @@ static SV *retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname)
        SEEN(hv, cname, 0);             /* Will return if table not allocated properly */
        if (len == 0)
                return (SV *) hv;       /* No data follow if table empty */
        SEEN(hv, cname, 0);             /* Will return if table not allocated properly */
        if (len == 0)
                return (SV *) hv;       /* No data follow if table empty */
-       hv_ksplit(hv, len);             /* pre-extend hash to save multiple splits */
+       hv_ksplit(hv, len + 1);         /* pre-extend hash to save multiple splits */
 
        /*
         * Now get each key/value pair in turn...
 
        /*
         * Now get each key/value pair in turn...
@@ -5226,7 +5195,7 @@ static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const char *cname)
     SEEN(hv, cname, 0);                /* Will return if table not allocated properly */
     if (len == 0)
         return (SV *) hv;      /* No data follow if table empty */
     SEEN(hv, cname, 0);                /* Will return if table not allocated properly */
     if (len == 0)
         return (SV *) hv;      /* No data follow if table empty */
-    hv_ksplit(hv, len);                /* pre-extend hash to save multiple splits */
+    hv_ksplit(hv, len + 1);            /* pre-extend hash to save multiple splits */
 
     /*
      * Now get each key/value pair in turn...
 
     /*
      * Now get each key/value pair in turn...
@@ -5338,7 +5307,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
        dSP;
        int type, count, tagnum;
        SV *cv;
        dSP;
        int type, count, tagnum;
        SV *cv;
-       SV *sv, *text, *sub;
+       SV *sv, *text, *sub, *errsv;
 
        TRACEME(("retrieve_code (#%d)", cxt->tagnum));
 
 
        TRACEME(("retrieve_code (#%d)", cxt->tagnum));
 
@@ -5366,6 +5335,12 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
        case SX_LSCALAR:
                text = retrieve_lscalar(aTHX_ cxt, cname);
                break;
        case SX_LSCALAR:
                text = retrieve_lscalar(aTHX_ cxt, cname);
                break;
+       case SX_UTF8STR:
+               text = retrieve_utf8str(aTHX_ cxt, cname);
+               break;
+       case SX_LUTF8STR:
+               text = retrieve_lutf8str(aTHX_ cxt, cname);
+               break;
        default:
                CROAK(("Unexpected type %d in retrieve_code\n", type));
        }
        default:
                CROAK(("Unexpected type %d in retrieve_code\n", type));
        }
@@ -5375,6 +5350,8 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
         */
 
        sub = newSVpvn("sub ", 4);
         */
 
        sub = newSVpvn("sub ", 4);
+       if (SvUTF8(text))
+               SvUTF8_on(sub);
        sv_catpv(sub, SvPV_nolen(text)); /* XXX no sv_catsv! */
        SvREFCNT_dec(text);
 
        sv_catpv(sub, SvPV_nolen(text)); /* XXX no sv_catsv! */
        SvREFCNT_dec(text);
 
@@ -5404,25 +5381,27 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
        ENTER;
        SAVETMPS;
 
        ENTER;
        SAVETMPS;
 
+       errsv = get_sv("@", GV_ADD);
+       sv_setpvn(errsv, "", 0);        /* clear $@ */
        if (SvROK(cxt->eval) && SvTYPE(SvRV(cxt->eval)) == SVt_PVCV) {
        if (SvROK(cxt->eval) && SvTYPE(SvRV(cxt->eval)) == SVt_PVCV) {
-               SV* errsv = get_sv("@", GV_ADD);
-               sv_setpvn(errsv, "", 0);        /* clear $@ */
                PUSHMARK(sp);
                XPUSHs(sv_2mortal(newSVsv(sub)));
                PUTBACK;
                count = call_sv(cxt->eval, G_SCALAR);
                PUSHMARK(sp);
                XPUSHs(sv_2mortal(newSVsv(sub)));
                PUTBACK;
                count = call_sv(cxt->eval, G_SCALAR);
-               SPAGAIN;
                if (count != 1)
                        CROAK(("Unexpected return value from $Storable::Eval callback\n"));
                if (count != 1)
                        CROAK(("Unexpected return value from $Storable::Eval callback\n"));
-               cv = POPs;
-               if (SvTRUE(errsv)) {
-                       CROAK(("code %s caused an error: %s",
-                               SvPV_nolen(sub), SvPV_nolen(errsv)));
-               }
-               PUTBACK;
        } else {
        } else {
-               cv = eval_pv(SvPV_nolen(sub), TRUE);
+               eval_sv(sub, G_SCALAR);
+       }
+       SPAGAIN;
+       cv = POPs;
+       PUTBACK;
+
+       if (SvTRUE(errsv)) {
+               CROAK(("code %s caused an error: %s",
+                       SvPV_nolen(sub), SvPV_nolen(errsv)));
        }
        }
+
        if (cv && SvROK(cv) && SvTYPE(SvRV(cv)) == SVt_PVCV) {
            sv = SvRV(cv);
        } else {
        if (cv && SvROK(cv) && SvTYPE(SvRV(cv)) == SVt_PVCV) {
            sv = SvRV(cv);
        } else {
@@ -5446,7 +5425,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
  *
  * Retrieve a whole array in pre-0.6 binary format.
  *
  *
  * Retrieve a whole array in pre-0.6 binary format.
  *
- * Layout is SX_ARRAY <size> followed by each item, in increading index order.
+ * Layout is SX_ARRAY <size> followed by each item, in increasing index order.
  * Each item is stored as SX_ITEM <object> or SX_IT_UNDEF for "holes".
  *
  * When we come here, SX_ARRAY has been read already.
  * Each item is stored as SX_ITEM <object> or SX_IT_UNDEF for "holes".
  *
  * When we come here, SX_ARRAY has been read already.
@@ -5459,6 +5438,7 @@ static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, const char *cname)
        SV *sv;
        int c;
 
        SV *sv;
        int c;
 
+       PERL_UNUSED_ARG(cname);
        TRACEME(("old_retrieve_array (#%d)", cxt->tagnum));
 
        /*
        TRACEME(("old_retrieve_array (#%d)", cxt->tagnum));
 
        /*
@@ -5521,6 +5501,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname)
        int c;
        SV *sv_h_undef = (SV *) 0;              /* hv_store() bug */
 
        int c;
        SV *sv_h_undef = (SV *) 0;              /* hv_store() bug */
 
+       PERL_UNUSED_ARG(cname);
        TRACEME(("old_retrieve_hash (#%d)", cxt->tagnum));
 
        /*
        TRACEME(("old_retrieve_hash (#%d)", cxt->tagnum));
 
        /*
@@ -5533,7 +5514,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname)
        SEEN(hv, 0, 0);                 /* Will return if table not allocated properly */
        if (len == 0)
                return (SV *) hv;       /* No data follow if table empty */
        SEEN(hv, 0, 0);                 /* Will return if table not allocated properly */
        if (len == 0)
                return (SV *) hv;       /* No data follow if table empty */
-       hv_ksplit(hv, len);             /* pre-extend hash to save multiple splits */
+       hv_ksplit(hv, len + 1);         /* pre-extend hash to save multiple splits */
 
        /*
         * Now get each key/value pair in turn...
 
        /*
         * Now get each key/value pair in turn...
@@ -5737,7 +5718,7 @@ static SV *magic_check(pTHX_ stcxt_t *cxt)
     if ((cxt->netorder = (use_network_order & 0x1)))   /* Extra () for -Wall */
         return &PL_sv_undef;                   /* No byte ordering info */
 
     if ((cxt->netorder = (use_network_order & 0x1)))   /* Extra () for -Wall */
         return &PL_sv_undef;                   /* No byte ordering info */
 
-    /* In C truth is 1, falsehood is 0. Very convienient.  */
+    /* In C truth is 1, falsehood is 0. Very convenient.  */
     use_NV_size = version_major >= 2 && version_minor >= 2;
 
     if (version_major >= 0) {
     use_NV_size = version_major >= 2 && version_minor >= 2;
 
     if (version_major >= 0) {
@@ -5806,7 +5787,7 @@ static SV *retrieve(pTHX_ stcxt_t *cxt, const char *cname)
        /*
         * Grab address tag which identifies the object if we are retrieving
         * an older format. Since the new binary format counts objects and no
        /*
         * Grab address tag which identifies the object if we are retrieving
         * an older format. Since the new binary format counts objects and no
-        * longer explicitely tags them, we must keep track of the correspondance
+        * longer explicitly tags them, we must keep track of the correspondence
         * ourselves.
         *
         * The following section will disappear one day when the old format is
         * ourselves.
         *
         * The following section will disappear one day when the old format is
@@ -6004,7 +5985,7 @@ static SV *do_retrieve(
        /*
         * Prepare context.
         *
        /*
         * Prepare context.
         *
-        * Data is loaded into the memory buffer when f is NULL, unless `in' is
+        * Data is loaded into the memory buffer when f is NULL, unless 'in' is
         * also NULL, in which case we're expecting the data to already lie
         * in the buffer (dclone case).
         */
         * also NULL, in which case we're expecting the data to already lie
         * in the buffer (dclone case).
         */
@@ -6073,7 +6054,7 @@ static SV *do_retrieve(
         * Check whether input source is tainted, so that we don't wrongly
         * taint perfectly good values...
         *
         * Check whether input source is tainted, so that we don't wrongly
         * taint perfectly good values...
         *
-        * We assume file input is always tainted.  If both `f' and `in' are
+        * We assume file input is always tainted.  If both 'f' and 'in' are
         * NULL, then we come from dclone, and tainted is already filled in
         * the context.  That's a kludge, but the whole dclone() thing is
         * already quite a kludge anyway! -- RAM, 15/09/2000.
         * NULL, then we come from dclone, and tainted is already filled in
         * the context.  That's a kludge, but the whole dclone() thing is
         * already quite a kludge anyway! -- RAM, 15/09/2000.
@@ -6156,7 +6137,7 @@ static SV *do_retrieve(
         * so that we can croak when behaviour cannot be re-installed, and also
         * avoid testing for overloading magic at each reference retrieval.
         *
         * so that we can croak when behaviour cannot be re-installed, and also
         * avoid testing for overloading magic at each reference retrieval.
         *
-        * Unfortunately, the root reference is implicitely stored, so we must
+        * Unfortunately, the root reference is implicitly stored, so we must
         * check for possible overloading now.  Furthermore, if we don't restore
         * overloading, we cannot croak as if the original ref was, because we
         * have no way to determine whether it was an overloaded ref or not in
         * check for possible overloading now.  Furthermore, if we don't restore
         * overloading, we cannot croak as if the original ref was, because we
         * have no way to determine whether it was an overloaded ref or not in
@@ -6263,7 +6244,7 @@ static SV *dclone(pTHX_ SV *sv)
        cxt = real_context;                                     /* And we need this temporary... */
 
        /*
        cxt = real_context;                                     /* And we need this temporary... */
 
        /*
-        * Now, `cxt' may refer to a new context.
+        * Now, 'cxt' may refer to a new context.
         */
 
        ASSERT(!cxt->s_dirty, ("clean context"));
         */
 
        ASSERT(!cxt->s_dirty, ("clean context"));
@@ -6354,23 +6335,25 @@ init_perinterp()
 # pstore
 #
 # Store the transitive data closure of given object to disk.
 # pstore
 #
 # Store the transitive data closure of given object to disk.
-# Returns 0 on error, a true value otherwise.
+# Returns undef on error, a true value otherwise.
 
 # net_pstore
 #
 # Same as pstore(), but network order is used for integers and doubles are
 # emitted as strings.
 
 
 # net_pstore
 #
 # Same as pstore(), but network order is used for integers and doubles are
 # emitted as strings.
 
-int
+SV *
 pstore(f,obj)
 OutputStream   f
 SV *   obj
  ALIAS:
   net_pstore = 1
 pstore(f,obj)
 OutputStream   f
 SV *   obj
  ALIAS:
   net_pstore = 1
- CODE:
-  RETVAL = do_store(aTHX_ f, obj, 0, ix, (SV **)0);
- OUTPUT:
-  RETVAL
+ PPCODE:
+  RETVAL = do_store(aTHX_ f, obj, 0, ix, (SV **)0) ? &PL_sv_yes : &PL_sv_undef;
+  /* do_store() can reallocate the stack, so need a sequence point to ensure
+     that ST(0) knows about it. Hence using two statements.  */
+  ST(0) = RETVAL;
+  XSRETURN(1);
 
 # mstore
 #
 
 # mstore
 #
@@ -6417,23 +6400,20 @@ SV *    sv
  OUTPUT:
   RETVAL
 
  OUTPUT:
   RETVAL
 
-bool
+void
 last_op_in_netorder()
 last_op_in_netorder()
- CODE:
-  RETVAL = !!last_op_in_netorder(aTHX);
- OUTPUT:
-  RETVAL
-
-bool
-is_storing()
  ALIAS:
  is_storing = ST_STORE
  is_retrieving = ST_RETRIEVE
  ALIAS:
  is_storing = ST_STORE
  is_retrieving = ST_RETRIEVE
- CODE:
- {
-  dSTCXT;
-
-  RETVAL = cxt->entry && (cxt->optype & ix) ? TRUE : FALSE;
- }
- OUTPUT:
-  RETVAL
+ PREINIT:
+  bool result;
+ PPCODE:
+  if (ix) {
+   dSTCXT;
+
+   result = cxt->entry && (cxt->optype & ix) ? TRUE : FALSE;
+  } else {
+   result = !!last_op_in_netorder(aTHX);
+  }
+  ST(0) = boolSV(result);
+  XSRETURN(1);
Unnamed repository; edit this file 'description' to name the repository.