typedef struct {
HV *map;
- AV *next_pkg;
- AV *next_name;
CV *placeholder;
#if SO_THREADSAFE
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"
/* --- Private helpers ----------------------------------------------------- */
-#define SO_LINKLIST(O) ((O)->op_next ? (O)->op_next : sub_op_linklist(O))
-
-STATIC OP *sub_op_linklist(pTHX_ OP *o) {
-#define sub_op_linklist(O) sub_op_linklist(aTHX_ (O))
- OP *first;
-
- if (o->op_next)
- return o->op_next;
-
- /* establish postfix order */
- first = cUNOPo->op_first;
- if (first) {
- register OP *kid;
- o->op_next = SO_LINKLIST(first);
- kid = first;
- for (;;) {
- if (kid->op_sibling) {
- kid->op_next = SO_LINKLIST(kid->op_sibling);
- kid = kid->op_sibling;
- } else {
- kid->op_next = o;
- break;
- }
- }
- }
- else
- o->op_next = o;
-
- return o->op_next;
-}
-
STATIC IV sub_op_hint(pTHX) {
#define sub_op_hint() sub_op_hint(aTHX)
SV *hint;
}
}
- 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 */
+ }
}
}
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;
{
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;
}
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);