From: beau@beaucox.com <beau@beaucox.com>
Date: Thu, 18 Mar 2004 12:45:45 +0000 (-1000)
Subject: Storable PERL_NO_GET_CONTEXT
X-Git-Tag: accepted/trunk/20130322.191538~22178
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=138ec36d917f55d1d4cc801fa1b9271b6856d6fe;p=platform%2Fupstream%2Fperl.git

Storable PERL_NO_GET_CONTEXT
Message-Id: <20040318_224545_009145.beau@beaucox.com>

p4raw-id: //depot/perl@22533
---

diff --git a/MANIFEST b/MANIFEST
index 9d7b696..ce49c3c 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -648,6 +648,7 @@ ext/Storable/hints/linux.pl	Hint for Storable for named architecture
 ext/Storable/Makefile.PL	Storable extension
 ext/Storable/MANIFEST		Storable extension
 ext/Storable/README		Storable extension
+ext/Storable/ppport.h		Storable extension
 ext/Storable/Storable.pm	Storable extension
 ext/Storable/Storable.xs	Storable extension
 ext/Storable/t/blessed.t	See if Storable works
diff --git a/ext/Storable/MANIFEST b/ext/Storable/MANIFEST
index aa26dbb..03cd5ef 100644
--- a/ext/Storable/MANIFEST
+++ b/ext/Storable/MANIFEST
@@ -5,6 +5,7 @@ Storable.pm		    The perl side of Storable
 Storable.xs		    The C side of Storable
 ChangeLog		    Changes since baseline
 hints/linux.pl		    Hint file to drop gcc to -O2
+ppport.h		    Compatibility header
 t/HAS_HOOK.pm		    For auto-requiring of modules for STORABLE_thaw
 t/HAS_OVERLOAD.pm	    For auto-requiring of mdoules for overload
 t/blessed.t		    See if Storable works
diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index 7f47983..1a9afa8 100644
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -8,10 +8,13 @@
  *
  */
 
+#define PERL_NO_GET_CONTEXT     /* we want efficiency */
 #include <EXTERN.h>
 #include <perl.h>
 #include <XSUB.h>
 
+#include "ppport.h"             /* handle old perls */
+
 #ifndef PATCHLEVEL
 #    include <patchlevel.h>		/* Perl's one, needed since 5.6 */
 #    if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
@@ -974,32 +977,62 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
 	SvRV(ref) = 0;							\
 	SvREFCNT_dec(ref);						\
   } STMT_END
+/*
+ * sort (used in store_hash) - conditionally use qsort when
+ * sortsv is not available ( <= 5.6.1 ).
+ */
+
+#if (PATCHLEVEL <= 6)
+
+#if defined(USE_ITHREADS)
+
+#define STORE_HASH_SORT \
+        ENTER; { \
+        PerlInterpreter *orig_perl = PERL_GET_CONTEXT; \
+        SAVESPTR(orig_perl); \
+        PERL_SET_CONTEXT(aTHX); \
+        qsort((char *) AvARRAY(av), len, sizeof(SV *), sortcmp); \
+        } LEAVE;
+
+#else /* ! USE_ITHREADS */
 
-static int store();
-static SV *retrieve(stcxt_t *cxt, char *cname);
+#define STORE_HASH_SORT \
+        qsort((char *) AvARRAY(av), len, sizeof(SV *), sortcmp);
+
+#endif  /* USE_ITHREADS */
+
+#else /* PATCHLEVEL > 6 */
+
+#define STORE_HASH_SORT \
+        sortsv(AvARRAY(av), len, Perl_sv_cmp);  
+
+#endif /* PATCHLEVEL <= 6 */
+
+static int store(pTHX_ stcxt_t *cxt, SV *sv);
+static SV *retrieve(pTHX_ stcxt_t *cxt, char *cname);
 
 /*
  * Dynamic dispatching table for SV store.
  */
 
-static int store_ref(stcxt_t *cxt, SV *sv);
-static int store_scalar(stcxt_t *cxt, SV *sv);
-static int store_array(stcxt_t *cxt, AV *av);
-static int store_hash(stcxt_t *cxt, HV *hv);
-static int store_tied(stcxt_t *cxt, SV *sv);
-static int store_tied_item(stcxt_t *cxt, SV *sv);
-static int store_code(stcxt_t *cxt, CV *cv);
-static int store_other(stcxt_t *cxt, SV *sv);
-static int store_blessed(stcxt_t *cxt, SV *sv, int type, HV *pkg);
-
-static int (*sv_store[])(stcxt_t *cxt, SV *sv) = {
+static int store_ref(pTHX_ stcxt_t *cxt, SV *sv);
+static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv);
+static int store_array(pTHX_ stcxt_t *cxt, AV *av);
+static int store_hash(pTHX_ stcxt_t *cxt, HV *hv);
+static int store_tied(pTHX_ stcxt_t *cxt, SV *sv);
+static int store_tied_item(pTHX_ stcxt_t *cxt, SV *sv);
+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 (*)(stcxt_t *cxt, SV *sv)) store_array,	/* svis_ARRAY */
-	(int (*)(stcxt_t *cxt, SV *sv)) store_hash,		/* svis_HASH */
+	(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 (*)(stcxt_t *cxt, SV *sv)) store_code,		/* svis_CODE */
+	(int (*)(pTHX_ stcxt_t *cxt, SV *sv)) store_code,		/* svis_CODE */
 	store_other,									/* svis_OTHER */
 };
 
@@ -1009,24 +1042,24 @@ static int (*sv_store[])(stcxt_t *cxt, SV *sv) = {
  * Dynamic dispatching tables for SV retrieval.
  */
 
-static SV *retrieve_lscalar(stcxt_t *cxt, char *cname);
-static SV *retrieve_lutf8str(stcxt_t *cxt, char *cname);
-static SV *old_retrieve_array(stcxt_t *cxt, char *cname);
-static SV *old_retrieve_hash(stcxt_t *cxt, char *cname);
-static SV *retrieve_ref(stcxt_t *cxt, char *cname);
-static SV *retrieve_undef(stcxt_t *cxt, char *cname);
-static SV *retrieve_integer(stcxt_t *cxt, char *cname);
-static SV *retrieve_double(stcxt_t *cxt, char *cname);
-static SV *retrieve_byte(stcxt_t *cxt, char *cname);
-static SV *retrieve_netint(stcxt_t *cxt, char *cname);
-static SV *retrieve_scalar(stcxt_t *cxt, char *cname);
-static SV *retrieve_utf8str(stcxt_t *cxt, char *cname);
-static SV *retrieve_tied_array(stcxt_t *cxt, char *cname);
-static SV *retrieve_tied_hash(stcxt_t *cxt, char *cname);
-static SV *retrieve_tied_scalar(stcxt_t *cxt, char *cname);
-static SV *retrieve_other(stcxt_t *cxt, char *cname);
-
-static SV *(*sv_old_retrieve[])(stcxt_t *cxt, char *cname) = {
+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) = {
 	0,			/* SX_OBJECT -- entry unused dynamically */
 	retrieve_lscalar,		/* SX_LSCALAR */
 	old_retrieve_array,		/* SX_ARRAY -- for pre-0.6 binaries */
@@ -1057,21 +1090,21 @@ static SV *(*sv_old_retrieve[])(stcxt_t *cxt, char *cname) = {
 	retrieve_other,			/* SX_ERROR */
 };
 
-static SV *retrieve_array(stcxt_t *cxt, char *cname);
-static SV *retrieve_hash(stcxt_t *cxt, char *cname);
-static SV *retrieve_sv_undef(stcxt_t *cxt, char *cname);
-static SV *retrieve_sv_yes(stcxt_t *cxt, char *cname);
-static SV *retrieve_sv_no(stcxt_t *cxt, char *cname);
-static SV *retrieve_blessed(stcxt_t *cxt, char *cname);
-static SV *retrieve_idx_blessed(stcxt_t *cxt, char *cname);
-static SV *retrieve_hook(stcxt_t *cxt, char *cname);
-static SV *retrieve_overloaded(stcxt_t *cxt, char *cname);
-static SV *retrieve_tied_key(stcxt_t *cxt, char *cname);
-static SV *retrieve_tied_idx(stcxt_t *cxt, char *cname);
-static SV *retrieve_flag_hash(stcxt_t *cxt, char *cname);
-static SV *retrieve_code(stcxt_t *cxt, char *cname);
-
-static SV *(*sv_retrieve[])(stcxt_t *cxt, char *cname) = {
+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 *(*sv_retrieve[])(pTHX_ stcxt_t *cxt, char *cname) = {
 	0,			/* SX_OBJECT -- entry unused dynamically */
 	retrieve_lscalar,		/* SX_LSCALAR */
 	retrieve_array,			/* SX_ARRAY */
@@ -1104,7 +1137,7 @@ static SV *(*sv_retrieve[])(stcxt_t *cxt, char *cname) = {
 
 #define RETRIEVE(c,x) (*(c)->retrieve_vtbl[(x) >= SX_ERROR ? SX_ERROR : (x)])
 
-static SV *mbuf2sv(void);
+static SV *mbuf2sv(pTHX);
 
 /***
  *** Context management.
@@ -1115,7 +1148,7 @@ static SV *mbuf2sv(void);
  *
  * Called once per "thread" (interpreter) to initialize some global context.
  */
-static void init_perinterp(void)
+static void init_perinterp(pTHX)
 {
     INIT_STCXT;
 
@@ -1142,6 +1175,7 @@ static void reset_context(stcxt_t *cxt)
  * Initialize a new store context for real recursion.
  */
 static void init_store_context(
+        pTHX_
 	stcxt_t *cxt,
 	PerlIO *f,
 	int optype,
@@ -1236,7 +1270,7 @@ static void init_store_context(
  *
  * Clean store context by
  */
-static void clean_store_context(stcxt_t *cxt)
+static void clean_store_context(pTHX_ stcxt_t *cxt)
 {
 	HE *he;
 
@@ -1314,7 +1348,7 @@ static void clean_store_context(stcxt_t *cxt)
  *
  * Initialize a new retrieve context for real recursion.
  */
-static void init_retrieve_context(stcxt_t *cxt, int optype, int is_tainted)
+static void init_retrieve_context(pTHX_ stcxt_t *cxt, int optype, int is_tainted)
 {
 	TRACEME(("init_retrieve_context"));
 
@@ -1361,7 +1395,7 @@ static void init_retrieve_context(stcxt_t *cxt, int optype, int is_tainted)
  *
  * Clean retrieve context by
  */
-static void clean_retrieve_context(stcxt_t *cxt)
+static void clean_retrieve_context(pTHX_ stcxt_t *cxt)
 {
 	TRACEME(("clean_retrieve_context"));
 
@@ -1412,7 +1446,7 @@ static void clean_retrieve_context(stcxt_t *cxt)
  *
  * A workaround for the CROAK bug: cleanup the last context.
  */
-static void clean_context(stcxt_t *cxt)
+static void clean_context(pTHX_ stcxt_t *cxt)
 {
 	TRACEME(("clean_context"));
 
@@ -1424,9 +1458,9 @@ static void clean_context(stcxt_t *cxt)
 	ASSERT(!cxt->membuf_ro, ("mbase is not read-only"));
 
 	if (cxt->optype & ST_RETRIEVE)
-		clean_retrieve_context(cxt);
+		clean_retrieve_context(aTHX_ cxt);
 	else if (cxt->optype & ST_STORE)
-		clean_store_context(cxt);
+		clean_store_context(aTHX_ cxt);
 	else
 		reset_context(cxt);
 
@@ -1440,8 +1474,7 @@ static void clean_context(stcxt_t *cxt)
  * Allocate a new context and push it on top of the parent one.
  * This new context is made globally visible via SET_STCXT().
  */
-static stcxt_t *allocate_context(parent_cxt)
-stcxt_t *parent_cxt;
+static stcxt_t *allocate_context(pTHX_ stcxt_t *parent_cxt)
 {
 	stcxt_t *cxt;
 
@@ -1464,8 +1497,7 @@ stcxt_t *parent_cxt;
  * Free current context, which cannot be the "root" one.
  * Make the context underneath globally visible via SET_STCXT().
  */
-static void free_context(cxt)
-stcxt_t *cxt;
+static void free_context(pTHX_ stcxt_t *cxt)
 {
 	stcxt_t *prev = (stcxt_t *)(cxt->prev ? SvPVX(SvRV(cxt->prev)) : 0);
 
@@ -1489,7 +1521,7 @@ stcxt_t *cxt;
  *
  * Tells whether we're in the middle of a store operation.
  */
-int is_storing(void)
+int is_storing(pTHX)
 {
 	dSTCXT;
 
@@ -1501,7 +1533,7 @@ int is_storing(void)
  *
  * Tells whether we're in the middle of a retrieve operation.
  */
-int is_retrieving(void)
+int is_retrieving(pTHX)
 {
 	dSTCXT;
 
@@ -1516,7 +1548,7 @@ int is_retrieving(void)
  * 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(void)
+int last_op_in_netorder(pTHX)
 {
 	dSTCXT;
 
@@ -1536,6 +1568,7 @@ int last_op_in_netorder(void)
  * nor its ancestors know about the method.
  */
 static SV *pkg_fetchmeth(
+        pTHX_
 	HV *cache,
 	HV *pkg,
 	char *method)
@@ -1573,6 +1606,7 @@ static SV *pkg_fetchmeth(
  * Force cached value to be undef: hook ignored even if present.
  */
 static void pkg_hide(
+        pTHX_
 	HV *cache,
 	HV *pkg,
 	char *method)
@@ -1587,6 +1621,7 @@ static void pkg_hide(
  * Discard cached value: a whole fetch loop will be retried at next lookup.
  */
 static void pkg_uncache(
+        pTHX_
 	HV *cache,
 	HV *pkg,
 	char *method)
@@ -1603,6 +1638,7 @@ static void pkg_uncache(
  * know about the method.
  */
 static SV *pkg_can(
+        pTHX_
 	HV *cache,
 	HV *pkg,
 	char *method)
@@ -1634,7 +1670,7 @@ static SV *pkg_can(
 	}
 
 	TRACEME(("not cached yet"));
-	return pkg_fetchmeth(cache, pkg, method);		/* Fetch and cache */
+	return pkg_fetchmeth(aTHX_ cache, pkg, method);		/* Fetch and cache */
 }
 
 /*
@@ -1644,6 +1680,7 @@ static SV *pkg_can(
  * Propagates the single returned value if not called in void context.
  */
 static SV *scalar_call(
+        pTHX_
 	SV *obj,
 	SV *hook,
 	int cloning,
@@ -1700,6 +1737,7 @@ static SV *scalar_call(
  * Returns the list of returned values in an array.
  */
 static AV *array_call(
+        pTHX_
 	SV *obj,
 	SV *hook,
 	int cloning)
@@ -1745,6 +1783,7 @@ static AV *array_call(
  * Return true if the class was known, false if the ID was just generated.
  */
 static int known_class(
+        pTHX_
 	stcxt_t *cxt,
 	char *name,		/* Class name */
 	int len,		/* Name length */
@@ -1788,7 +1827,7 @@ static int known_class(
  * Store a reference.
  * Layout is SX_REF <object> or SX_OVERLOAD <object>.
  */
-static int store_ref(stcxt_t *cxt, SV *sv)
+static int store_ref(pTHX_ stcxt_t *cxt, SV *sv)
 {
 	TRACEME(("store_ref (0x%"UVxf")", PTR2UV(sv)));
 
@@ -1808,7 +1847,7 @@ static int store_ref(stcxt_t *cxt, SV *sv)
 	} else
 		PUTMARK(SX_REF);
 
-	return store(cxt, sv);
+	return store(aTHX_ cxt, sv);
 }
 
 /*
@@ -1822,7 +1861,7 @@ static int store_ref(stcxt_t *cxt, SV *sv)
  * If integer or double, the layout is SX_INTEGER <data> or SX_DOUBLE <data>.
  * Small integers (within [-127, +127]) are stored as SX_BYTE <byte>.
  */
-static int store_scalar(stcxt_t *cxt, SV *sv)
+static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
 {
 	IV iv;
 	char *pv;
@@ -2028,7 +2067,7 @@ static int store_scalar(stcxt_t *cxt, SV *sv)
  * Layout is SX_ARRAY <size> followed by each item, in increading index order.
  * Each item is stored as <object>.
  */
-static int store_array(stcxt_t *cxt, AV *av)
+static int store_array(pTHX_ stcxt_t *cxt, AV *av)
 {
 	SV **sav;
 	I32 len = av_len(av) + 1;
@@ -2057,7 +2096,7 @@ static int store_array(stcxt_t *cxt, AV *av)
 			continue;
 		}
 		TRACEME(("(#%d) item", i));
-		if ((ret = store(cxt, *sav)))	/* Extra () for -Wall, grr... */
+		if ((ret = store(aTHX_ cxt, *sav)))	/* Extra () for -Wall, grr... */
 			return ret;
 	}
 
@@ -2066,6 +2105,9 @@ static int store_array(stcxt_t *cxt, AV *av)
 	return 0;
 }
 
+
+#if (PATCHLEVEL <= 6)
+
 /*
  * sortcmp
  *
@@ -2075,9 +2117,13 @@ static int store_array(stcxt_t *cxt, AV *av)
 static int
 sortcmp(const void *a, const void *b)
 {
-	return sv_cmp(*(SV * const *) a, *(SV * const *) b);
+#if defined(USE_ITHREADS)
+        dTHX;
+#endif /* USE_ITHREADS */
+        return sv_cmp(*(SV * const *) a, *(SV * const *) b);
 }
 
+#endif /* PATCHLEVEL <= 6 */
 
 /*
  * store_hash
@@ -2101,7 +2147,7 @@ sortcmp(const void *a, const void *b)
  * Currently the only hash flag is "restriced"
  * Key flags are as for hv.h
  */
-static int store_hash(stcxt_t *cxt, HV *hv)
+static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
 {
 	I32 len = 
 #ifdef HAS_RESTRICTED_HASHES
@@ -2188,7 +2234,7 @@ static int store_hash(stcxt_t *cxt, HV *hv)
 			av_store(av, AvFILLp(av)+1, key);	/* av_push(), really */
 		}
 			
-		qsort((char *) AvARRAY(av), len, sizeof(SV *), sortcmp);
+		STORE_HASH_SORT;
 
 		for (i = 0; i < len; i++) {
 #ifdef HAS_RESTRICTED_HASHES
@@ -2236,7 +2282,7 @@ static int store_hash(stcxt_t *cxt, HV *hv)
 			
 			TRACEME(("(#%d) value 0x%"UVxf, i, PTR2UV(val)));
 
-			if ((ret = store(cxt, val)))	/* Extra () for -Wall, grr... */
+			if ((ret = store(aTHX_ cxt, val)))	/* Extra () for -Wall, grr... */
 				goto out;
 
 			/*
@@ -2355,7 +2401,7 @@ static int store_hash(stcxt_t *cxt, HV *hv)
 
 			TRACEME(("(#%d) value 0x%"UVxf, i, PTR2UV(val)));
 
-			if ((ret = store(cxt, val)))	/* Extra () for -Wall, grr... */
+			if ((ret = store(aTHX_ cxt, val)))	/* Extra () for -Wall, grr... */
 				goto out;
 
 
@@ -2402,7 +2448,7 @@ static int store_hash(stcxt_t *cxt, HV *hv)
                             TRACEME(("(#%d) key '%s'", i, key));
                         }
                         if (flags & SHV_K_ISSV) {
-                            store(cxt, key_sv);
+                            store(aTHX_ cxt, key_sv);
                         } else {
                             WLEN(len);
                             if (len)
@@ -2428,13 +2474,13 @@ out:
  * Layout is SX_CODE <length> followed by a scalar containing the perl
  * source code of the code reference.
  */
-static int store_code(stcxt_t *cxt, CV *cv)
+static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
 {
 #if PERL_VERSION < 6
     /*
 	 * retrieve_code does not work with perl 5.005 or less
 	 */
-	return store_other(cxt, (SV*)cv);
+	return store_other(aTHX_ cxt, (SV*)cv);
 #else
 	dSP;
 	I32 len;
@@ -2448,7 +2494,7 @@ static int store_code(stcxt_t *cxt, CV *cv)
 		(cxt->deparse < 0 && !(cxt->deparse =
 			SvTRUE(perl_get_sv("Storable::Deparse", TRUE)) ? 1 : 0))
 	) {
-		return store_other(cxt, (SV*)cv);
+		return store_other(aTHX_ cxt, (SV*)cv);
 	}
 
 	/*
@@ -2532,7 +2578,7 @@ static int store_code(stcxt_t *cxt, CV *cv)
  * dealing with a tied hash, we store SX_TIED_HASH <hash object>, where
  * <hash object> stands for the serialization of the tied hash.
  */
-static int store_tied(stcxt_t *cxt, SV *sv)
+static int store_tied(pTHX_ stcxt_t *cxt, SV *sv)
 {
 	MAGIC *mg;
 	SV *obj = NULL;
@@ -2583,7 +2629,7 @@ static int store_tied(stcxt_t *cxt, SV *sv)
 
 	/* [#17040] mg_obj is NULL for scalar self-ties. AMS 20030416 */
 	obj = mg->mg_obj ? mg->mg_obj : newSV(0);
-	if ((ret = store(cxt, obj)))
+	if ((ret = store(aTHX_ cxt, obj)))
 		return ret;
 
 	TRACEME(("ok (tied)"));
@@ -2603,7 +2649,7 @@ static int store_tied(stcxt_t *cxt, SV *sv)
  *     SX_TIED_KEY <object> <key>
  *     SX_TIED_IDX <object> <index>
  */
-static int store_tied_item(stcxt_t *cxt, SV *sv)
+static int store_tied_item(pTHX_ stcxt_t *cxt, SV *sv)
 {
 	MAGIC *mg;
 	int ret;
@@ -2622,12 +2668,12 @@ static int store_tied_item(stcxt_t *cxt, SV *sv)
 		PUTMARK(SX_TIED_KEY);
 		TRACEME(("store_tied_item: storing OBJ 0x%"UVxf, PTR2UV(mg->mg_obj)));
 
-		if ((ret = store(cxt, mg->mg_obj)))		/* Extra () for -Wall, grr... */
+		if ((ret = store(aTHX_ cxt, mg->mg_obj)))		/* Extra () for -Wall, grr... */
 			return ret;
 
 		TRACEME(("store_tied_item: storing PTR 0x%"UVxf, PTR2UV(mg->mg_ptr)));
 
-		if ((ret = store(cxt, (SV *) mg->mg_ptr)))	/* Idem, for -Wall */
+		if ((ret = store(aTHX_ cxt, (SV *) mg->mg_ptr)))	/* Idem, for -Wall */
 			return ret;
 	} else {
 		I32 idx = mg->mg_len;
@@ -2636,7 +2682,7 @@ static int store_tied_item(stcxt_t *cxt, SV *sv)
 		PUTMARK(SX_TIED_IDX);
 		TRACEME(("store_tied_item: storing OBJ 0x%"UVxf, PTR2UV(mg->mg_obj)));
 
-		if ((ret = store(cxt, mg->mg_obj)))		/* Idem, for -Wall */
+		if ((ret = store(aTHX_ cxt, mg->mg_obj)))		/* Idem, for -Wall */
 			return ret;
 
 		TRACEME(("store_tied_item: storing IDX %d", idx));
@@ -2695,6 +2741,7 @@ static int store_tied_item(stcxt_t *cxt, SV *sv)
  * any other tied variable.
  */
 static int store_hook(
+        pTHX_
 	stcxt_t *cxt,
 	SV *sv,
 	int type,
@@ -2789,7 +2836,7 @@ static int store_hook(
 	TRACEME(("about to call STORABLE_freeze on class %s", class));
 
 	ref = newRV_noinc(sv);				/* Temporary reference */
-	av = array_call(ref, hook, clone);	/* @a = $object->STORABLE_freeze($c) */
+	av = array_call(aTHX_ ref, hook, clone);	/* @a = $object->STORABLE_freeze($c) */
 	SvRV(ref) = 0;
 	SvREFCNT_dec(ref);					/* Reclaim temporary reference */
 
@@ -2814,12 +2861,12 @@ static int store_hook(
 			CROAK(("Too late to ignore hooks for %s class \"%s\"",
 				(cxt->optype & ST_CLONE) ? "cloning" : "storing", class));
 	
-		pkg_hide(cxt->hook, pkg, "STORABLE_freeze");
+		pkg_hide(aTHX_ cxt->hook, pkg, "STORABLE_freeze");
 
-		ASSERT(!pkg_can(cxt->hook, pkg, "STORABLE_freeze"), ("hook invisible"));
+		ASSERT(!pkg_can(aTHX_ cxt->hook, pkg, "STORABLE_freeze"), ("hook invisible"));
 		TRACEME(("ignoring STORABLE_freeze in class \"%s\"", class));
 
-		return store_blessed(cxt, sv, type, pkg);
+		return store_blessed(aTHX_ cxt, sv, type, pkg);
 	}
 
 	/*
@@ -2883,7 +2930,7 @@ static int store_hook(
 		} else
 			PUTMARK(flags);
 
-		if ((ret = store(cxt, xsv)))	/* Given by hook for us to store */
+		if ((ret = store(aTHX_ cxt, xsv)))	/* Given by hook for us to store */
 			return ret;
 
 		svh = hv_fetch(cxt->hseen, (char *) &xsv, sizeof(xsv), FALSE);
@@ -2933,7 +2980,7 @@ static int store_hook(
 	 * proposed the right fix.  -- RAM, 15/09/2000
 	 */
 
-	if (!known_class(cxt, class, len, &classnum)) {
+	if (!known_class(aTHX_ cxt, class, len, &classnum)) {
 		TRACEME(("first time we see class %s, ID = %d", class, classnum));
 		classnum = -1;				/* Mark: we must store classname */
 	} else {
@@ -3060,7 +3107,7 @@ static int store_hook(
 		 * [<magic object>]
 		 */
 
-		if ((ret = store(cxt, mg->mg_obj)))	/* Extra () for -Wall, grr... */
+		if ((ret = store(aTHX_ cxt, mg->mg_obj)))	/* Extra () for -Wall, grr... */
 			return ret;
 	}
 
@@ -3092,6 +3139,7 @@ static int store_hook(
  * on the high-order bit in flag (same encoding as above for <len>).
  */
 static int store_blessed(
+        pTHX_
 	stcxt_t *cxt,
 	SV *sv,
 	int type,
@@ -3109,9 +3157,9 @@ static int store_blessed(
 	 * if needed.
 	 */
 
-	hook = pkg_can(cxt->hook, pkg, "STORABLE_freeze");
+	hook = pkg_can(aTHX_ cxt->hook, pkg, "STORABLE_freeze");
 	if (hook)
-		return store_hook(cxt, sv, type, pkg, hook);
+		return store_hook(aTHX_ cxt, sv, type, pkg, hook);
 
 	/*
 	 * This is a blessed SV without any serialization hook.
@@ -3130,7 +3178,7 @@ static int store_blessed(
 	 * used).
 	 */
 
-	if (known_class(cxt, class, len, &classnum)) {
+	if (known_class(aTHX_ cxt, class, len, &classnum)) {
 		TRACEME(("already seen class %s, ID = %d", class, classnum));
 		PUTMARK(SX_IX_BLESS);
 		if (classnum <= LG_BLESS) {
@@ -3159,7 +3207,7 @@ static int store_blessed(
 	 * Now emit the <object> part.
 	 */
 
-	return SV_STORE(type)(cxt, sv);
+	return SV_STORE(type)(aTHX_ cxt, sv);
 }
 
 /*
@@ -3172,7 +3220,7 @@ static int store_blessed(
  * true value, then don't croak, just warn, and store a placeholder string
  * instead.
  */
-static int store_other(stcxt_t *cxt, SV *sv)
+static int store_other(pTHX_ stcxt_t *cxt, SV *sv)
 {
 	I32 len;
 	static char buf[80];
@@ -3219,7 +3267,7 @@ static int store_other(stcxt_t *cxt, SV *sv)
  * Returns the type of the SV, identified by an integer. That integer
  * may then be used to index the dynamic routine dispatch table.
  */
-static int sv_type(SV *sv)
+static int sv_type(pTHX_ SV *sv)
 {
 	switch (SvTYPE(sv)) {
 	case SVt_NULL:
@@ -3279,7 +3327,7 @@ static int sv_type(SV *sv)
  * object (one for which storage has started -- it may not be over if we have
  * a self-referenced structure). This data set forms a stored <object>.
  */
-static int store(stcxt_t *cxt, SV *sv)
+static int store(pTHX_ stcxt_t *cxt, SV *sv)
 {
 	SV **svh;
 	int ret;
@@ -3364,7 +3412,7 @@ static int store(stcxt_t *cxt, SV *sv)
 	 * Abort immediately if we get a non-zero status back.
 	 */
 
-	type = sv_type(sv);
+	type = sv_type(aTHX_ sv);
 
 undef_special_case:
 	TRACEME(("storing 0x%"UVxf" tag #%d, type %d...",
@@ -3372,9 +3420,9 @@ undef_special_case:
 
 	if (SvOBJECT(sv)) {
 		HV *pkg = SvSTASH(sv);
-		ret = store_blessed(cxt, sv, type, pkg);
+		ret = store_blessed(aTHX_ cxt, sv, type, pkg);
 	} else
-		ret = SV_STORE(type)(cxt, sv);
+		ret = SV_STORE(type)(aTHX_ cxt, sv);
 
 	TRACEME(("%s (stored 0x%"UVxf", refcnt=%d, %s)",
 		ret ? "FAILED" : "ok", PTR2UV(sv),
@@ -3394,7 +3442,7 @@ undef_special_case:
  * Note that no byte ordering info is emitted when <network> is true, since
  * integers will be emitted in network order in that case.
  */
-static int magic_write(stcxt_t *cxt)
+static int magic_write(pTHX_ stcxt_t *cxt)
 {
     /*
      * Starting with 0.6, the "use_network_order" byte flag is also used to
@@ -3491,6 +3539,7 @@ static int magic_write(stcxt_t *cxt)
  * dclone() and store() is performed to memory.
  */
 static int do_store(
+        pTHX_
 	PerlIO *f,
 	SV *sv,
 	int optype,
@@ -3514,7 +3563,7 @@ static int do_store(
 	 */
 
 	if (cxt->s_dirty)
-		clean_context(cxt);
+		clean_context(aTHX_ cxt);
 
 	/*
 	 * Now that STORABLE_xxx hooks exist, it is possible that they try to
@@ -3522,7 +3571,7 @@ static int do_store(
 	 */
 
 	if (cxt->entry)
-		cxt = allocate_context(cxt);
+		cxt = allocate_context(aTHX_ cxt);
 
 	cxt->entry++;
 
@@ -3532,7 +3581,7 @@ static int do_store(
 	/*
 	 * Ensure sv is actually a reference. From perl, we called something
 	 * like:
-	 *       pstore(FILE, \@array);
+	 *       pstore(aTHX_ FILE, \@array);
 	 * so we must get the scalar value behing that reference.
 	 */
 
@@ -3551,9 +3600,9 @@ static int do_store(
 	 * Prepare context and emit headers.
 	 */
 
-	init_store_context(cxt, f, optype, network_order);
+	init_store_context(aTHX_ cxt, f, optype, network_order);
 
-	if (-1 == magic_write(cxt))		/* Emit magic and ILP info */
+	if (-1 == magic_write(aTHX_ cxt))		/* Emit magic and ILP info */
 		return 0;					/* Error */
 
 	/*
@@ -3562,7 +3611,7 @@ static int do_store(
 
 	ASSERT(is_storing(), ("within store operation"));
 
-	status = store(cxt, sv);		/* Just do it! */
+	status = store(aTHX_ cxt, sv);		/* Just do it! */
 
 	/*
 	 * If they asked for a memory store and they provided an SV pointer,
@@ -3574,7 +3623,7 @@ static int do_store(
 	 */
 
 	if (!cxt->fio && res)
-		*res = mbuf2sv();
+		*res = mbuf2sv(aTHX);
 
 	/*
 	 * Final cleanup.
@@ -3592,9 +3641,9 @@ static int do_store(
 	 * about to enter do_retrieve...
 	 */
 
-	clean_store_context(cxt);
+	clean_store_context(aTHX_ cxt);
 	if (cxt->prev && !(cxt->optype & ST_CLONE))
-		free_context(cxt);
+		free_context(aTHX_ cxt);
 
 	TRACEME(("do_store returns %d", status));
 
@@ -3607,10 +3656,10 @@ static int do_store(
  * Store the transitive data closure of given object to disk.
  * Returns 0 on error, a true value otherwise.
  */
-int pstore(PerlIO *f, SV *sv)
+int pstore(pTHX_ PerlIO *f, SV *sv)
 {
 	TRACEME(("pstore"));
-	return do_store(f, sv, 0, FALSE, (SV**) 0);
+	return do_store(aTHX_ f, sv, 0, FALSE, (SV**) 0);
 
 }
 
@@ -3620,10 +3669,10 @@ int pstore(PerlIO *f, SV *sv)
  * Same as pstore(), but network order is used for integers and doubles are
  * emitted as strings.
  */
-int net_pstore(PerlIO *f, SV *sv)
+int net_pstore(pTHX_ PerlIO *f, SV *sv)
 {
 	TRACEME(("net_pstore"));
-	return do_store(f, sv, 0, TRUE, (SV**) 0);
+	return do_store(aTHX_ f, sv, 0, TRUE, (SV**) 0);
 }
 
 /***
@@ -3635,7 +3684,7 @@ int net_pstore(PerlIO *f, SV *sv)
  *
  * Build a new SV out of the content of the internal memory buffer.
  */
-static SV *mbuf2sv(void)
+static SV *mbuf2sv(pTHX)
 {
 	dSTCXT;
 
@@ -3648,13 +3697,13 @@ static SV *mbuf2sv(void)
  * Store the transitive data closure of given object to memory.
  * Returns undef on error, a scalar value containing the data otherwise.
  */
-SV *mstore(SV *sv)
+SV *mstore(pTHX_ SV *sv)
 {
 	SV *out;
 
 	TRACEME(("mstore"));
 
-	if (!do_store((PerlIO*) 0, sv, 0, FALSE, &out))
+	if (!do_store(aTHX_ (PerlIO*) 0, sv, 0, FALSE, &out))
 		return &PL_sv_undef;
 
 	return out;
@@ -3666,13 +3715,13 @@ SV *mstore(SV *sv)
  * Same as mstore(), but network order is used for integers and doubles are
  * emitted as strings.
  */
-SV *net_mstore(SV *sv)
+SV *net_mstore(pTHX_ SV *sv)
 {
 	SV *out;
 
 	TRACEME(("net_mstore"));
 
-	if (!do_store((PerlIO*) 0, sv, 0, TRUE, &out))
+	if (!do_store(aTHX_ (PerlIO*) 0, sv, 0, TRUE, &out))
 		return &PL_sv_undef;
 
 	return out;
@@ -3688,7 +3737,7 @@ SV *net_mstore(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_other(pTHX_ stcxt_t *cxt, char *cname)
 {
 	if (
 		cxt->ver_major != STORABLE_BIN_MAJOR &&
@@ -3713,7 +3762,7 @@ static SV *retrieve_other(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_idx_blessed(pTHX_ stcxt_t *cxt, char *cname)
 {
 	I32 idx;
 	char *class;
@@ -3743,7 +3792,7 @@ static SV *retrieve_idx_blessed(stcxt_t *cxt, char *cname)
 	 * Retrieve object and bless it.
 	 */
 
-	sv = retrieve(cxt, class);	/* First SV which is SEEN will be blessed */
+	sv = retrieve(aTHX_ cxt, class);	/* First SV which is SEEN will be blessed */
 
 	return sv;
 }
@@ -3754,7 +3803,7 @@ static SV *retrieve_idx_blessed(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, char *cname)
 {
 	I32 len;
 	SV *sv;
@@ -3793,7 +3842,7 @@ static SV *retrieve_blessed(stcxt_t *cxt, char *cname)
 	 * Retrieve object and bless it.
 	 */
 
-	sv = retrieve(cxt, class);	/* First SV which is SEEN will be blessed */
+	sv = retrieve(aTHX_ cxt, class);	/* First SV which is SEEN will be blessed */
 	if (class != buf)
 		Safefree(class);
 
@@ -3820,7 +3869,7 @@ static SV *retrieve_blessed(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_hook(pTHX_ stcxt_t *cxt, char *cname)
 {
 	I32 len;
 	char buf[LG_BLESS + 1];		/* Avoid malloc() if possible */
@@ -3886,11 +3935,11 @@ static SV *retrieve_hook(stcxt_t *cxt, char *cname)
 			mtype = 'P';
 			break;
 		default:
-			return retrieve_other(cxt, 0);	/* Let it croak */
+			return retrieve_other(aTHX_ cxt, 0);	/* Let it croak */
 		}
 		break;
 	default:
-		return retrieve_other(cxt, 0);		/* Let it croak */
+		return retrieve_other(aTHX_ cxt, 0);		/* Let it croak */
 	}
 	SEEN(sv, 0, 0);							/* Don't bless yet */
 
@@ -3908,7 +3957,7 @@ static SV *retrieve_hook(stcxt_t *cxt, char *cname)
 
 	while (flags & SHF_NEED_RECURSE) {
 		TRACEME(("retrieve_hook recursing..."));
-		rv = retrieve(cxt, 0);
+		rv = retrieve(aTHX_ cxt, 0);
 		if (!rv)
 			return (SV *) 0;
 		SvREFCNT_dec(rv);
@@ -4054,7 +4103,7 @@ static SV *retrieve_hook(stcxt_t *cxt, char *cname)
 	 */
 
 	BLESS(sv, class);
-	hook = pkg_can(cxt->hook, SvSTASH(sv), "STORABLE_thaw");
+	hook = pkg_can(aTHX_ cxt->hook, SvSTASH(sv), "STORABLE_thaw");
 	if (!hook) {
 		/*
 		 * Hook not found.  Maybe they did not require the module where this
@@ -4079,8 +4128,8 @@ static SV *retrieve_hook(stcxt_t *cxt, char *cname)
 		 * the lookup again.
 		 */
 
-		pkg_uncache(cxt->hook, SvSTASH(sv), "STORABLE_thaw");
-		hook = pkg_can(cxt->hook, SvSTASH(sv), "STORABLE_thaw");
+		pkg_uncache(aTHX_ cxt->hook, SvSTASH(sv), "STORABLE_thaw");
+		hook = pkg_can(aTHX_ cxt->hook, SvSTASH(sv), "STORABLE_thaw");
 
 		if (!hook)
 			CROAK(("No STORABLE_thaw defined for objects of class %s "
@@ -4118,7 +4167,7 @@ static SV *retrieve_hook(stcxt_t *cxt, char *cname)
 		 class, PTR2UV(sv), (IV) AvFILLp(av) + 1));
 
 	rv = newRV(sv);
-	(void) scalar_call(rv, hook, clone, av, G_SCALAR|G_DISCARD);
+	(void) scalar_call(aTHX_ rv, hook, clone, av, G_SCALAR|G_DISCARD);
 	SvREFCNT_dec(rv);
 
 	/*
@@ -4141,7 +4190,7 @@ static SV *retrieve_hook(stcxt_t *cxt, char *cname)
 
 	TRACEME(("retrieving magic object for 0x%"UVxf"...", PTR2UV(sv)));
 
-	rv = retrieve(cxt, 0);		/* Retrieve <magic object> */
+	rv = retrieve(aTHX_ cxt, 0);		/* Retrieve <magic object> */
 
 	TRACEME(("restoring the magic object 0x%"UVxf" part of 0x%"UVxf,
 		PTR2UV(rv), PTR2UV(sv)));
@@ -4196,7 +4245,7 @@ static SV *retrieve_hook(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_ref(pTHX_ stcxt_t *cxt, char *cname)
 {
 	SV *rv;
 	SV *sv;
@@ -4214,7 +4263,7 @@ static SV *retrieve_ref(stcxt_t *cxt, char *cname)
 
 	rv = NEWSV(10002, 0);
 	SEEN(rv, cname, 0);		/* Will return if rv is null */
-	sv = retrieve(cxt, 0);	/* Retrieve <object> */
+	sv = retrieve(aTHX_ cxt, 0);	/* Retrieve <object> */
 	if (!sv)
 		return (SV *) 0;	/* Failed */
 
@@ -4257,7 +4306,7 @@ static SV *retrieve_ref(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, char *cname)
 {
 	SV *rv;
 	SV *sv;
@@ -4271,7 +4320,7 @@ static SV *retrieve_overloaded(stcxt_t *cxt, char *cname)
 
 	rv = NEWSV(10002, 0);
 	SEEN(rv, cname, 0);		/* Will return if rv is null */
-	sv = retrieve(cxt, 0);	/* Retrieve <object> */
+	sv = retrieve(aTHX_ cxt, 0);	/* Retrieve <object> */
 	if (!sv)
 		return (SV *) 0;	/* Failed */
 
@@ -4326,7 +4375,7 @@ static SV *retrieve_overloaded(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_tied_array(pTHX_ stcxt_t *cxt, char *cname)
 {
 	SV *tv;
 	SV *sv;
@@ -4335,7 +4384,7 @@ static SV *retrieve_tied_array(stcxt_t *cxt, char *cname)
 
 	tv = NEWSV(10002, 0);
 	SEEN(tv, cname, 0);			/* Will return if tv is null */
-	sv = retrieve(cxt, 0);		/* Retrieve <object> */
+	sv = retrieve(aTHX_ cxt, 0);		/* Retrieve <object> */
 	if (!sv)
 		return (SV *) 0;		/* Failed */
 
@@ -4355,7 +4404,7 @@ static SV *retrieve_tied_array(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, char *cname)
 {
 	SV *tv;
 	SV *sv;
@@ -4364,7 +4413,7 @@ static SV *retrieve_tied_hash(stcxt_t *cxt, char *cname)
 
 	tv = NEWSV(10002, 0);
 	SEEN(tv, cname, 0);			/* Will return if tv is null */
-	sv = retrieve(cxt, 0);		/* Retrieve <object> */
+	sv = retrieve(aTHX_ cxt, 0);		/* Retrieve <object> */
 	if (!sv)
 		return (SV *) 0;		/* Failed */
 
@@ -4383,7 +4432,7 @@ static SV *retrieve_tied_hash(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, char *cname)
 {
 	SV *tv;
 	SV *sv, *obj = NULL;
@@ -4392,7 +4441,7 @@ static SV *retrieve_tied_scalar(stcxt_t *cxt, char *cname)
 
 	tv = NEWSV(10002, 0);
 	SEEN(tv, cname, 0);			/* Will return if rv is null */
-	sv = retrieve(cxt, 0);		/* Retrieve <object> */
+	sv = retrieve(aTHX_ cxt, 0);		/* Retrieve <object> */
 	if (!sv) {
 		return (SV *) 0;		/* Failed */
 	}
@@ -4419,7 +4468,7 @@ static SV *retrieve_tied_scalar(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_tied_key(pTHX_ stcxt_t *cxt, char *cname)
 {
 	SV *tv;
 	SV *sv;
@@ -4429,11 +4478,11 @@ static SV *retrieve_tied_key(stcxt_t *cxt, char *cname)
 
 	tv = NEWSV(10002, 0);
 	SEEN(tv, cname, 0);			/* Will return if tv is null */
-	sv = retrieve(cxt, 0);		/* Retrieve <object> */
+	sv = retrieve(aTHX_ cxt, 0);		/* Retrieve <object> */
 	if (!sv)
 		return (SV *) 0;		/* Failed */
 
-	key = retrieve(cxt, 0);		/* Retrieve <key> */
+	key = retrieve(aTHX_ cxt, 0);		/* Retrieve <key> */
 	if (!key)
 		return (SV *) 0;		/* Failed */
 
@@ -4451,7 +4500,7 @@ static SV *retrieve_tied_key(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_tied_idx(pTHX_ stcxt_t *cxt, char *cname)
 {
 	SV *tv;
 	SV *sv;
@@ -4461,7 +4510,7 @@ static SV *retrieve_tied_idx(stcxt_t *cxt, char *cname)
 
 	tv = NEWSV(10002, 0);
 	SEEN(tv, cname, 0);			/* Will return if tv is null */
-	sv = retrieve(cxt, 0);		/* Retrieve <object> */
+	sv = retrieve(aTHX_ cxt, 0);		/* Retrieve <object> */
 	if (!sv)
 		return (SV *) 0;		/* Failed */
 
@@ -4484,7 +4533,7 @@ static SV *retrieve_tied_idx(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, char *cname)
 {
 	I32 len;
 	SV *sv;
@@ -4530,7 +4579,7 @@ static SV *retrieve_lscalar(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_scalar(pTHX_ stcxt_t *cxt, char *cname)
 {
 	int len;
 	SV *sv;
@@ -4589,13 +4638,13 @@ static SV *retrieve_scalar(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_utf8str(pTHX_ stcxt_t *cxt, char *cname)
 {
     SV *sv;
 
     TRACEME(("retrieve_utf8str"));
 
-    sv = retrieve_scalar(cxt, cname);
+    sv = retrieve_scalar(aTHX_ cxt, cname);
     if (sv) {
 #ifdef HAS_UTF8_SCALARS
         SvUTF8_on(sv);
@@ -4618,13 +4667,13 @@ static SV *retrieve_utf8str(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_lutf8str(pTHX_ stcxt_t *cxt, char *cname)
 {
     SV *sv;
 
     TRACEME(("retrieve_lutf8str"));
 
-    sv = retrieve_lscalar(cxt, cname);
+    sv = retrieve_lscalar(aTHX_ cxt, cname);
     if (sv) {
 #ifdef HAS_UTF8_SCALARS
         SvUTF8_on(sv);
@@ -4646,7 +4695,7 @@ static SV *retrieve_lutf8str(stcxt_t *cxt, char *cname)
  * Retrieve defined integer.
  * Layout is SX_INTEGER <data>, whith SX_INTEGER already read.
  */
-static SV *retrieve_integer(stcxt_t *cxt, char *cname)
+static SV *retrieve_integer(pTHX_ stcxt_t *cxt, char *cname)
 {
 	SV *sv;
 	IV iv;
@@ -4669,7 +4718,7 @@ static SV *retrieve_integer(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_netint(pTHX_ stcxt_t *cxt, char *cname)
 {
 	SV *sv;
 	I32 iv;
@@ -4697,7 +4746,7 @@ static SV *retrieve_netint(stcxt_t *cxt, char *cname)
  * Retrieve defined double.
  * Layout is SX_DOUBLE <data>, whith SX_DOUBLE already read.
  */
-static SV *retrieve_double(stcxt_t *cxt, char *cname)
+static SV *retrieve_double(pTHX_ stcxt_t *cxt, char *cname)
 {
 	SV *sv;
 	NV nv;
@@ -4720,7 +4769,7 @@ static SV *retrieve_double(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(stcxt_t *cxt, char *cname)
+static SV *retrieve_byte(pTHX_ stcxt_t *cxt, char *cname)
 {
 	SV *sv;
 	int siv;
@@ -4745,7 +4794,7 @@ static SV *retrieve_byte(stcxt_t *cxt, char *cname)
  *
  * Return the undefined value.
  */
-static SV *retrieve_undef(stcxt_t *cxt, char *cname)
+static SV *retrieve_undef(pTHX_ stcxt_t *cxt, char *cname)
 {
 	SV* sv;
 
@@ -4762,7 +4811,7 @@ static SV *retrieve_undef(stcxt_t *cxt, char *cname)
  *
  * Return the immortal undefined value.
  */
-static SV *retrieve_sv_undef(stcxt_t *cxt, char *cname)
+static SV *retrieve_sv_undef(pTHX_ stcxt_t *cxt, char *cname)
 {
 	SV *sv = &PL_sv_undef;
 
@@ -4783,7 +4832,7 @@ static SV *retrieve_sv_undef(stcxt_t *cxt, char *cname)
  *
  * Return the immortal yes value.
  */
-static SV *retrieve_sv_yes(stcxt_t *cxt, char *cname)
+static SV *retrieve_sv_yes(pTHX_ stcxt_t *cxt, char *cname)
 {
 	SV *sv = &PL_sv_yes;
 
@@ -4798,7 +4847,7 @@ static SV *retrieve_sv_yes(stcxt_t *cxt, char *cname)
  *
  * Return the immortal no value.
  */
-static SV *retrieve_sv_no(stcxt_t *cxt, char *cname)
+static SV *retrieve_sv_no(pTHX_ stcxt_t *cxt, char *cname)
 {
 	SV *sv = &PL_sv_no;
 
@@ -4817,7 +4866,7 @@ static SV *retrieve_sv_no(stcxt_t *cxt, char *cname)
  *
  * When we come here, SX_ARRAY has been read already.
  */
-static SV *retrieve_array(stcxt_t *cxt, char *cname)
+static SV *retrieve_array(pTHX_ stcxt_t *cxt, char *cname)
 {
 	I32 len;
 	I32 i;
@@ -4845,7 +4894,7 @@ static SV *retrieve_array(stcxt_t *cxt, char *cname)
 
 	for (i = 0; i < len; i++) {
 		TRACEME(("(#%d) item", i));
-		sv = retrieve(cxt, 0);			/* Retrieve item */
+		sv = retrieve(aTHX_ cxt, 0);			/* Retrieve item */
 		if (!sv)
 			return (SV *) 0;
 		if (av_store(av, i, sv) == 0)
@@ -4868,7 +4917,7 @@ static SV *retrieve_array(stcxt_t *cxt, char *cname)
  *
  * When we come here, SX_HASH has been read already.
  */
-static SV *retrieve_hash(stcxt_t *cxt, char *cname)
+static SV *retrieve_hash(pTHX_ stcxt_t *cxt, char *cname)
 {
 	I32 len;
 	I32 size;
@@ -4900,7 +4949,7 @@ static SV *retrieve_hash(stcxt_t *cxt, char *cname)
 		 */
 
 		TRACEME(("(#%d) value", i));
-		sv = retrieve(cxt, 0);
+		sv = retrieve(aTHX_ cxt, 0);
 		if (!sv)
 			return (SV *) 0;
 
@@ -4942,7 +4991,7 @@ static SV *retrieve_hash(stcxt_t *cxt, char *cname)
  *
  * When we come here, SX_HASH has been read already.
  */
-static SV *retrieve_flag_hash(stcxt_t *cxt, char *cname)
+static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, char *cname)
 {
     I32 len;
     I32 size;
@@ -4988,7 +5037,7 @@ static SV *retrieve_flag_hash(stcxt_t *cxt, char *cname)
          */
 
         TRACEME(("(#%d) value", i));
-        sv = retrieve(cxt, 0);
+        sv = retrieve(aTHX_ cxt, 0);
         if (!sv)
             return (SV *) 0;
 
@@ -5005,7 +5054,7 @@ static SV *retrieve_flag_hash(stcxt_t *cxt, char *cname)
             */
             SV *keysv;
             TRACEME(("(#%d) keysv, flags=%d", i, flags));
-            keysv = retrieve(cxt, 0);
+            keysv = retrieve(aTHX_ cxt, 0);
             if (!keysv)
                 return (SV *) 0;
 
@@ -5078,7 +5127,7 @@ static SV *retrieve_flag_hash(stcxt_t *cxt, char *cname)
  *
  * Return a code reference.
  */
-static SV *retrieve_code(stcxt_t *cxt, char *cname)
+static SV *retrieve_code(pTHX_ stcxt_t *cxt, char *cname)
 {
 #if PERL_VERSION < 6
     CROAK(("retrieve_code does not work with perl 5.005 or less\n"));
@@ -5109,10 +5158,10 @@ static SV *retrieve_code(stcxt_t *cxt, char *cname)
 	GETMARK(type);
 	switch (type) {
 	case SX_SCALAR:
-		text = retrieve_scalar(cxt, cname);
+		text = retrieve_scalar(aTHX_ cxt, cname);
 		break;
 	case SX_LSCALAR:
-		text = retrieve_lscalar(cxt, cname);
+		text = retrieve_lscalar(aTHX_ cxt, cname);
 		break;
 	default:
 		CROAK(("Unexpected type %d in retrieve_code\n", type));
@@ -5199,7 +5248,7 @@ static SV *retrieve_code(stcxt_t *cxt, char *cname)
  *
  * When we come here, SX_ARRAY has been read already.
  */
-static SV *old_retrieve_array(stcxt_t *cxt, char *cname)
+static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, char *cname)
 {
 	I32 len;
 	I32 i;
@@ -5233,9 +5282,9 @@ static SV *old_retrieve_array(stcxt_t *cxt, char *cname)
 			continue;			/* av_extend() already filled us with undef */
 		}
 		if (c != SX_ITEM)
-			(void) retrieve_other((stcxt_t *) 0, 0);	/* Will croak out */
+			(void) retrieve_other(aTHX_ (stcxt_t *) 0, 0);	/* Will croak out */
 		TRACEME(("(#%d) item", i));
-		sv = retrieve(cxt, 0);						/* Retrieve item */
+		sv = retrieve(aTHX_ cxt, 0);						/* Retrieve item */
 		if (!sv)
 			return (SV *) 0;
 		if (av_store(av, i, sv) == 0)
@@ -5259,7 +5308,7 @@ static SV *old_retrieve_array(stcxt_t *cxt, char *cname)
  *
  * When we come here, SX_HASH has been read already.
  */
-static SV *old_retrieve_hash(stcxt_t *cxt, char *cname)
+static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, char *cname)
 {
 	I32 len;
 	I32 size;
@@ -5305,11 +5354,11 @@ static SV *old_retrieve_hash(stcxt_t *cxt, char *cname)
 			sv = SvREFCNT_inc(sv_h_undef);
 		} else if (c == SX_VALUE) {
 			TRACEME(("(#%d) value", i));
-			sv = retrieve(cxt, 0);
+			sv = retrieve(aTHX_ cxt, 0);
 			if (!sv)
 				return (SV *) 0;
 		} else
-			(void) retrieve_other((stcxt_t *) 0, 0);	/* Will croak out */
+			(void) retrieve_other(aTHX_ (stcxt_t *) 0, 0);	/* Will croak out */
 
 		/*
 		 * Get key.
@@ -5320,7 +5369,7 @@ static SV *old_retrieve_hash(stcxt_t *cxt, char *cname)
 
 		GETMARK(c);
 		if (c != SX_KEY)
-			(void) retrieve_other((stcxt_t *) 0, 0);	/* Will croak out */
+			(void) retrieve_other(aTHX_ (stcxt_t *) 0, 0);	/* Will croak out */
 		RLEN(size);						/* Get key size */
 		KBUFCHK((STRLEN)size);					/* Grow hash key read pool if needed */
 		if (size)
@@ -5356,7 +5405,7 @@ static SV *old_retrieve_hash(stcxt_t *cxt, char *cname)
  * Note that there's no byte ordering info emitted when network order was
  * used at store time.
  */
-static SV *magic_check(stcxt_t *cxt)
+static SV *magic_check(pTHX_ stcxt_t *cxt)
 {
     /* The worst case for a malicious header would be old magic (which is
        longer), major, minor, byteorder length byte of 255, 255 bytes of
@@ -5531,7 +5580,7 @@ static SV *magic_check(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(stcxt_t *cxt, char *cname)
+static SV *retrieve(pTHX_ stcxt_t *cxt, char *cname)
 {
 	int type;
 	SV **svh;
@@ -5640,7 +5689,7 @@ first_time:		/* Will disappear when support for old format is dropped */
 	 * Okay, first time through for this one.
 	 */
 
-	sv = RETRIEVE(cxt, type)(cxt, cname);
+	sv = RETRIEVE(cxt, type)(aTHX_ cxt, cname);
 	if (!sv)
 		return (SV *) 0;			/* Failed */
 
@@ -5691,6 +5740,7 @@ first_time:		/* Will disappear when support for old format is dropped */
  * Common routine for pretrieve and mretrieve.
  */
 static SV *do_retrieve(
+        pTHX_
 	PerlIO *f,
 	SV *in,
 	int optype)
@@ -5721,7 +5771,7 @@ static SV *do_retrieve(
 	 */
 
 	if (cxt->s_dirty)
-		clean_context(cxt);
+		clean_context(aTHX_ cxt);
 
 	/*
 	 * Now that STORABLE_xxx hooks exist, it is possible that they try to
@@ -5729,7 +5779,7 @@ static SV *do_retrieve(
 	 */
 
 	if (cxt->entry)
-		cxt = allocate_context(cxt);
+		cxt = allocate_context(aTHX_ cxt);
 
 	cxt->entry++;
 
@@ -5759,7 +5809,7 @@ static SV *do_retrieve(
 
 	cxt->fio = f;				/* Where I/O are performed */
 
-	if (!magic_check(cxt))
+	if (!magic_check(aTHX_ cxt))
 		CROAK(("Magic number checking on storable %s failed",
 			cxt->fio ? "file" : "string"));
 
@@ -5778,11 +5828,11 @@ static SV *do_retrieve(
 
 	is_tainted = f ? 1 : (in ? SvTAINTED(in) : cxt->s_tainted);
 	TRACEME(("input source is %s", is_tainted ? "tainted" : "trusted"));
-	init_retrieve_context(cxt, optype, is_tainted);
+	init_retrieve_context(aTHX_ cxt, optype, is_tainted);
 
 	ASSERT(is_retrieving(), ("within retrieve operation"));
 
-	sv = retrieve(cxt, 0);		/* Recursively retrieve object, get root SV */
+	sv = retrieve(aTHX_ cxt, 0);		/* Recursively retrieve object, get root SV */
 
 	/*
 	 * Final cleanup.
@@ -5797,9 +5847,9 @@ static SV *do_retrieve(
 	 * The "root" context is never freed.
 	 */
 
-	clean_retrieve_context(cxt);
+	clean_retrieve_context(aTHX_ cxt);
 	if (cxt->prev)				/* This context was stacked */
-		free_context(cxt);		/* It was not the "root" context */
+		free_context(aTHX_ cxt);		/* It was not the "root" context */
 
 	/*
 	 * Prepare returned value.
@@ -5840,7 +5890,7 @@ static SV *do_retrieve(
 	if (pre_06_fmt) {			/* Was not handling overloading by then */
 		SV *rv;
 		TRACEME(("fixing for old formats -- pre 0.6"));
-		if (sv_type(sv) == svis_REF && (rv = SvRV(sv)) && SvOBJECT(rv)) {
+		if (sv_type(aTHX_ sv) == svis_REF && (rv = SvRV(sv)) && SvOBJECT(rv)) {
 			TRACEME(("ended do_retrieve() with an object -- pre 0.6"));
 			return sv;
 		}
@@ -5884,10 +5934,10 @@ static SV *do_retrieve(
  *
  * Retrieve data held in file and return the root object, undef on error.
  */
-SV *pretrieve(PerlIO *f)
+SV *pretrieve(pTHX_ PerlIO *f)
 {
 	TRACEME(("pretrieve"));
-	return do_retrieve(f, Nullsv, 0);
+	return do_retrieve(aTHX_ f, Nullsv, 0);
 }
 
 /*
@@ -5895,10 +5945,10 @@ SV *pretrieve(PerlIO *f)
  *
  * Retrieve data held in scalar and return the root object, undef on error.
  */
-SV *mretrieve(SV *sv)
+SV *mretrieve(pTHX_ SV *sv)
 {
 	TRACEME(("mretrieve"));
-	return do_retrieve((PerlIO*) 0, sv, 0);
+	return do_retrieve(aTHX_ (PerlIO*) 0, sv, 0);
 }
 
 /***
@@ -5914,7 +5964,7 @@ SV *mretrieve(SV *sv)
  * there. Not that efficient, but it should be faster than doing it from
  * pure perl anyway.
  */
-SV *dclone(SV *sv)
+SV *dclone(pTHX_ SV *sv)
 {
 	dSTCXT;
 	int size;
@@ -5929,14 +5979,14 @@ SV *dclone(SV *sv)
 	 */
 
 	if (cxt->s_dirty)
-		clean_context(cxt);
+		clean_context(aTHX_ cxt);
 
 	/*
 	 * do_store() optimizes for dclone by not freeing its context, should
 	 * we need to allocate one because we're deep cloning from a hook.
 	 */
 
-	if (!do_store((PerlIO*) 0, sv, ST_CLONE, FALSE, (SV**) 0))
+	if (!do_store(aTHX_ (PerlIO*) 0, sv, ST_CLONE, FALSE, (SV**) 0))
 		return &PL_sv_undef;				/* Error during store */
 
 	/*
@@ -5967,7 +6017,7 @@ SV *dclone(SV *sv)
 	 */
 
 	cxt->s_tainted = SvTAINTED(sv);
-	out = do_retrieve((PerlIO*) 0, Nullsv, ST_CLONE);
+	out = do_retrieve(aTHX_ (PerlIO*) 0, Nullsv, ST_CLONE);
 
 	TRACEME(("dclone returns 0x%"UVxf, PTR2UV(out)));
 
@@ -6014,7 +6064,7 @@ MODULE = Storable	PACKAGE = Storable
 PROTOTYPES: ENABLE
 
 BOOT:
-    init_perinterp();
+    init_perinterp(aTHX);
     gv_fetchpv("Storable::drop_utf8",   GV_ADDMULTI, SVt_PV);
 #ifdef DEBUGME
     /* Only disable the used only once warning if we are in debugging mode.  */
@@ -6026,42 +6076,84 @@ BOOT:
 
 void
 init_perinterp()
+ CODE:
+  init_perinterp(aTHX);
 
 int
 pstore(f,obj)
 OutputStream	f
 SV *	obj
+ CODE:
+  RETVAL = pstore(aTHX_ f, obj);
+ OUTPUT:
+  RETVAL
 
 int
 net_pstore(f,obj)
 OutputStream	f
 SV *	obj
+ CODE:
+  RETVAL = net_pstore(aTHX_ f, obj);
+ OUTPUT:
+  RETVAL
 
 SV *
 mstore(obj)
 SV *	obj
+ CODE:
+  RETVAL = mstore(aTHX_ obj);
+ OUTPUT:
+  RETVAL
 
 SV *
 net_mstore(obj)
 SV *	obj
+ CODE:
+  RETVAL = net_mstore(aTHX_ obj);
+ OUTPUT:
+  RETVAL
 
 SV *
 pretrieve(f)
 InputStream	f
+ CODE:
+  RETVAL = pretrieve(aTHX_ f);
+ OUTPUT:
+  RETVAL
 
 SV *
 mretrieve(sv)
 SV *	sv
+ CODE:
+  RETVAL = mretrieve(aTHX_ sv);
+ OUTPUT:
+  RETVAL
 
 SV *
 dclone(sv)
 SV *	sv
+ CODE:
+  RETVAL = dclone(aTHX_ sv);
+ OUTPUT:
+  RETVAL
 
 int
 last_op_in_netorder()
+ CODE:
+  RETVAL = last_op_in_netorder(aTHX);
+ OUTPUT:
+  RETVAL
 
 int
 is_storing()
+ CODE:
+  RETVAL = is_storing(aTHX);
+ OUTPUT:
+  RETVAL
 
 int
 is_retrieving()
+ CODE:
+  RETVAL = is_retrieving(aTHX);
+ OUTPUT:
+  RETVAL
diff --git a/ext/Storable/ppport.h b/ext/Storable/ppport.h
new file mode 100644
index 0000000..9b04376
--- /dev/null
+++ b/ext/Storable/ppport.h
@@ -0,0 +1,1098 @@
+
+/* ppport.h -- Perl/Pollution/Portability Version 2.011_01 
+ *
+ * Automatically Created by Devel::PPPort on Thu Mar 18 11:06:48 2004 
+ *
+ * Do NOT edit this file directly! -- Edit PPPort.pm instead.
+ *
+ * Version 2.x, Copyright (C) 2001, Paul Marquess.
+ * Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
+ * This code may be used and distributed under the same license as any
+ * version of Perl.
+ * 
+ * This version of ppport.h is designed to support operation with Perl
+ * installations back to 5.004, and has been tested up to 5.8.1.
+ *
+ * If this version of ppport.h is failing during the compilation of this
+ * module, please check if a newer version of Devel::PPPort is available
+ * on CPAN before sending a bug report.
+ *
+ * If you are using the latest version of Devel::PPPort and it is failing
+ * during compilation of this module, please send a report to perlbug@perl.com
+ *
+ * Include all following information:
+ *
+ *  1. The complete output from running "perl -V"
+ *
+ *  2. This file.
+ *
+ *  3. The name & version of the module you were trying to build.
+ *
+ *  4. A full log of the build that failed.
+ *
+ *  5. Any other information that you think could be relevant.
+ *
+ *
+ * For the latest version of this code, please retreive the Devel::PPPort
+ * module from CPAN.
+ * 
+ */
+
+/*
+ * In order for a Perl extension module to be as portable as possible
+ * across differing versions of Perl itself, certain steps need to be taken.
+ * Including this header is the first major one, then using dTHR is all the
+ * appropriate places and using a PL_ prefix to refer to global Perl
+ * variables is the second.
+ *
+ */
+
+
+/* If you use one of a few functions that were not present in earlier
+ * versions of Perl, please add a define before the inclusion of ppport.h
+ * for a static include, or use the GLOBAL request in a single module to
+ * produce a global definition that can be referenced from the other
+ * modules.
+ * 
+ * Function:            Static define:           Extern define:
+ * newCONSTSUB()        NEED_newCONSTSUB         NEED_newCONSTSUB_GLOBAL
+ *
+ */
+ 
+
+/* To verify whether ppport.h is needed for your module, and whether any
+ * special defines should be used, ppport.h can be run through Perl to check
+ * your source code. Simply say:
+ * 
+ * 	perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc]
+ * 
+ * The result will be a list of patches suggesting changes that should at
+ * least be acceptable, if not necessarily the most efficient solution, or a
+ * fix for all possible problems. It won't catch where dTHR is needed, and
+ * doesn't attempt to account for global macro or function definitions,
+ * nested includes, typemaps, etc.
+ * 
+ * In order to test for the need of dTHR, please try your module under a
+ * recent version of Perl that has threading compiled-in.
+ *
+ */ 
+
+
+/*
+#!/usr/bin/perl
+@ARGV = ("*.xs") if !@ARGV;
+%badmacros = %funcs = %macros = (); $replace = 0;
+foreach (<DATA>) {
+	$funcs{$1} = 1 if /Provide:\s+(\S+)/;
+	$macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
+	$replace = $1 if /Replace:\s+(\d+)/;
+	$badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/;
+	$badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
+}
+foreach $filename (map(glob($_),@ARGV)) {
+	unless (open(IN, "<$filename")) {
+		warn "Unable to read from $file: $!\n";
+		next;
+	}
+	print "Scanning $filename...\n";
+	$c = ""; while (<IN>) { $c .= $_; } close(IN);
+	$need_include = 0; %add_func = (); $changes = 0;
+	$has_include = ($c =~ /#.*include.*ppport/m);
+
+	foreach $func (keys %funcs) {
+		if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) {
+			if ($c !~ /\b$func\b/m) {
+				print "If $func isn't needed, you don't need to request it.\n" if
+				$changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m);
+			} else {
+				print "Uses $func\n";
+				$need_include = 1;
+			}
+		} else {
+			if ($c =~ /\b$func\b/m) {
+				$add_func{$func} =1 ;
+				print "Uses $func\n";
+				$need_include = 1;
+			}
+		}
+	}
+
+	if (not $need_include) {
+		foreach $macro (keys %macros) {
+			if ($c =~ /\b$macro\b/m) {
+				print "Uses $macro\n";
+				$need_include = 1;
+			}
+		}
+	}
+
+	foreach $badmacro (keys %badmacros) {
+		if ($c =~ /\b$badmacro\b/m) {
+			$changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm);
+			print "Uses $badmacros{$badmacro} (instead of $badmacro)\n";
+			$need_include = 1;
+		}
+	}
+	
+	if (scalar(keys %add_func) or $need_include != $has_include) {
+		if (!$has_include) {
+			$inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
+			       "#include \"ppport.h\"\n";
+			$c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m;
+		} elsif (keys %add_func) {
+			$inc = join('',map("#define NEED_$_\n", sort keys %add_func));
+			$c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m;
+		}
+		if (!$need_include) {
+			print "Doesn't seem to need ppport.h.\n";
+			$c =~ s/^.*#.*include.*ppport.*\n//m;
+		}
+		$changes++;
+	}
+	
+	if ($changes) {
+		open(OUT,"ppport.h.$$");
+		print OUT $c;
+		close(OUT);
+		open(DIFF, "diff -u $filename ppport.h.$$|");
+		while (<DIFF>) { s!ppport\.h\.$$!$filename.patched!; print STDOUT; }
+		close(DIFF);
+		unlink("ppport.h.$$");
+	} else {
+		print "Looks OK\n";
+	}
+}
+__DATA__
+*/
+
+#ifndef _P_P_PORTABILITY_H_
+#define _P_P_PORTABILITY_H_
+
+#ifndef PERL_REVISION
+#   ifndef __PATCHLEVEL_H_INCLUDED__
+#       define PERL_PATCHLEVEL_H_IMPLICIT
+#       include <patchlevel.h>
+#   endif
+#   if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
+#       include <could_not_find_Perl_patchlevel.h>
+#   endif
+#   ifndef PERL_REVISION
+#	define PERL_REVISION	(5)
+        /* Replace: 1 */
+#       define PERL_VERSION	PATCHLEVEL
+#       define PERL_SUBVERSION	SUBVERSION
+        /* Replace PERL_PATCHLEVEL with PERL_VERSION */
+        /* Replace: 0 */
+#   endif
+#endif
+
+#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
+
+/* It is very unlikely that anyone will try to use this with Perl 6 
+   (or greater), but who knows.
+ */
+#if PERL_REVISION != 5
+#	error ppport.h only works with Perl version 5
+#endif /* PERL_REVISION != 5 */
+
+#ifndef ERRSV
+#	define ERRSV perl_get_sv("@",FALSE)
+#endif
+
+#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
+/* Replace: 1 */
+#	define PL_Sv		Sv
+#	define PL_compiling	compiling
+#	define PL_copline	copline
+#	define PL_curcop	curcop
+#	define PL_curstash	curstash
+#	define PL_defgv		defgv
+#	define PL_dirty		dirty
+#	define PL_dowarn	dowarn
+#	define PL_hints		hints
+#	define PL_na		na
+#	define PL_perldb	perldb
+#	define PL_rsfp_filters	rsfp_filters
+#	define PL_rsfpv		rsfp
+#	define PL_stdingv	stdingv
+#	define PL_sv_no		sv_no
+#	define PL_sv_undef	sv_undef
+#	define PL_sv_yes	sv_yes
+/* Replace: 0 */
+#endif
+
+#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
+
+#ifndef dNOOP
+#  define NOOP (void)0
+#  define dNOOP extern int Perl___notused PERL_UNUSED_DECL
+#endif
+
+#ifndef dTHR
+#  define dTHR          dNOOP
+#endif
+
+#ifndef dTHX
+#  define dTHX          dNOOP
+#  define dTHXa(x)      dNOOP
+#  define dTHXoa(x)     dNOOP
+#endif
+
+#ifndef pTHX
+#    define pTHX	void
+#    define pTHX_
+#    define aTHX
+#    define aTHX_
+#endif         
+
+#ifndef dAX
+#   define dAX I32 ax = MARK - PL_stack_base + 1
+#endif
+#ifndef dITEMS
+#   define dITEMS I32 items = SP - MARK
+#endif
+
+/* IV could also be a quad (say, a long long), but Perls
+ * capable of those should have IVSIZE already. */
+#if !defined(IVSIZE) && defined(LONGSIZE)
+#   define IVSIZE LONGSIZE
+#endif
+#ifndef IVSIZE
+#   define IVSIZE 4 /* A bold guess, but the best we can make. */
+#endif
+
+#ifndef UVSIZE
+#   define UVSIZE IVSIZE
+#endif
+
+#ifndef NVTYPE
+#   if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
+#       define NVTYPE long double
+#   else
+#       define NVTYPE double
+#   endif
+typedef NVTYPE NV;
+#endif
+
+#ifndef INT2PTR
+
+#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
+#  define PTRV                  UV
+#  define INT2PTR(any,d)        (any)(d)
+#else
+#  if PTRSIZE == LONGSIZE
+#    define PTRV                unsigned long
+#  else
+#    define PTRV                unsigned
+#  endif
+#  define INT2PTR(any,d)        (any)(PTRV)(d)
+#endif
+#define NUM2PTR(any,d)  (any)(PTRV)(d)
+#define PTR2IV(p)       INT2PTR(IV,p)
+#define PTR2UV(p)       INT2PTR(UV,p)
+#define PTR2NV(p)       NUM2PTR(NV,p)
+#if PTRSIZE == LONGSIZE
+#  define PTR2ul(p)     (unsigned long)(p)
+#else
+#  define PTR2ul(p)     INT2PTR(unsigned long,p)        
+#endif
+
+#endif /* !INT2PTR */
+
+#ifndef boolSV
+#	define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
+#endif
+
+#ifndef gv_stashpvn
+#	define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
+#endif
+
+#ifndef newSVpvn
+#	define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
+#endif
+
+#ifndef newRV_inc
+/* Replace: 1 */
+#	define newRV_inc(sv) newRV(sv)
+/* Replace: 0 */
+#endif
+
+/* DEFSV appears first in 5.004_56 */
+#ifndef DEFSV
+#  define DEFSV	GvSV(PL_defgv)
+#endif
+
+#ifndef SAVE_DEFSV
+#    define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
+#endif
+
+#ifndef newRV_noinc
+#  ifdef __GNUC__
+#    define newRV_noinc(sv)               \
+      ({                                  \
+          SV *nsv = (SV*)newRV(sv);       \
+          SvREFCNT_dec(sv);               \
+          nsv;                            \
+      })
+#  else
+#    if defined(USE_THREADS)
+static SV * newRV_noinc (SV * sv)
+{
+          SV *nsv = (SV*)newRV(sv);       
+          SvREFCNT_dec(sv);               
+          return nsv;                     
+}
+#    else
+#      define newRV_noinc(sv)    \
+        (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
+#    endif
+#  endif
+#endif
+
+/* Provide: newCONSTSUB */
+
+/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
+#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
+
+#if defined(NEED_newCONSTSUB)
+static
+#else
+extern void newCONSTSUB(HV * stash, char * name, SV *sv);
+#endif
+
+#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
+void
+newCONSTSUB(stash,name,sv)
+HV *stash;
+char *name;
+SV *sv;
+{
+	U32 oldhints = PL_hints;
+	HV *old_cop_stash = PL_curcop->cop_stash;
+	HV *old_curstash = PL_curstash;
+	line_t oldline = PL_curcop->cop_line;
+	PL_curcop->cop_line = PL_copline;
+
+	PL_hints &= ~HINT_BLOCK_SCOPE;
+	if (stash)
+		PL_curstash = PL_curcop->cop_stash = stash;
+
+	newSUB(
+
+#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
+     /* before 5.003_22 */
+		start_subparse(),
+#else
+#  if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
+     /* 5.003_22 */
+     		start_subparse(0),
+#  else
+     /* 5.003_23  onwards */
+     		start_subparse(FALSE, 0),
+#  endif
+#endif
+
+		newSVOP(OP_CONST, 0, newSVpv(name,0)),
+		newSVOP(OP_CONST, 0, &PL_sv_no),   /* SvPV(&PL_sv_no) == "" -- GMB */
+		newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
+	);
+
+	PL_hints = oldhints;
+	PL_curcop->cop_stash = old_cop_stash;
+	PL_curstash = old_curstash;
+	PL_curcop->cop_line = oldline;
+}
+#endif
+
+#endif /* newCONSTSUB */
+
+#ifndef START_MY_CXT
+
+/*
+ * Boilerplate macros for initializing and accessing interpreter-local
+ * data from C.  All statics in extensions should be reworked to use
+ * this, if you want to make the extension thread-safe.  See ext/re/re.xs
+ * for an example of the use of these macros.
+ *
+ * Code that uses these macros is responsible for the following:
+ * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
+ * 2. Declare a typedef named my_cxt_t that is a structure that contains
+ *    all the data that needs to be interpreter-local.
+ * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
+ * 4. Use the MY_CXT_INIT macro such that it is called exactly once
+ *    (typically put in the BOOT: section).
+ * 5. Use the members of the my_cxt_t structure everywhere as
+ *    MY_CXT.member.
+ * 6. Use the dMY_CXT macro (a declaration) in all the functions that
+ *    access MY_CXT.
+ */
+
+#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
+    defined(PERL_CAPI)    || defined(PERL_IMPLICIT_CONTEXT)
+
+/* This must appear in all extensions that define a my_cxt_t structure,
+ * right after the definition (i.e. at file scope).  The non-threads
+ * case below uses it to declare the data as static. */
+#define START_MY_CXT
+
+#if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
+/* Fetches the SV that keeps the per-interpreter data. */
+#define dMY_CXT_SV \
+	SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
+#else /* >= perl5.004_68 */
+#define dMY_CXT_SV \
+	SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY,		\
+				  sizeof(MY_CXT_KEY)-1, TRUE)
+#endif /* < perl5.004_68 */
+
+/* This declaration should be used within all functions that use the
+ * interpreter-local data. */
+#define dMY_CXT	\
+	dMY_CXT_SV;							\
+	my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
+
+/* Creates and zeroes the per-interpreter data.
+ * (We allocate my_cxtp in a Perl SV so that it will be released when
+ * the interpreter goes away.) */
+#define MY_CXT_INIT \
+	dMY_CXT_SV;							\
+	/* newSV() allocates one more than needed */			\
+	my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+	Zero(my_cxtp, 1, my_cxt_t);					\
+	sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+
+/* This macro must be used to access members of the my_cxt_t structure.
+ * e.g. MYCXT.some_data */
+#define MY_CXT		(*my_cxtp)
+
+/* Judicious use of these macros can reduce the number of times dMY_CXT
+ * is used.  Use is similar to pTHX, aTHX etc. */
+#define pMY_CXT		my_cxt_t *my_cxtp
+#define pMY_CXT_	pMY_CXT,
+#define _pMY_CXT	,pMY_CXT
+#define aMY_CXT		my_cxtp
+#define aMY_CXT_	aMY_CXT,
+#define _aMY_CXT	,aMY_CXT
+
+#else /* single interpreter */
+
+#define START_MY_CXT	static my_cxt_t my_cxt;
+#define dMY_CXT_SV	dNOOP
+#define dMY_CXT		dNOOP
+#define MY_CXT_INIT	NOOP
+#define MY_CXT		my_cxt
+
+#define pMY_CXT		void
+#define pMY_CXT_
+#define _pMY_CXT
+#define aMY_CXT
+#define aMY_CXT_
+#define _aMY_CXT
+
+#endif 
+
+#endif /* START_MY_CXT */
+
+#ifndef IVdf
+#  if IVSIZE == LONGSIZE
+#       define	IVdf		"ld"
+#       define	UVuf		"lu"
+#       define	UVof		"lo"
+#       define	UVxf		"lx"
+#       define	UVXf		"lX"
+#   else
+#       if IVSIZE == INTSIZE
+#           define	IVdf	"d"
+#           define	UVuf	"u"
+#           define	UVof	"o"
+#           define	UVxf	"x"
+#           define	UVXf	"X"
+#       endif
+#   endif
+#endif
+
+#ifndef NVef
+#   if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
+	defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ 
+#       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 AvFILLp			/* Older perls (<=5.003) lack AvFILLp */
+#   define AvFILLp AvFILL
+#endif
+
+#ifdef SvPVbyte
+#   if PERL_REVISION == 5 && PERL_VERSION < 7
+       /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
+#       undef SvPVbyte
+#       define SvPVbyte(sv, lp) \
+          ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
+           ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
+       static char *
+       my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
+       {   
+           sv_utf8_downgrade(sv,0);
+           return SvPV(sv,*lp);
+       }
+#   endif
+#else
+#   define SvPVbyte SvPV
+#endif
+
+#ifndef SvPV_nolen
+#   define SvPV_nolen(sv) \
+        ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+         ? SvPVX(sv) : sv_2pv_nolen(sv))
+    static char *
+    sv_2pv_nolen(pTHX_ register SV *sv)
+    {   
+        STRLEN n_a;
+        return sv_2pv(sv, &n_a);
+    }
+#endif
+
+#ifndef get_cv
+#   define get_cv(name,create) perl_get_cv(name,create)
+#endif
+
+#ifndef get_sv
+#   define get_sv(name,create) perl_get_sv(name,create)
+#endif
+
+#ifndef get_av
+#   define get_av(name,create) perl_get_av(name,create)
+#endif
+
+#ifndef get_hv
+#   define get_hv(name,create) perl_get_hv(name,create)
+#endif
+
+#ifndef call_argv
+#   define call_argv perl_call_argv
+#endif
+
+#ifndef call_method
+#   define call_method perl_call_method
+#endif
+
+#ifndef call_pv
+#   define call_pv perl_call_pv
+#endif
+
+#ifndef call_sv
+#   define call_sv perl_call_sv
+#endif
+
+#ifndef eval_pv
+#   define eval_pv perl_eval_pv
+#endif
+
+#ifndef eval_sv
+#   define eval_sv perl_eval_sv
+#endif
+
+#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
+#   define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
+#endif
+
+#ifndef PERL_SCAN_SILENT_ILLDIGIT
+#   define PERL_SCAN_SILENT_ILLDIGIT 0x04
+#endif
+
+#ifndef PERL_SCAN_ALLOW_UNDERSCORES
+#   define PERL_SCAN_ALLOW_UNDERSCORES 0x01
+#endif
+
+#ifndef PERL_SCAN_DISALLOW_PREFIX
+#   define PERL_SCAN_DISALLOW_PREFIX 0x02
+#endif
+
+#if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1))
+#define I32_CAST
+#else
+#define I32_CAST (I32*)
+#endif
+
+#ifndef grok_hex
+static UV _grok_hex (pTHX_ char *string, STRLEN *len, I32 *flags, NV *result) {
+    NV r = scan_hex(string, *len, I32_CAST len);
+    if (r > UV_MAX) {
+        *flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
+        if (result) *result = r;
+        return UV_MAX;
+    }
+    return (UV)r;
+}
+        
+#   define grok_hex(string, len, flags, result)     \
+        _grok_hex(pTHX_ (string), (len), (flags), (result))
+#endif 
+
+#ifndef grok_oct
+static UV _grok_oct (pTHX_ char *string, STRLEN *len, I32 *flags, NV *result) {
+    NV r = scan_oct(string, *len, I32_CAST len);
+    if (r > UV_MAX) {
+        *flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
+        if (result) *result = r;
+        return UV_MAX;
+    }
+    return (UV)r;
+}
+
+#   define grok_oct(string, len, flags, result)     \
+        _grok_oct(pTHX_ (string), (len), (flags), (result))
+#endif
+
+#if !defined(grok_bin) && defined(scan_bin)
+static UV _grok_bin (pTHX_ char *string, STRLEN *len, I32 *flags, NV *result) {
+    NV r = scan_bin(string, *len, I32_CAST len);
+    if (r > UV_MAX) {
+        *flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
+        if (result) *result = r;
+        return UV_MAX;
+    }
+    return (UV)r;
+}
+
+#   define grok_bin(string, len, flags, result)     \
+        _grok_bin(pTHX_ (string), (len), (flags), (result))
+#endif
+
+#ifndef IN_LOCALE
+#   define IN_LOCALE \
+	(PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
+#endif
+
+#ifndef IN_LOCALE_RUNTIME
+#   define IN_LOCALE_RUNTIME   (PL_curcop->op_private & HINT_LOCALE)
+#endif
+
+#ifndef IN_LOCALE_COMPILETIME
+#   define IN_LOCALE_COMPILETIME   (PL_hints & HINT_LOCALE)
+#endif
+
+
+#ifndef IS_NUMBER_IN_UV
+#   define IS_NUMBER_IN_UV		            0x01   
+#   define IS_NUMBER_GREATER_THAN_UV_MAX    0x02
+#   define IS_NUMBER_NOT_INT	            0x04
+#   define IS_NUMBER_NEG		            0x08
+#   define IS_NUMBER_INFINITY	            0x10 
+#   define IS_NUMBER_NAN                    0x20  
+#endif
+   
+#ifndef grok_numeric_radix
+#   define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(aTHX_ sp, send)
+
+#define grok_numeric_radix Perl_grok_numeric_radix
+    
+static
+bool
+Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
+{
+#ifdef USE_LOCALE_NUMERIC
+#if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1))
+    if (PL_numeric_radix_sv && IN_LOCALE) { 
+        STRLEN len;
+        char* radix = SvPV(PL_numeric_radix_sv, len);
+        if (*sp + len <= send && memEQ(*sp, radix, len)) {
+            *sp += len;
+            return TRUE; 
+        }
+    }
+#else
+    /* pre5.6.0 perls don't have PL_numeric_radix_sv so the radix
+     * must manually be requested from locale.h */
+#include <locale.h>
+    struct lconv *lc = localeconv();
+    char *radix = lc->decimal_point;
+    if (radix && IN_LOCALE) { 
+        STRLEN len = strlen(radix);
+        if (*sp + len <= send && memEQ(*sp, radix, len)) {
+            *sp += len;
+            return TRUE; 
+        }
+    }
+#endif /* PERL_VERSION */
+#endif /* USE_LOCALE_NUMERIC */
+    /* always try "." if numeric radix didn't match because
+     * we may have data from different locales mixed */
+    if (*sp < send && **sp == '.') {
+        ++*sp;
+        return TRUE;
+    }
+    return FALSE;
+}
+#endif /* grok_numeric_radix */
+
+#ifndef grok_number
+
+#define grok_number Perl_grok_number
+
+static
+int
+Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
+{
+  const char *s = pv;
+  const char *send = pv + len;
+  const UV max_div_10 = UV_MAX / 10;
+  const char max_mod_10 = UV_MAX % 10;
+  int numtype = 0;
+  int sawinf = 0;
+  int sawnan = 0;
+
+  while (s < send && isSPACE(*s))
+    s++;
+  if (s == send) {
+    return 0;
+  } else if (*s == '-') {
+    s++;
+    numtype = IS_NUMBER_NEG;
+  }
+  else if (*s == '+')
+  s++;
+
+  if (s == send)
+    return 0;
+
+  /* next must be digit or the radix separator or beginning of infinity */
+  if (isDIGIT(*s)) {
+    /* UVs are at least 32 bits, so the first 9 decimal digits cannot
+       overflow.  */
+    UV value = *s - '0';
+    /* This construction seems to be more optimiser friendly.
+       (without it gcc does the isDIGIT test and the *s - '0' separately)
+       With it gcc on arm is managing 6 instructions (6 cycles) per digit.
+       In theory the optimiser could deduce how far to unroll the loop
+       before checking for overflow.  */
+    if (++s < send) {
+      int digit = *s - '0';
+      if (digit >= 0 && digit <= 9) {
+        value = value * 10 + digit;
+        if (++s < send) {
+          digit = *s - '0';
+          if (digit >= 0 && digit <= 9) {
+            value = value * 10 + digit;
+            if (++s < send) {
+              digit = *s - '0';
+              if (digit >= 0 && digit <= 9) {
+                value = value * 10 + digit;
+		        if (++s < send) {
+                  digit = *s - '0';
+                  if (digit >= 0 && digit <= 9) {
+                    value = value * 10 + digit;
+                    if (++s < send) {
+                      digit = *s - '0';
+                      if (digit >= 0 && digit <= 9) {
+                        value = value * 10 + digit;
+                        if (++s < send) {
+                          digit = *s - '0';
+                          if (digit >= 0 && digit <= 9) {
+                            value = value * 10 + digit;
+                            if (++s < send) {
+                              digit = *s - '0';
+                              if (digit >= 0 && digit <= 9) {
+                                value = value * 10 + digit;
+                                if (++s < send) {
+                                  digit = *s - '0';
+                                  if (digit >= 0 && digit <= 9) {
+                                    value = value * 10 + digit;
+                                    if (++s < send) {
+                                      /* Now got 9 digits, so need to check
+                                         each time for overflow.  */
+                                      digit = *s - '0';
+                                      while (digit >= 0 && digit <= 9
+                                             && (value < max_div_10
+                                                 || (value == max_div_10
+                                                     && digit <= max_mod_10))) {
+                                        value = value * 10 + digit;
+                                        if (++s < send)
+                                          digit = *s - '0';
+                                        else
+                                          break;
+                                      }
+                                      if (digit >= 0 && digit <= 9
+                                          && (s < send)) {
+                                        /* value overflowed.
+                                           skip the remaining digits, don't
+                                           worry about setting *valuep.  */
+                                        do {
+                                          s++;
+                                        } while (s < send && isDIGIT(*s));
+                                        numtype |=
+                                          IS_NUMBER_GREATER_THAN_UV_MAX;
+                                        goto skip_value;
+                                      }
+                                    }
+                                  }
+				                }
+                              }
+                            }
+                          }
+                        }
+                      }
+                    }
+                  }
+                }
+              }
+            }
+          }
+	    }
+      }
+    }
+    numtype |= IS_NUMBER_IN_UV;
+    if (valuep)
+      *valuep = value;
+
+  skip_value:
+    if (GROK_NUMERIC_RADIX(&s, send)) {
+      numtype |= IS_NUMBER_NOT_INT;
+      while (s < send && isDIGIT(*s))  /* optional digits after the radix */
+        s++;
+    }
+  }
+  else if (GROK_NUMERIC_RADIX(&s, send)) {
+    numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
+    /* no digits before the radix means we need digits after it */
+    if (s < send && isDIGIT(*s)) {
+      do {
+        s++;
+      } while (s < send && isDIGIT(*s));
+      if (valuep) {
+        /* integer approximation is valid - it's 0.  */
+        *valuep = 0;
+      }
+    }
+    else
+      return 0;
+  } else if (*s == 'I' || *s == 'i') {
+    s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
+    s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
+    s++; if (s < send && (*s == 'I' || *s == 'i')) {
+      s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
+      s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
+      s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
+      s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
+      s++;
+    }
+    sawinf = 1;
+  } else if (*s == 'N' || *s == 'n') {
+    /* XXX TODO: There are signaling NaNs and quiet NaNs. */
+    s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
+    s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
+    s++;
+    sawnan = 1;
+  } else
+    return 0;
+
+  if (sawinf) {
+    numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
+    numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
+  } else if (sawnan) {
+    numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
+    numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
+  } else if (s < send) {
+    /* we can have an optional exponent part */
+    if (*s == 'e' || *s == 'E') {
+      /* The only flag we keep is sign.  Blow away any "it's UV"  */
+      numtype &= IS_NUMBER_NEG;
+      numtype |= IS_NUMBER_NOT_INT;
+      s++;
+      if (s < send && (*s == '-' || *s == '+'))
+        s++;
+      if (s < send && isDIGIT(*s)) {
+        do {
+          s++;
+        } while (s < send && isDIGIT(*s));
+      }
+      else
+      return 0;
+    }
+  }
+  while (s < send && isSPACE(*s))
+    s++;
+  if (s >= send)
+    return numtype;
+  if (len == 10 && memEQ(pv, "0 but true", 10)) {
+    if (valuep)
+      *valuep = 0;
+    return IS_NUMBER_IN_UV;
+  }
+  return 0;
+}
+#endif /* grok_number */
+
+#ifndef PERL_MAGIC_sv
+#   define PERL_MAGIC_sv             '\0'
+#endif
+
+#ifndef PERL_MAGIC_overload
+#   define PERL_MAGIC_overload       'A'
+#endif
+
+#ifndef PERL_MAGIC_overload_elem
+#   define PERL_MAGIC_overload_elem  'a'
+#endif
+
+#ifndef PERL_MAGIC_overload_table
+#   define PERL_MAGIC_overload_table 'c'
+#endif
+
+#ifndef PERL_MAGIC_bm
+#   define PERL_MAGIC_bm             'B'
+#endif
+
+#ifndef PERL_MAGIC_regdata
+#   define PERL_MAGIC_regdata        'D'
+#endif
+
+#ifndef PERL_MAGIC_regdatum
+#   define PERL_MAGIC_regdatum       'd'
+#endif
+
+#ifndef PERL_MAGIC_env
+#   define PERL_MAGIC_env            'E'
+#endif
+
+#ifndef PERL_MAGIC_envelem
+#   define PERL_MAGIC_envelem        'e'
+#endif
+
+#ifndef PERL_MAGIC_fm
+#   define PERL_MAGIC_fm             'f'
+#endif
+
+#ifndef PERL_MAGIC_regex_global
+#   define PERL_MAGIC_regex_global   'g'
+#endif
+
+#ifndef PERL_MAGIC_isa
+#   define PERL_MAGIC_isa            'I'
+#endif
+
+#ifndef PERL_MAGIC_isaelem
+#   define PERL_MAGIC_isaelem        'i'
+#endif
+
+#ifndef PERL_MAGIC_nkeys
+#   define PERL_MAGIC_nkeys          'k'
+#endif
+
+#ifndef PERL_MAGIC_dbfile
+#   define PERL_MAGIC_dbfile         'L'
+#endif
+
+#ifndef PERL_MAGIC_dbline
+#   define PERL_MAGIC_dbline         'l'
+#endif
+
+#ifndef PERL_MAGIC_mutex
+#   define PERL_MAGIC_mutex          'm'
+#endif
+
+#ifndef PERL_MAGIC_shared
+#   define PERL_MAGIC_shared         'N'
+#endif
+
+#ifndef PERL_MAGIC_shared_scalar
+#   define PERL_MAGIC_shared_scalar  'n'
+#endif
+
+#ifndef PERL_MAGIC_collxfrm
+#   define PERL_MAGIC_collxfrm       'o'
+#endif
+
+#ifndef PERL_MAGIC_tied
+#   define PERL_MAGIC_tied           'P'
+#endif
+
+#ifndef PERL_MAGIC_tiedelem
+#   define PERL_MAGIC_tiedelem       'p'
+#endif
+
+#ifndef PERL_MAGIC_tiedscalar
+#   define PERL_MAGIC_tiedscalar     'q'
+#endif
+
+#ifndef PERL_MAGIC_qr
+#   define PERL_MAGIC_qr             'r'
+#endif
+
+#ifndef PERL_MAGIC_sig
+#   define PERL_MAGIC_sig            'S'
+#endif
+
+#ifndef PERL_MAGIC_sigelem
+#   define PERL_MAGIC_sigelem        's'
+#endif
+
+#ifndef PERL_MAGIC_taint
+#   define PERL_MAGIC_taint          't'
+#endif
+
+#ifndef PERL_MAGIC_uvar
+#   define PERL_MAGIC_uvar           'U'
+#endif
+
+#ifndef PERL_MAGIC_uvar_elem
+#   define PERL_MAGIC_uvar_elem      'u'
+#endif
+
+#ifndef PERL_MAGIC_vstring
+#   define PERL_MAGIC_vstring        'V'
+#endif
+
+#ifndef PERL_MAGIC_vec
+#   define PERL_MAGIC_vec            'v'
+#endif
+
+#ifndef PERL_MAGIC_utf8
+#   define PERL_MAGIC_utf8           'w'
+#endif
+
+#ifndef PERL_MAGIC_substr
+#   define PERL_MAGIC_substr         'x'
+#endif
+
+#ifndef PERL_MAGIC_defelem
+#   define PERL_MAGIC_defelem        'y'
+#endif
+
+#ifndef PERL_MAGIC_glob
+#   define PERL_MAGIC_glob           '*'
+#endif
+
+#ifndef PERL_MAGIC_arylen
+#   define PERL_MAGIC_arylen         '#'
+#endif
+
+#ifndef PERL_MAGIC_pos
+#   define PERL_MAGIC_pos            '.'
+#endif
+
+#ifndef PERL_MAGIC_backref
+#   define PERL_MAGIC_backref        '<'
+#endif
+
+#ifndef PERL_MAGIC_ext
+#   define PERL_MAGIC_ext            '~'
+#endif
+
+#endif /* _P_P_PORTABILITY_H_ */
+
+/* End of File ppport.h */