X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fre-engine-Hooks.git;a=blobdiff_plain;f=Hooks.xs;h=3f9ce3e1a6039198d6f880c6ce60f97afce73585;hp=0320d2abaa9b5e2a42f70c56f826d52a10981f80;hb=HEAD;hpb=f609ee10b4b981c6c131936a39d13108d608a4fc diff --git a/Hooks.xs b/Hooks.xs index 0320d2a..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 XSH_PACKAGE "re::engine::Hooks" -#define REH_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S)))))) +#include "xsh/caps.h" +#include "xsh/util.h" -#ifndef SvPV_const -# define SvPV_const(S, L) SvPV(S, L) -#endif +/* ... Lexical hints ....................................................... */ -/* ... Thread safety and multiplicity ...................................... */ - -#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; } @@ -117,16 +107,21 @@ void reh_register(pTHX_ const char *key, reh_config *cfg) { #endif #if PERL_VERSION <= 10 -EXTERN_C REGEXP *reh_regcomp(pTHX_ const SV * const, const U32); +EXTERN_C REGEXP *reh_re_compile(pTHX_ const SV * const, const U32); #else -EXTERN_C REGEXP *reh_regcomp(pTHX_ SV * const, U32); +EXTERN_C REGEXP *reh_re_compile(pTHX_ SV * const, U32); +#endif +#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 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 *); #endif -EXTERN_C I32 reh_regexec(pTHX_ REGEXP * const, char *, char *, - char *, I32, SV *, void *, U32); -EXTERN_C char * reh_re_intuit_start(pTHX_ REGEXP * const, SV *, char *, - char *, U32, re_scream_pos_data *); EXTERN_C SV * reh_re_intuit_string(pTHX_ REGEXP * const); -EXTERN_C void reh_regfree(pTHX_ REGEXP * const); EXTERN_C void reh_re_free(pTHX_ REGEXP * const); EXTERN_C void reh_reg_numbered_buff_fetch(pTHX_ REGEXP * const, const I32, SV * const); @@ -140,16 +135,15 @@ EXTERN_C SV * reh_reg_named_buff_iter(pTHX_ REGEXP * const, const SV * const, const U32); EXTERN_C SV * reh_reg_qr_package(pTHX_ REGEXP * const); #ifdef USE_ITHREADS -EXTERN_C void * reh_regdupe(pTHX_ REGEXP * const, CLONE_PARAMS *); EXTERN_C void * reh_re_dupe(pTHX_ REGEXP * const, CLONE_PARAMS *); #endif -#if REH_HAS_PERL(5, 17, 1) -EXTERN_C REGEXP *reh_op_compile(pTHX_ SV ** const patternp, int pat_count, OP *expr, const regexp_engine* eng, REGEXP *VOL old_re, bool *is_bare_re, U32 orig_rx_flags, U32 pm_flags); +#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 const struct regexp_engine reh_regexp_engine = { - reh_regcomp, - reh_regexec, + reh_re_compile, + reh_regexec_flags, reh_re_intuit_start, reh_re_intuit_string, reh_re_free, @@ -162,8 +156,8 @@ const struct regexp_engine reh_regexp_engine = { #if defined(USE_ITHREADS) , reh_re_dupe #endif -#if REH_HAS_PERL(5, 17, 1) - , reh_op_compile +#if XSH_HAS_PERL(5, 17, 1) + , reh_re_op_compile #endif }; @@ -175,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); @@ -185,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 PTABLE_NAME ptable_private +#define PTABLE_VAL_FREE(V) reh_private_free(V) +#define PTABLE_VAL_NEED_CONTEXT 0 -#define pPTBL pTHX -#define pPTBL_ pTHX_ -#define aPTBL aTHX -#define aPTBL_ aTHX_ +#include "xsh/ptable.h" -#include "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; @@ -210,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; \ @@ -221,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 reh_private *reh_private_map_store(pTHX_ void *ri, reh_private *priv) { +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; } @@ -237,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; } @@ -269,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); @@ -312,21 +305,25 @@ void reh_call_exec_node_hook(pTHX_ regexp *rx, regnode *node, regmatch_info *reg REH_PRIVATE_MAP_FOREACH(cbs->exec_node(aTHX_ rx, node, reginfo, st)); } +EXTERN_C void reh_regfree_internal(pTHX_ REGEXP * const); + void reh_re_free(pTHX_ REGEXP * const RX) { regexp *rx = rxREGEXP(RX); reh_private_map_delete(rx->pprivate); - reh_regfree(aTHX_ RX); + reh_regfree_internal(aTHX_ RX); } #ifdef USE_ITHREADS +EXTERN_C void *reh_regdupe_internal(pTHX_ REGEXP * const, CLONE_PARAMS *); + void *reh_re_dupe(pTHX_ REGEXP * const RX, CLONE_PARAMS *param) { regexp *rx = rxREGEXP(RX); void *new_ri; - new_ri = reh_regdupe(aTHX_ RX, param); + new_ri = reh_regdupe_internal(aTHX_ RX, param); reh_private_map_copy(rx->pprivate, new_ri); @@ -335,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 ------------------------------------------------------------------ */ @@ -352,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 @@ -380,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)