X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=indirect.xs;h=ba0543dae7e778c864bac2a9543479f2a2317e53;hp=ec570d7fec22ce58d4a4a2f404a57ad66394e28e;hb=f005f899e4ca83b205bf4cfb37e5d7c56b5d2b4b;hpb=6f86033f2d299addd4279cfbdf681e866aa9570d diff --git a/indirect.xs b/indirect.xs index ec570d7..ba0543d 100644 --- a/indirect.xs +++ b/indirect.xs @@ -113,12 +113,17 @@ #endif #ifndef I_MULTIPLICITY -# if defined(MULTIPLICITY) || defined(PERL_IMPLICIT_CONTEXT) +# if defined(MULTIPLICITY) # define I_MULTIPLICITY 1 # else # define I_MULTIPLICITY 0 # endif #endif +#if I_MULTIPLICITY +# ifndef PERL_IMPLICIT_CONTEXT +# error MULTIPLICITY builds must set PERL_IMPLICIT_CONTEXT +# endif +#endif #if I_MULTIPLICITY && !defined(tTHX) # define tTHX PerlInterpreter* #endif @@ -139,19 +144,40 @@ # undef MY_CXT # define MY_CXT indirect_globaldata # undef START_MY_CXT -# define START_MY_CXT STATIC my_cxt_t MY_CXT; +# define START_MY_CXT static my_cxt_t MY_CXT; # undef MY_CXT_INIT # define MY_CXT_INIT NOOP # undef MY_CXT_CLONE # define MY_CXT_CLONE NOOP #endif +#if I_THREADSAFE +/* We must use preexistent global mutexes or we will never be able to destroy + * them. */ +# if I_HAS_PERL(5, 9, 3) +# define I_LOADED_LOCK MUTEX_LOCK(&PL_my_ctx_mutex) +# define I_LOADED_UNLOCK MUTEX_UNLOCK(&PL_my_ctx_mutex) +# else +# define I_LOADED_LOCK OP_REFCNT_LOCK +# define I_LOADED_UNLOCK OP_REFCNT_UNLOCK +# endif +#else +# define I_LOADED_LOCK NOOP +# define I_LOADED_UNLOCK NOOP +#endif + #if defined(OP_CHECK_MUTEX_LOCK) && defined(OP_CHECK_MUTEX_UNLOCK) -# define I_CHECK_MUTEX_LOCK OP_CHECK_MUTEX_LOCK -# define I_CHECK_MUTEX_UNLOCK OP_CHECK_MUTEX_UNLOCK +# define I_CHECK_LOCK OP_CHECK_MUTEX_LOCK +# define I_CHECK_UNLOCK OP_CHECK_MUTEX_UNLOCK +#elif I_HAS_PERL(5, 9, 3) +# define I_CHECK_LOCK OP_REFCNT_LOCK +# define I_CHECK_UNLOCK OP_REFCNT_UNLOCK #else -# define I_CHECK_MUTEX_LOCK OP_REFCNT_LOCK -# define I_CHECK_MUTEX_UNLOCK OP_REFCNT_UNLOCK +/* Before perl 5.9.3, indirect_ck_*() calls are already protected by the + * I_LOADED mutex, which falls back to the OP_REFCNT mutex. Make sure we don't + * lock it twice. */ +# define I_CHECK_LOCK NOOP +# define I_CHECK_UNLOCK NOOP #endif typedef OP *(*indirect_ck_t)(pTHX_ OP *); @@ -162,30 +188,103 @@ typedef OP *(*indirect_ck_t)(pTHX_ OP *); #else -STATIC void indirect_ck_replace(pTHX_ OPCODE type, indirect_ck_t new_ck, indirect_ck_t *old_ck_p) { +static void indirect_ck_replace(pTHX_ OPCODE type, indirect_ck_t new_ck, indirect_ck_t *old_ck_p) { #define indirect_ck_replace(T, NC, OCP) indirect_ck_replace(aTHX_ (T), (NC), (OCP)) - I_CHECK_MUTEX_LOCK; + I_CHECK_LOCK; if (!*old_ck_p) { *old_ck_p = PL_check[type]; PL_check[type] = new_ck; } - I_CHECK_MUTEX_UNLOCK; + I_CHECK_UNLOCK; } #endif -STATIC void indirect_ck_restore(pTHX_ OPCODE type, indirect_ck_t *old_ck_p) { +static void indirect_ck_restore(pTHX_ OPCODE type, indirect_ck_t *old_ck_p) { #define indirect_ck_restore(T, OCP) indirect_ck_restore(aTHX_ (T), (OCP)) - I_CHECK_MUTEX_LOCK; + I_CHECK_LOCK; if (*old_ck_p) { PL_check[type] = *old_ck_p; *old_ck_p = 0; } - I_CHECK_MUTEX_UNLOCK; + I_CHECK_UNLOCK; } /* --- Helpers ------------------------------------------------------------- */ +/* ... Check if the module is loaded ....................................... */ + +static I32 indirect_loaded = 0; + +#if I_THREADSAFE + +#define PTABLE_NAME ptable_loaded +#define PTABLE_VAL_FREE(V) NOOP + +#include "ptable.h" + +#define ptable_loaded_store(T, K, V) ptable_loaded_store(aPTBLMS_ (T), (K), (V)) +#define ptable_loaded_delete(T, K) ptable_loaded_delete(aPTBLMS_ (T), (K)) +#define ptable_loaded_free(T) ptable_loaded_free(aPTBLMS_ (T)) + +static ptable *indirect_loaded_cxts = NULL; + +static int indirect_is_loaded(pTHX_ void *cxt) { +#define indirect_is_loaded(C) indirect_is_loaded(aTHX_ (C)) + int res = 0; + + I_LOADED_LOCK; + if (indirect_loaded_cxts && ptable_fetch(indirect_loaded_cxts, cxt)) + res = 1; + I_LOADED_UNLOCK; + + return res; +} + +static int indirect_set_loaded_locked(pTHX_ void *cxt) { +#define indirect_set_loaded_locked(C) indirect_set_loaded_locked(aTHX_ (C)) + int global_setup = 0; + + if (indirect_loaded <= 0) { + assert(indirect_loaded == 0); + assert(!indirect_loaded_cxts); + indirect_loaded_cxts = ptable_new(); + global_setup = 1; + } + ++indirect_loaded; + assert(indirect_loaded_cxts); + ptable_loaded_store(indirect_loaded_cxts, cxt, cxt); + + return global_setup; +} + +static int indirect_clear_loaded_locked(pTHX_ void *cxt) { +#define indirect_clear_loaded_locked(C) indirect_clear_loaded_locked(aTHX_ (C)) + int global_teardown = 0; + + if (indirect_loaded > 1) { + assert(indirect_loaded_cxts); + ptable_loaded_delete(indirect_loaded_cxts, cxt); + --indirect_loaded; + } else if (indirect_loaded_cxts) { + assert(indirect_loaded == 1); + ptable_loaded_free(indirect_loaded_cxts); + indirect_loaded_cxts = NULL; + indirect_loaded = 0; + global_teardown = 1; + } + + return global_teardown; +} + +#else + +#define indirect_is_loaded(C) (indirect_loaded > 0) +#define indirect_set_loaded_locked(C) ((indirect_loaded++ <= 0) ? 1 : 0) +#define indirect_clear_loaded_locked(C) ((--indirect_loaded <= 0) ? 1 : 0) + +#endif + /* ... Thread-safe hints ................................................... */ #if I_WORKAROUND_REQUIRE_PROPAGATION @@ -300,7 +399,7 @@ typedef struct { # define indirect_dup_inc(S, U) SvREFCNT_inc(sv_dup((S), &((U)->params))) #endif -STATIC void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) { +static void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) { indirect_ptable_clone_ud *ud = ud_; indirect_hint_t *h1 = ent->val; indirect_hint_t *h2; @@ -322,24 +421,30 @@ STATIC void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) { ptable_hints_store(ud->tbl, ent->key, h2); } -STATIC void indirect_thread_cleanup(pTHX_ void *ud) { +static void indirect_thread_cleanup(pTHX_ void *ud) { + int global_teardown; dMY_CXT; + global_teardown = indirect_clear_loaded_locked(&MY_CXT); + assert(!global_teardown); + SvREFCNT_dec(MY_CXT.global_code); MY_CXT.global_code = NULL; + ptable_free(MY_CXT.map); MY_CXT.map = NULL; + ptable_hints_free(MY_CXT.tbl); MY_CXT.tbl = NULL; } -STATIC int indirect_endav_free(pTHX_ SV *sv, MAGIC *mg) { +static int indirect_endav_free(pTHX_ SV *sv, MAGIC *mg) { SAVEDESTRUCTOR_X(indirect_thread_cleanup, NULL); return 0; } -STATIC MGVTBL indirect_endav_vtbl = { +static MGVTBL indirect_endav_vtbl = { 0, 0, 0, @@ -359,7 +464,7 @@ STATIC MGVTBL indirect_endav_vtbl = { #endif /* I_THREADSAFE */ #if I_WORKAROUND_REQUIRE_PROPAGATION -STATIC IV indirect_require_tag(pTHX) { +static IV indirect_require_tag(pTHX) { #define indirect_require_tag() indirect_require_tag(aTHX) const CV *cv, *outside; @@ -404,7 +509,7 @@ get_enclosing_cv: } #endif /* I_WORKAROUND_REQUIRE_PROPAGATION */ -STATIC SV *indirect_tag(pTHX_ SV *value) { +static SV *indirect_tag(pTHX_ SV *value) { #define indirect_tag(V) indirect_tag(aTHX_ (V)) indirect_hint_t *h; SV *code = NULL; @@ -443,7 +548,7 @@ STATIC SV *indirect_tag(pTHX_ SV *value) { return newSViv(PTR2IV(h)); } -STATIC SV *indirect_detag(pTHX_ const SV *hint) { +static SV *indirect_detag(pTHX_ const SV *hint) { #define indirect_detag(H) indirect_detag(aTHX_ (H)) indirect_hint_t *h; #if I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION @@ -468,9 +573,9 @@ STATIC SV *indirect_detag(pTHX_ const SV *hint) { return I_HINT_CODE(h); } -STATIC U32 indirect_hash = 0; +static VOL U32 indirect_hash = 0; -STATIC SV *indirect_hint(pTHX) { +static SV *indirect_hint(pTHX) { #define indirect_hint() indirect_hint(aTHX) SV *hint = NULL; @@ -499,17 +604,20 @@ STATIC SV *indirect_hint(pTHX) { } #endif - if (hint && SvIOK(hint)) + if (hint && SvIOK(hint)) { return indirect_detag(hint); - else { + } else { dMY_CXT; - return MY_CXT.global_code; + if (indirect_is_loaded(&MY_CXT)) + return MY_CXT.global_code; + else + return NULL; } } /* ... op -> source position ............................................... */ -STATIC void indirect_map_store(pTHX_ const OP *o, STRLEN pos, SV *sv, line_t line) { +static void indirect_map_store(pTHX_ const OP *o, STRLEN pos, SV *sv, line_t line) { #define indirect_map_store(O, P, N, L) indirect_map_store(aTHX_ (O), (P), (N), (L)) indirect_op_info_t *oi; const char *s; @@ -545,7 +653,7 @@ STATIC void indirect_map_store(pTHX_ const OP *o, STRLEN pos, SV *sv, line_t lin oi->line = line; } -STATIC const indirect_op_info_t *indirect_map_fetch(pTHX_ const OP *o) { +static const indirect_op_info_t *indirect_map_fetch(pTHX_ const OP *o) { #define indirect_map_fetch(O) indirect_map_fetch(aTHX_ (O)) dMY_CXT; @@ -555,17 +663,17 @@ STATIC const indirect_op_info_t *indirect_map_fetch(pTHX_ const OP *o) { return ptable_fetch(MY_CXT.map, o); } -STATIC void indirect_map_delete(pTHX_ const OP *o) { +static void indirect_map_delete(pTHX_ const OP *o) { #define indirect_map_delete(O) indirect_map_delete(aTHX_ (O)) dMY_CXT; - if (MY_CXT.map) + if (indirect_is_loaded(&MY_CXT) && MY_CXT.map) ptable_delete(MY_CXT.map, o); } /* --- Check functions ----------------------------------------------------- */ -STATIC int indirect_find(pTHX_ SV *name_sv, const char *line_bufptr, STRLEN *name_pos) { +static int indirect_find(pTHX_ SV *name_sv, const char *line_bufptr, STRLEN *name_pos) { #define indirect_find(NSV, LBP, NP) indirect_find(aTHX_ (NSV), (LBP), (NP)) STRLEN name_len, line_len; const char *name, *name_end; @@ -606,9 +714,9 @@ STATIC int indirect_find(pTHX_ SV *name_sv, const char *line_bufptr, STRLEN *nam /* ... ck_const ............................................................ */ -STATIC OP *(*indirect_old_ck_const)(pTHX_ OP *) = 0; +static OP *(*indirect_old_ck_const)(pTHX_ OP *) = 0; -STATIC OP *indirect_ck_const(pTHX_ OP *o) { +static OP *indirect_ck_const(pTHX_ OP *o) { o = indirect_old_ck_const(aTHX_ o); if (indirect_hint()) { @@ -650,9 +758,9 @@ STATIC OP *indirect_ck_const(pTHX_ OP *o) { /* ... ck_rv2sv ............................................................ */ -STATIC OP *(*indirect_old_ck_rv2sv)(pTHX_ OP *) = 0; +static OP *(*indirect_old_ck_rv2sv)(pTHX_ OP *) = 0; -STATIC OP *indirect_ck_rv2sv(pTHX_ OP *o) { +static OP *indirect_ck_rv2sv(pTHX_ OP *o) { if (indirect_hint()) { OP *op = cUNOPo->op_first; SV *sv; @@ -717,9 +825,9 @@ done: /* ... ck_padany ........................................................... */ -STATIC OP *(*indirect_old_ck_padany)(pTHX_ OP *) = 0; +static OP *(*indirect_old_ck_padany)(pTHX_ OP *) = 0; -STATIC OP *indirect_ck_padany(pTHX_ OP *o) { +static OP *indirect_ck_padany(pTHX_ OP *o) { o = indirect_old_ck_padany(aTHX_ o); if (indirect_hint()) { @@ -744,10 +852,10 @@ STATIC OP *indirect_ck_padany(pTHX_ OP *o) { /* ... ck_scope ............................................................ */ -STATIC OP *(*indirect_old_ck_scope) (pTHX_ OP *) = 0; -STATIC OP *(*indirect_old_ck_lineseq)(pTHX_ OP *) = 0; +static OP *(*indirect_old_ck_scope) (pTHX_ OP *) = 0; +static OP *(*indirect_old_ck_lineseq)(pTHX_ OP *) = 0; -STATIC OP *indirect_ck_scope(pTHX_ OP *o) { +static OP *indirect_ck_scope(pTHX_ OP *o) { OP *(*old_ck)(pTHX_ OP *) = 0; switch (o->op_type) { @@ -771,9 +879,9 @@ STATIC OP *indirect_ck_scope(pTHX_ OP *o) { /* ... ck_method ........................................................... */ -STATIC OP *(*indirect_old_ck_method)(pTHX_ OP *) = 0; +static OP *(*indirect_old_ck_method)(pTHX_ OP *) = 0; -STATIC OP *indirect_ck_method(pTHX_ OP *o) { +static OP *indirect_ck_method(pTHX_ OP *o) { if (indirect_hint()) { OP *op = cUNOPo->op_first; @@ -814,9 +922,9 @@ done: /* "use foo/no foo" compiles its call to import/unimport directly to a * method_named op. */ -STATIC OP *(*indirect_old_ck_method_named)(pTHX_ OP *) = 0; +static OP *(*indirect_old_ck_method_named)(pTHX_ OP *) = 0; -STATIC OP *indirect_ck_method_named(pTHX_ OP *o) { +static OP *indirect_ck_method_named(pTHX_ OP *o) { if (indirect_hint()) { STRLEN pos; line_t line; @@ -846,9 +954,9 @@ done: /* ... ck_entersub ......................................................... */ -STATIC OP *(*indirect_old_ck_entersub)(pTHX_ OP *) = 0; +static OP *(*indirect_old_ck_entersub)(pTHX_ OP *) = 0; -STATIC OP *indirect_ck_entersub(pTHX_ OP *o) { +static OP *indirect_ck_entersub(pTHX_ OP *o) { SV *code = indirect_hint(); o = indirect_old_ck_entersub(aTHX_ o); @@ -933,79 +1041,96 @@ done: return o; } -STATIC U32 indirect_initialized = 0; +/* --- Module setup/teardown ----------------------------------------------- */ -STATIC void indirect_teardown(pTHX_ void *root) { - if (!indirect_initialized) - return; +static void indirect_teardown(pTHX_ void *interp) { + dMY_CXT; #if I_MULTIPLICITY - if (aTHX != root) + if (aTHX != interp) return; #endif - { - dMY_CXT; - ptable_free(MY_CXT.map); - MY_CXT.map = NULL; -#if I_THREADSAFE - ptable_hints_free(MY_CXT.tbl); - MY_CXT.tbl = NULL; -#endif + I_LOADED_LOCK; + + if (indirect_clear_loaded_locked(&MY_CXT)) { + indirect_ck_restore(OP_CONST, &indirect_old_ck_const); + indirect_ck_restore(OP_RV2SV, &indirect_old_ck_rv2sv); + indirect_ck_restore(OP_PADANY, &indirect_old_ck_padany); + indirect_ck_restore(OP_SCOPE, &indirect_old_ck_scope); + indirect_ck_restore(OP_LINESEQ, &indirect_old_ck_lineseq); + + indirect_ck_restore(OP_METHOD, &indirect_old_ck_method); + indirect_ck_restore(OP_METHOD_NAMED, &indirect_old_ck_method_named); + indirect_ck_restore(OP_ENTERSUB, &indirect_old_ck_entersub); } - indirect_ck_restore(OP_CONST, &indirect_old_ck_const); - indirect_ck_restore(OP_RV2SV, &indirect_old_ck_rv2sv); - indirect_ck_restore(OP_PADANY, &indirect_old_ck_padany); - indirect_ck_restore(OP_SCOPE, &indirect_old_ck_scope); - indirect_ck_restore(OP_LINESEQ, &indirect_old_ck_lineseq); + I_LOADED_UNLOCK; + + SvREFCNT_dec(MY_CXT.global_code); + MY_CXT.global_code = NULL; + + ptable_free(MY_CXT.map); + MY_CXT.map = NULL; - indirect_ck_restore(OP_METHOD, &indirect_old_ck_method); - indirect_ck_restore(OP_METHOD_NAMED, &indirect_old_ck_method_named); - indirect_ck_restore(OP_ENTERSUB, &indirect_old_ck_entersub); +#if I_THREADSAFE + ptable_hints_free(MY_CXT.tbl); + MY_CXT.tbl = NULL; +#endif - indirect_initialized = 0; + return; } -STATIC void indirect_setup(pTHX) { +static void indirect_setup(pTHX) { #define indirect_setup() indirect_setup(aTHX) - if (indirect_initialized) - return; + MY_CXT_INIT; /* Takes/release PL_my_ctx_mutex */ + + I_LOADED_LOCK; + + if (indirect_set_loaded_locked(&MY_CXT)) { + PERL_HASH(indirect_hash, __PACKAGE__, __PACKAGE_LEN__); + + indirect_ck_replace(OP_CONST, indirect_ck_const, &indirect_old_ck_const); + indirect_ck_replace(OP_RV2SV, indirect_ck_rv2sv, &indirect_old_ck_rv2sv); + indirect_ck_replace(OP_PADANY, indirect_ck_padany, &indirect_old_ck_padany); + indirect_ck_replace(OP_SCOPE, indirect_ck_scope, &indirect_old_ck_scope); + indirect_ck_replace(OP_LINESEQ, indirect_ck_scope, &indirect_old_ck_lineseq); + + indirect_ck_replace(OP_METHOD, indirect_ck_method, + &indirect_old_ck_method); + indirect_ck_replace(OP_METHOD_NAMED, indirect_ck_method_named, + &indirect_old_ck_method_named); + indirect_ck_replace(OP_ENTERSUB, indirect_ck_entersub, + &indirect_old_ck_entersub); + } + + I_LOADED_UNLOCK; { - MY_CXT_INIT; + HV *stash; + + stash = gv_stashpvn(__PACKAGE__, __PACKAGE_LEN__, 1); + newCONSTSUB(stash, "I_THREADSAFE", newSVuv(I_THREADSAFE)); + newCONSTSUB(stash, "I_FORKSAFE", newSVuv(I_FORKSAFE)); + #if I_THREADSAFE MY_CXT.tbl = ptable_new(); MY_CXT.owner = aTHX; #endif + MY_CXT.map = ptable_new(); MY_CXT.global_code = NULL; } - indirect_ck_replace(OP_CONST, indirect_ck_const, &indirect_old_ck_const); - indirect_ck_replace(OP_RV2SV, indirect_ck_rv2sv, &indirect_old_ck_rv2sv); - indirect_ck_replace(OP_PADANY, indirect_ck_padany, &indirect_old_ck_padany); - indirect_ck_replace(OP_SCOPE, indirect_ck_scope, &indirect_old_ck_scope); - indirect_ck_replace(OP_LINESEQ, indirect_ck_scope, &indirect_old_ck_lineseq); - - indirect_ck_replace(OP_METHOD, indirect_ck_method, - &indirect_old_ck_method); - indirect_ck_replace(OP_METHOD_NAMED, indirect_ck_method_named, - &indirect_old_ck_method_named); - indirect_ck_replace(OP_ENTERSUB, indirect_ck_entersub, - &indirect_old_ck_entersub); - #if I_MULTIPLICITY call_atexit(indirect_teardown, aTHX); #else call_atexit(indirect_teardown, NULL); #endif - indirect_initialized = 1; + return; } -STATIC U32 indirect_booted = 0; - /* --- XS ------------------------------------------------------------------ */ MODULE = indirect PACKAGE = indirect @@ -1014,16 +1139,6 @@ PROTOTYPES: ENABLE BOOT: { - if (!indirect_booted++) { - HV *stash; - - PERL_HASH(indirect_hash, __PACKAGE__, __PACKAGE_LEN__); - - stash = gv_stashpvn(__PACKAGE__, __PACKAGE_LEN__, 1); - newCONSTSUB(stash, "I_THREADSAFE", newSVuv(I_THREADSAFE)); - newCONSTSUB(stash, "I_FORKSAFE", newSVuv(I_FORKSAFE)); - } - indirect_setup(); } @@ -1052,6 +1167,13 @@ PPCODE: MY_CXT.tbl = t; MY_CXT.owner = aTHX; MY_CXT.global_code = global_code_dup; + { + int global_setup; + I_LOADED_LOCK; + global_setup = indirect_set_loaded_locked(&MY_CXT); + assert(!global_setup); + I_LOADED_UNLOCK; + } } gv = gv_fetchpv(__PACKAGE__ "::_THREAD_CLEANUP", 0, SVt_PVCV); if (gv) {