X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Magic.xs;h=e45baeab02d807bb2a3fa7bea8ffba7662d85f89;hb=4de8639a5eb25d672b6248bd80e433abd0a267e2;hp=94d816fe00fef8a826352b47b93fc70415c6ef40;hpb=056b5122597d90171577d0fad01bf17d08e401e8;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/Magic.xs b/Magic.xs index 94d816f..e45baea 100644 --- a/Magic.xs +++ b/Magic.xs @@ -401,7 +401,9 @@ STATIC const char vmg_argstorefailed[] = "Error while storing arguments"; #define MY_CXT_KEY __PACKAGE__ "::_guts" XS_VERSION typedef struct { - HV *b__op_stashes[OPc_MAX]; + HV *b__op_stashes[OPc_MAX]; + I32 depth; + MAGIC *freed_tokens; } my_cxt_t; START_MY_CXT @@ -767,11 +769,12 @@ typedef struct { STATIC void vmg_mg_del(pTHX_ SV *sv, MAGIC *prevmagic, MAGIC *mg, MAGIC *moremagic) { #define vmg_mg_del(S, P, M, N) vmg_mg_del(aTHX_ (S), (P), (M), (N)) + dMY_CXT; + if (prevmagic) prevmagic->mg_moremagic = moremagic; else SvMAGIC_set(sv, moremagic); - mg->mg_moremagic = NULL; /* Destroy private data */ #if VMG_UVAR @@ -779,15 +782,42 @@ STATIC void vmg_mg_del(pTHX_ SV *sv, MAGIC *prevmagic, MAGIC *mg, MAGIC *moremag Safefree(mg->mg_ptr); } else { #endif /* VMG_UVAR */ - if (mg->mg_obj != sv) + if (mg->mg_obj != sv) { SvREFCNT_dec(mg->mg_obj); + mg->mg_obj = NULL; + } /* Unreference the wizard */ SvREFCNT_dec((SV *) mg->mg_ptr); + mg->mg_ptr = NULL; #if VMG_UVAR } #endif /* VMG_UVAR */ - Safefree(mg); + if (MY_CXT.depth) { + mg->mg_moremagic = MY_CXT.freed_tokens; + MY_CXT.freed_tokens = mg; + } else { + mg->mg_moremagic = NULL; + Safefree(mg); + } +} + +STATIC int vmg_magic_chain_free(pTHX_ MAGIC *mg, MAGIC *skip) { +#define vmg_magic_chain_free(M, S) vmg_magic_chain_free(aTHX_ (M), (S)) + int skipped = 0; + + while (mg) { + MAGIC *moremagic = mg->mg_moremagic; + + if (mg == skip) + ++skipped; + else + Safefree(mg); + + mg = moremagic; + } + + return skipped; } STATIC UV vmg_cast(pTHX_ SV *sv, const vmg_wizard *w, const SV *wiz, SV **args, I32 items) { @@ -1026,12 +1056,77 @@ STATIC SV *vmg_op_info(pTHX_ unsigned int opinfo) { #define VMG_CB_CALL_ARGS_MASK 15 #define VMG_CB_CALL_ARGS_SHIFT 4 -#define VMG_CB_CALL_OPINFO (VMG_OP_INFO_NAME|VMG_OP_INFO_OBJECT) +#define VMG_CB_CALL_OPINFO (VMG_OP_INFO_NAME|VMG_OP_INFO_OBJECT) /* 1|2 */ +#define VMG_CB_CALL_GUARD 4 + +STATIC int vmg_dispell_guard_oncroak(pTHX_ void *ud) { + dMY_CXT; + + MY_CXT.depth--; + + /* If we're at the upmost magic call and we're about to die, we can just free + * the tokens right now, since we will jump past the problematic part of our + * caller. */ + if (MY_CXT.depth == 0 && MY_CXT.freed_tokens) { + vmg_magic_chain_free(MY_CXT.freed_tokens, NULL); + MY_CXT.freed_tokens = NULL; + } + + return 1; +} + +STATIC int vmg_dispell_guard_free(pTHX_ SV *sv, MAGIC *mg) { + vmg_magic_chain_free((MAGIC *) mg->mg_ptr, NULL); + + return 0; +} + +#if VMG_THREADSAFE + +STATIC int vmg_dispell_guard_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *params) { + /* The freed magic tokens aren't cloned by perl because it cannot reach them + * (they have been detached from their parent SV when they were enqueued). + * Hence there's nothing to purge in the new thread. */ + mg->mg_ptr = NULL; + + return 0; +} + +#endif /* VMG_THREADSAFE */ + +STATIC MGVTBL vmg_dispell_guard_vtbl = { + NULL, /* get */ + NULL, /* set */ + NULL, /* len */ + NULL, /* clear */ + vmg_dispell_guard_free, /* free */ + NULL, /* copy */ +#if VMG_THREADSAFE + vmg_dispell_guard_dup, /* dup */ +#else + NULL, /* dup */ +#endif +#if MGf_LOCAL + NULL, /* local */ +#endif /* MGf_LOCAL */ +}; + +STATIC SV *vmg_dispell_guard_new(pTHX_ MAGIC *root) { +#define vmg_dispell_guard_new(R) vmg_dispell_guard_new(aTHX_ (R)) + SV *guard; + + guard = sv_newmortal(); + sv_magicext(guard, NULL, PERL_MAGIC_ext, &vmg_dispell_guard_vtbl, + (char *) root, 0); + + return guard; +} STATIC int vmg_cb_call(pTHX_ SV *cb, unsigned int flags, SV *sv, ...) { va_list ap; int ret = 0; unsigned int i, args, opinfo; + MAGIC **chain = NULL; SV *svr; dSP; @@ -1056,7 +1151,16 @@ STATIC int vmg_cb_call(pTHX_ SV *cb, unsigned int flags, SV *sv, ...) { XPUSHs(vmg_op_info(opinfo)); PUTBACK; - vmg_call_sv(cb, G_SCALAR, 0, NULL); + if (flags & VMG_CB_CALL_GUARD) { + dMY_CXT; + MY_CXT.depth++; + vmg_call_sv(cb, G_SCALAR, vmg_dispell_guard_oncroak, NULL); + MY_CXT.depth--; + if (MY_CXT.depth == 0 && MY_CXT.freed_tokens) + chain = &MY_CXT.freed_tokens; + } else { + vmg_call_sv(cb, G_SCALAR, 0, NULL); + } SPAGAIN; svr = POPs; @@ -1067,6 +1171,11 @@ STATIC int vmg_cb_call(pTHX_ SV *cb, unsigned int flags, SV *sv, ...) { FREETMPS; LEAVE; + if (chain) { + vmg_dispell_guard_new(*chain); + *chain = NULL; + } + return ret; } @@ -1180,8 +1289,13 @@ STATIC U32 vmg_svt_len_noop(pTHX_ SV *sv, MAGIC *mg) { 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 !VMG_HAS_PERL(5, 12, 0) + flags |= VMG_CB_CALL_GUARD; +#endif - return vmg_cb_call1(w->cb_clear, w->opinfo, sv, mg->mg_obj); + return vmg_cb_call1(w->cb_clear, flags, sv, mg->mg_obj); } #define vmg_svt_clear_noop vmg_svt_default_noop @@ -1201,6 +1315,8 @@ STATIC int vmg_svt_free_cleanup(pTHX_ void *ud) { } SvREFCNT_dec(sv); + vmg_dispell_guard_oncroak(aTHX_ ud); + /* After that, propagate the error upwards. */ return 1; } @@ -1240,7 +1356,18 @@ STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) { XPUSHs(vmg_op_info(w->opinfo)); PUTBACK; - vmg_call_sv(w->cb_free, G_SCALAR, vmg_svt_free_cleanup, sv); + { + dMY_CXT; + MY_CXT.depth++; + vmg_call_sv(w->cb_free, G_SCALAR, vmg_svt_free_cleanup, sv); + MY_CXT.depth--; + if (MY_CXT.depth == 0 && MY_CXT.freed_tokens) { + /* Free all the tokens in the chain but the current one (if it's present). + * It will be taken care of by our caller, Perl_mg_free(). */ + vmg_magic_chain_free(MY_CXT.freed_tokens, mg); + MY_CXT.freed_tokens = NULL; + } + } SPAGAIN; svr = POPs; @@ -1320,6 +1447,7 @@ STATIC int vmg_svt_local(pTHX_ SV *nsv, MAGIC *mg) { /* ... uvar magic .......................................................... */ #if VMG_UVAR + STATIC OP *vmg_pp_resetuvar(pTHX) { SvRMAGICAL_on(cSVOP_sv); return NORMAL; @@ -1327,7 +1455,7 @@ STATIC OP *vmg_pp_resetuvar(pTHX) { STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) { vmg_uvar_ud *ud; - MAGIC *mg, *umg; + MAGIC *mg, *umg, *moremagic; SV *key = NULL, *newkey = NULL; int tied = 0; @@ -1341,9 +1469,13 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) { if (ud->old_uf.uf_set) ud->old_uf.uf_set(aTHX_ action, sv); - for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { + for (mg = SvMAGIC(sv); mg; mg = moremagic) { const vmg_wizard *w; + /* mg may be freed later by the uvar call, so we need to fetch the next + * token before reaching that fateful point. */ + moremagic = mg->mg_moremagic; + switch (mg->mg_type) { case PERL_MAGIC_ext: break; @@ -1370,21 +1502,25 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) { & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS|HV_FETCH_LVALUE|HV_DELETE)) { case 0: if (w->cb_fetch) - vmg_cb_call2(w->cb_fetch, w->opinfo, sv, mg->mg_obj, key); + vmg_cb_call2(w->cb_fetch, w->opinfo | VMG_CB_CALL_GUARD, sv, + mg->mg_obj, key); break; case HV_FETCH_ISSTORE: case HV_FETCH_LVALUE: case (HV_FETCH_ISSTORE|HV_FETCH_LVALUE): if (w->cb_store) - vmg_cb_call2(w->cb_store, w->opinfo, sv, mg->mg_obj, key); + vmg_cb_call2(w->cb_store, w->opinfo | VMG_CB_CALL_GUARD, sv, + mg->mg_obj, key); break; case HV_FETCH_ISEXISTS: if (w->cb_exists) - vmg_cb_call2(w->cb_exists, w->opinfo, sv, mg->mg_obj, key); + vmg_cb_call2(w->cb_exists, w->opinfo | VMG_CB_CALL_GUARD, sv, + mg->mg_obj, key); break; case HV_DELETE: if (w->cb_delete) - vmg_cb_call2(w->cb_delete, w->opinfo, sv, mg->mg_obj, key); + vmg_cb_call2(w->cb_delete, w->opinfo | VMG_CB_CALL_GUARD, sv, + mg->mg_obj, key); break; } } @@ -1410,6 +1546,7 @@ STATIC I32 vmg_svt_val(pTHX_ IV action, SV *sv) { return 0; } + #endif /* VMG_UVAR */ /* --- Macros for the XS section ------------------------------------------- */ @@ -1469,6 +1606,8 @@ BOOT: MY_CXT_INIT; for (c = OPc_NULL; c < OPc_MAX; ++c) MY_CXT.b__op_stashes[c] = NULL; + MY_CXT.depth = 0; + MY_CXT.freed_tokens = NULL; #if VMG_THREADSAFE MUTEX_INIT(&vmg_vtable_refcount_mutex); MUTEX_INIT(&vmg_op_name_init_mutex); @@ -1506,6 +1645,7 @@ CLONE(...) PROTOTYPE: DISABLE PREINIT: U32 had_b__op_stash = 0; + I32 old_depth; int c; PPCODE: { @@ -1514,6 +1654,7 @@ PPCODE: if (MY_CXT.b__op_stashes[c]) had_b__op_stash |= (((U32) 1) << c); } + old_depth = MY_CXT.depth; } { MY_CXT_CLONE; @@ -1521,6 +1662,8 @@ PPCODE: MY_CXT.b__op_stashes[c] = (had_b__op_stash & (((U32) 1) << c)) ? gv_stashpv(vmg_opclassnames[c], 1) : NULL; } + MY_CXT.depth = old_depth; + MY_CXT.freed_tokens = NULL; } XSRETURN(0);