X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Magic.xs;h=1dada023c031867f619d812dc50bdc76facc7a78;hb=1ff75d21f8a370b6533873480725f78eebd70efc;hp=25d1d1c05dca695df4b81a2ed1d2fa7e9fb03373;hpb=501e4a135efbce048925d6020db002791f43b8e0;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/Magic.xs b/Magic.xs index 25d1d1c..1dada02 100644 --- a/Magic.xs +++ b/Magic.xs @@ -36,6 +36,11 @@ # define dNOOP #endif +/* Safe unless stated otherwise in Makefile.PL */ +#ifndef VMG_FORKSAFE +# define VMG_FORKSAFE 1 +#endif + #ifndef VMG_MULTIPLICITY # if defined(MULTIPLICITY) || defined(PERL_IMPLICIT_CONTEXT) # define VMG_MULTIPLICITY 1 @@ -89,10 +94,6 @@ STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) { # define Newx(v, n, c) New(0, v, n, c) #endif -#ifndef NewOp -# define NewOp(m, var, c, type) Newz(m, var, c, type) -#endif - #ifndef SvMAGIC_set # define SvMAGIC_set(sv, val) (SvMAGIC(sv) = (val)) #endif @@ -139,8 +140,9 @@ STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) { # endif #endif -/* uvar magic and Hash::Util::FieldHash were commited with 28419 */ -#if VMG_HAS_PERL_MAINT(5, 9, 4, 28419) || VMG_HAS_PERL(5, 10, 0) +/* uvar magic and Hash::Util::FieldHash were commited with 28419, but only + * enable it on 5.10 */ +#if VMG_HAS_PERL(5, 10, 0) # define VMG_UVAR 1 #else # define VMG_UVAR 0 @@ -233,8 +235,10 @@ STATIC const char *const vmg_opclassnames[] = { }; STATIC opclass vmg_opclass(const OP *o) { +#if 0 if (!o) return OPc_NULL; +#endif if (o->op_type == 0) return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP; @@ -313,12 +317,23 @@ typedef struct { START_MY_CXT +/* --- Error messages ------------------------------------------------------ */ + +STATIC const char vmg_invalid_wiz[] = "Invalid wizard object"; +STATIC const char vmg_invalid_sig[] = "Invalid numeric signature"; +STATIC const char vmg_wrongargnum[] = "Wrong number of arguments"; +STATIC const char vmg_toomanysigs[] = "Too many magic signatures used"; +STATIC const char vmg_argstorefailed[] = "Error while storing arguments"; +STATIC const char vmg_globstorefail[] = "Couldn't store global wizard information"; + /* --- Signatures ---------------------------------------------------------- */ -#define SIG_MIN ((U16) (1u << 8)) +#define SIG_MIN ((U16) 0u) #define SIG_MAX ((U16) ((1u << 16) - 1)) #define SIG_NBR (SIG_MAX - SIG_MIN + 1) -#define SIG_WIZ ((U16) ((1u << 8) - 1)) + +#define SIG_WZO ((U16) (0x3891)) +#define SIG_WIZ ((U16) (0x3892)) /* ... Generate signatures ................................................. */ @@ -328,6 +343,8 @@ STATIC U16 vmg_gensig(pTHX) { char buf[8]; dMY_CXT; + if (HvKEYS(MY_CXT.wizards) >= SIG_NBR) croak(vmg_toomanysigs); + do { sig = SIG_NBR * Drand01() + SIG_MIN; } while (hv_exists(MY_CXT.wizards, buf, sprintf(buf, "%u", sig))); @@ -408,9 +425,14 @@ STATIC SV *vmg_data_get(SV *sv, U16 sig) { if (SvTYPE(sv) >= SVt_PVMG) { for (mg = SvMAGIC(sv); mg; mg = moremagic) { moremagic = mg->mg_moremagic; - if ((mg->mg_type == PERL_MAGIC_ext) && (mg->mg_private == sig)) { break; } + if (mg->mg_type == PERL_MAGIC_ext && mg->mg_private == SIG_WIZ) { + MGWIZ *w = SV2MGWIZ(mg->mg_ptr); + if (w->sig == sig) + break; + } } - if (mg) { return mg->mg_obj; } + if (mg) + return mg->mg_obj; } return NULL; @@ -445,14 +467,19 @@ STATIC UV vmg_cast(pTHX_ SV *sv, SV *wiz, AV *args) { if (SvTYPE(sv) >= SVt_PVMG) { for (mg = SvMAGIC(sv); mg; mg = moremagic) { moremagic = mg->mg_moremagic; - if ((mg->mg_type == PERL_MAGIC_ext) && (mg->mg_private == w->sig)) { break; } + if (mg->mg_type == PERL_MAGIC_ext && mg->mg_private == SIG_WIZ) { + MGWIZ *z = SV2MGWIZ(mg->mg_ptr); + if (z->sig == w->sig) + break; + } } - if (mg) { return 1; } + if (mg) + return 1; } data = (w->cb_data) ? vmg_data_new(w->cb_data, sv, args) : NULL; mg = sv_magicext(sv, data, PERL_MAGIC_ext, w->vtbl, (const char *) wiz, HEf_SVKEY); - mg->mg_private = w->sig; + mg->mg_private = SIG_WIZ; #if MGf_COPY if (w->cb_copy) mg->mg_flags |= MGf_COPY; @@ -493,7 +520,8 @@ STATIC UV vmg_cast(pTHX_ SV *sv, SV *wiz, AV *args) { /* One uvar magic in the chain is enough. */ for (prevmagic = NULL, mg = SvMAGIC(sv); mg; prevmagic = mg, mg = moremagic) { moremagic = mg->mg_moremagic; - if (mg->mg_type == PERL_MAGIC_uvar) { break; } + if (mg->mg_type == PERL_MAGIC_uvar) + break; } if (mg) { /* Found another uvar magic. */ @@ -525,28 +553,29 @@ STATIC UV vmg_dispell(pTHX_ SV *sv, U16 sig) { #endif /* VMG_UVAR */ MAGIC *mg, *prevmagic, *moremagic = NULL; - if (SvTYPE(sv) < SVt_PVMG) { return 0; } + if (SvTYPE(sv) < SVt_PVMG) + return 0; for (prevmagic = NULL, mg = SvMAGIC(sv); mg; prevmagic = mg, mg = moremagic) { moremagic = mg->mg_moremagic; - if (mg->mg_type == PERL_MAGIC_ext) { - if (mg->mg_private == sig) { + if (mg->mg_type == PERL_MAGIC_ext && mg->mg_private == SIG_WIZ) { + MGWIZ *w = SV2MGWIZ(mg->mg_ptr); + if (w->sig == sig) { #if VMG_UVAR /* If the current has no uvar, short-circuit uvar deletion. */ - uvars = (SV2MGWIZ(mg->mg_ptr)->uvar) ? (uvars + 1) : 0; + uvars = w->uvar ? (uvars + 1) : 0; #endif /* VMG_UVAR */ break; #if VMG_UVAR - } else if ((mg->mg_private >= SIG_MIN) && - (mg->mg_private <= SIG_MAX) && - SV2MGWIZ(mg->mg_ptr)->uvar) { + } else if (w->uvar) { ++uvars; /* We can't break here since we need to find the ext magic to delete. */ #endif /* VMG_UVAR */ } } } - if (!mg) { return 0; } + if (!mg) + return 0; if (prevmagic) { prevmagic->mg_moremagic = moremagic; @@ -555,8 +584,11 @@ STATIC UV vmg_dispell(pTHX_ SV *sv, U16 sig) { } mg->mg_moremagic = NULL; - if (mg->mg_obj != sv) { SvREFCNT_dec(mg->mg_obj); } /* Destroy private data */ - SvREFCNT_dec((SV *) mg->mg_ptr); /* Unreference the wizard */ + /* Destroy private data */ + if (mg->mg_obj != sv) + SvREFCNT_dec(mg->mg_obj); + /* Unreference the wizard */ + SvREFCNT_dec((SV *) mg->mg_ptr); Safefree(mg); #if VMG_UVAR @@ -564,12 +596,12 @@ STATIC UV vmg_dispell(pTHX_ SV *sv, U16 sig) { /* mg was the first ext magic in the chain that had uvar */ for (mg = moremagic; mg; mg = mg->mg_moremagic) { - if ((mg->mg_type == PERL_MAGIC_ext) && - (mg->mg_private >= SIG_MIN) && - (mg->mg_private <= SIG_MAX) && - SV2MGWIZ(mg->mg_ptr)->uvar) { - ++uvars; - break; + if (mg->mg_type == PERL_MAGIC_ext && mg->mg_private == SIG_WIZ) { + MGWIZ *w = SV2MGWIZ(mg->mg_ptr); + if (w->uvar) { + ++uvars; + break; + } } } @@ -577,7 +609,8 @@ STATIC UV vmg_dispell(pTHX_ SV *sv, U16 sig) { struct ufuncs *uf; for (prevmagic = NULL, mg = SvMAGIC(sv); mg; prevmagic = mg, mg = moremagic){ moremagic = mg->mg_moremagic; - if (mg->mg_type == PERL_MAGIC_uvar) { break; } + if (mg->mg_type == PERL_MAGIC_uvar) + break; } /* assert(mg); */ uf = (struct ufuncs *) mg->mg_ptr; @@ -604,6 +637,10 @@ STATIC UV vmg_dispell(pTHX_ SV *sv, U16 sig) { #define VMG_OP_INFO_NAME 1 #define VMG_OP_INFO_OBJECT 2 +#if VMG_THREADSAFE +STATIC perl_mutex vmg_op_name_init_mutex; +#endif + STATIC U32 vmg_op_name_init = 0; STATIC unsigned char vmg_op_name_len[MAXO] = { 0 }; @@ -611,12 +648,18 @@ STATIC void vmg_op_info_init(pTHX_ unsigned int opinfo) { #define vmg_op_info_init(W) vmg_op_info_init(aTHX_ (W)) switch (opinfo) { case VMG_OP_INFO_NAME: +#if VMG_THREADSAFE + MUTEX_LOCK(&vmg_op_name_init_mutex); +#endif if (!vmg_op_name_init) { OPCODE t; for (t = 0; t < OP_max; ++t) vmg_op_name_len[t] = strlen(PL_op_name[t]); vmg_op_name_init = 1; } +#if VMG_THREADSAFE + MUTEX_UNLOCK(&vmg_op_name_init_mutex); +#endif break; case VMG_OP_INFO_OBJECT: { dMY_CXT; @@ -646,7 +689,7 @@ STATIC SV *vmg_op_info(pTHX_ unsigned int opinfo) { case VMG_OP_INFO_OBJECT: { dMY_CXT; return sv_bless(sv_2mortal(newRV_noinc(newSViv(PTR2IV(PL_op)))), - gv_stashpv(vmg_opclassnames[vmg_opclass(PL_op)], 1)); + MY_CXT.b__op_stashes[vmg_opclass(PL_op)]); } default: break; @@ -775,6 +818,10 @@ STATIC int vmg_svt_clear(pTHX_ SV *sv, MAGIC *mg) { STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) { const MGWIZ *w; +#if VMG_HAS_PERL(5, 9, 5) + PERL_CONTEXT saved_cx; + I32 cxix; +#endif unsigned int had_err, has_err, flags = G_SCALAR | G_EVAL; int ret = 0; @@ -812,8 +859,23 @@ STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) { if (had_err) flags |= G_KEEPERR; +#if VMG_HAS_PERL(5, 9, 5) + /* This context should not be used anymore, but since we croak in places the + * core doesn't even dare to, some pointers to it may remain in the upper call + * stack. Make sure call_sv() doesn't clobber it. */ + if (cxstack_ix < cxstack_max) + cxix = cxstack_ix + 1; + else + cxix = Perl_cxinc(aTHX); + saved_cx = cxstack[cxix]; +#endif + call_sv(w->cb_free, flags); +#if VMG_HAS_PERL(5, 9, 5) + cxstack[cxix] = saved_cx; +#endif + has_err = SvTRUE(ERRSV); if (IN_PERL_COMPILETIME && !had_err && has_err) ++PL_error_count; @@ -823,15 +885,6 @@ STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) { FREETMPS; LEAVE; - if (has_err) { - /* Get the eval context that was pushed by call_sv, and fake an entry for the - * namesv, as die_where will need it to be non NULL later */ - PERL_CONTEXT *cx = cxstack + cxstack_ix + 1; - if (!cx->blk_eval.old_namesv) - cx->blk_eval.old_namesv - = sv_2mortal(newSVpvn_share("Variable/Magic/DUMMY.pm", 23, 0)); - } - /* Calling SvREFCNT_dec() will trigger destructors in an infinite loop, so * we have to rely on SvREFCNT() being a lvalue. Heck, even the core does it */ --SvREFCNT(sv); @@ -899,8 +952,10 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) { key = umg->mg_obj; uf = (struct ufuncs *) umg->mg_ptr; - if (uf[1].uf_val != NULL) { uf[1].uf_val(aTHX_ action, sv); } - if (uf[1].uf_set != NULL) { uf[1].uf_set(aTHX_ action, sv); } + if (uf[1].uf_val) + uf[1].uf_val(aTHX_ action, sv); + if (uf[1].uf_set) + uf[1].uf_set(aTHX_ action, sv); action &= HV_FETCH_ISSTORE | HV_FETCH_ISEXISTS | HV_FETCH_LVALUE | HV_DELETE; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { @@ -914,7 +969,7 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) { default: continue; } - if (mg->mg_private < SIG_MIN || mg->mg_private > SIG_MAX) continue; + if (mg->mg_private != SIG_WIZ) continue; w = SV2MGWIZ(mg->mg_ptr); switch (w->uvar) { case 0: @@ -989,29 +1044,37 @@ STATIC int vmg_wizard_free(pTHX_ SV *wiz, MAGIC *mg) { if (hv_delete(MY_CXT.wizards, buf, sprintf(buf, "%u", w->sig), 0) != wiz) return 0; } - SvFLAGS(wiz) |= SVf_BREAK; - FREETMPS; - if (w->cb_data != NULL) { SvREFCNT_dec(SvRV(w->cb_data)); } - if (w->cb_get != NULL) { SvREFCNT_dec(SvRV(w->cb_get)); } - if (w->cb_set != NULL) { SvREFCNT_dec(SvRV(w->cb_set)); } - if (w->cb_len != NULL) { SvREFCNT_dec(SvRV(w->cb_len)); } - if (w->cb_clear != NULL) { SvREFCNT_dec(SvRV(w->cb_clear)); } - if (w->cb_free != NULL) { SvREFCNT_dec(SvRV(w->cb_free)); } + /* Unmortalize the wizard to avoid it being freed in weird places. */ + if (SvTEMP(wiz) && !SvREFCNT(wiz)) { + const I32 myfloor = PL_tmps_floor; + I32 i; + for (i = PL_tmps_ix; i > myfloor; --i) { + if (PL_tmps_stack[i] == wiz) + PL_tmps_stack[i] = NULL; + } + } + + if (w->cb_data) SvREFCNT_dec(SvRV(w->cb_data)); + if (w->cb_get) SvREFCNT_dec(SvRV(w->cb_get)); + if (w->cb_set) SvREFCNT_dec(SvRV(w->cb_set)); + if (w->cb_len) SvREFCNT_dec(SvRV(w->cb_len)); + if (w->cb_clear) SvREFCNT_dec(SvRV(w->cb_clear)); + if (w->cb_free) SvREFCNT_dec(SvRV(w->cb_free)); #if MGf_COPY - if (w->cb_copy != NULL) { SvREFCNT_dec(SvRV(w->cb_copy)); } + if (w->cb_copy) SvREFCNT_dec(SvRV(w->cb_copy)); #endif /* MGf_COPY */ #if 0 /* MGf_DUP */ - if (w->cb_dup != NULL) { SvREFCNT_dec(SvRV(w->cb_dup)); } + if (w->cb_dup) SvREFCNT_dec(SvRV(w->cb_dup)); #endif /* MGf_DUP */ #if MGf_LOCAL - if (w->cb_local != NULL) { SvREFCNT_dec(SvRV(w->cb_local)); } + if (w->cb_local) SvREFCNT_dec(SvRV(w->cb_local)); #endif /* MGf_LOCAL */ #if VMG_UVAR - if (w->cb_fetch != NULL) { SvREFCNT_dec(SvRV(w->cb_fetch)); } - if (w->cb_store != NULL) { SvREFCNT_dec(SvRV(w->cb_store)); } - if (w->cb_exists != NULL) { SvREFCNT_dec(SvRV(w->cb_exists)); } - if (w->cb_delete != NULL) { SvREFCNT_dec(SvRV(w->cb_delete)); } + if (w->cb_fetch) SvREFCNT_dec(SvRV(w->cb_fetch)); + if (w->cb_store) SvREFCNT_dec(SvRV(w->cb_store)); + if (w->cb_exists) SvREFCNT_dec(SvRV(w->cb_exists)); + if (w->cb_delete) SvREFCNT_dec(SvRV(w->cb_delete)); #endif /* VMG_UVAR */ Safefree(w->vtbl); @@ -1037,35 +1100,28 @@ STATIC MGVTBL vmg_wizard_vtbl = { #endif /* MGf_LOCAL */ }; -STATIC const char vmg_invalid_wiz[] = "Invalid wizard object"; -STATIC const char vmg_invalid_sig[] = "Invalid numeric signature"; -STATIC const char vmg_wrongargnum[] = "Wrong number of arguments"; -STATIC const char vmg_toomanysigs[] = "Too many magic signatures used"; -STATIC const char vmg_argstorefailed[] = "Error while storing arguments"; -STATIC const char vmg_globstorefail[] = "Couldn't store global wizard information"; - STATIC U16 vmg_sv2sig(pTHX_ SV *sv) { #define vmg_sv2sig(S) vmg_sv2sig(aTHX_ (S)) - U16 sig; + IV sig; if (SvIOK(sv)) { - sig = SvUVX(sv); + sig = SvIVX(sv); } else if (SvNOK(sv)) { sig = SvNVX(sv); } else if ((SvPOK(sv) && grok_number(SvPVX(sv), SvCUR(sv), NULL))) { - sig = SvUV(sv); + sig = SvIV(sv); } else { croak(vmg_invalid_sig); } - if (sig < SIG_MIN) { sig += SIG_MIN; } - if (sig > SIG_MAX) { sig %= SIG_MAX + 1; } + + if (sig < SIG_MIN || sig > SIG_MAX) + croak(vmg_invalid_sig); return sig; } STATIC U16 vmg_wizard_sig(pTHX_ SV *wiz) { #define vmg_wizard_sig(W) vmg_wizard_sig(aTHX_ (W)) - char buf[8]; U16 sig; if (SvROK(wiz)) { @@ -1078,16 +1134,17 @@ STATIC U16 vmg_wizard_sig(pTHX_ SV *wiz) { { dMY_CXT; - if (!hv_fetch(MY_CXT.wizards, buf, sprintf(buf, "%u", sig), 0)) - sig = 0; + char buf[8]; + SV **old = hv_fetch(MY_CXT.wizards, buf, sprintf(buf, "%u", sig), 0); + if (!(old && SV2MGWIZ(*old))) + croak(vmg_invalid_wiz); } + return sig; } STATIC SV *vmg_wizard_wiz(pTHX_ SV *wiz) { #define vmg_wizard_wiz(W) vmg_wizard_wiz(aTHX_ (W)) - char buf[8]; - SV **old; U16 sig; if (SvROK(wiz)) { @@ -1105,8 +1162,12 @@ STATIC SV *vmg_wizard_wiz(pTHX_ SV *wiz) { { dMY_CXT; - return (old = hv_fetch(MY_CXT.wizards, buf, sprintf(buf, "%u", sig), 0)) - ? *old : NULL; + char buf[8]; + SV **old = hv_fetch(MY_CXT.wizards, buf, sprintf(buf, "%u", sig), 0); + if (!(old && SV2MGWIZ(*old))) + croak(vmg_invalid_wiz); + + return *old; } } @@ -1185,6 +1246,10 @@ BOOT: MY_CXT.wizards = newHV(); hv_iterinit(MY_CXT.wizards); /* Allocate iterator */ MY_CXT.b__op_stashes[0] = NULL; +#if VMG_THREADSAFE + MUTEX_INIT(&vmg_op_name_init_mutex); +#endif + stash = gv_stashpv(__PACKAGE__, 1); newCONSTSUB(stash, "SIG_MIN", newSVuv(SIG_MIN)); newCONSTSUB(stash, "SIG_MAX", newSVuv(SIG_MAX)); @@ -1203,6 +1268,7 @@ BOOT: newSVuv(VMG_COMPAT_SCALAR_LENGTH_NOLEN)); newCONSTSUB(stash, "VMG_PERL_PATCHLEVEL", newSVuv(VMG_PERL_PATCHLEVEL)); newCONSTSUB(stash, "VMG_THREADSAFE", newSVuv(VMG_THREADSAFE)); + newCONSTSUB(stash, "VMG_FORKSAFE", newSVuv(VMG_FORKSAFE)); newCONSTSUB(stash, "VMG_OP_INFO_NAME", newSVuv(VMG_OP_INFO_NAME)); newCONSTSUB(stash, "VMG_OP_INFO_OBJECT", newSVuv(VMG_OP_INFO_OBJECT)); } @@ -1227,13 +1293,16 @@ CODE: STRLEN len; char *sig = HePV(key, len); SV *sv; - const MGWIZ *w; - MAGIC *mg; - w = SV2MGWIZ(HeVAL(key)); - w = vmg_wizard_clone(w); - sv = MGWIZ2SV(w); - mg = sv_magicext(sv, NULL, PERL_MAGIC_ext, &vmg_wizard_vtbl, NULL, 0); - mg->mg_private = SIG_WIZ; + const MGWIZ *w = SV2MGWIZ(HeVAL(key)); + if (w) { + MAGIC *mg; + w = vmg_wizard_clone(w); + sv = MGWIZ2SV(w); + mg = sv_magicext(sv, NULL, PERL_MAGIC_ext, &vmg_wizard_vtbl, NULL, 0); + mg->mg_private = SIG_WZO; + } else { + sv = MGWIZ2SV(NULL); + } SvREADONLY_on(sv); if (!hv_store(hv, sig, len, sv, HeHASH(key))) croak("%s during CLONE", vmg_globstorefail); } @@ -1247,7 +1316,7 @@ CODE: MY_CXT.wizards = hv; for (c = 0; c < OPc_MAX; ++c) { MY_CXT.b__op_stashes[c] = (had_b__op_stash & (((U32) 1) << c)) - ? gv_stashpv("B::OP", 1) : NULL; + ? gv_stashpv(vmg_opclassnames[c], 1) : NULL; } } @@ -1287,12 +1356,12 @@ CODE: if (SvOK(svsig)) { SV **old; sig = vmg_sv2sig(svsig); - if ((old = hv_fetch(MY_CXT.wizards, buf, sprintf(buf, "%u", sig), 0))) { + old = hv_fetch(MY_CXT.wizards, buf, sprintf(buf, "%u", sig), 0); + if (old && SV2MGWIZ(*old)) { ST(0) = sv_2mortal(newRV_inc(*old)); XSRETURN(1); } } else { - if (HvKEYS(MY_CXT.wizards) >= SIG_NBR) { croak(vmg_toomanysigs); } sig = vmg_gensig(); } @@ -1340,7 +1409,7 @@ CODE: sv = MGWIZ2SV(w); mg = sv_magicext(sv, NULL, PERL_MAGIC_ext, &vmg_wizard_vtbl, NULL, 0); - mg->mg_private = SIG_WIZ; + mg->mg_private = SIG_WZO; SvREADONLY_on(sv); if (!hv_store(MY_CXT.wizards, buf, sprintf(buf, "%u", sig), sv, 0)) croak(vmg_globstorefail); @@ -1351,18 +1420,24 @@ OUTPUT: SV *gensig() PROTOTYPE: +PREINIT: + U16 sig; + char buf[8]; CODE: dMY_CXT; - if (HvKEYS(MY_CXT.wizards) >= SIG_NBR) { croak(vmg_toomanysigs); } - RETVAL = newSVuv(vmg_gensig()); + sig = vmg_gensig(); + if (!hv_store(MY_CXT.wizards, buf, sprintf(buf, "%u", sig), MGWIZ2SV(NULL), 0)) croak(vmg_globstorefail); + RETVAL = newSVuv(sig); OUTPUT: RETVAL SV *getsig(SV *wiz) PROTOTYPE: $ +PREINIT: + U16 sig; CODE: - if (!SvROK(wiz)) { croak(vmg_invalid_wiz); } - RETVAL = newSVuv(SV2MGWIZ(SvRV(wiz))->sig); + sig = vmg_wizard_sig(wiz); + RETVAL = newSVuv(sig); OUTPUT: RETVAL @@ -1373,8 +1448,6 @@ PREINIT: SV *ret; CODE: wiz = vmg_wizard_wiz(wiz); - if (!wiz) - XSRETURN_UNDEF; if (items > 2) { I32 i; args = newAV(); @@ -1382,7 +1455,7 @@ CODE: for (i = 2; i < items; ++i) { SV *arg = ST(i); SvREFCNT_inc(arg); - if (av_store(args, i - 2, arg) == NULL) { croak(vmg_argstorefailed); } + if (av_store(args, i - 2, arg) == NULL) croak(vmg_argstorefailed); } } ret = newSVuv(vmg_cast(SvRV(sv), wiz, args)); @@ -1398,11 +1471,10 @@ PREINIT: SV *data; U16 sig; PPCODE: - sig = vmg_wizard_sig(wiz); - if (!sig) - XSRETURN_UNDEF; + sig = vmg_wizard_sig(wiz); data = vmg_data_get(SvRV(sv), sig); - if (!data) { XSRETURN_UNDEF; } + if (!data) + XSRETURN_EMPTY; ST(0) = data; XSRETURN(1); @@ -1412,8 +1484,6 @@ PREINIT: U16 sig; CODE: sig = vmg_wizard_sig(wiz); - if (!sig) - XSRETURN_UNDEF; RETVAL = newSVuv(vmg_dispell(SvRV(sv), sig)); OUTPUT: RETVAL