+#define vmg_svt_set_noop vmg_svt_default_noop
+
+/* ... len magic ........................................................... */
+
+static U32 vmg_sv_len(pTHX_ SV *sv) {
+#define vmg_sv_len(S) vmg_sv_len(aTHX_ (S))
+ STRLEN len;
+#if XSH_HAS_PERL(5, 9, 3)
+ const U8 *s = VOID2(const U8 *, VOID2(const void *, SvPV_const(sv, len)));
+#else
+ U8 *s = SvPV(sv, len);
+#endif
+
+ return DO_UTF8(sv) ? utf8_length(s, s + len) : len;
+}
+
+static U32 vmg_svt_len(pTHX_ SV *sv, MAGIC *mg) {
+ const vmg_wizard *w = vmg_wizard_from_mg_nocheck(mg);
+ unsigned int opinfo = w->opinfo;
+ U32 len, ret;
+ SV *svr;
+ svtype t = SvTYPE(sv);
+
+ dSP;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHSTACKi(PERLSI_MAGIC);
+
+ PUSHMARK(SP);
+ EXTEND(SP, 3);
+ PUSHs(sv_2mortal(newRV_inc(sv)));
+ PUSHs(mg->mg_obj ? mg->mg_obj : &PL_sv_undef);
+ if (t < SVt_PVAV) {
+ len = vmg_sv_len(sv);
+ mPUSHu(len);
+ } else if (t == SVt_PVAV) {
+ len = av_len((AV *) sv) + 1;
+ mPUSHu(len);
+ } else {
+ len = 0;
+ PUSHs(&PL_sv_undef);
+ }
+ if (opinfo)
+ XPUSHs(vmg_op_info(opinfo));
+ PUTBACK;
+
+ vmg_call_sv(w->cb_len, G_SCALAR, 0, NULL);
+
+ SPAGAIN;
+ svr = POPs;
+ ret = SvOK(svr) ? (U32) SvUV(svr) : len;
+ if (t == SVt_PVAV)
+ --ret;
+ PUTBACK;
+
+ POPSTACK;
+
+ FREETMPS;
+ LEAVE;
+
+ return ret;
+}
+
+static U32 vmg_svt_len_noop(pTHX_ SV *sv, MAGIC *mg) {
+ U32 len = 0;
+ svtype t = SvTYPE(sv);
+
+ if (t < SVt_PVAV) {
+ len = vmg_sv_len(sv);
+ } else if (t == SVt_PVAV) {
+ len = (U32) av_len((AV *) sv);
+ }
+
+ return len;
+}
+
+/* ... clear magic ......................................................... */
+
+static int vmg_svt_clear(pTHX_ SV *sv, MAGIC *mg) {
+ const vmg_wizard *w = vmg_wizard_from_mg_nocheck(mg);
+ unsigned int flags = w->opinfo;
+
+#if !XSH_HAS_PERL(5, 12, 0)
+ flags |= VMG_CB_CALL_GUARD;
+#endif
+
+ return vmg_cb_call1(w->cb_clear, flags, sv, mg->mg_obj);
+}
+
+#define vmg_svt_clear_noop vmg_svt_default_noop
+
+/* ... free magic .......................................................... */
+
+#if VMG_PROPAGATE_ERRSV_NEEDS_TRAMPOLINE
+
+static OP *vmg_pp_propagate_errsv(pTHX) {
+ SVOP *o = cSVOPx(PL_op);
+
+ if (o->op_sv) {
+ sv_setsv(ERRSV, o->op_sv);
+ SvREFCNT_dec(o->op_sv);
+ o->op_sv = NULL;
+ }
+
+ return NORMAL;
+}
+
+#endif /* VMG_PROPAGATE_ERRSV_NEEDS_TRAMPOLINE */
+
+static int vmg_propagate_errsv_free(pTHX_ SV *sv, MAGIC *mg) {
+ if (mg->mg_obj)
+ sv_setsv(ERRSV, mg->mg_obj);
+
+ return 0;
+}
+
+/* perl is already kind enough to handle the cloning of the mg_obj member,
+ hence we don't need to define a dup magic callback. */
+
+static MGVTBL vmg_propagate_errsv_vtbl = {
+ 0, /* get */
+ 0, /* set */
+ 0, /* len */
+ 0, /* clear */
+ vmg_propagate_errsv_free, /* free */
+ 0, /* copy */
+ 0, /* dup */
+#if MGf_LOCAL
+ 0, /* local */
+#endif /* MGf_LOCAL */
+};
+
+typedef struct {
+ SV *sv;
+#if VMG_CAREFUL_SELF_DESTRUCTION
+ SV *rsv; /* The ref to the sv currently being freed, pushed on the stack */
+#endif
+ int in_eval;
+ I32 base;
+} vmg_svt_free_cleanup_ud;
+
+static int vmg_svt_free_cleanup(pTHX_ void *ud_) {
+ vmg_svt_free_cleanup_ud *ud = VOID2(vmg_svt_free_cleanup_ud *, ud_);
+
+ if (ud->in_eval) {
+ U32 optype = PL_op ? PL_op->op_type : OP_NULL;
+
+ if (optype == OP_LEAVETRY || optype == OP_LEAVEEVAL) {
+ SV *errsv = newSVsv(ERRSV);
+
+ FREETMPS;
+ LEAVE_SCOPE(ud->base);