Empty the global pointer table at the end of a thread

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

diff --git a/Magic.xs b/Magic.xs
index 6ffe42dd6f88b517276adad6552d00aeb6b0bb5c..caff817b84c869d0d76fd6a63c9e0e9fe7c8d4f8 100644 (file)
--- a/Magic.xs
+++ b/Magic.xs
@@ -490,6 +490,22 @@ STATIC void vmg_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
   ptable_store(ud->wizards, ent->key, w);
 }
 
+STATIC void vmg_thread_cleanup(pTHX_ void *);
+
+STATIC void vmg_thread_cleanup(pTHX_ void *ud) {
+ int *level = ud;
+
+ if (*level) {
+  --*level;
+  LEAVE;
+  SAVEDESTRUCTOR_X(vmg_thread_cleanup, level);
+  ENTER;
+ } else {
+  dMY_CXT;
+  PerlMemShared_free(level);
+  ptable_free(MY_CXT.wizards);
+ }
+}
 #endif /* VMG_THREADSAFE */
 
 /* --- Wizard objects ------------------------------------------------------ */
@@ -588,6 +604,27 @@ STATIC const MGWIZ *vmg_wizard_mgwiz(pTHX_ SV *wiz) {
 
 /* --- User-level functions implementation --------------------------------- */
 
+STATIC const MAGIC *vmg_find(pTHX_ const SV *sv, SV *wiz) {
+#define vmg_find(S, W) vmg_find(aTHX_ (S), (W))
+ const MAGIC *mg, *moremagic;
+ UV wid;
+
+ if (SvTYPE(sv) < SVt_PVMG)
+  return NULL;
+
+ wid = vmg_wizard_id(wiz);
+ for (mg = SvMAGIC(sv); mg; mg = moremagic) {
+  moremagic = mg->mg_moremagic;
+  if (mg->mg_type == PERL_MAGIC_ext && mg->mg_private == SIG_WIZ) {
+   UV zid = vmg_wizard_id(mg->mg_ptr);
+   if (zid == wid)
+    return mg;
+  }
+ }
+
+ return NULL;
+}
+
 /* ... Construct private data .............................................. */
 
 STATIC SV *vmg_data_new(pTHX_ SV *ctor, SV *sv, AV *args) {
@@ -626,23 +663,8 @@ STATIC SV *vmg_data_new(pTHX_ SV *ctor, SV *sv, AV *args) {
 
 STATIC SV *vmg_data_get(pTHX_ SV *sv, SV *wiz) {
 #define vmg_data_get(S, W) vmg_data_get(aTHX_ (S), (W))
- MAGIC *mg, *moremagic;
-
- if (SvTYPE(sv) >= SVt_PVMG) {
-  UV wid = vmg_wizard_id(wiz);
-  for (mg = SvMAGIC(sv); mg; mg = moremagic) {
-   moremagic = mg->mg_moremagic;
-   if (mg->mg_type == PERL_MAGIC_ext && mg->mg_private == SIG_WIZ) {
-    UV zid = vmg_wizard_id(mg->mg_ptr);
-    if (zid == wid)
-     break;
-   }
-  }
-  if (mg)
-   return mg->mg_obj;
- }
-
- return NULL;
+ const MAGIC *mg = vmg_find(sv, wiz);
+ return mg ? mg->mg_obj : NULL;
 } 
 
 /* ... Magic cast/dispell .................................................. */
@@ -664,24 +686,16 @@ STATIC void vmg_uvar_del(SV *sv, MAGIC *prevmagic, MAGIC *mg, MAGIC *moremagic)
 
 STATIC UV vmg_cast(pTHX_ SV *sv, SV *wiz, AV *args) {
 #define vmg_cast(S, W, A) vmg_cast(aTHX_ (S), (W), (A))
- MAGIC *mg = NULL, *moremagic = NULL;
- SV *data;
- const MGWIZ *w = vmg_wizard_mgwiz(wiz);
- U32 oldgmg     = SvGMAGICAL(sv);
+ MAGIC       *mg, *moremagic = NULL;
+ SV          *data;
+ const MGWIZ *w;
+ U32          oldgmg;
 
- if (SvTYPE(sv) >= SVt_PVMG) {
-  UV wid = vmg_wizard_id(wiz);
-  for (mg = SvMAGIC(sv); mg; mg = moremagic) {
-   moremagic = mg->mg_moremagic;
-   if (mg->mg_type == PERL_MAGIC_ext && mg->mg_private == SIG_WIZ) {
-    UV zid = vmg_wizard_id(mg->mg_ptr);
-    if (zid == wid)
-     break;
-   }
-  }
-  if (mg)
-   return 1;
- }
+ if (vmg_find(sv, wiz))
+  return 1;
+
+ w = vmg_wizard_mgwiz(wiz);
+ oldgmg = SvGMAGICAL(sv);
 
  data = (w->cb_data) ? vmg_data_new(w->cb_data, sv, args) : NULL;
  mg = sv_magicext(sv, data, PERL_MAGIC_ext, w->vtbl, (const char *) wiz, HEf_SVKEY);
@@ -1296,10 +1310,9 @@ CLONE(...)
 PROTOTYPE: DISABLE
 PREINIT:
  ptable *t;
- int    *level;
  U32     had_b__op_stash = 0;
  opclass c;
-CODE:
+PPCODE:
  {
   my_cxt_t ud;
   dMY_CXT;
@@ -1322,6 +1335,15 @@ CODE:
                               ? gv_stashpv(vmg_opclassnames[c], 1) : NULL;
   }
  }
+ {
+  int *level;
+  level = PerlMemShared_malloc(sizeof *level);
+  *level = 1;
+  LEAVE;
+  SAVEDESTRUCTOR_X(vmg_thread_cleanup, level);
+  ENTER;
+ }
+ XSRETURN(0);
 
 #endif /* VMG_THREADSAFE */
 
@@ -1329,11 +1351,8 @@ SV *_wizard(...)
 PROTOTYPE: DISABLE
 PREINIT:
  I32 i = 0;
- char buf[8];
  MGWIZ *w;
  MGVTBL *t;
- MAGIC *mg;
- SV *wiz;
  SV *cb;
 CODE:
  dMY_CXT;
@@ -1439,8 +1458,6 @@ PPCODE:
 
 SV *dispell(SV *sv, SV *wiz)
 PROTOTYPE: \[$@%&*]$
-PREINIT:
- U16 sig;
 CODE:
  wiz = vmg_wizard_validate(wiz);
  RETVAL = newSVuv(vmg_dispell(SvRV(sv), wiz));