X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Magic.xs;h=c6d7454253ae85cd695ac5771c90f833e62155c0;hb=409cfea21be163f1168685893a9a61a5cfc45b8e;hp=03363e1057916ede0fa519cd2ac56f38a681b8bb;hpb=9ad970e109ea4caa9767db1bda9d475444920c7a;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/Magic.xs b/Magic.xs index 03363e1..c6d7454 100644 --- a/Magic.xs +++ b/Magic.xs @@ -276,6 +276,24 @@ STATIC OP *vmg_trampoline_bump(pTHX_ vmg_trampoline *t, SV *sv, OP *o) { #endif /* VMG_NEEDS_TRAMPOLINE */ +/* --- Cleaner version of sv_magicext() ------------------------------------ */ + +STATIC MAGIC *vmg_sv_magicext(pTHX_ SV *sv, SV *obj, const MGVTBL *vtbl, const void *ptr, I32 len) { +#define vmg_sv_magicext(S, O, V, P, L) vmg_sv_magicext(aTHX_ (S), (O), (V), (P), (L)) + MAGIC *mg; + + mg = sv_magicext(sv, obj, PERL_MAGIC_ext, vtbl, ptr, len); + if (!mg) + return NULL; + + mg->mg_private = 0; + + if (mg->mg_flags & MGf_REFCOUNTED) + SvREFCNT_dec(obj); + + return mg; +} + /* --- Safe version of call_sv() ------------------------------------------- */ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), void *ud) { @@ -285,8 +303,8 @@ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), vo SV *old_err = NULL; if (SvTRUE(ERRSV)) { - old_err = ERRSV; - ERRSV = newSV(0); + old_err = newSVsv(ERRSV); + sv_setsv(ERRSV, &PL_sv_undef); } cxix = (cxstack_ix < cxstack_max) ? (cxstack_ix + 1) : Perl_cxinc(aTHX); @@ -299,11 +317,8 @@ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), vo cxstack[cxix] = saved_cx; if (SvTRUE(ERRSV)) { - if (old_err) { - sv_setsv(old_err, ERRSV); - SvREFCNT_dec(ERRSV); - ERRSV = old_err; - } + SvREFCNT_dec(old_err); + if (IN_PERL_COMPILETIME) { if (!PL_in_eval) { if (PL_errors) @@ -326,8 +341,8 @@ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), vo } } else { if (old_err) { - SvREFCNT_dec(ERRSV); - ERRSV = old_err; + sv_setsv(ERRSV, old_err); + SvREFCNT_dec(old_err); } } @@ -337,19 +352,22 @@ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), vo /* --- Stolen chunk of B --------------------------------------------------- */ typedef enum { - OPc_NULL = 0, - OPc_BASEOP = 1, - OPc_UNOP = 2, - OPc_BINOP = 3, - OPc_LOGOP = 4, - OPc_LISTOP = 5, - OPc_PMOP = 6, - OPc_SVOP = 7, - OPc_PADOP = 8, - OPc_PVOP = 9, - OPc_LOOP = 10, - OPc_COP = 11, - OPc_MAX = 12 + OPc_NULL, + OPc_BASEOP, + OPc_UNOP, + OPc_BINOP, + OPc_LOGOP, + OPc_LISTOP, + OPc_PMOP, + OPc_SVOP, + OPc_PADOP, + OPc_PVOP, + OPc_LOOP, + OPc_COP, +#if VMG_HAS_PERL(5, 21, 5) + OPc_METHOP, +#endif + OPc_MAX } opclass; STATIC const char *const vmg_opclassnames[] = { @@ -364,7 +382,11 @@ STATIC const char *const vmg_opclassnames[] = { "B::PADOP", "B::PVOP", "B::LOOP", - "B::COP" + "B::COP", +#if VMG_HAS_PERL(5, 21, 5) + "B::METHOP", +#endif + NULL }; STATIC opclass vmg_opclass(const OP *o) { @@ -436,6 +458,10 @@ STATIC opclass vmg_opclass(const OP *o) { return OPc_BASEOP; else return OPc_PVOP; +#if VMG_HAS_PERL(5, 21, 5) + case OA_METHOP: + return OPc_METHOP; +#endif } return OPc_BASEOP; @@ -697,11 +723,10 @@ STATIC SV *vmg_wizard_sv_new(pTHX_ const vmg_wizard *w) { #endif if (w) { - MAGIC *mg = sv_magicext(wiz, NULL, PERL_MAGIC_ext, &vmg_wizard_sv_vtbl, - (const char *) w, 0); - mg->mg_private = 0; + MAGIC *mg; + mg = vmg_sv_magicext(wiz, NULL, &vmg_wizard_sv_vtbl, w, 0); #if VMG_THREADSAFE - mg->mg_flags |= MGf_DUP; + mg->mg_flags |= MGf_DUP; #endif } SvREADONLY_on(wiz); @@ -892,11 +917,7 @@ STATIC UV vmg_cast(pTHX_ SV *sv, const vmg_wizard *w, const SV *wiz, SV **args, data = (w->cb_data) ? vmg_data_new(w->cb_data, sv, args, items) : NULL; t = vmg_vtable_vtbl(w->vtable); - mg = sv_magicext(sv, data, PERL_MAGIC_ext, t, (const char *) wiz, HEf_SVKEY); - mg->mg_private = 0; - - /* sv_magicext() calls mg_magical and increments data's refcount */ - SvREFCNT_dec(data); + mg = vmg_sv_magicext(sv, data, t, wiz, HEf_SVKEY); if (t->svt_copy) mg->mg_flags |= MGf_COPY; @@ -1173,8 +1194,7 @@ STATIC SV *vmg_dispell_guard_new(pTHX_ MAGIC *root) { SV *guard; guard = sv_newmortal(); - sv_magicext(guard, NULL, PERL_MAGIC_ext, &vmg_dispell_guard_vtbl, - (char *) root, 0); + vmg_sv_magicext(guard, NULL, &vmg_dispell_guard_vtbl, root, 0); return guard; } @@ -1367,8 +1387,8 @@ STATIC OP *vmg_pp_propagate_errsv(pTHX) { SVOP *o = cSVOPx(PL_op); if (o->op_sv) { - SvREFCNT_dec(ERRSV); - ERRSV = o->op_sv; + sv_setsv(ERRSV, o->op_sv); + SvREFCNT_dec(o->op_sv); o->op_sv = NULL; } @@ -1378,11 +1398,8 @@ STATIC OP *vmg_pp_propagate_errsv(pTHX) { #endif /* VMG_PROPAGATE_ERRSV_NEEDS_TRAMPOLINE */ STATIC int vmg_propagate_errsv_free(pTHX_ SV *sv, MAGIC *mg) { - if (mg->mg_obj) { - ERRSV = mg->mg_obj; - mg->mg_obj = NULL; - mg->mg_flags &= ~MGf_REFCOUNTED; - } + if (mg->mg_obj) + sv_setsv(ERRSV, mg->mg_obj); return 0; } @@ -1427,20 +1444,16 @@ STATIC int vmg_svt_free_cleanup(pTHX_ void *ud_) { PL_op = vmg_trampoline_bump(&MY_CXT.propagate_errsv, errsv, PL_op); } else if (optype == OP_LEAVEEVAL) { SV *guard = sv_newmortal(); - sv_magicext(guard, errsv, PERL_MAGIC_ext, &vmg_propagate_errsv_vtbl, - NULL, 0); + vmg_sv_magicext(guard, errsv, &vmg_propagate_errsv_vtbl, NULL, 0); } #else /* !VMG_PROPAGATE_ERRSV_NEEDS_TRAMPOLINE */ # if !VMG_HAS_PERL(5, 8, 9) { SV *guard = sv_newmortal(); - sv_magicext(guard, errsv, PERL_MAGIC_ext, &vmg_propagate_errsv_vtbl, - NULL, 0); + vmg_sv_magicext(guard, errsv, &vmg_propagate_errsv_vtbl, NULL, 0); } # else - sv_magicext(ERRSV, errsv, PERL_MAGIC_ext, &vmg_propagate_errsv_vtbl, - NULL, 0); - SvREFCNT_dec(errsv); + vmg_sv_magicext(ERRSV, errsv, &vmg_propagate_errsv_vtbl, NULL, 0); # endif #endif /* VMG_PROPAGATE_ERRSV_NEEDS_TRAMPOLINE */