Split the "custom op" part away

[perl/modules/Sub-Op.git] / Op.xs

diff --git a/Op.xs b/Op.xs
index f101fa7509fb1d866cac0d72b6c72a5a598996b3..285c1e9768ae593cc7f2c51b7697ad88fad20f77 100644 (file)
--- 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: $