#include "sub_op.h"
-void sub_op_register(pTHX_ const sub_op_config_t *c) {
+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 (!(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->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(c->name, c->len), 0);
+ (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->len, key, 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) {
+ 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) {
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);
}
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);