X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Magic.xs;h=207fcb383a75a3162632239b0cc74c7ff5335504;hb=64d80b88646a16ec430354d4139798d152f0e3ca;hp=44d4c89331b76978793645243ff53e31afe4f2d7;hpb=3b3cd1c3a8f372f441f38bddbd09fee34919b391;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/Magic.xs b/Magic.xs index 44d4c89..207fcb3 100644 --- a/Magic.xs +++ b/Magic.xs @@ -49,12 +49,17 @@ #endif #ifndef VMG_MULTIPLICITY -# if defined(MULTIPLICITY) || defined(PERL_IMPLICIT_CONTEXT) +# if defined(MULTIPLICITY) # define VMG_MULTIPLICITY 1 # else # define VMG_MULTIPLICITY 0 # endif #endif +#if VMG_MULTIPLICITY +# ifndef PERL_IMPLICIT_CONTEXT +# error MULTIPLICITY builds must set PERL_IMPLICIT_CONTEXT +# endif +#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 @@ -1740,68 +1745,158 @@ static I32 vmg_svt_val(pTHX_ IV action, SV *sv) { #endif /* VMG_UVAR */ -/* --- Macros for the XS section ------------------------------------------- */ +/* --- Module setup/teardown ----------------------------------------------- */ -#ifdef CvISXSUB -# define VMG_CVOK(C) \ - ((CvISXSUB(C) ? (void *) CvXSUB(C) : (void *) CvROOT(C)) ? 1 : 0) -#else -# define VMG_CVOK(C) (CvROOT(C) || CvXSUB(C)) -#endif +#if VMG_THREADSAFE -#define VMG_CBOK(S) ((SvTYPE(S) == SVt_PVCV) ? VMG_CVOK(S) : SvOK(S)) +static I32 vmg_loaded = 0; -#define VMG_SET_CB(S, N) { \ - SV *cb = (S); \ - if (SvOK(cb) && SvROK(cb)) { \ - cb = SvRV(cb); \ - if (VMG_CBOK(cb)) \ - SvREFCNT_inc_simple_void(cb); \ - else \ - cb = NULL; \ - } else { \ - cb = NULL; \ - } \ - w->cb_ ## N = cb; \ +/* 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); + + return; } -#define VMG_SET_SVT_CB(S, N) { \ - SV *cb = (S); \ - if (SvOK(cb) && SvROK(cb)) { \ - cb = SvRV(cb); \ - if (VMG_CBOK(cb)) { \ - t->svt_ ## N = vmg_svt_ ## N; \ - SvREFCNT_inc_simple_void(cb); \ - } else { \ - t->svt_ ## N = vmg_svt_ ## N ## _noop; \ - cb = NULL; \ - } \ - } else { \ - t->svt_ ## N = NULL; \ - cb = NULL; \ - } \ - w->cb_ ## N = cb; \ +static int vmg_global_teardown_free(pTHX_ SV *sv, MAGIC *mg) { + VMG_LOADED_LOCK; + + if (vmg_loaded == 0) + vmg_global_teardown_late_locked(); + + VMG_LOADED_UNLOCK; + + return 0; } -/* --- XS ------------------------------------------------------------------ */ +static MGVTBL vmg_global_teardown_vtbl = { + 0, + 0, + 0, + 0, + vmg_global_teardown_free +#if MGf_COPY + , 0 +#endif +#if MGf_DUP + , 0 +#endif +#if MGf_LOCAL + , 0 +#endif +}; -MODULE = Variable::Magic PACKAGE = Variable::Magic +static signed char vmg_destruct_level(pTHX) { +#define vmg_destruct_level() vmg_destruct_level(aTHX) + signed char lvl; -PROTOTYPES: ENABLE + lvl = PL_perl_destruct_level; -BOOT: -{ +#ifdef DEBUGGING + { + const char *s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL"); + if (s) { + int i; +#if VMG_HAS_PERL(5, 21, 3) + if (strEQ(s, "-1")) { + i = -1; + } else { +# if VMG_HAS_PERL(5, 21, 10) + UV uv; + if (Perl_grok_atoUV(s, &uv, NULL) && uv <= INT_MAX) + i = (int) uv; + else + i = 0; +# else /* VMG_HAS_PERL(5, 21, 3) && !VMG_HAS_PERL(5, 21, 10) */ + i = Perl_grok_atou(s, NULL); +# endif + } +#else /* !VMG_HAS_PERL(5, 21, 3) */ + i = atoi(s); +#endif + if (lvl < i) + lvl = i; + } + } +#endif + + return lvl; +} + +#endif /* VMG_THREADSAFE */ + +static void vmg_teardown(pTHX_ void *interp) { + dMY_CXT; + +#if VMG_MULTIPLICITY + if (aTHX != interp) + return; +#endif + +#if VMG_THREADSAFE + VMG_LOADED_LOCK; + + 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 { + assert(vmg_loaded > 1); + --vmg_loaded; + } + + VMG_LOADED_UNLOCK; +#endif + + if (MY_CXT.depth == 0 && MY_CXT.freed_tokens) { + vmg_magic_chain_free(MY_CXT.freed_tokens, NULL); + MY_CXT.freed_tokens = NULL; + } + + return; +} + +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) { + assert(vmg_loaded == 0); + MUTEX_INIT(&vmg_vtable_refcount_mutex); + MUTEX_INIT(&vmg_op_name_init_mutex); + } + ++vmg_loaded; + + VMG_LOADED_UNLOCK; +#endif + for (c = OPc_NULL; c < OPc_MAX; ++c) MY_CXT.b__op_stashes[c] = NULL; MY_CXT.depth = 0; MY_CXT.freed_tokens = NULL; - /* XS doesn't like a blank line here */ #if VMG_PROPAGATE_ERRSV_NEEDS_TRAMPOLINE vmg_trampoline_init(&MY_CXT.propagate_errsv, vmg_pp_propagate_errsv); #endif @@ -1809,12 +1904,6 @@ BOOT: vmg_trampoline_init(&MY_CXT.reset_rmg, vmg_pp_reset_rmg); #endif - /* XS doesn't like a blank line here */ -#if VMG_THREADSAFE - MUTEX_INIT(&vmg_vtable_refcount_mutex); - MUTEX_INIT(&vmg_op_name_init_mutex); -#endif - stash = gv_stashpv(__PACKAGE__, 1); newCONSTSUB(stash, "MGf_COPY", newSVuv(MGf_COPY)); newCONSTSUB(stash, "MGf_DUP", newSVuv(MGf_DUP)); @@ -1842,6 +1931,68 @@ BOOT: newCONSTSUB(stash, "VMG_FORKSAFE", newSVuv(VMG_FORKSAFE)); newCONSTSUB(stash, "VMG_OP_INFO_NAME", newSVuv(VMG_OP_INFO_NAME)); newCONSTSUB(stash, "VMG_OP_INFO_OBJECT", newSVuv(VMG_OP_INFO_OBJECT)); + +#if VMG_MULTIPLICITY + call_atexit(vmg_teardown, aTHX); +#else + call_atexit(vmg_teardown, NULL); +#endif + + return; +} + +/* --- Macros for the XS section ------------------------------------------- */ + +#ifdef CvISXSUB +# define VMG_CVOK(C) \ + ((CvISXSUB(C) ? (void *) CvXSUB(C) : (void *) CvROOT(C)) ? 1 : 0) +#else +# define VMG_CVOK(C) (CvROOT(C) || CvXSUB(C)) +#endif + +#define VMG_CBOK(S) ((SvTYPE(S) == SVt_PVCV) ? VMG_CVOK(S) : SvOK(S)) + +#define VMG_SET_CB(S, N) { \ + SV *cb = (S); \ + if (SvOK(cb) && SvROK(cb)) { \ + cb = SvRV(cb); \ + if (VMG_CBOK(cb)) \ + SvREFCNT_inc_simple_void(cb); \ + else \ + cb = NULL; \ + } else { \ + cb = NULL; \ + } \ + w->cb_ ## N = cb; \ +} + +#define VMG_SET_SVT_CB(S, N) { \ + SV *cb = (S); \ + if (SvOK(cb) && SvROK(cb)) { \ + cb = SvRV(cb); \ + if (VMG_CBOK(cb)) { \ + t->svt_ ## N = vmg_svt_ ## N; \ + SvREFCNT_inc_simple_void(cb); \ + } else { \ + t->svt_ ## N = vmg_svt_ ## N ## _noop; \ + cb = NULL; \ + } \ + } else { \ + t->svt_ ## N = NULL; \ + cb = NULL; \ + } \ + w->cb_ ## N = cb; \ +} + +/* --- XS ------------------------------------------------------------------ */ + +MODULE = Variable::Magic PACKAGE = Variable::Magic + +PROTOTYPES: ENABLE + +BOOT: +{ + vmg_setup(); } #if VMG_THREADSAFE @@ -1870,6 +2021,10 @@ PPCODE: } MY_CXT.depth = old_depth; MY_CXT.freed_tokens = NULL; + VMG_LOADED_LOCK; + assert(vmg_loaded > 0); + ++vmg_loaded; + VMG_LOADED_UNLOCK; } XSRETURN(0);