X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=indirect.xs;h=3083abc0f08e2bc4cdef27e55514645d267fa223;hp=57a0ea79dbf1289a8a756d6e70420c5161403176;hb=b05f4291bec38d550b98e45a9e6f2320403905d3;hpb=461d68367d0b993e2dcbb87f1bf5b850c73c1232

diff --git a/indirect.xs b/indirect.xs
index 57a0ea7..3083abc 100644
--- a/indirect.xs
+++ b/indirect.xs
@@ -113,12 +113,17 @@
 #endif
 
 #ifndef I_MULTIPLICITY
-# if defined(MULTIPLICITY) || defined(PERL_IMPLICIT_CONTEXT)
+# if defined(MULTIPLICITY)
 #  define I_MULTIPLICITY 1
 # else
 #  define I_MULTIPLICITY 0
 # endif
 #endif
+#if I_MULTIPLICITY
+# ifndef PERL_IMPLICIT_CONTEXT
+#  error MULTIPLICITY builds must set PERL_IMPLICIT_CONTEXT
+# endif
+#endif
 #if I_MULTIPLICITY && !defined(tTHX)
 # define tTHX PerlInterpreter*
 #endif
@@ -146,12 +151,33 @@
 # define MY_CXT_CLONE NOOP
 #endif
 
+#if I_THREADSAFE
+/* We must use preexistent global mutexes or we will never be able to destroy
+ * them. */
+# if I_HAS_PERL(5, 9, 3)
+#  define I_LOADED_LOCK   MUTEX_LOCK(&PL_my_ctx_mutex)
+#  define I_LOADED_UNLOCK MUTEX_UNLOCK(&PL_my_ctx_mutex)
+# else
+#  define I_LOADED_LOCK   OP_REFCNT_LOCK
+#  define I_LOADED_UNLOCK OP_REFCNT_UNLOCK
+# endif
+#else
+# define I_LOADED_LOCK   NOOP
+# define I_LOADED_UNLOCK NOOP
+#endif
+
 #if defined(OP_CHECK_MUTEX_LOCK) && defined(OP_CHECK_MUTEX_UNLOCK)
-# define I_CHECK_MUTEX_LOCK   OP_CHECK_MUTEX_LOCK
-# define I_CHECK_MUTEX_UNLOCK OP_CHECK_MUTEX_UNLOCK
+# define I_CHECK_LOCK   OP_CHECK_MUTEX_LOCK
+# define I_CHECK_UNLOCK OP_CHECK_MUTEX_UNLOCK
+#elif I_HAS_PERL(5, 9, 3)
+# define I_CHECK_LOCK   OP_REFCNT_LOCK
+# define I_CHECK_UNLOCK OP_REFCNT_UNLOCK
 #else
-# define I_CHECK_MUTEX_LOCK   OP_REFCNT_LOCK
-# define I_CHECK_MUTEX_UNLOCK OP_REFCNT_UNLOCK
+/* Before perl 5.9.3, indirect_ck_*() calls are already protected by the
+ * I_LOADED mutex, which falls back to the OP_REFCNT mutex. Make sure we don't
+ * lock it twice. */
+# define I_CHECK_LOCK   NOOP
+# define I_CHECK_UNLOCK NOOP
 #endif
 
 typedef OP *(*indirect_ck_t)(pTHX_ OP *);
@@ -164,28 +190,102 @@ typedef OP *(*indirect_ck_t)(pTHX_ OP *);
 
 static void indirect_ck_replace(pTHX_ OPCODE type, indirect_ck_t new_ck, indirect_ck_t *old_ck_p) {
 #define indirect_ck_replace(T, NC, OCP) indirect_ck_replace(aTHX_ (T), (NC), (OCP))
- I_CHECK_MUTEX_LOCK;
+ I_CHECK_LOCK;
  if (!*old_ck_p) {
   *old_ck_p      = PL_check[type];
   PL_check[type] = new_ck;
  }
- I_CHECK_MUTEX_UNLOCK;
+ I_CHECK_UNLOCK;
 }
 
 #endif
 
 static void indirect_ck_restore(pTHX_ OPCODE type, indirect_ck_t *old_ck_p) {
 #define indirect_ck_restore(T, OCP) indirect_ck_restore(aTHX_ (T), (OCP))
- I_CHECK_MUTEX_LOCK;
+ I_CHECK_LOCK;
  if (*old_ck_p) {
   PL_check[type] = *old_ck_p;
   *old_ck_p      = 0;
  }
- I_CHECK_MUTEX_UNLOCK;
+ I_CHECK_UNLOCK;
 }
 
 /* --- Helpers ------------------------------------------------------------- */
 
+/* ... Check if the module is loaded ....................................... */
+
+static I32 indirect_loaded = 0;
+
+#if I_THREADSAFE
+
+#define PTABLE_NAME        ptable_loaded
+#define PTABLE_NEED_DELETE 1
+#define PTABLE_NEED_WALK   0
+
+#include "ptable.h"
+
+#define ptable_loaded_store(T, K, V) ptable_loaded_store(aPTBLMS_ (T), (K), (V))
+#define ptable_loaded_delete(T, K)   ptable_loaded_delete(aPTBLMS_ (T), (K))
+#define ptable_loaded_free(T)        ptable_loaded_free(aPTBLMS_ (T))
+
+static ptable *indirect_loaded_cxts = NULL;
+
+static int indirect_is_loaded(pTHX_ void *cxt) {
+#define indirect_is_loaded(C) indirect_is_loaded(aTHX_ (C))
+ int res = 0;
+
+ I_LOADED_LOCK;
+ if (indirect_loaded_cxts && ptable_fetch(indirect_loaded_cxts, cxt))
+  res = 1;
+ I_LOADED_UNLOCK;
+
+ return res;
+}
+
+static int indirect_set_loaded_locked(pTHX_ void *cxt) {
+#define indirect_set_loaded_locked(C) indirect_set_loaded_locked(aTHX_ (C))
+ int global_setup = 0;
+
+ if (indirect_loaded <= 0) {
+  assert(indirect_loaded == 0);
+  assert(!indirect_loaded_cxts);
+  indirect_loaded_cxts = ptable_new();
+  global_setup         = 1;
+ }
+ ++indirect_loaded;
+ assert(indirect_loaded_cxts);
+ ptable_loaded_store(indirect_loaded_cxts, cxt, cxt);
+
+ return global_setup;
+}
+
+static int indirect_clear_loaded_locked(pTHX_ void *cxt) {
+#define indirect_clear_loaded_locked(C) indirect_clear_loaded_locked(aTHX_ (C))
+ int global_teardown = 0;
+
+ if (indirect_loaded > 1) {
+  assert(indirect_loaded_cxts);
+  ptable_loaded_delete(indirect_loaded_cxts, cxt);
+  --indirect_loaded;
+ } else if (indirect_loaded_cxts) {
+  assert(indirect_loaded == 1);
+  ptable_loaded_free(indirect_loaded_cxts);
+  indirect_loaded_cxts = NULL;
+  indirect_loaded      = 0;
+  global_teardown      = 1;
+ }
+
+ return global_teardown;
+}
+
+#else
+
+#define indirect_is_loaded(C)           (indirect_loaded > 0)
+#define indirect_set_loaded_locked(C)   ((indirect_loaded++ <= 0) ? 1 : 0)
+#define indirect_clear_loaded_locked(C) ((--indirect_loaded <= 0) ? 1 : 0)
+
+#endif
+
 /* ... Thread-safe hints ................................................... */
 
 #if I_WORKAROUND_REQUIRE_PROPAGATION
@@ -221,6 +321,8 @@ typedef SV indirect_hint_t;
 
 #define PTABLE_NAME        ptable_hints
 #define PTABLE_VAL_FREE(V) I_HINT_FREE(V)
+#define PTABLE_NEED_DELETE 0
+#define PTABLE_NEED_WALK   1
 
 #define pPTBL  pTHX
 #define pPTBL_ pTHX_
@@ -247,6 +349,8 @@ typedef struct {
 
 #define PTABLE_NAME        ptable
 #define PTABLE_VAL_FREE(V) if (V) { Safefree(((indirect_op_info_t *) (V))->buf); Safefree(V); }
+#define PTABLE_NEED_DELETE 1
+#define PTABLE_NEED_WALK   0
 
 #define pPTBL  pTHX
 #define pPTBL_ pTHX_
@@ -322,43 +426,10 @@ static void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
  ptable_hints_store(ud->tbl, ent->key, h2);
 }
 
-static void indirect_thread_cleanup(pTHX_ void *ud) {
- dMY_CXT;
-
- SvREFCNT_dec(MY_CXT.global_code);
- MY_CXT.global_code = NULL;
- ptable_free(MY_CXT.map);
- MY_CXT.map = NULL;
- ptable_hints_free(MY_CXT.tbl);
- MY_CXT.tbl = NULL;
-}
-
-static int indirect_endav_free(pTHX_ SV *sv, MAGIC *mg) {
- SAVEDESTRUCTOR_X(indirect_thread_cleanup, NULL);
-
- return 0;
-}
-
-static MGVTBL indirect_endav_vtbl = {
- 0,
- 0,
- 0,
- 0,
- indirect_endav_free
-#if MGf_COPY
- , 0
-#endif
-#if MGf_DUP
- , 0
-#endif
-#if MGf_LOCAL
- , 0
-#endif
-};
-
 #endif /* I_THREADSAFE */
 
 #if I_WORKAROUND_REQUIRE_PROPAGATION
+
 static IV indirect_require_tag(pTHX) {
 #define indirect_require_tag() indirect_require_tag(aTHX)
  const CV *cv, *outside;
@@ -402,6 +473,7 @@ get_enclosing_cv:
 
  return PTR2IV(cv);
 }
+
 #endif /* I_WORKAROUND_REQUIRE_PROPAGATION */
 
 static SV *indirect_tag(pTHX_ SV *value) {
@@ -468,7 +540,7 @@ static SV *indirect_detag(pTHX_ const SV *hint) {
  return I_HINT_CODE(h);
 }
 
-static U32 indirect_hash = 0;
+static VOL U32 indirect_hash = 0;
 
 static SV *indirect_hint(pTHX) {
 #define indirect_hint() indirect_hint(aTHX)
@@ -499,11 +571,14 @@ static SV *indirect_hint(pTHX) {
  }
 #endif
 
- if (hint && SvIOK(hint))
+ if (hint && SvIOK(hint)) {
   return indirect_detag(hint);
- else {
+ } else {
   dMY_CXT;
-  return MY_CXT.global_code;
+  if (indirect_is_loaded(&MY_CXT))
+   return MY_CXT.global_code;
+  else
+   return NULL;
  }
 }
 
@@ -559,7 +634,7 @@ static void indirect_map_delete(pTHX_ const OP *o) {
 #define indirect_map_delete(O) indirect_map_delete(aTHX_ (O))
  dMY_CXT;
 
- if (MY_CXT.map)
+ if (indirect_is_loaded(&MY_CXT) && MY_CXT.map)
   ptable_delete(MY_CXT.map, o);
 }
 
@@ -933,79 +1008,87 @@ done:
  return o;
 }
 
-static U32 indirect_initialized = 0;
+/* --- Module setup/teardown ----------------------------------------------- */
 
-static void indirect_teardown(pTHX_ void *root) {
- if (!indirect_initialized)
-  return;
+static void indirect_teardown(pTHX_ void *interp) {
+ dMY_CXT;
 
-#if I_MULTIPLICITY
- if (aTHX != root)
-  return;
-#endif
+ I_LOADED_LOCK;
 
- {
-  dMY_CXT;
-  ptable_free(MY_CXT.map);
-  MY_CXT.map = NULL;
-#if I_THREADSAFE
-  ptable_hints_free(MY_CXT.tbl);
-  MY_CXT.tbl = NULL;
-#endif
+ if (indirect_clear_loaded_locked(&MY_CXT)) {
+  indirect_ck_restore(OP_CONST,   &indirect_old_ck_const);
+  indirect_ck_restore(OP_RV2SV,   &indirect_old_ck_rv2sv);
+  indirect_ck_restore(OP_PADANY,  &indirect_old_ck_padany);
+  indirect_ck_restore(OP_SCOPE,   &indirect_old_ck_scope);
+  indirect_ck_restore(OP_LINESEQ, &indirect_old_ck_lineseq);
+
+  indirect_ck_restore(OP_METHOD,       &indirect_old_ck_method);
+  indirect_ck_restore(OP_METHOD_NAMED, &indirect_old_ck_method_named);
+  indirect_ck_restore(OP_ENTERSUB,     &indirect_old_ck_entersub);
  }
 
- indirect_ck_restore(OP_CONST,   &indirect_old_ck_const);
- indirect_ck_restore(OP_RV2SV,   &indirect_old_ck_rv2sv);
- indirect_ck_restore(OP_PADANY,  &indirect_old_ck_padany);
- indirect_ck_restore(OP_SCOPE,   &indirect_old_ck_scope);
- indirect_ck_restore(OP_LINESEQ, &indirect_old_ck_lineseq);
+ I_LOADED_UNLOCK;
+
+ SvREFCNT_dec(MY_CXT.global_code);
+ MY_CXT.global_code = NULL;
+
+ ptable_free(MY_CXT.map);
+ MY_CXT.map = NULL;
 
- indirect_ck_restore(OP_METHOD,       &indirect_old_ck_method);
- indirect_ck_restore(OP_METHOD_NAMED, &indirect_old_ck_method_named);
- indirect_ck_restore(OP_ENTERSUB,     &indirect_old_ck_entersub);
+#if I_THREADSAFE
+ ptable_hints_free(MY_CXT.tbl);
+ MY_CXT.tbl = NULL;
+#endif
 
- indirect_initialized = 0;
+ return;
 }
 
 static void indirect_setup(pTHX) {
 #define indirect_setup() indirect_setup(aTHX)
- if (indirect_initialized)
-  return;
+ MY_CXT_INIT; /* Takes/release PL_my_ctx_mutex */
+
+ I_LOADED_LOCK;
+
+ if (indirect_set_loaded_locked(&MY_CXT)) {
+  PERL_HASH(indirect_hash, __PACKAGE__, __PACKAGE_LEN__);
+
+  indirect_ck_replace(OP_CONST,   indirect_ck_const,  &indirect_old_ck_const);
+  indirect_ck_replace(OP_RV2SV,   indirect_ck_rv2sv,  &indirect_old_ck_rv2sv);
+  indirect_ck_replace(OP_PADANY,  indirect_ck_padany, &indirect_old_ck_padany);
+  indirect_ck_replace(OP_SCOPE,   indirect_ck_scope,  &indirect_old_ck_scope);
+  indirect_ck_replace(OP_LINESEQ, indirect_ck_scope,  &indirect_old_ck_lineseq);
+
+  indirect_ck_replace(OP_METHOD,       indirect_ck_method,
+                                       &indirect_old_ck_method);
+  indirect_ck_replace(OP_METHOD_NAMED, indirect_ck_method_named,
+                                       &indirect_old_ck_method_named);
+  indirect_ck_replace(OP_ENTERSUB,     indirect_ck_entersub,
+                                       &indirect_old_ck_entersub);
+ }
+
+ I_LOADED_UNLOCK;
 
  {
-  MY_CXT_INIT;
+  HV *stash;
+
+  stash = gv_stashpvn(__PACKAGE__, __PACKAGE_LEN__, 1);
+  newCONSTSUB(stash, "I_THREADSAFE", newSVuv(I_THREADSAFE));
+  newCONSTSUB(stash, "I_FORKSAFE",   newSVuv(I_FORKSAFE));
+
 #if I_THREADSAFE
   MY_CXT.tbl         = ptable_new();
   MY_CXT.owner       = aTHX;
 #endif
+
   MY_CXT.map         = ptable_new();
   MY_CXT.global_code = NULL;
  }
 
- indirect_ck_replace(OP_CONST,   indirect_ck_const,  &indirect_old_ck_const);
- indirect_ck_replace(OP_RV2SV,   indirect_ck_rv2sv,  &indirect_old_ck_rv2sv);
- indirect_ck_replace(OP_PADANY,  indirect_ck_padany, &indirect_old_ck_padany);
- indirect_ck_replace(OP_SCOPE,   indirect_ck_scope,  &indirect_old_ck_scope);
- indirect_ck_replace(OP_LINESEQ, indirect_ck_scope,  &indirect_old_ck_lineseq);
-
- indirect_ck_replace(OP_METHOD,       indirect_ck_method,
-                                      &indirect_old_ck_method);
- indirect_ck_replace(OP_METHOD_NAMED, indirect_ck_method_named,
-                                      &indirect_old_ck_method_named);
- indirect_ck_replace(OP_ENTERSUB,     indirect_ck_entersub,
-                                      &indirect_old_ck_entersub);
-
-#if I_MULTIPLICITY
- call_atexit(indirect_teardown, aTHX);
-#else
  call_atexit(indirect_teardown, NULL);
-#endif
 
- indirect_initialized = 1;
+ return;
 }
 
-static U32 indirect_booted = 0;
-
 /* --- XS ------------------------------------------------------------------ */
 
 MODULE = indirect      PACKAGE = indirect
@@ -1014,16 +1097,6 @@ PROTOTYPES: ENABLE
 
 BOOT:
 {
- if (!indirect_booted++) {
-  HV *stash;
-
-  PERL_HASH(indirect_hash, __PACKAGE__, __PACKAGE_LEN__);
-
-  stash = gv_stashpvn(__PACKAGE__, __PACKAGE_LEN__, 1);
-  newCONSTSUB(stash, "I_THREADSAFE", newSVuv(I_THREADSAFE));
-  newCONSTSUB(stash, "I_FORKSAFE",   newSVuv(I_FORKSAFE));
- }
-
  indirect_setup();
 }
 
@@ -1035,7 +1108,6 @@ PROTOTYPE: DISABLE
 PREINIT:
  ptable *t;
  SV     *global_code_dup;
- GV     *gv;
 PPCODE:
  {
   indirect_ptable_clone_ud ud;
@@ -1052,27 +1124,17 @@ PPCODE:
   MY_CXT.tbl         = t;
   MY_CXT.owner       = aTHX;
   MY_CXT.global_code = global_code_dup;
- }
- gv = gv_fetchpv(__PACKAGE__ "::_THREAD_CLEANUP", 0, SVt_PVCV);
- if (gv) {
-  CV *cv = GvCV(gv);
-  if (!PL_endav)
-   PL_endav = newAV();
-  SvREFCNT_inc(cv);
-  if (!av_store(PL_endav, av_len(PL_endav) + 1, (SV *) cv))
-   SvREFCNT_dec(cv);
-  sv_magicext((SV *) PL_endav, NULL, PERL_MAGIC_ext, &indirect_endav_vtbl, NULL, 0);
+  {
+   int global_setup;
+   I_LOADED_LOCK;
+   global_setup = indirect_set_loaded_locked(&MY_CXT);
+   assert(!global_setup);
+   I_LOADED_UNLOCK;
+  }
  }
  XSRETURN(0);
 
-void
-_THREAD_CLEANUP(...)
-PROTOTYPE: DISABLE
-PPCODE:
- indirect_thread_cleanup(aTHX_ NULL);
- XSRETURN(0);
-
-#endif
+#endif /* I_THREADSAFE */
 
 SV *
 _tag(SV *value)