X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Magic.xs;h=33fc60e70e295a065e1a990fa0f878c0621ca3a3;hb=5c32c65e51fca0ff49c43b814e9653e01b1e56f1;hp=cf5bc21472701075610c731a660948e45cbc9404;hpb=ea4de64c75c0516d7cc92a586c9f8b76465ca130;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/Magic.xs b/Magic.xs index cf5bc21..33fc60e 100644 --- a/Magic.xs +++ b/Magic.xs @@ -62,7 +62,9 @@ #endif #if VMG_MULTIPLICITY && defined(USE_ITHREADS) && defined(dMY_CXT) && defined(MY_CXT) && defined(START_MY_CXT) && defined(MY_CXT_INIT) && (defined(MY_CXT_CLONE) || defined(dMY_CXT_SV)) -# define VMG_THREADSAFE 1 +# ifndef VMG_THREADSAFE +# define VMG_THREADSAFE 1 +# endif # ifndef MY_CXT_CLONE # define MY_CXT_CLONE \ dMY_CXT_SV; \ @@ -71,6 +73,7 @@ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) # endif #else +# undef VMG_THREADSAFE # define VMG_THREADSAFE 0 # undef dMY_CXT # define dMY_CXT dNOOP @@ -130,6 +133,12 @@ # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling) #endif +#ifdef DEBUGGING +# define VMG_ASSERT(C) assert(C) +#else +# define VMG_ASSERT(C) +#endif + /* uvar magic and Hash::Util::FieldHash were commited with 28419, but we only * enable them on 5.10 */ #if VMG_HAS_PERL(5, 10, 0) @@ -485,9 +494,8 @@ static opclass vmg_opclass(const OP *o) { /* --- Error messages ------------------------------------------------------ */ -static const char vmg_invalid_wiz[] = "Invalid wizard object"; -static const char vmg_wrongargnum[] = "Wrong number of arguments"; -static const char vmg_argstorefailed[] = "Error while storing arguments"; +static const char vmg_invalid_wiz[] = "Invalid wizard object"; +static const char vmg_wrongargnum[] = "Wrong number of arguments"; /* --- Context-safe global data -------------------------------------------- */ @@ -1243,11 +1251,18 @@ static int vmg_cb_call(pTHX_ SV *cb, unsigned int flags, SV *sv, ...) { svr = POPs; if (SvOK(svr)) ret = (int) SvIV(svr); + if (SvROK(svr)) + SvREFCNT_inc(svr); + else + svr = NULL; PUTBACK; FREETMPS; LEAVE; + if (svr && !SvTEMP(svr)) + sv_2mortal(svr); + if (chain) { vmg_dispell_guard_new(*chain); *chain = NULL; @@ -1745,24 +1760,37 @@ static I32 vmg_svt_val(pTHX_ IV action, SV *sv) { #endif /* VMG_UVAR */ -/* --- Global setup/teardown ----------------------------------------------- */ +/* --- Module setup/teardown ----------------------------------------------- */ -static VOL U32 vmg_initialized = 0; - -static void vmg_global_teardown_late(pTHX) { -#define vmg_global_teardown_late() vmg_global_teardown_late(aTHX) #if VMG_THREADSAFE + +static I32 vmg_loaded = 0; + +/* We must use preexistent global mutexes or we will never be able to destroy + * them. */ +# if VMG_HAS_PERL(5, 9, 3) +# define VMG_LOADED_LOCK MUTEX_LOCK(&PL_my_ctx_mutex) +# define VMG_LOADED_UNLOCK MUTEX_UNLOCK(&PL_my_ctx_mutex) +# else +# define VMG_LOADED_LOCK OP_REFCNT_LOCK +# define VMG_LOADED_UNLOCK OP_REFCNT_UNLOCK +# endif + +static void vmg_global_teardown_late_locked(pTHX) { +#define vmg_global_teardown_late_locked() vmg_global_teardown_late_locked(aTHX) MUTEX_DESTROY(&vmg_op_name_init_mutex); MUTEX_DESTROY(&vmg_vtable_refcount_mutex); -#endif - - vmg_initialized = 0; return; } static int vmg_global_teardown_free(pTHX_ SV *sv, MAGIC *mg) { - vmg_global_teardown_late(); + VMG_LOADED_LOCK; + + if (vmg_loaded == 0) + vmg_global_teardown_late_locked(); + + VMG_LOADED_UNLOCK; return 0; } @@ -1821,52 +1849,31 @@ static signed char vmg_destruct_level(pTHX) { return lvl; } -static void vmg_global_teardown(pTHX_ void *root) { - if (!vmg_initialized) - return; +#endif /* VMG_THREADSAFE */ -#if VMG_MULTIPLICITY - if (aTHX != root) - return; -#endif +static void vmg_teardown(pTHX_ void *param) { + dMY_CXT; + +#if VMG_THREADSAFE + VMG_LOADED_LOCK; - if (vmg_destruct_level() == 0) { - vmg_global_teardown_late(); + if (vmg_loaded == 1) { + vmg_loaded = 0; + if (vmg_destruct_level() == 0) { + vmg_global_teardown_late_locked(); + } else { + if (!PL_strtab) + PL_strtab = newHV(); + vmg_sv_magicext((SV *) PL_strtab, NULL, &vmg_global_teardown_vtbl, NULL, 0); + } } else { - if (!PL_strtab) - PL_strtab = newHV(); - vmg_sv_magicext((SV *) PL_strtab, NULL, &vmg_global_teardown_vtbl, NULL, 0); + VMG_ASSERT(vmg_loaded > 1); + --vmg_loaded; } - return; -} - -static void vmg_global_setup(pTHX) { -#define vmg_global_setup() vmg_global_setup(aTHX) - if (vmg_initialized) - return; - -#if VMG_THREADSAFE - MUTEX_INIT(&vmg_vtable_refcount_mutex); - MUTEX_INIT(&vmg_op_name_init_mutex); + VMG_LOADED_UNLOCK; #endif -#if VMG_MULTIPLICITY - call_atexit(vmg_global_teardown, aTHX); -#else - call_atexit(vmg_global_teardown, NULL); -#endif - - vmg_initialized = 1; - - return; -} - -/* --- Interpreter setup/teardown ------------------------------------------ */ - -static void vmg_local_teardown(pTHX_ void *param) { - dMY_CXT; - if (MY_CXT.depth == 0 && MY_CXT.freed_tokens) { vmg_magic_chain_free(MY_CXT.freed_tokens, NULL); MY_CXT.freed_tokens = NULL; @@ -1875,12 +1882,27 @@ static void vmg_local_teardown(pTHX_ void *param) { return; } -static void vmg_local_setup(pTHX) { -#define vmg_local_setup() vmg_local_setup(aTHX) +static void vmg_setup(pTHX) { +#define vmg_setup() vmg_setup(aTHX) HV *stash; int c; - MY_CXT_INIT; + +#if VMG_THREADSAFE + VMG_LOADED_LOCK; + + if (vmg_loaded == 0) { + MUTEX_INIT(&vmg_vtable_refcount_mutex); + MUTEX_INIT(&vmg_op_name_init_mutex); + vmg_loaded = 1; + } else { + VMG_ASSERT(vmg_loaded > 0); + ++vmg_loaded; + } + + VMG_LOADED_UNLOCK; +#endif + for (c = OPc_NULL; c < OPc_MAX; ++c) MY_CXT.b__op_stashes[c] = NULL; @@ -1922,7 +1944,7 @@ static void vmg_local_setup(pTHX) { newCONSTSUB(stash, "VMG_OP_INFO_NAME", newSVuv(VMG_OP_INFO_NAME)); newCONSTSUB(stash, "VMG_OP_INFO_OBJECT", newSVuv(VMG_OP_INFO_OBJECT)); - call_atexit(vmg_local_teardown, NULL); + call_atexit(vmg_teardown, NULL); return; } @@ -1978,8 +2000,7 @@ PROTOTYPES: ENABLE BOOT: { - vmg_global_setup(); - vmg_local_setup(); + vmg_setup(); } #if VMG_THREADSAFE @@ -2008,6 +2029,10 @@ PPCODE: } MY_CXT.depth = old_depth; MY_CXT.freed_tokens = NULL; + VMG_LOADED_LOCK; + VMG_ASSERT(vmg_loaded > 0); + ++vmg_loaded; + VMG_LOADED_UNLOCK; } XSRETURN(0);