#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) {
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);
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)
}
} else {
if (old_err) {
- SvREFCNT_dec(ERRSV);
- ERRSV = old_err;
+ sv_setsv(ERRSV, old_err);
+ SvREFCNT_dec(old_err);
}
}
OPc_PVOP,
OPc_LOOP,
OPc_COP,
+#if VMG_HAS_PERL(5, 21, 5)
+ OPc_METHOP,
+#endif
OPc_MAX
} opclass;
"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) {
return OPc_BASEOP;
else
return OPc_PVOP;
+#if VMG_HAS_PERL(5, 21, 5)
+ case OA_METHOP:
+ return OPc_METHOP;
+#endif
}
return OPc_BASEOP;
#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);
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;
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;
}
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;
}
#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;
}
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 */