#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) {
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"
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;
}
#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 *);
#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
#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
};
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);
}
}
-#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;
#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; \
} \
} \
} \
- 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;
}
#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;
}
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);
#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 ------------------------------------------------------------------ */
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
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)
projects / perl / modules / re-engine-Hooks.git / blobdiff