Initial revision

CVS patchset: 5213
CVS date: 2001/12/06 00:07:07

3 files changed, 825 insertions, 0 deletions

diff --git a/db/perl/DB_File/fallback.h b/db/perl/DB_File/fallback.h
new file mode 100644
index 000000000..0213308a0
--- /dev/null
+++ b/db/perl/DB_File/fallback.h
@@ -0,0 +1,455 @@
+#define PERL_constant_NOTFOUND	1
+#define PERL_constant_NOTDEF	2
+#define PERL_constant_ISIV	3
+#define PERL_constant_ISNO	4
+#define PERL_constant_ISNV	5
+#define PERL_constant_ISPV	6
+#define PERL_constant_ISPVN	7
+#define PERL_constant_ISSV	8
+#define PERL_constant_ISUNDEF	9
+#define PERL_constant_ISUV	10
+#define PERL_constant_ISYES	11
+
+#ifndef NVTYPE
+typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it.  */
+#endif
+#ifndef aTHX_
+#define aTHX_ /* 5.6 or later define this for threading support.  */
+#endif
+#ifndef pTHX_
+#define pTHX_ /* 5.6 or later define this for threading support.  */
+#endif
+
+static int
+constant_6 (pTHX_ const char *name, IV *iv_return) {
+  /* When generated this function returned values for the list of names given
+     here.  However, subsequent manual editing may have added or removed some.
+     DB_TXN R_LAST R_NEXT R_PREV */
+  /* Offset 2 gives the best switch position.  */
+  switch (name[2]) {
+  case 'L':
+    if (memEQ(name, "R_LAST", 6)) {
+    /*                 ^         */
+#ifdef R_LAST
+      *iv_return = R_LAST;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'N':
+    if (memEQ(name, "R_NEXT", 6)) {
+    /*                 ^         */
+#ifdef R_NEXT
+      *iv_return = R_NEXT;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'P':
+    if (memEQ(name, "R_PREV", 6)) {
+    /*                 ^         */
+#ifdef R_PREV
+      *iv_return = R_PREV;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case '_':
+    if (memEQ(name, "DB_TXN", 6)) {
+    /*                 ^         */
+#ifdef DB_TXN
+      *iv_return = DB_TXN;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
+static int
+constant_7 (pTHX_ const char *name, IV *iv_return) {
+  /* When generated this function returned values for the list of names given
+     here.  However, subsequent manual editing may have added or removed some.
+     DB_LOCK R_FIRST R_NOKEY */
+  /* Offset 3 gives the best switch position.  */
+  switch (name[3]) {
+  case 'I':
+    if (memEQ(name, "R_FIRST", 7)) {
+    /*                  ^         */
+#ifdef R_FIRST
+      *iv_return = R_FIRST;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'L':
+    if (memEQ(name, "DB_LOCK", 7)) {
+    /*                  ^         */
+#ifdef DB_LOCK
+      *iv_return = DB_LOCK;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'O':
+    if (memEQ(name, "R_NOKEY", 7)) {
+    /*                  ^         */
+#ifdef R_NOKEY
+      *iv_return = R_NOKEY;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
+static int
+constant_8 (pTHX_ const char *name, IV *iv_return) {
+  /* When generated this function returned values for the list of names given
+     here.  However, subsequent manual editing may have added or removed some.
+     DB_SHMEM R_CURSOR R_IAFTER */
+  /* Offset 5 gives the best switch position.  */
+  switch (name[5]) {
+  case 'M':
+    if (memEQ(name, "DB_SHMEM", 8)) {
+    /*                    ^        */
+#ifdef DB_SHMEM
+      *iv_return = DB_SHMEM;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'S':
+    if (memEQ(name, "R_CURSOR", 8)) {
+    /*                    ^        */
+#ifdef R_CURSOR
+      *iv_return = R_CURSOR;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'T':
+    if (memEQ(name, "R_IAFTER", 8)) {
+    /*                    ^        */
+#ifdef R_IAFTER
+      *iv_return = R_IAFTER;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
+static int
+constant_9 (pTHX_ const char *name, IV *iv_return) {
+  /* When generated this function returned values for the list of names given
+     here.  However, subsequent manual editing may have added or removed some.
+     HASHMAGIC RET_ERROR R_IBEFORE */
+  /* Offset 7 gives the best switch position.  */
+  switch (name[7]) {
+  case 'I':
+    if (memEQ(name, "HASHMAGIC", 9)) {
+    /*                      ^       */
+#ifdef HASHMAGIC
+      *iv_return = HASHMAGIC;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'O':
+    if (memEQ(name, "RET_ERROR", 9)) {
+    /*                      ^       */
+#ifdef RET_ERROR
+      *iv_return = RET_ERROR;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'R':
+    if (memEQ(name, "R_IBEFORE", 9)) {
+    /*                      ^       */
+#ifdef R_IBEFORE
+      *iv_return = R_IBEFORE;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
+static int
+constant_10 (pTHX_ const char *name, IV *iv_return) {
+  /* When generated this function returned values for the list of names given
+     here.  However, subsequent manual editing may have added or removed some.
+     BTREEMAGIC R_FIXEDLEN R_SNAPSHOT __R_UNUSED */
+  /* Offset 5 gives the best switch position.  */
+  switch (name[5]) {
+  case 'E':
+    if (memEQ(name, "R_FIXEDLEN", 10)) {
+    /*                    ^           */
+#ifdef R_FIXEDLEN
+      *iv_return = R_FIXEDLEN;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'M':
+    if (memEQ(name, "BTREEMAGIC", 10)) {
+    /*                    ^           */
+#ifdef BTREEMAGIC
+      *iv_return = BTREEMAGIC;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'N':
+    if (memEQ(name, "__R_UNUSED", 10)) {
+    /*                    ^           */
+#ifdef __R_UNUSED
+      *iv_return = __R_UNUSED;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'P':
+    if (memEQ(name, "R_SNAPSHOT", 10)) {
+    /*                    ^           */
+#ifdef R_SNAPSHOT
+      *iv_return = R_SNAPSHOT;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
+static int
+constant_11 (pTHX_ const char *name, IV *iv_return) {
+  /* When generated this function returned values for the list of names given
+     here.  However, subsequent manual editing may have added or removed some.
+     HASHVERSION RET_SPECIAL RET_SUCCESS R_RECNOSYNC R_SETCURSOR */
+  /* Offset 10 gives the best switch position.  */
+  switch (name[10]) {
+  case 'C':
+    if (memEQ(name, "R_RECNOSYNC", 11)) {
+    /*                         ^       */
+#ifdef R_RECNOSYNC
+      *iv_return = R_RECNOSYNC;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'L':
+    if (memEQ(name, "RET_SPECIAL", 11)) {
+    /*                         ^       */
+#ifdef RET_SPECIAL
+      *iv_return = RET_SPECIAL;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'N':
+    if (memEQ(name, "HASHVERSION", 11)) {
+    /*                         ^       */
+#ifdef HASHVERSION
+      *iv_return = HASHVERSION;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'R':
+    if (memEQ(name, "R_SETCURSOR", 11)) {
+    /*                         ^       */
+#ifdef R_SETCURSOR
+      *iv_return = R_SETCURSOR;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'S':
+    if (memEQ(name, "RET_SUCCESS", 11)) {
+    /*                         ^       */
+#ifdef RET_SUCCESS
+      *iv_return = RET_SUCCESS;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
+static int
+constant (pTHX_ const char *name, STRLEN len, IV *iv_return) {
+  /* Initially switch on the length of the name.  */
+  /* When generated this function returned values for the list of names given
+     in this section of perl code.  Rather than manually editing these functions
+     to add or remove constants, which would result in this comment and section
+     of code becoming inaccurate, we recommend that you edit this section of
+     code, and use it to regenerate a new set of constant functions which you
+     then use to replace the originals.
+
+     Regenerate these constant functions by feeding this entire source file to
+     perl -x
+
+#!bleedperl -w
+use ExtUtils::Constant qw (constant_types C_constant XS_constant);
+
+my $types = {map {($_, 1)} qw(IV)};
+my @names = (qw(BTREEMAGIC BTREEVERSION DB_LOCK DB_SHMEM DB_TXN HASHMAGIC
+	       HASHVERSION MAX_PAGE_NUMBER MAX_PAGE_OFFSET MAX_REC_NUMBER
+	       RET_ERROR RET_SPECIAL RET_SUCCESS R_CURSOR R_DUP R_FIRST
+	       R_FIXEDLEN R_IAFTER R_IBEFORE R_LAST R_NEXT R_NOKEY
+	       R_NOOVERWRITE R_PREV R_RECNOSYNC R_SETCURSOR R_SNAPSHOT
+	       __R_UNUSED));
+
+print constant_types(); # macro defs
+foreach (C_constant ("DB_File", 'constant', 'IV', $types, undef, 3, @names) ) {
+    print $_, "\n"; # C constant subs
+}
+print "#### XS Section:\n";
+print XS_constant ("DB_File", $types);
+__END__
+   */
+
+  switch (len) {
+  case 5:
+    if (memEQ(name, "R_DUP", 5)) {
+#ifdef R_DUP
+      *iv_return = R_DUP;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 6:
+    return constant_6 (aTHX_ name, iv_return);
+    break;
+  case 7:
+    return constant_7 (aTHX_ name, iv_return);
+    break;
+  case 8:
+    return constant_8 (aTHX_ name, iv_return);
+    break;
+  case 9:
+    return constant_9 (aTHX_ name, iv_return);
+    break;
+  case 10:
+    return constant_10 (aTHX_ name, iv_return);
+    break;
+  case 11:
+    return constant_11 (aTHX_ name, iv_return);
+    break;
+  case 12:
+    if (memEQ(name, "BTREEVERSION", 12)) {
+#ifdef BTREEVERSION
+      *iv_return = BTREEVERSION;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 13:
+    if (memEQ(name, "R_NOOVERWRITE", 13)) {
+#ifdef R_NOOVERWRITE
+      *iv_return = R_NOOVERWRITE;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 14:
+    if (memEQ(name, "MAX_REC_NUMBER", 14)) {
+#ifdef MAX_REC_NUMBER
+      *iv_return = MAX_REC_NUMBER;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 15:
+    /* Names all of length 15.  */
+    /* MAX_PAGE_NUMBER MAX_PAGE_OFFSET */
+    /* Offset 9 gives the best switch position.  */
+    switch (name[9]) {
+    case 'N':
+      if (memEQ(name, "MAX_PAGE_NUMBER", 15)) {
+      /*                        ^            */
+#ifdef MAX_PAGE_NUMBER
+        *iv_return = MAX_PAGE_NUMBER;
+        return PERL_constant_ISIV;
+#else
+        return PERL_constant_NOTDEF;
+#endif
+      }
+      break;
+    case 'O':
+      if (memEQ(name, "MAX_PAGE_OFFSET", 15)) {
+      /*                        ^            */
+#ifdef MAX_PAGE_OFFSET
+        *iv_return = MAX_PAGE_OFFSET;
+        return PERL_constant_ISIV;
+#else
+        return PERL_constant_NOTDEF;
+#endif
+      }
+      break;
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
diff --git a/db/perl/DB_File/fallback.xs b/db/perl/DB_File/fallback.xs
new file mode 100644
index 000000000..8650cdf76
--- /dev/null
+++ b/db/perl/DB_File/fallback.xs
@@ -0,0 +1,88 @@
+void
+constant(sv)
+    PREINIT:
+#ifdef dXSTARG
+	dXSTARG; /* Faster if we have it.  */
+#else
+	dTARGET;
+#endif
+	STRLEN		len;
+        int		type;
+	IV		iv;
+	/* NV		nv;	Uncomment this if you need to return NVs */
+	/* const char	*pv;	Uncomment this if you need to return PVs */
+    INPUT:
+	SV *		sv;
+        const char *	s = SvPV(sv, len);
+    PPCODE:
+        /* Change this to constant(aTHX_ s, len, &iv, &nv);
+           if you need to return both NVs and IVs */
+	type = constant(aTHX_ s, len, &iv);
+      /* Return 1 or 2 items. First is error message, or undef if no error.
+           Second, if present, is found value */
+        switch (type) {
+        case PERL_constant_NOTFOUND:
+          sv = sv_2mortal(newSVpvf("%s is not a valid DB_File macro", s));
+          PUSHs(sv);
+          break;
+        case PERL_constant_NOTDEF:
+          sv = sv_2mortal(newSVpvf(
+	    "Your vendor has not defined DB_File macro %s, used", s));
+          PUSHs(sv);
+          break;
+        case PERL_constant_ISIV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHi(iv);
+          break;
+	/* Uncomment this if you need to return NOs
+        case PERL_constant_ISNO:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHs(&PL_sv_no);
+          break; */
+	/* Uncomment this if you need to return NVs
+        case PERL_constant_ISNV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHn(nv);
+          break; */
+	/* Uncomment this if you need to return PVs
+        case PERL_constant_ISPV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHp(pv, strlen(pv));
+          break; */
+	/* Uncomment this if you need to return PVNs
+        case PERL_constant_ISPVN:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHp(pv, iv);
+          break; */
+	/* Uncomment this if you need to return SVs
+        case PERL_constant_ISSV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHs(sv);
+          break; */
+	/* Uncomment this if you need to return UNDEFs
+        case PERL_constant_ISUNDEF:
+          break; */
+	/* Uncomment this if you need to return UVs
+        case PERL_constant_ISUV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHu((UV)iv);
+          break; */
+	/* Uncomment this if you need to return YESs
+        case PERL_constant_ISYES:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHs(&PL_sv_yes);
+          break; */
+        default:
+          sv = sv_2mortal(newSVpvf(
+	    "Unexpected return type %d while processing DB_File macro %s, used",
+               type, s));
+          PUSHs(sv);
+        }
diff --git a/db/perl/DB_File/ppport.h b/db/perl/DB_File/ppport.h
new file mode 100644
index 000000000..b4fbc7bff
--- /dev/null
+++ b/db/perl/DB_File/ppport.h
@@ -0,0 +1,282 @@
+/* This file is Based on output from 
+ * Perl/Pollution/Portability Version 2.0000 */
+
+#ifndef _P_P_PORTABILITY_H_
+#define _P_P_PORTABILITY_H_
+
+#ifndef PERL_REVISION
+#   ifndef __PATCHLEVEL_H_INCLUDED__
+#       include "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)
+
+#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_hints		hints
+#	define PL_na		na
+#	define PL_perldb	perldb
+#	define PL_rsfp_filters	rsfp_filters
+#	define PL_rsfp		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
+
+#ifndef pTHX
+#    define pTHX
+#    define pTHX_
+#    define aTHX
+#    define aTHX_
+#endif         
+
+#ifndef PTR2IV
+#    define PTR2IV(d)   (IV)(d)
+#endif
+ 
+#ifndef INT2PTR
+#    define INT2PTR(any,d)      (any)(d)
+#endif
+
+#ifndef dTHR
+#  ifdef WIN32
+#	define dTHR extern int Perl___notused
+#  else
+#	define dTHR extern int errno
+#  endif
+#endif
+
+#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(CRIPPLED_CC) || 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_REVISION == 5 && \
+    (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 */
+
+#ifndef NOOP
+#  define NOOP (void)0
+#endif
+
+#ifdef HASATTRIBUTE
+#  define PERL_UNUSED_DECL __attribute__((unused))
+#else
+#  define PERL_UNUSED_DECL
+#endif    
+
+#ifndef dNOOP
+#  define dNOOP extern int Perl___notused PERL_UNUSED_DECL
+#endif
+
+#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 */
+
+
+#endif /* _P_P_PORTABILITY_H_ */