X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Op.xs;h=c5be45bd6f33b60a7fd9bec62dbb217d0a3d29be;hb=b9c3a456f75424383f35cb83000965d76e56d4ed;hp=44c283e99c25c43e10edf4d4c237c54eb082d1c3;hpb=fa4378c8262b5f0d476bb0af2d52551dc3fe0cc0;p=perl%2Fmodules%2FSub-Op.git

diff --git a/Op.xs b/Op.xs
index 44c283e..c5be45b 100644
--- a/Op.xs
+++ b/Op.xs
@@ -113,29 +113,60 @@ typedef struct {
 
 #include "sub_op.h"
 
-void sub_op_register(pTHX_ const sub_op_keyword *k) {
- SV *key = newSViv(PTR2IV(k->pp));
+void sub_op_init(sub_op_config_t *c) {
+ c->name    = NULL;
+ c->namelen = 0;
+ c->pp      = 0;
+ c->check   = 0;
+ c->ud      = NULL;
+
+ return;
+}
+
+void sub_op_register(pTHX_ const sub_op_config_t *c, U32 flags) {
+ 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->namelen), 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->namelen), 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->namelen, key, 0);
  }
 }
 
+sub_op_config_t *sub_op_dup(pTHX_ const sub_op_config_t *orig) {
+ sub_op_config_t *dupe = PerlMemShared_malloc(sizeof *dupe);
+
+ dupe->namelen = orig->namelen;
+ dupe->name    = PerlMemShared_malloc(dupe->namelen);
+ Copy(orig->name, dupe->name, dupe->namelen, char);
+
+ dupe->pp      = orig->pp;
+ dupe->check   = orig->check;
+ dupe->ud      = orig->ud;
+
+ return dupe;
+}
+
+void sub_op_free(pTHX_ sub_op_config_t *c) {
+ PerlMemShared_free((char *) c->name);
+ PerlMemShared_free(c);
+
+ return;
+}
+
 /* --- Private helpers ----------------------------------------------------- */
 
 STATIC IV so_hint(pTHX) {
@@ -201,7 +232,6 @@ STATIC OP *so_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);
@@ -219,9 +249,6 @@ STATIC OP *so_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;
@@ -288,9 +315,6 @@ STATIC OP *so_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);
-    }
    }
   }
  }
@@ -334,7 +358,7 @@ PREINIT:
  HV  *map;
  CV  *placeholder;
  tTHX owner;
-CODE:
+PPCODE:
  {
   dMY_CXT;
   owner       = MY_CXT.owner;
@@ -347,6 +371,7 @@ CODE:
   MY_CXT.placeholder = placeholder;
   MY_CXT.owner       = aTHX;
  }
+ XSRETURN(0);
 
 #endif /* SO_THREADSAFE */
 
@@ -387,3 +412,15 @@ PPCODE:
   XSRETURN_UNDEF;
  ST(0) = sv_2mortal(newSVpvn(&on->buf, on->len));
  XSRETURN(1);
+
+void
+_constant_sub(SV *sv)
+PROTOTYPE: $
+PPCODE:
+ if (!SvROK(sv))
+  XSRETURN_UNDEF;
+ sv = SvRV(sv);
+ if (SvTYPE(sv) < SVt_PVCV)
+  XSRETURN_UNDEF;
+ ST(0) = sv_2mortal(newSVuv(CvCONST(sv)));
+ XSRETURN(1);