Only remap the hint through the pointer table for threaded perls

[perl/modules/indirect.git] / indirect.xs

diff --git a/indirect.xs b/indirect.xs
index 00622a5c10f5b2d5b3488ed2ca40f8b600dfdffe..45c1b50fedd200c8a023a389abb8842b35fb730b 100644 (file)
--- a/indirect.xs
+++ b/indirect.xs
@@ -133,21 +133,39 @@
 
 /* ... Thread-safe hints ................................................... */
 
-/* If any of those are true, we need to store the hint in a global table. */
-
-#if I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION
+#if I_WORKAROUND_REQUIRE_PROPAGATION
 
 typedef struct {
  SV  *code;
-#if I_WORKAROUND_REQUIRE_PROPAGATION
  I32  requires;
-#endif
 } indirect_hint_t;
 
-#define PTABLE_NAME ptable_hints
+#define I_HINT_STRUCT 1
+
+#define I_HINT_CODE(H) ((H)->code)
+
+#define I_HINT_FREE(H) {   \
+ indirect_hint_t *h = (H); \
+ SvREFCNT_dec(h->code);    \
+ PerlMemShared_free(h);    \
+}
+
+#else  /*  I_WORKAROUND_REQUIRE_PROPAGATION */
+
+typedef SV indirect_hint_t;
+
+#define I_HINT_STRUCT 0
+
+#define I_HINT_CODE(H) (H)
+
+#define I_HINT_FREE(H) SvREFCNT_dec(H);
+
+#endif /* !I_WORKAROUND_REQUIRE_PROPAGATION */
+
+#if I_THREADSAFE
 
-#define PTABLE_VAL_FREE(V) \
-   { indirect_hint_t *h = (V); SvREFCNT_dec(h->code); PerlMemShared_free(h); }
+#define PTABLE_NAME        ptable_hints
+#define PTABLE_VAL_FREE(V) I_HINT_FREE(V)
 
 #define pPTBL  pTHX
 #define pPTBL_ pTHX_
@@ -159,7 +177,7 @@ typedef struct {
 #define ptable_hints_store(T, K, V) ptable_hints_store(aTHX_ (T), (K), (V))
 #define ptable_hints_free(T)        ptable_hints_free(aTHX_ (T))
 
-#endif /* I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION */
+#endif /* I_THREADSAFE */
 
 /* Define the op->str ptable here because we need to be able to clean it during
  * thread cleanup. */
@@ -188,14 +206,12 @@ typedef struct {
 #define MY_CXT_KEY __PACKAGE__ "::_guts" XS_VERSION
 
 typedef struct {
-#if I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION
+#if I_THREADSAFE
  ptable     *tbl; /* It really is a ptable_hints */
+ tTHX        owner;
 #endif
  ptable     *map;
  const char *linestr;
-#if I_THREADSAFE
- tTHX        owner;
-#endif
 } my_cxt_t;
 
 START_MY_CXT
@@ -228,15 +244,28 @@ STATIC SV *indirect_clone(pTHX_ SV *sv, tTHX owner) {
 STATIC void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
  my_cxt_t        *ud = ud_;
  indirect_hint_t *h1 = ent->val;
- indirect_hint_t *h2 = PerlMemShared_malloc(sizeof *h2);
+ indirect_hint_t *h2;
 
- *h2 = *h1;
+ if (ud->owner == aTHX)
+  return;
 
- if (ud->owner != aTHX)
-  h2->code = indirect_clone(h1->code, ud->owner);
+#if I_HINT_STRUCT
 
- ptable_hints_store(ud->tbl, ent->key, h2);
+ h2           = PerlMemShared_malloc(sizeof *h2);
+ h2->code     = indirect_clone(h1->code, ud->owner);
  SvREFCNT_inc(h2->code);
+#if I_WORKAROUND_REQUIRE_PROPAGATION
+ h2->requires = h1->requires;
+#endif
+
+#else  /*  I_HINT_STRUCT */
+
+ h2 = indirect_clone(h1, ud->owner);
+ SvREFCNT_inc(h2);
+
+#endif /* !I_HINT_STRUCT */
+
+ ptable_hints_store(ud->tbl, ent->key, h2);
 }
 
 STATIC void indirect_thread_cleanup(pTHX_ void *);
@@ -259,8 +288,6 @@ STATIC void indirect_thread_cleanup(pTHX_ void *ud) {
 
 #endif /* I_THREADSAFE */
 
-#if I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION
-
 STATIC SV *indirect_tag(pTHX_ SV *value) {
 #define indirect_tag(V) indirect_tag(aTHX_ (V))
  indirect_hint_t *h;
@@ -277,6 +304,7 @@ STATIC SV *indirect_tag(pTHX_ SV *value) {
   }
  }
 
+#if I_HINT_STRUCT
  h = PerlMemShared_malloc(sizeof *h);
  h->code = code;
 
@@ -298,12 +326,18 @@ STATIC SV *indirect_tag(pTHX_ SV *value) {
 
   h->requires = requires;
  }
-#endif
+#endif /* I_WORKAROUND_REQUIRE_PROPAGATION */
 
+#else  /*  I_HINT_STRUCT */
+ h = code;
+#endif /* !I_HINT_STRUCT */
+
+#if I_THREADSAFE
  /* We only need for the key to be an unique tag for looking up the value later.
   * Allocated memory provides convenient unique identifiers, so that's why we
   * use the hint as the key itself. */
  ptable_hints_store(MY_CXT.tbl, h, h);
+#endif /* I_THREADSAFE */
 
  return newSViv(PTR2IV(h));
 }
@@ -316,7 +350,10 @@ STATIC SV *indirect_detag(pTHX_ const SV *hint) {
  if (!(hint && SvIOK(hint)))
   return NULL;
 
- h = ptable_fetch(MY_CXT.tbl, INT2PTR(void *, SvIVX(hint)));
+ h = INT2PTR(indirect_hint_t *, SvIVX(hint));
+#if I_THREADSAFE
+ h = ptable_fetch(MY_CXT.tbl, h);
+#endif /* I_THREADSAFE */
 
 #if I_WORKAROUND_REQUIRE_PROPAGATION
  {
@@ -335,30 +372,11 @@ STATIC SV *indirect_detag(pTHX_ const SV *hint) {
    }
   }
  }
-#endif
-
- return h->code;
-}
-
-#else
-
-STATIC SV *indirect_tag(pTHX_ SV *value) {
-#define indirect_tag(V) indirect_tag(aTHX_ (V))
- UV tag = 0;
-
- if (SvROK(value)) {
-  value = SvRV(value);
-  SvREFCNT_inc_simple_NN(value);
-  tag = PTR2IV(value);
- }
+#endif /* I_WORKAROUND_REQUIRE_PROPAGATION */
 
- return newSViv(tag);
+ return I_HINT_CODE(h);
 }
 
-#define indirect_detag(H) (((H) && SvIOK(H)) ? INT2PTR(SV *, SvIVX(H)) : NULL)
-
-#endif /* I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION */
-
 STATIC U32 indirect_hash = 0;
 
 STATIC SV *indirect_hint(pTHX) {
@@ -763,14 +781,12 @@ BOOT:
   HV *stash;
 
   MY_CXT_INIT;
-  MY_CXT.map     = ptable_new();
-  MY_CXT.linestr = NULL;
-#if I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION
-  MY_CXT.tbl     = ptable_new();
-#endif
 #if I_THREADSAFE
+  MY_CXT.tbl     = ptable_new();
   MY_CXT.owner   = aTHX;
 #endif
+  MY_CXT.map     = ptable_new();
+  MY_CXT.linestr = NULL;
 
   PERL_HASH(indirect_hash, __PACKAGE__, __PACKAGE_LEN__);