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

diff --git a/Op.xs b/Op.xs
index 8b761ad..89716e7 100644
--- a/Op.xs
+++ b/Op.xs
@@ -98,79 +98,48 @@ STATIC SV *so_clone(pTHX_ SV *sv, tTHX owner) {
 /* 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;
+STATIC ptable *so_op_name = NULL;
 
 #ifdef USE_ITHREADS
-STATIC perl_mutex sub_op_name_mutex;
+STATIC perl_mutex so_op_name_mutex;
 #endif
 
 typedef struct {
  STRLEN len;
  char   buf;
-} sub_op_name_t;
+} 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)
@@ -191,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;
 
@@ -232,7 +201,6 @@ STATIC OP *sub_op_ck_entersub(pTHX_ OP *o) {
   gv = cGVOPx_gv(gvop);
 
   {
-   HV *stash = GvSTASH(gv);
    SV *pp_sv, **svp;
    CV *cv = NULL;
    const char *name = GvNAME(gv);
@@ -250,9 +218,6 @@ STATIC OP *sub_op_ck_entersub(pTHX_ OP *o) {
    if (gv && SvTYPE(gv) >= SVt_PVGV && (cv = GvCV(gv)) == MY_CXT.placeholder) {
     SvREFCNT_dec(cv);
     GvCV(gv) = NULL;
-    if (!GvSV(gv) && !GvAV(gv) && !GvHV(gv) && !GvIO(gv) && !GvFORM(gv)) {
-     (void) hv_delete(stash, name, len, G_DISCARD);
-    }
    }
 
    o->op_type   = OP_CUSTOM;
@@ -271,19 +236,17 @@ STATIC OP *sub_op_ck_entersub(pTHX_ OP *o) {
     }
    }
 
-   sub_op_linklist(o);
-
    {
-    sub_op_name_t *on = PerlMemShared_malloc(sizeof(*on) + len);
+    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(&sub_op_name_mutex);
+    MUTEX_LOCK(&so_op_name_mutex);
 #endif /* USE_ITHREADS */
-    ptable_store(sub_op_name, o, on);
+    ptable_store(so_op_name, o, on);
 #ifdef USE_ITHREADS
-    MUTEX_UNLOCK(&sub_op_name_mutex);
+    MUTEX_UNLOCK(&so_op_name_mutex);
 #endif /* USE_ITHREADS */
    }
   }
@@ -293,12 +256,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;
 
@@ -321,9 +284,6 @@ STATIC OP *sub_op_ck_gelem(pTHX_ OP *o) {
    if (gv && SvTYPE(gv) >= SVt_PVGV && (cv = GvCV(gv)) == MY_CXT.placeholder) {
     SvREFCNT_dec(cv);
     GvCV(gv) = NULL;
-    if (!GvSV(gv) && !GvAV(gv) && !GvHV(gv) && !GvIO(gv) && !GvFORM(gv)) {
-     (void)hv_delete(GvSTASH(gv), GvNAME_get(gv), GvNAMELEN_get(gv), G_DISCARD);
-    }
    }
   }
  }
@@ -340,9 +300,9 @@ PROTOTYPES: ENABLE
 
 BOOT:
 {
- sub_op_name = ptable_new();
+ so_op_name = ptable_new();
 #ifdef USE_ITHREADS
- MUTEX_INIT(&sub_op_name_mutex);
+ MUTEX_INIT(&so_op_name_mutex);
 #endif
 
  MY_CXT_INIT;
@@ -352,10 +312,10 @@ BOOT:
  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
@@ -367,7 +327,7 @@ PREINIT:
  HV  *map;
  CV  *placeholder;
  tTHX owner;
-CODE:
+PPCODE:
  {
   dMY_CXT;
   owner       = MY_CXT.owner;
@@ -380,6 +340,7 @@ CODE:
   MY_CXT.placeholder = placeholder;
   MY_CXT.owner       = aTHX;
  }
+ XSRETURN(0);
 
 #endif /* SO_THREADSAFE */
 
@@ -402,7 +363,7 @@ _custom_name(SV *op)
 PROTOTYPE: $
 PREINIT:
  OP *o;
- sub_op_name_t *on;
+ so_op_name_t *on;
 PPCODE:
  if (!SvROK(op))
   XSRETURN_UNDEF;
@@ -410,11 +371,11 @@ PPCODE:
  if (!o || o->op_type != OP_CUSTOM)
   XSRETURN_UNDEF;
 #ifdef USE_ITHREADS
- MUTEX_LOCK(&sub_op_name_mutex);
+ MUTEX_LOCK(&so_op_name_mutex);
 #endif /* USE_ITHREADS */
- on = ptable_fetch(sub_op_name, o);
+ on = ptable_fetch(so_op_name, o);
 #ifdef USE_ITHREADS
- MUTEX_UNLOCK(&sub_op_name_mutex);
+ MUTEX_UNLOCK(&so_op_name_mutex);
 #endif /* USE_ITHREADS */
  if (!on)
   XSRETURN_UNDEF;