X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FSub-Op.git;a=blobdiff_plain;f=Op.xs;h=17fa468fc11fad06ff19b269e215cdb9acdf4541;hp=c5be45bd6f33b60a7fd9bec62dbb217d0a3d29be;hb=159088ccddecdea45fdae8093319b41c097adc86;hpb=b9c3a456f75424383f35cb83000965d76e56d4ed diff --git a/Op.xs b/Op.xs index c5be45b..17fa468 100644 --- a/Op.xs +++ b/Op.xs @@ -126,6 +126,9 @@ 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)); + 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); @@ -134,15 +137,11 @@ void sub_op_register(pTHX_ const sub_op_config_t *c, U32 flags) { PL_custom_op_descs = newHV(); (void) hv_store_ent(PL_custom_op_descs, key, newSVpv(c->name, c->namelen), 0); - if (c->check) { - SV *check = newSViv(PTR2IV(c->check)); - sv_magicext(key, check, PERL_MAGIC_ext, NULL, c->ud, 0); - SvREFCNT_dec(check); - } + SvREFCNT_dec(key); { dMY_CXT; - (void) hv_store(MY_CXT.map, c->name, c->namelen, key, 0); + (void) hv_store(MY_CXT.map, c->name, c->namelen, newSViv(PTR2IV(c)), 0); } } @@ -232,19 +231,18 @@ STATIC OP *so_ck_entersub(pTHX_ OP *o) { gv = cGVOPx_gv(gvop); { - SV *pp_sv, **svp; - CV *cv = NULL; + SV **svp; + CV *cv = NULL; const char *name = GvNAME(gv); I32 len = GvNAMELEN(gv); + const sub_op_config_t *c; dMY_CXT; svp = hv_fetch(MY_CXT.map, name, len, 0); if (!svp) goto skip; - pp_sv = *svp; - if (!pp_sv || !SvOK(pp_sv)) - goto skip; + c = INT2PTR(const sub_op_config_t *, SvIVX(*svp)); if (gv && SvTYPE(gv) >= SVt_PVGV && (cv = GvCV(gv)) == MY_CXT.placeholder) { SvREFCNT_dec(cv); @@ -252,20 +250,15 @@ STATIC OP *so_ck_entersub(pTHX_ OP *o) { } o->op_type = OP_CUSTOM; - o->op_ppaddr = INT2PTR(Perl_ppaddr_t, SvIVX(pp_sv)); + o->op_ppaddr = c->pp; if (last_arg) last_arg->op_sibling = NULL; op_free(rv2cv); - { - MAGIC *mg = mg_find(pp_sv, PERL_MAGIC_ext); - if (mg) { - sub_op_check_t check = INT2PTR(sub_op_check_t, SvIVX(mg->mg_obj)); - o = CALL_FPTR(check)(aTHX_ o, mg->mg_ptr); - } - } + if (c->check) + o = CALL_FPTR(c->check)(aTHX_ o, c->ud); { so_op_name_t *on = PerlMemShared_malloc(sizeof(*on) + len);