X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fre-engine-Hooks.git;a=blobdiff_plain;f=Hooks.xs;fp=Hooks.xs;h=3f9ce3e1a6039198d6f880c6ce60f97afce73585;hp=9d3c6bac06ae00f4dd5e1471b2fc52cc96d0df61;hb=5bf3d4775537378e1fab2796afa571d0a0cf6bfc;hpb=1d6014615be1c3832320632981e2c454b43edecf diff --git a/Hooks.xs b/Hooks.xs index 9d3c6ba..3f9ce3e 100644 --- a/Hooks.xs +++ b/Hooks.xs @@ -6,37 +6,21 @@ #include "perl.h" #include "XSUB.h" -#define __PACKAGE__ "re::engine::Hooks" -#define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1) +/* --- XS helpers ---------------------------------------------------------- */ -/* --- Compatibility wrappers ---------------------------------------------- */ - -#define REH_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S)))))) +#define XSH_PACKAGE "re::engine::Hooks" -#ifndef SvPV_const -# define SvPV_const(S, L) SvPV(S, L) -#endif +#include "xsh/caps.h" +#include "xsh/util.h" -/* ... Thread safety and multiplicity ...................................... */ +/* ... Lexical hints ....................................................... */ -#ifndef REH_MULTIPLICITY -# if defined(MULTIPLICITY) || defined(PERL_IMPLICIT_CONTEXT) -# define REH_MULTIPLICITY 1 -# else -# define REH_MULTIPLICITY 0 -# endif +#if !defined(cop_hints_fetch_pvn) && XSH_HAS_PERL(5, 9, 5) +# define cop_hints_fetch_pvn(COP, PKG, PKGLEN, PKGHASH, FLAGS) \ + Perl_refcounted_he_fetch(aTHX_ (COP)->cop_hints_hash, NULL, \ + (PKG), (PKGLEN), (FLAGS), (PKGHASH)) #endif -#ifdef USE_ITHREADS -# define REH_LOCK(M) MUTEX_LOCK(M) -# define REH_UNLOCK(M) MUTEX_UNLOCK(M) -#else -# define REH_LOCK(M) NOOP -# define REH_UNLOCK(M) NOOP -#endif - -/* --- Lexical hints ------------------------------------------------------- */ - STATIC U32 reh_hash = 0; STATIC SV *reh_hint(pTHX) { @@ -44,24 +28,30 @@ STATIC SV *reh_hint(pTHX) { SV *hint; #ifdef cop_hints_fetch_pvn - hint = cop_hints_fetch_pvn(PL_curcop, __PACKAGE__, __PACKAGE_LEN__, + hint = cop_hints_fetch_pvn(PL_curcop, XSH_PACKAGE, XSH_PACKAGE_LEN, reh_hash, 0); -#elif REH_HAS_PERL(5, 9, 5) - hint = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, - NULL, - __PACKAGE__, __PACKAGE_LEN__, - 0, - reh_hash); #else - SV **val = hv_fetch(GvHV(PL_hintgv), __PACKAGE__, __PACKAGE_LEN__, 0); - if (!val) - return 0; - hint = *val; + SV **val = hv_fetch(GvHV(PL_hintgv), XSH_PACKAGE, XSH_PACKAGE_LEN, 0); + hint = val ? *val : NULL; #endif return hint; } +/* ... Thread-local storage ................................................ */ + +#define XSH_THREADS_USER_CONTEXT 0 +#define XSH_THREADS_USER_LOCAL_SETUP 0 +#define XSH_THREADS_USER_LOCAL_TEARDOWN 0 + +#include "xsh/threads.h" + +/* --- Compatibility wrappers ---------------------------------------------- */ + +#ifndef SvPV_const +# define SvPV_const(S, L) SvPV(S, L) +#endif + /* --- Public API ---------------------------------------------------------- */ #include "re_engine_hooks.h" @@ -100,10 +90,10 @@ void reh_register(pTHX_ const char *key, reh_config *cfg) { a->key = key_dup; a->klen = len; - REH_LOCK(&reh_action_list_mutex); + XSH_LOCK(&reh_action_list_mutex); a->next = reh_action_list; reh_action_list = a; - REH_UNLOCK(&reh_action_list_mutex); + XSH_UNLOCK(&reh_action_list_mutex); return; } @@ -121,12 +111,12 @@ EXTERN_C REGEXP *reh_re_compile(pTHX_ const SV * const, const U32); #else EXTERN_C REGEXP *reh_re_compile(pTHX_ SV * const, U32); #endif -#if REH_HAS_PERL(5, 19, 4) +#if XSH_HAS_PERL(5, 19, 4) EXTERN_C I32 reh_regexec_flags(pTHX_ REGEXP * const, char *, char *, char *, SSize_t, SV *, void *, U32); #else EXTERN_C I32 reh_regexec_flags(pTHX_ REGEXP * const, char *, char *, char *, I32, SV *, void *, U32); #endif -#if REH_HAS_PERL(5, 19, 1) +#if XSH_HAS_PERL(5, 19, 1) EXTERN_C char * reh_re_intuit_start(pTHX_ REGEXP * const, SV *, const char * const, char *, char *, U32, re_scream_pos_data *); #else EXTERN_C char * reh_re_intuit_start(pTHX_ REGEXP * const, SV *, char *, char *, U32, re_scream_pos_data *); @@ -147,7 +137,7 @@ EXTERN_C SV * reh_reg_qr_package(pTHX_ REGEXP * const); #ifdef USE_ITHREADS EXTERN_C void * reh_re_dupe(pTHX_ REGEXP * const, CLONE_PARAMS *); #endif -#if REH_HAS_PERL(5, 17, 1) +#if XSH_HAS_PERL(5, 17, 1) EXTERN_C REGEXP *reh_re_op_compile(pTHX_ SV ** const, int, OP *, const regexp_engine*, REGEXP *VOL, bool *, U32, U32); #endif @@ -166,7 +156,7 @@ const struct regexp_engine reh_regexp_engine = { #if defined(USE_ITHREADS) , reh_re_dupe #endif -#if REH_HAS_PERL(5, 17, 1) +#if XSH_HAS_PERL(5, 17, 1) , reh_re_op_compile #endif }; @@ -179,8 +169,11 @@ typedef struct { U32 refcount; } reh_private; -STATIC void reh_private_free(pTHX_ reh_private *priv) { -#define reh_private_free(P) reh_private_free(aTHX_ (P)) +STATIC void reh_private_free(pPMS_ reh_private *priv) { +#define reh_private_free(P) reh_private_free(aPMS_ (P)) + if (!priv) + return; + if (priv->refcount <= 1) { PerlMemShared_free((void *) priv->cbs); PerlMemShared_free(priv); @@ -189,20 +182,16 @@ STATIC void reh_private_free(pTHX_ reh_private *priv) { } } -#define PTABLE_NAME ptable_private -#define PTABLE_VAL_FREE(V) reh_private_free(V) - -#define pPTBL pTHX -#define pPTBL_ pTHX_ -#define aPTBL aTHX -#define aPTBL_ aTHX_ +#define PTABLE_NAME ptable_private +#define PTABLE_VAL_FREE(V) reh_private_free(V) +#define PTABLE_VAL_NEED_CONTEXT 0 -#include "ptable.h" +#include "xsh/ptable.h" -#define ptable_private_store(T, K, V) ptable_private_store(aTHX_ (T), (K), (V)) -#define ptable_private_delete(T, K) ptable_private_delete(aTHX_ (T), (K)) -#define ptable_private_clear(T) ptable_private_clear(aTHX_ (T)) -#define ptable_private_free(T) ptable_private_free(aTHX_ (T)) +#define ptable_private_store(T, K, V) ptable_private_store(aPMS_ (T), (K), (V)) +#define ptable_private_delete(T, K) ptable_private_delete(aPMS_ (T), (K)) +#define ptable_private_clear(T) ptable_private_clear(aPMS_ (T)) +#define ptable_private_free(T) ptable_private_free(aPMS_ (T)) STATIC ptable *reh_private_map; @@ -214,7 +203,7 @@ STATIC perl_mutex reh_private_map_mutex; #define REH_PRIVATE_MAP_FOREACH(C) STMT_START { \ reh_private *priv; \ - REH_LOCK(&reh_private_map_mutex); \ + XSH_LOCK(&reh_private_map_mutex); \ priv = ptable_fetch(reh_private_map, rx->pprivate); \ if (priv) { \ const reh_config *cbs = priv->cbs; \ @@ -225,14 +214,14 @@ STATIC perl_mutex reh_private_map_mutex; } \ } \ } \ - REH_UNLOCK(&reh_private_map_mutex); \ + XSH_UNLOCK(&reh_private_map_mutex); \ } STMT_END STATIC void reh_private_map_store(pTHX_ void *ri, reh_private *priv) { #define reh_private_map_store(R, P) reh_private_map_store(aTHX_ (R), (P)) - REH_LOCK(&reh_private_map_mutex); + XSH_LOCK(&reh_private_map_mutex); ptable_private_store(reh_private_map, ri, priv); - REH_UNLOCK(&reh_private_map_mutex); + XSH_UNLOCK(&reh_private_map_mutex); return; } @@ -241,20 +230,20 @@ STATIC void reh_private_map_copy(pTHX_ void *ri_from, void *ri_to) { #define reh_private_map_copy(F, T) reh_private_map_copy(aTHX_ (F), (T)) reh_private *priv; - REH_LOCK(&reh_private_map_mutex); + XSH_LOCK(&reh_private_map_mutex); priv = ptable_fetch(reh_private_map, ri_from); if (priv) { ++priv->refcount; ptable_private_store(reh_private_map, ri_to, priv); } - REH_UNLOCK(&reh_private_map_mutex); + XSH_UNLOCK(&reh_private_map_mutex); } STATIC void reh_private_map_delete(pTHX_ void *ri) { #define reh_private_map_delete(R) reh_private_map_delete(aTHX_ (R)) - REH_LOCK(&reh_private_map_mutex); + XSH_LOCK(&reh_private_map_mutex); ptable_private_delete(reh_private_map, ri); - REH_UNLOCK(&reh_private_map_mutex); + XSH_UNLOCK(&reh_private_map_mutex); return; } @@ -273,9 +262,9 @@ void reh_call_comp_begin_hook(pTHX_ regexp *rx) { reh_config *cbs = NULL; reh_action *a, *root; - REH_LOCK(&reh_action_list_mutex); + XSH_LOCK(&reh_action_list_mutex); root = reh_action_list; - REH_UNLOCK(&reh_action_list_mutex); + XSH_UNLOCK(&reh_action_list_mutex); for (a = root; a; a = a->next) { char *p = strstr(keys, a->key); @@ -343,13 +332,30 @@ void *reh_re_dupe(pTHX_ REGEXP * const RX, CLONE_PARAMS *param) { #endif -STATIC void reh_teardown(pTHX_ void *root) { -#if REH_MULTIPLICITY - if (aTHX != root) - return; +/* --- Module setup/teardown ----------------------------------------------- */ + +STATIC void xsh_user_global_setup(pTHX) { + PERL_HASH(reh_hash, XSH_PACKAGE, XSH_PACKAGE_LEN); + + reh_private_map = ptable_new(8); + +#ifdef USE_ITHREADS + MUTEX_INIT(&reh_action_list_mutex); + MUTEX_INIT(&reh_private_map_mutex); #endif + return; +} + +STATIC void xsh_user_global_teardown(pTHX) { ptable_private_free(reh_private_map); + +#ifdef USE_ITHREADS + MUTEX_DESTROY(&reh_private_map_mutex); + MUTEX_DESTROY(&reh_action_list_mutex); +#endif + + return; } /* --- XS ------------------------------------------------------------------ */ @@ -360,17 +366,7 @@ PROTOTYPES: ENABLE BOOT: { - reh_private_map = ptable_new(); -#ifdef USE_ITHREADS - MUTEX_INIT(&reh_action_list_mutex); - MUTEX_INIT(&reh_private_map_mutex); -#endif - PERL_HASH(reh_hash, __PACKAGE__, __PACKAGE_LEN__); -#if REH_MULTIPLICITY - call_atexit(reh_teardown, aTHX); -#else - call_atexit(reh_teardown, NULL); -#endif + xsh_setup(); } void @@ -388,9 +384,9 @@ PREINIT: STRLEN len; const char *s; PPCODE: - REH_LOCK(&reh_action_list_mutex); + XSH_LOCK(&reh_action_list_mutex); a = reh_action_list; - REH_UNLOCK(&reh_action_list_mutex); + XSH_UNLOCK(&reh_action_list_mutex); s = SvPV_const(key, len); while (a && !ret) { if (a->klen == len && memcmp(a->key, s, len) == 0)