Make op_info thread safe

[perl/modules/Variable-Magic.git] / Magic.xs

diff --git a/Magic.xs b/Magic.xs
index aeea182bc94ce8c9db4be1a9ed98c1c15ce9c968..f034a280440aecd63b249819f5665606db2fc9d1 100644 (file)
--- a/Magic.xs
+++ b/Magic.xs
@@ -101,6 +101,10 @@ STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) {
 # define mPUSHu(U) PUSHs(sv_2mortal(newSVuv(U)))
 #endif
 
+#ifndef SvPV_const
+# define SvPV_const SvPV
+#endif
+
 #ifndef PERL_MAGIC_ext
 # define PERL_MAGIC_ext '~'
 #endif
@@ -199,7 +203,10 @@ STATIC void vmg_sv_magicuvar(pTHX_ SV *sv, const char *uf, I32 len) {
 
 #define MY_CXT_KEY __PACKAGE__ "::_guts" XS_VERSION
 
-typedef HV * my_cxt_t;
+typedef struct {
+ HV *wizards;
+ HV *b__op_stash;
+} my_cxt_t;
 
 START_MY_CXT
 
@@ -220,7 +227,7 @@ STATIC U16 vmg_gensig(pTHX) {
 
  do {
   sig = SIG_NBR * Drand01() + SIG_MIN;
- } while (hv_exists(MY_CXT, buf, sprintf(buf, "%u", sig)));
+ } while (hv_exists(MY_CXT.wizards, buf, sprintf(buf, "%u", sig)));
 
  return sig;
 }
@@ -494,27 +501,28 @@ STATIC UV vmg_dispell(pTHX_ SV *sv, U16 sig) {
 #define VMG_OP_INFO_NAME   1
 #define VMG_OP_INFO_OBJECT 2
 
-STATIC STRLEN *vmg_op_name_len = NULL;
-
-STATIC HV *vmg_b__op_stash = NULL;
+STATIC U32           vmg_op_name_init      = 0;
+STATIC unsigned char vmg_op_name_len[MAXO] = { 0 };
 
 STATIC void vmg_op_info_init(pTHX_ unsigned int opinfo) {
 #define vmg_op_info_init(W) vmg_op_info_init(aTHX_ (W))
  switch (opinfo) {
   case VMG_OP_INFO_NAME:
-   if (!vmg_op_name_len) {
+   if (!vmg_op_name_init) {
     OPCODE t;
-    Newx(vmg_op_name_len, MAXO, STRLEN);
     for (t = 0; t < OP_max; ++t)
      vmg_op_name_len[t] = strlen(PL_op_name[t]);
+    vmg_op_name_init = 1;
    }
    break;
-  case VMG_OP_INFO_OBJECT:
-   if (!vmg_b__op_stash) {
+  case VMG_OP_INFO_OBJECT: {
+   dMY_CXT;
+   if (!MY_CXT.b__op_stash) {
     require_pv("B.pm");
-    vmg_b__op_stash = gv_stashpv("B::OP", 1);
+    MY_CXT.b__op_stash = gv_stashpv("B::OP", 1);
    }
    break;
+  }
   default:
    break;
  }
@@ -530,9 +538,11 @@ STATIC SV *vmg_op_info(pTHX_ unsigned int opinfo) {
    OPCODE t = PL_op->op_type;
    return sv_2mortal(newSVpvn(PL_op_name[t], vmg_op_name_len[t]));
   }
-  case VMG_OP_INFO_OBJECT:
+  case VMG_OP_INFO_OBJECT: {
+   dMY_CXT;
    return sv_bless(sv_2mortal(newRV_noinc(newSViv(PTR2IV(PL_op)))),
-                              vmg_b__op_stash);
+                              MY_CXT.b__op_stash);
+  }
   default:
    break;
  }
@@ -666,13 +676,13 @@ STATIC int vmg_svt_clear(pTHX_ SV *sv, MAGIC *mg) {
 }
 
 STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
- SV *wiz = (SV *) mg->mg_ptr;
  const MGWIZ *w;
  unsigned int flags;
  int ret = 0;
 
- /* This may happen in global destruction */
- if (SvTYPE(wiz) == SVTYPEMASK)
+ /* Don't even bother if we are in global destruction - the wizard is prisoner
+  * of circular references and we are way beyond user realm */
+ if (PL_dirty)
   return 0;
 
  w = SV2MGWIZ(mg->mg_ptr);
@@ -845,7 +855,7 @@ STATIC int vmg_wizard_free(pTHX_ SV *wiz, MAGIC *mg) {
 
  {
   dMY_CXT;
-  if (hv_delete(MY_CXT, buf, sprintf(buf, "%u", w->sig), 0) != wiz)
+  if (hv_delete(MY_CXT.wizards, buf, sprintf(buf, "%u", w->sig), 0) != wiz)
    return 0;
  }
  SvFLAGS(wiz) |= SVf_BREAK;
@@ -901,6 +911,7 @@ STATIC const char vmg_invalid_sig[]    = "Invalid numeric signature";
 STATIC const char vmg_wrongargnum[]    = "Wrong number of arguments";
 STATIC const char vmg_toomanysigs[]    = "Too many magic signatures used";
 STATIC const char vmg_argstorefailed[] = "Error while storing arguments";
+STATIC const char vmg_globstorefail[]  = "Couldn't store global wizard information";
 
 STATIC U16 vmg_sv2sig(pTHX_ SV *sv) {
 #define vmg_sv2sig(S) vmg_sv2sig(aTHX_ (S))
@@ -936,7 +947,7 @@ STATIC U16 vmg_wizard_sig(pTHX_ SV *wiz) {
 
  {
   dMY_CXT;
-  if (!hv_fetch(MY_CXT, buf, sprintf(buf, "%u", sig), 0))
+  if (!hv_fetch(MY_CXT.wizards, buf, sprintf(buf, "%u", sig), 0))
    sig = 0;
  }
  return sig;
@@ -963,7 +974,7 @@ STATIC SV *vmg_wizard_wiz(pTHX_ SV *wiz) {
 
  {
   dMY_CXT;
-  return (old = hv_fetch(MY_CXT, buf, sprintf(buf, "%u", sig), 0))
+  return (old = hv_fetch(MY_CXT.wizards, buf, sprintf(buf, "%u", sig), 0))
           ? *old : NULL;
  }
 }
@@ -1040,8 +1051,9 @@ BOOT:
 {
  HV *stash;
  MY_CXT_INIT;
- MY_CXT = newHV();
- hv_iterinit(MY_CXT); /* Allocate iterator */
+ MY_CXT.wizards = newHV();
+ hv_iterinit(MY_CXT.wizards); /* Allocate iterator */
+ MY_CXT.b__op_stash = NULL;
  stash = gv_stashpv(__PACKAGE__, 1);
  newCONSTSUB(stash, "SIG_MIN",   newSVuv(SIG_MIN));
  newCONSTSUB(stash, "SIG_MAX",   newSVuv(SIG_MAX));
@@ -1071,28 +1083,35 @@ CLONE(...)
 PROTOTYPE: DISABLE
 PREINIT:
  HV *hv;
+ U32 had_b__op_stash = 0;
 CODE:
  {
   HE *key;
   dMY_CXT;
   hv = newHV();
   hv_iterinit(hv); /* Allocate iterator */
-  hv_iterinit(MY_CXT);
-  while ((key = hv_iternext(MY_CXT))) {
+  hv_iterinit(MY_CXT.wizards);
+  while ((key = hv_iternext(MY_CXT.wizards))) {
    STRLEN len;
    char *sig = HePV(key, len);
    SV *sv;
+   const MGWIZ *w;
    MAGIC *mg;
-   sv = MGWIZ2SV(vmg_wizard_clone(SV2MGWIZ(HeVAL(key))));
+   w  = SV2MGWIZ(HeVAL(key));
+   w  = vmg_wizard_clone(w);
+   sv = MGWIZ2SV(w);
    mg = sv_magicext(sv, NULL, PERL_MAGIC_ext, &vmg_wizard_vtbl, NULL, 0);
    mg->mg_private = SIG_WIZ;
    SvREADONLY_on(sv);
-   hv_store(hv, sig, len, sv, HeHASH(key));
+   if (!hv_store(hv, sig, len, sv, HeHASH(key))) croak("%s during CLONE", vmg_globstorefail);
   }
+  if (MY_CXT.b__op_stash)
+   had_b__op_stash = 1;
  }
  {
   MY_CXT_CLONE;
-  MY_CXT = hv;
+  MY_CXT.wizards     = hv;
+  MY_CXT.b__op_stash = had_b__op_stash ? gv_stashpv("B::OP", 1) : NULL;
  }
 
 #endif /* VMG_THREADSAFE */
@@ -1131,12 +1150,12 @@ CODE:
  if (SvOK(svsig)) {
   SV **old;
   sig = vmg_sv2sig(svsig);
-  if ((old = hv_fetch(MY_CXT, buf, sprintf(buf, "%u", sig), 0))) {
+  if ((old = hv_fetch(MY_CXT.wizards, buf, sprintf(buf, "%u", sig), 0))) {
    ST(0) = sv_2mortal(newRV_inc(*old));
    XSRETURN(1);
   }
  } else {
-  if (HvKEYS(MY_CXT) >= SIG_NBR) { croak(vmg_toomanysigs); }
+  if (HvKEYS(MY_CXT.wizards) >= SIG_NBR) { croak(vmg_toomanysigs); }
   sig = vmg_gensig();
  }
  
@@ -1187,7 +1206,7 @@ CODE:
  mg->mg_private = SIG_WIZ;
  SvREADONLY_on(sv);
 
- hv_store(MY_CXT, buf, sprintf(buf, "%u", sig), sv, 0);
+ if (!hv_store(MY_CXT.wizards, buf, sprintf(buf, "%u", sig), sv, 0)) croak(vmg_globstorefail);
 
  RETVAL = newRV_noinc(sv);
 OUTPUT:
@@ -1197,7 +1216,7 @@ SV *gensig()
 PROTOTYPE:
 CODE:
  dMY_CXT;
- if (HvKEYS(MY_CXT) >= SIG_NBR) { croak(vmg_toomanysigs); }
+ if (HvKEYS(MY_CXT.wizards) >= SIG_NBR) { croak(vmg_toomanysigs); }
  RETVAL = newSVuv(vmg_gensig());
 OUTPUT:
  RETVAL
@@ -1235,12 +1254,13 @@ CODE:
 OUTPUT:
  RETVAL
 
-SV *getdata(SV *sv, SV *wiz)
+void
+getdata(SV *sv, SV *wiz)
 PROTOTYPE: \[$@%&*]$
 PREINIT:
  SV *data;
  U16 sig;
-CODE:
+PPCODE:
  sig = vmg_wizard_sig(wiz);
  if (!sig)
   XSRETURN_UNDEF;
@@ -1260,13 +1280,3 @@ CODE:
  RETVAL = newSVuv(vmg_dispell(SvRV(sv), sig));
 OUTPUT:
  RETVAL
-
-void
-_cleanup()
-PROTOTYPE:
-PPCODE:
- if (vmg_op_name_len) {
-  Safefree(vmg_op_name_len);
-  vmg_op_name_len = NULL;
- }
- XSRETURN(0);