X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Op.xs;h=8b761adfab1044a113921842b16003c5e56c0b00;hb=cf6a8cf942e28d57dc90e19e87237c87a3219cea;hp=b1ecdb483d46f79365aa519e1b40460751311607;hpb=3b39085a294ef16114b0d119dc8ebdecbe87fb51;p=perl%2Fmodules%2FSub-Op.git

diff --git a/Op.xs b/Op.xs
index b1ecdb4..8b761ad 100644
--- a/Op.xs
+++ b/Op.xs
@@ -55,8 +55,6 @@
 
 typedef struct {
  HV  *map;
- AV  *next_pkg;
- AV  *next_name;
  CV  *placeholder;
 #if SO_THREADSAFE
  tTHX owner;
@@ -92,6 +90,25 @@ STATIC SV *so_clone(pTHX_ SV *sv, tTHX owner) {
 
 #endif /* SO_THREADSAFE */
 
+#define PTABLE_NAME        ptable
+#define PTABLE_VAL_FREE(V) PerlMemShared_free(V)
+
+#include "ptable.h"
+
+/* PerlMemShared_free() needs the [ap]PTBLMS_? default values */
+#define ptable_store(T, K, V) ptable_store(aPTBLMS_ (T), (K), (V))
+
+STATIC ptable *sub_op_name = NULL;
+
+#ifdef USE_ITHREADS
+STATIC perl_mutex sub_op_name_mutex;
+#endif
+
+typedef struct {
+ STRLEN len;
+ char   buf;
+} sub_op_name_t;
+
 /* --- Public API ---------------------------------------------------------- */
 
 #include "sub_op.h"
@@ -255,6 +272,20 @@ STATIC OP *sub_op_ck_entersub(pTHX_ OP *o) {
    }
 
    sub_op_linklist(o);
+
+   {
+    sub_op_name_t *on = PerlMemShared_malloc(sizeof(*on) + len);
+    Copy(name, &on->buf, len, char);
+    (&on->buf)[len] = '\0';
+    on->len = len;
+#ifdef USE_ITHREADS
+    MUTEX_LOCK(&sub_op_name_mutex);
+#endif /* USE_ITHREADS */
+    ptable_store(sub_op_name, o, on);
+#ifdef USE_ITHREADS
+    MUTEX_UNLOCK(&sub_op_name_mutex);
+#endif /* USE_ITHREADS */
+   }
   }
  }
 
@@ -309,10 +340,13 @@ PROTOTYPES: ENABLE
 
 BOOT:
 {
+ sub_op_name = ptable_new();
+#ifdef USE_ITHREADS
+ MUTEX_INIT(&sub_op_name_mutex);
+#endif
+
  MY_CXT_INIT;
  MY_CXT.map         = newHV();
- MY_CXT.next_pkg    = newAV();
- MY_CXT.next_name   = newAV();
  MY_CXT.placeholder = NULL;
 #if SO_THREADSAFE
  MY_CXT.owner       = aTHX;
@@ -343,8 +377,6 @@ CODE:
  {
   MY_CXT_CLONE;
   MY_CXT.map         = map;
-  MY_CXT.next_pkg    = newAV();
-  MY_CXT.next_name   = newAV();
   MY_CXT.placeholder = placeholder;
   MY_CXT.owner       = aTHX;
  }
@@ -370,18 +402,21 @@ _custom_name(SV *op)
 PROTOTYPE: $
 PREINIT:
  OP *o;
- SV *key;
- HE *he;
+ sub_op_name_t *on;
 PPCODE:
  if (!SvROK(op))
   XSRETURN_UNDEF;
  o = INT2PTR(OP *, SvIV(SvRV(op)));
  if (!o || o->op_type != OP_CUSTOM)
   XSRETURN_UNDEF;
- key = newSViv(PTR2IV(o->op_ppaddr));
- he  = hv_fetch_ent(PL_custom_op_names, key, 0, 0);
- SvREFCNT_dec(key);
- if (!he)
+#ifdef USE_ITHREADS
+ MUTEX_LOCK(&sub_op_name_mutex);
+#endif /* USE_ITHREADS */
+ on = ptable_fetch(sub_op_name, o);
+#ifdef USE_ITHREADS
+ MUTEX_UNLOCK(&sub_op_name_mutex);
+#endif /* USE_ITHREADS */
+ if (!on)
   XSRETURN_UNDEF;
- ST(0) = sv_mortalcopy(HeVAL(he));
+ ST(0) = sv_2mortal(newSVpvn(&on->buf, on->len));
  XSRETURN(1);