X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Op.xs;h=bc85f7f921a4cf43c7af85f2e264bbb55c675f8d;hb=cca835349c605e0526dc400c6224e4551bf8b54a;hp=b1ecdb483d46f79365aa519e1b40460751311607;hpb=3b39085a294ef16114b0d119dc8ebdecbe87fb51;p=perl%2Fmodules%2FSub-Op.git diff --git a/Op.xs b/Op.xs index b1ecdb4..bc85f7f 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,68 +90,56 @@ 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 *so_op_name = NULL; + +#ifdef USE_ITHREADS +STATIC perl_mutex so_op_name_mutex; +#endif + +typedef struct { + STRLEN len; + char buf; +} so_op_name_t; + /* --- Public API ---------------------------------------------------------- */ #include "sub_op.h" -void sub_op_register(pTHX_ const sub_op_keyword *k) { - SV *key = newSViv(PTR2IV(k->pp)); +void sub_op_register(pTHX_ const sub_op_config_t *c) { + SV *key = newSViv(PTR2IV(c->pp)); if (!PL_custom_op_names) PL_custom_op_names = newHV(); - (void) hv_store_ent(PL_custom_op_names, key, newSVpv(k->name, k->len), 0); + (void) hv_store_ent(PL_custom_op_names, key, newSVpv(c->name, c->len), 0); if (!PL_custom_op_descs) PL_custom_op_descs = newHV(); - (void) hv_store_ent(PL_custom_op_descs, key, newSVpv(k->name, k->len), 0); + (void) hv_store_ent(PL_custom_op_descs, key, newSVpv(c->name, c->len), 0); - if (k->check) { - SV *check = newSViv(PTR2IV(k->check)); - sv_magicext(key, check, PERL_MAGIC_ext, NULL, k->ud, 0); + if (c->check) { + SV *check = newSViv(PTR2IV(c->check)); + sv_magicext(key, check, PERL_MAGIC_ext, NULL, c->ud, 0); SvREFCNT_dec(check); } { dMY_CXT; - (void) hv_store(MY_CXT.map, k->name, k->len, key, 0); + (void) hv_store(MY_CXT.map, c->name, c->len, key, 0); } } /* --- 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) +STATIC IV so_hint(pTHX) { +#define so_hint() so_hint(aTHX) SV *hint; #if SO_HAS_PERL(5, 9, 5) @@ -174,12 +160,12 @@ STATIC IV sub_op_hint(pTHX) { return (SvOK(hint) && SvIOK(hint)) ? SvIVX(hint) : 0; } -STATIC OP *(*sub_op_old_ck_entersub)(pTHX_ OP *) = 0; +STATIC OP *(*so_old_ck_entersub)(pTHX_ OP *) = 0; -STATIC OP *sub_op_ck_entersub(pTHX_ OP *o) { - o = CALL_FPTR(sub_op_old_ck_entersub)(aTHX_ o); +STATIC OP *so_ck_entersub(pTHX_ OP *o) { + o = CALL_FPTR(so_old_ck_entersub)(aTHX_ o); - if (sub_op_hint()) { + if (so_hint()) { OP *ex_list, *rv2cv, *gvop, *last_arg = NULL; GV *gv; @@ -254,7 +240,19 @@ STATIC OP *sub_op_ck_entersub(pTHX_ OP *o) { } } - sub_op_linklist(o); + { + so_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(&so_op_name_mutex); +#endif /* USE_ITHREADS */ + ptable_store(so_op_name, o, on); +#ifdef USE_ITHREADS + MUTEX_UNLOCK(&so_op_name_mutex); +#endif /* USE_ITHREADS */ + } } } @@ -262,12 +260,12 @@ skip: return o; } -STATIC OP *(*sub_op_old_ck_gelem)(pTHX_ OP *) = 0; +STATIC OP *(*so_old_ck_gelem)(pTHX_ OP *) = 0; -STATIC OP *sub_op_ck_gelem(pTHX_ OP *o) { - o = CALL_FPTR(sub_op_old_ck_entersub)(aTHX_ o); +STATIC OP *so_ck_gelem(pTHX_ OP *o) { + o = CALL_FPTR(so_old_ck_entersub)(aTHX_ o); - if (sub_op_hint()) { + if (so_hint()) { OP *rv2gv, *gvop; GV *gv; @@ -309,19 +307,22 @@ PROTOTYPES: ENABLE BOOT: { + so_op_name = ptable_new(); +#ifdef USE_ITHREADS + MUTEX_INIT(&so_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; #endif /* SO_THREADSAFE */ - sub_op_old_ck_entersub = PL_check[OP_ENTERSUB]; - PL_check[OP_ENTERSUB] = sub_op_ck_entersub; - sub_op_old_ck_gelem = PL_check[OP_GELEM]; - PL_check[OP_GELEM] = sub_op_ck_gelem; + so_old_ck_entersub = PL_check[OP_ENTERSUB]; + PL_check[OP_ENTERSUB] = so_ck_entersub; + so_old_ck_gelem = PL_check[OP_GELEM]; + PL_check[OP_GELEM] = so_ck_gelem; } #if SO_THREADSAFE @@ -343,8 +344,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 +369,21 @@ _custom_name(SV *op) PROTOTYPE: $ PREINIT: OP *o; - SV *key; - HE *he; + so_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(&so_op_name_mutex); +#endif /* USE_ITHREADS */ + on = ptable_fetch(so_op_name, o); +#ifdef USE_ITHREADS + MUTEX_UNLOCK(&so_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);