X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FSub-Op.git;a=blobdiff_plain;f=Op.xs;fp=Op.xs;h=285c1e9768ae593cc7f2c51b7697ad88fad20f77;hp=f101fa7509fb1d866cac0d72b6c72a5a598996b3;hb=0eb003f3bbeeada878cab10f7dabc020c775b666;hpb=302bf09fbd4b673e199bdd22b330ebbdbec4e1fe diff --git a/Op.xs b/Op.xs index f101fa7..285c1e9 100644 --- a/Op.xs +++ b/Op.xs @@ -90,25 +90,6 @@ 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" @@ -118,7 +99,6 @@ void sub_op_init(sub_op_config_t *c) { c->namelen = 0; c->proto = NULL; c->protolen = 0; - c->pp = 0; c->check = 0; c->ref = 0; c->ud = NULL; @@ -127,25 +107,12 @@ void sub_op_init(sub_op_config_t *c) { } void sub_op_register(pTHX_ const sub_op_config_t *c, U32 flags) { - SV *key = newSViv(PTR2IV(c->pp)); + dMY_CXT; if (!(flags & SUB_OP_REGISTER_STEAL)) c = sub_op_dup(aTHX_ c); - if (!PL_custom_op_names) - PL_custom_op_names = newHV(); - (void) hv_store_ent(PL_custom_op_names, key, newSVpv(c->name, c->namelen), 0); - - if (!PL_custom_op_descs) - PL_custom_op_descs = newHV(); - (void) hv_store_ent(PL_custom_op_descs, key, newSVpv(c->name, c->namelen), 0); - - SvREFCNT_dec(key); - - { - dMY_CXT; - (void) hv_store(MY_CXT.map, c->name, c->namelen, newSViv(PTR2IV(c)), 0); - } + (void) hv_store(MY_CXT.map, c->name, c->namelen, newSViv(PTR2IV(c)), 0); } sub_op_config_t *sub_op_dup(pTHX_ const sub_op_config_t *orig) { @@ -172,7 +139,6 @@ sub_op_config_t *sub_op_dup(pTHX_ const sub_op_config_t *orig) { } dupe->protolen = len; - dupe->pp = orig->pp; dupe->check = orig->check; dupe->ref = orig->ref; dupe->ud = orig->ud; @@ -187,6 +153,48 @@ void sub_op_free(pTHX_ sub_op_config_t *c) { return; } +OP *sub_op_study(const OP *o, OP **last_arg_p, OP **rv2cv_p) { + OP *ex_list, *last_arg, *rv2cv, *gvop; + + ex_list = cUNOPo->op_first; + /* pushmark when a method call */ + if (!ex_list || ex_list->op_type != OP_NULL) + goto skip; + + rv2cv = cUNOPx(ex_list)->op_first; + if (!rv2cv) + goto skip; + + while (1) { + OP *next = rv2cv->op_sibling; + if (!next) + break; + last_arg = rv2cv; + rv2cv = next; + } + + if (!(rv2cv->op_flags & OPf_KIDS)) + goto skip; + + gvop = cUNOPx(rv2cv)->op_first; + + if (gvop && gvop->op_type == OP_GV) + goto done; + +skip: + last_arg = NULL; + rv2cv = NULL; + gvop = NULL; + +done: + if (last_arg_p) + *last_arg_p = last_arg; + if (rv2cv_p) + *rv2cv_p = rv2cv; + + return gvop; +} + /* --- Private helpers ----------------------------------------------------- */ STATIC IV so_hint(pTHX) { @@ -211,7 +219,7 @@ STATIC IV so_hint(pTHX) { return (SvOK(hint) && SvIOK(hint)) ? SvIVX(hint) : 0; } -STATIC OP *so_find_gvop(OP *o, OP **last_arg_p, OP **rv2cv_p) { +STATIC OP *so_find_gvop(const OP *o) { OP *ex_list, *last_arg, *rv2cv, *gvop; ex_list = cUNOPo->op_first; @@ -227,30 +235,18 @@ STATIC OP *so_find_gvop(OP *o, OP **last_arg_p, OP **rv2cv_p) { OP *next = rv2cv->op_sibling; if (!next) break; - last_arg = rv2cv; - rv2cv = next; + rv2cv = next; } if (!(rv2cv->op_flags & OPf_KIDS)) goto skip; gvop = cUNOPx(rv2cv)->op_first; - if (gvop && gvop->op_type == OP_GV) - goto done; + return gvop; skip: - last_arg = NULL; - rv2cv = NULL; - gvop = NULL; - -done: - if (last_arg_p) - *last_arg_p = last_arg; - if (rv2cv_p) - *rv2cv_p = rv2cv; - - return gvop; + return NULL; } STATIC OP *(*so_old_ck_entersub)(pTHX_ OP *) = 0; @@ -259,7 +255,7 @@ STATIC OP *so_ck_entersub(pTHX_ OP *o) { o = CALL_FPTR(so_old_ck_entersub)(aTHX_ o); if (so_hint()) { - OP *ex_list, *last_arg, *rv2cv, *gvop; + OP *gvop; GV *gv; if (o->op_type != OP_ENTERSUB) @@ -267,7 +263,7 @@ STATIC OP *so_ck_entersub(pTHX_ OP *o) { if (o->op_private & OPpENTERSUB_AMPER) /* hopefully \&foo */ goto skip; - gvop = so_find_gvop(o, &last_arg, &rv2cv); + gvop = so_find_gvop(o); if (!gvop) goto skip; @@ -292,30 +288,8 @@ STATIC OP *so_ck_entersub(pTHX_ OP *o) { GvCV(gv) = NULL; } - o->op_type = OP_CUSTOM; - o->op_ppaddr = c->pp; - - if (last_arg) - last_arg->op_sibling = NULL; - - op_free(rv2cv); - if (c->check) o = CALL_FPTR(c->check)(aTHX_ o, c->ud); - - { - 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 */ - } } } @@ -349,7 +323,7 @@ STATIC OP *so_ck_refgen(pTHX_ OP *o) { if (kid->op_type != OP_RV2CV) continue; - gvop = so_find_gvop(kid, NULL, NULL); + gvop = so_find_gvop(kid); if (!gvop) continue; @@ -433,11 +407,6 @@ 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.placeholder = NULL; @@ -493,30 +462,6 @@ PPCODE: } XSRETURN(0); -void -_custom_name(SV *op) -PROTOTYPE: $ -PREINIT: - OP *o; - 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; -#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_2mortal(newSVpvn(&on->buf, on->len)); - XSRETURN(1); - void _constant_sub(SV *sv) PROTOTYPE: $