Integrate changes #12652 and #12653 from maintperl;

more tweaks to change#12626
* move the boilerplate code over to perl.h and make DynaLoader
  use it
* make re, Opcode, File::Glob and B threadsafe
* re.xs needed s/deinstall/uninstall/ (guess nobody uses
  C<no re;> anywhere)

include XS_VERSION in MY_CXT_KEY (tweak for change#12652)

File::Glob required a bit more work in bleadperl
because of ExtUtils::Constant (see the Makefile.PL change)

p4raw-link: @12652 on //depot/maint-5.6/perl: 3bc8871b91a24662eada2114d9a016153718b1c4
p4raw-link: @12626 on //depot/maint-5.6/perl: 512dcce54ea4db665708f91609bdd0a6126d1acd

p4raw-id: //depot/perl@12654
p4raw-integrated: from //depot/maint-5.6/perl@12650 'edit in'
	ext/B/B.xs ext/DynaLoader/dlutils.c (@12652..) 'merge in'
	perl.h (@12597..) ext/File/Glob/Glob.xs ext/Opcode/Opcode.xs
	ext/re/re.xs (@12652..)

6 files changed, 108 insertions, 67 deletions

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 0a95d98fa6..b2c163a4eb 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -70,9 +70,17 @@ static char *opclassnames[] = {
     "B::COP"	
 };
 
-static int walkoptree_debug = 0;	/* Flag for walkoptree debug hook */
+#define MY_CXT_KEY "B::_guts"##XS_VERSION
 
-static SV *specialsv_list[6];
+typedef struct {
+    int		x_walkoptree_debug;	/* Flag for walkoptree debug hook */
+    SV *	x_specialsv_list[6];
+} my_cxt_t;
+
+START_MY_CXT
+
+#define walkoptree_debug	(MY_CXT.x_walkoptree_debug)
+#define specialsv_list		(MY_CXT.x_specialsv_list)
 
 static opclass
 cc_opclass(pTHX_ OP *o)
@@ -192,6 +200,7 @@ make_sv_object(pTHX_ SV *arg, SV *sv)
 {
     char *type = 0;
     IV iv;
+    dMY_CXT;
     
     for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) {
 	if (sv == specialsv_list[iv]) {
@@ -312,7 +321,8 @@ walkoptree(pTHX_ SV *opsv, char *method)
 {
     dSP;
     OP *o;
-    
+    dMY_CXT;
+
     if (!SvROK(opsv))
 	croak("opsv is not a reference");
     opsv = sv_mortalcopy(opsv);
@@ -373,6 +383,7 @@ BOOT:
 {
     HV *stash = gv_stashpvn("B", 1, TRUE);
     AV *export_ok = perl_get_av("B::EXPORT_OK",TRUE);
+    MY_CXT_INIT;
     specialsv_list[0] = Nullsv;
     specialsv_list[1] = &PL_sv_undef;
     specialsv_list[2] = &PL_sv_yes;
@@ -440,6 +451,7 @@ walkoptree(opsv, method)
 int
 walkoptree_debug(...)
     CODE:
+	dMY_CXT;
 	RETVAL = walkoptree_debug;
 	if (items > 0 && SvTRUE(ST(1)))
 	    walkoptree_debug = 1;
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index 604c7f40e1..f15cf7315f 100644
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -8,7 +8,10 @@
  *                      files when the interpreter exits
  */
 
-#define MY_CXT_KEY "DynaLoader_guts"
+#ifndef XS_VERSION
+#  define XS_VERSION "0"
+#endif
+#define MY_CXT_KEY "DynaLoader::_guts"##XS_VERSION
 
 typedef struct {
     char *	x_dl_last_error;	/* pointer to allocated memory for
@@ -26,63 +29,20 @@ typedef struct {
 #endif
 } my_cxt_t;
 
-/* XXX most of this is boilerplate code that should abstracted further into
- * macros and exposed via XSUB.h */
-
-#if defined(USE_ITHREADS)
-
-#define dMY_CXT_SV \
-	SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY,		\
-				  sizeof(MY_CXT_KEY)-1, TRUE)
-
-/* we allocate my_cxt in a Perl SV so that it will be released when
- * the interpreter goes away */
-#define dMY_CXT_INIT \
-	dMY_CXT_SV;							\
-	/* newSV() allocates one more than needed */			\
-	my_cxt_t *my_cxt = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));	\
-	Zero(my_cxt, 1, my_cxt_t);					\
-	sv_setuv(my_cxt_sv, (UV)my_cxt);
-
-#define dMY_CXT	\
-	dMY_CXT_SV;							\
-	my_cxt_t *my_cxt = (my_cxt_t*)SvUV(my_cxt_sv)
+START_MY_CXT
 
-#define dl_last_error	(my_cxt->x_dl_last_error)
-#define dl_nonlazy	(my_cxt->x_dl_nonlazy)
+#define dl_last_error	(MY_CXT.x_dl_last_error)
+#define dl_nonlazy	(MY_CXT.x_dl_nonlazy)
 #ifdef DL_LOADONCEONLY
-#define dl_loaded_files	(my_cxt->x_dl_loaded_files)
+#define dl_loaded_files	(MY_CXT.x_dl_loaded_files)
 #endif
 #ifdef DL_CXT_EXTRA
-#define dl_cxtx		(my_cxt->x_dl_cxtx)
+#define dl_cxtx		(MY_CXT.x_dl_cxtx)
 #endif
 #ifdef DEBUGGING
-#define dl_debug	(my_cxt->x_dl_debug)
+#define dl_debug	(MY_CXT.x_dl_debug)
 #endif
 
-#else /* USE_ITHREADS */
-
-static my_cxt_t my_cxt;
-
-#define dMY_CXT_SV	dNOOP
-#define dMY_CXT_INIT	dNOOP
-#define dMY_CXT		dNOOP
-
-#define dl_last_error	(my_cxt.x_dl_last_error)
-#define dl_nonlazy	(my_cxt.x_dl_nonlazy)
-#ifdef DL_LOADONCEONLY
-#define dl_loaded_files	(my_cxt.x_dl_loaded_files)
-#endif
-#ifdef DL_CXT_EXTRA
-#define dl_cxtx		(my_cxt.x_dl_cxtx)
-#endif
-#ifdef DEBUGGING
-#define dl_debug	(my_cxt.x_dl_debug)
-#endif
-
-#endif /* !defined(USE_ITHREADS) */
-
-
 #ifdef DEBUGGING
 #define DLDEBUG(level,code) \
     STMT_START {					\
@@ -123,7 +83,7 @@ static void
 dl_generic_private_init(pTHX)	/* called by dl_*.xs dl_private_init() */
 {
     char *perl_dl_nonlazy;
-    dMY_CXT_INIT;
+    MY_CXT_INIT;
 
     dl_last_error = NULL;
     dl_nonlazy = 0;
diff --git a/ext/File/Glob/Glob.xs b/ext/File/Glob/Glob.xs
index 85ddf02e6d..f2210bcd04 100644
--- a/ext/File/Glob/Glob.xs
+++ b/ext/File/Glob/Glob.xs
@@ -4,8 +4,15 @@
 
 #include "bsd_glob.h"
 
-/* XXX: need some thread awareness */
-static int GLOB_ERROR = 0;
+#define MY_CXT_KEY "File::Glob::_guts"##XS_VERSION
+
+typedef struct {
+    int		x_GLOB_ERROR;
+} my_cxt_t;
+
+START_MY_CXT
+
+#define GLOB_ERROR	(MY_CXT.x_GLOB_ERROR)
 
 #include "constants.c"
 
@@ -20,6 +27,11 @@ errfunc(const char *foo, int bar) {
 
 MODULE = File::Glob		PACKAGE = File::Glob
 
+BOOT:
+{
+    MY_CXT_INIT;
+}
+
 void
 doglob(pattern,...)
     char *pattern
@@ -32,6 +44,8 @@ PREINIT:
     SV *tmp;
 PPCODE:
     {
+	dMY_CXT;
+
 	/* allow for optional flags argument */
 	if (items > 1) {
 	    flags = (int) SvIV(ST(1));
diff --git a/ext/File/Glob/Makefile.PL b/ext/File/Glob/Makefile.PL
index b73a0c483e..0ff49ebe17 100644
--- a/ext/File/Glob/Makefile.PL
+++ b/ext/File/Glob/Makefile.PL
@@ -27,6 +27,6 @@ WriteConstants(
     NAMES => [qw(GLOB_ABEND GLOB_ALPHASORT GLOB_ALTDIRFUNC GLOB_BRACE GLOB_ERR
                  GLOB_LIMIT GLOB_MARK GLOB_NOCASE GLOB_NOCHECK GLOB_NOMAGIC
                  GLOB_NOSORT GLOB_NOSPACE GLOB_QUOTE GLOB_TILDE),
-              {name=>"GLOB_ERROR", macro=>1}],
+              {name=>"GLOB_ERROR", macro=>["#ifdef GLOB_ERROR\n\tdMY_CXT;\n\n","#endif\n"]}],
     BREAKOUT_AT => 8,
 );
diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs
index 22f022ba32..c00a5e528b 100644
--- a/ext/Opcode/Opcode.xs
+++ b/ext/Opcode/Opcode.xs
@@ -7,10 +7,21 @@
 #define OP_MASK_BUF_SIZE (MAXO + 100)
 
 /* XXX op_named_bits and opset_all are never freed */
-static HV *op_named_bits;	/* cache shared for whole process	*/
-static SV *opset_all;		/* mask with all bits set		*/
-static IV  opset_len;		/* length of opmasks in bytes		*/
-static int opcode_debug = 0;
+#define MY_CXT_KEY "Opcode::_guts"##XS_VERSION
+
+typedef struct {
+    HV *	x_op_named_bits;	/* cache shared for whole process */
+    SV *	x_opset_all;		/* mask with all bits set	*/
+    IV		x_opset_len;		/* length of opmasks in bytes	*/
+    int		x_opcode_debug;
+} my_cxt_t;
+
+START_MY_CXT
+
+#define op_named_bits		(MY_CXT.x_op_named_bits)
+#define opset_all		(MY_CXT.x_opset_all)
+#define opset_len		(MY_CXT.x_opset_len)
+#define opcode_debug		(MY_CXT.x_opcode_debug)
 
 static SV  *new_opset (pTHX_ SV *old_opset);
 static int  verify_opset (pTHX_ SV *opset, int fatal);
@@ -34,6 +45,7 @@ op_names_init(pTHX)
     STRLEN len;
     char **op_names;
     char *bitmap;
+    dMY_CXT;
 
     op_named_bits = newHV();
     op_names = get_op_names();
@@ -66,6 +78,8 @@ static void
 put_op_bitspec(pTHX_ char *optag, STRLEN len, SV *mask)
 {
     SV **svp;
+    dMY_CXT;
+
     verify_opset(aTHX_ mask,1);
     if (!len)
 	len = strlen(optag);
@@ -87,6 +101,8 @@ static SV *
 get_op_bitspec(pTHX_ char *opname, STRLEN len, int fatal)
 {
     SV **svp;
+    dMY_CXT;
+
     if (!len)
 	len = strlen(opname);
     svp = hv_fetch(op_named_bits, opname, len, 0);
@@ -110,6 +126,8 @@ static SV *
 new_opset(pTHX_ SV *old_opset)
 {
     SV *opset;
+    dMY_CXT;
+
     if (old_opset) {
 	verify_opset(aTHX_ old_opset,1);
 	opset = newSVsv(old_opset);
@@ -129,6 +147,8 @@ static int
 verify_opset(pTHX_ SV *opset, int fatal)
 {
     char *err = Nullch;
+    dMY_CXT;
+
     if      (!SvOK(opset))              err = "undefined";
     else if (!SvPOK(opset))             err = "wrong type";
     else if (SvCUR(opset) != opset_len) err = "wrong size";
@@ -142,6 +162,8 @@ verify_opset(pTHX_ SV *opset, int fatal)
 static void
 set_opset_bits(pTHX_ char *bitmap, SV *bitspec, int on, char *opname)
 {
+    dMY_CXT;
+
     if (SvIOK(bitspec)) {
 	int myopcode = SvIV(bitspec);
 	int offset = myopcode >> 3;
@@ -180,6 +202,7 @@ opmask_add(pTHX_ SV *opset)	/* THE ONLY FUNCTION TO EDIT PL_op_mask ITSELF	*/
     char *bitmask;
     STRLEN len;
     int myopcode = 0;
+    dMY_CXT;
 
     verify_opset(aTHX_ opset,1);		/* croaks on bad opset	*/
 
@@ -204,6 +227,8 @@ static void
 opmask_addlocal(pTHX_ SV *opset, char *op_mask_buf) /* Localise PL_op_mask then opmask_add() */
 {
     char *orig_op_mask = PL_op_mask;
+    dMY_CXT;
+
     SAVEVPTR(PL_op_mask);
     /* XXX casting to an ordinary function ptr from a member function ptr
      * is disallowed by Borland
@@ -225,11 +250,14 @@ MODULE = Opcode	PACKAGE = Opcode
 PROTOTYPES: ENABLE
 
 BOOT:
+{
+    MY_CXT_INIT;
     assert(PL_maxo < OP_MASK_BUF_SIZE);
     opset_len = (PL_maxo + 7) / 8;
     if (opcode_debug >= 1)
 	warn("opset_len %ld\n", (long)opset_len);
     op_names_init(aTHX);
+}
 
 void
 _safe_pkg_prep(Package)
@@ -308,7 +336,9 @@ invert_opset(opset)
 CODE:
     {
     char *bitmap;
+    dMY_CXT;
     STRLEN len = opset_len;
+
     opset = sv_2mortal(new_opset(aTHX_ opset));	/* verify and clone opset */
     bitmap = SvPVX(opset);
     while(len-- > 0)
@@ -330,6 +360,8 @@ PPCODE:
     int i, j, myopcode;
     char *bitmap = SvPV(opset, len);
     char **names = (desc) ? get_op_descs() : get_op_names();
+    dMY_CXT;
+
     verify_opset(aTHX_ opset,1);
     for (myopcode=0, i=0; i < opset_len; i++) {
 	U16 bits = bitmap[i];
@@ -348,6 +380,8 @@ CODE:
     SV *bitspec, *opset;
     char *bitmap;
     STRLEN len, on;
+    dMY_CXT;
+
     opset = sv_2mortal(new_opset(aTHX_ Nullsv));
     bitmap = SvPVX(opset);
     for (i = 0; i < items; i++) {
@@ -382,6 +416,7 @@ CODE:
     SV *bitspec, *mask;
     char *bitmap, *opname;
     STRLEN len;
+    dMY_CXT;
 
     if (!SvROK(safe) || !SvOBJECT(SvRV(safe)) || SvTYPE(SvRV(safe))!=SVt_PVHV)
 	croak("Not a Safe object");
@@ -416,6 +451,8 @@ PPCODE:
     STRLEN len;
     SV **args;
     char **op_desc = get_op_descs(); 
+    dMY_CXT;
+
     /* copy args to a scratch area since we may push output values onto	*/
     /* the stack faster than we read values off it if masks are used.	*/
     args = (SV**)SvPVX(sv_2mortal(newSVpvn((char*)&ST(0), items*sizeof(SV*))));
@@ -453,6 +490,7 @@ define_optag(optagsv, mask)
 CODE:
     STRLEN len;
     char *optag = SvPV(optagsv, len);
+
     put_op_bitspec(aTHX_ optag, len, mask); /* croaks */
     ST(0) = &PL_sv_yes;
 
@@ -465,6 +503,7 @@ CODE:
 void
 full_opset()
 CODE:
+    dMY_CXT;
     ST(0) = sv_2mortal(new_opset(aTHX_ opset_all));
 
 void
diff --git a/ext/re/re.xs b/ext/re/re.xs
index faab0b370b..55f0f75884 100644
--- a/ext/re/re.xs
+++ b/ext/re/re.xs
@@ -17,42 +17,58 @@ extern char*	my_re_intuit_start (pTHX_ regexp *prog, SV *sv, char *strpos,
 				    struct re_scream_pos_data_s *data);
 extern SV*	my_re_intuit_string (pTHX_ regexp *prog);
 
-static int oldfl;
+#define MY_CXT_KEY "re::_guts"##XS_VERSION
+
+typedef struct {
+    int		x_oldflag;		/* debug flag */
+} my_cxt_t;
+
+START_MY_CXT
+
+#define oldflag		(MY_CXT.x_oldflag)
 
 static void
-deinstall(pTHX)
+uninstall(pTHX)
 {
+    dMY_CXT;
     PL_regexecp = Perl_regexec_flags;
     PL_regcompp = Perl_pregcomp;
     PL_regint_start = Perl_re_intuit_start;
     PL_regint_string = Perl_re_intuit_string;
     PL_regfree = Perl_pregfree;
 
-    if (!oldfl)
+    if (!oldflag)
 	PL_debug &= ~DEBUG_r_FLAG;
 }
 
 static void
 install(pTHX)
 {
+    dMY_CXT;
     PL_colorset = 0;			/* Allow reinspection of ENV. */
     PL_regexecp = &my_regexec;
     PL_regcompp = &my_regcomp;
     PL_regint_start = &my_re_intuit_start;
     PL_regint_string = &my_re_intuit_string;
     PL_regfree = &my_regfree;
-    oldfl = PL_debug & DEBUG_r_FLAG;
+    oldflag = PL_debug & DEBUG_r_FLAG;
     PL_debug |= DEBUG_r_FLAG;
 }
 
 MODULE = re	PACKAGE = re
 
+BOOT:
+{
+   MY_CXT_INIT;
+}
+
+
 void
 install()
   CODE:
     install(aTHX);
 
 void
-deinstall()
+uninstall()
   CODE:
-    deinstall(aTHX);
+    uninstall(aTHX);