]> git.vpit.fr Git - perl/modules/re-engine-Hooks.git/commitdiff
Attach the callbacks to every regexps in a thread-safe way
authorVincent Pit <vince@profvince.com>
Sat, 31 Mar 2012 12:48:27 +0000 (14:48 +0200)
committerVincent Pit <vince@profvince.com>
Sat, 31 Mar 2012 12:48:27 +0000 (14:48 +0200)
This means that starting from now the tweaked regexp engine is no longer
required to be in use at the time a regexp is executed.

42 files changed:
Hooks.xs
MANIFEST
ptable.h [new file with mode: 0644]
re_defs.h
src/5010001/regcomp.c
src/5011000/regcomp.c
src/5011001/regcomp.c
src/5011002/regcomp.c
src/5011003/regcomp.c
src/5011004/regcomp.c
src/5011005/regcomp.c
src/5012000/regcomp.c
src/5012001/regcomp.c
src/5012002/regcomp.c
src/5012003/regcomp.c
src/5012004/regcomp.c
src/5013000/regcomp.c
src/5013001/regcomp.c
src/5013002/regcomp.c
src/5013003/regcomp.c
src/5013004/regcomp.c
src/5013005/regcomp.c
src/5013006/regcomp.c
src/5013007/regcomp.c
src/5013008/regcomp.c
src/5013009/regcomp.c
src/5013010/regcomp.c
src/5013011/regcomp.c
src/5014000/regcomp.c
src/5014001/regcomp.c
src/5014002/regcomp.c
src/5015000/regcomp.c
src/5015001/regcomp.c
src/5015002/regcomp.c
src/5015003/regcomp.c
src/5015004/regcomp.c
src/5015005/regcomp.c
src/5015006/regcomp.c
src/5015007/regcomp.c
src/5015008/regcomp.c
src/5015009/regcomp.c
src/update.pl

index ef0c5082bdecc69867f59c85ad19932c0158edc9..b312223c08fff684b75445b2a1940a2731d85af7 100644 (file)
--- a/Hooks.xs
+++ b/Hooks.xs
 # define SvPV_const(S, L) SvPV(S, L)
 #endif
 
+/* ... Thread safety and multiplicity ...................................... */
+
+#ifndef REH_MULTIPLICITY
+# if defined(MULTIPLICITY) || defined(PERL_IMPLICIT_CONTEXT)
+#  define REH_MULTIPLICITY 1
+# else
+#  define REH_MULTIPLICITY 0
+# endif
+#endif
+
 #ifdef USE_ITHREADS
 # define REH_LOCK(M)   MUTEX_LOCK(M)
 # define REH_UNLOCK(M) MUTEX_UNLOCK(M)
@@ -98,54 +108,6 @@ void reh_register(pTHX_ const char *key, reh_config *cfg) {
  return;
 }
 
-/* --- Private API --------------------------------------------------------- */
-
-void reh_call_comp_hook(pTHX_ regexp *rx, regnode *node) {
- SV *hint = reh_hint();
-
- if (hint && SvPOK(hint)) {
-  STRLEN      len;
-  const char *keys = SvPV_const(hint, len);
-  reh_action *a;
-
-  REH_LOCK(&reh_action_list_mutex);
-  a = reh_action_list;
-  REH_UNLOCK(&reh_action_list_mutex);
-
-  for (; a; a = a->next) {
-   if (a->cbs.comp) {
-    char *p = strstr(keys, a->key);
-
-    if (p && (p + a->klen <= keys + len) && p[a->klen] == ' ')
-     a->cbs.comp(aTHX_ rx, node);
-   }
-  }
- }
-}
-
-void reh_call_exec_hook(pTHX_ regexp *rx, regnode *node, regmatch_info *reginfo, regmatch_state *st) {
- SV *hint = reh_hint();
-
- if (hint && SvPOK(hint)) {
-  STRLEN      len;
-  const char *keys = SvPV_const(hint, len);
-  reh_action *a;
-
-  REH_LOCK(&reh_action_list_mutex);
-  a = reh_action_list;
-  REH_UNLOCK(&reh_action_list_mutex);
-
-  for (; a; a = a->next) {
-   if (a->cbs.exec) {
-    char *p = strstr(keys, a->key);
-
-    if (p && (p + a->klen <= keys + len) && p[a->klen] == ' ')
-     a->cbs.exec(aTHX_ rx, node, reginfo, st);
-   }
-  }
- }
-}
-
 /* --- Custom regexp engine ------------------------------------------------ */
 
 #if PERL_VERSION <= 10
@@ -165,6 +127,7 @@ 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);
 EXTERN_C void    reh_reg_numbered_buff_store(pTHX_ REGEXP * const,
@@ -178,34 +141,17 @@ EXTERN_C SV *    reh_reg_named_buff_iter(pTHX_ REGEXP * const,
 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
 
 EXTERN_C const struct regexp_engine reh_regexp_engine;
 
-REGEXP *
-#if PERL_VERSION <= 10
-reh_re_compile(pTHX_ const SV * const pattern, const U32 flags)
-#else
-reh_re_compile(pTHX_ SV * const pattern, U32 flags)
-#endif
-{
- struct regexp *rx;
- REGEXP        *RX;
-
- RX = reh_regcomp(aTHX_ pattern, flags);
- rx = rxREGEXP(RX);
-
- rx->engine = &reh_regexp_engine;
-
- return RX;
-}
-
 const struct regexp_engine reh_regexp_engine = {
- reh_re_compile,
+ reh_regcomp,
  reh_regexec,
  reh_re_intuit_start,
  reh_re_intuit_string,
- reh_regfree,
+ reh_re_free,
  reh_reg_numbered_buff_fetch,
  reh_reg_numbered_buff_store,
  reh_reg_numbered_buff_length,
@@ -213,10 +159,185 @@ const struct regexp_engine reh_regexp_engine = {
  reh_reg_named_buff_iter,
  reh_reg_qr_package,
 #if defined(USE_ITHREADS)
- reh_regdupe
+ reh_re_dupe
 #endif
 };
 
+/* --- Private API --------------------------------------------------------- */
+
+typedef struct {
+ size_t            count;
+ const reh_config *cbs;
+ U32               refcount;
+} reh_private;
+
+STATIC void reh_private_free(pTHX_ reh_private *priv) {
+#define reh_private_free(P) reh_private_free(aTHX_ (P))
+ if (priv->refcount <= 1) {
+  PerlMemShared_free((void *) priv->cbs);
+  PerlMemShared_free(priv);
+ } else {
+  --priv->refcount;
+ }
+}
+
+#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_
+
+#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))
+
+STATIC ptable *reh_private_map;
+
+#ifdef USE_ITHREADS
+
+STATIC perl_mutex reh_private_map_mutex;
+
+#endif /* USE_ITHREADS */
+
+#define REH_PRIVATE_MAP_FOREACH(C) STMT_START {      \
+ reh_private *priv;                                  \
+ REH_LOCK(&reh_private_map_mutex);                   \
+ priv = ptable_fetch(reh_private_map, rx->pprivate); \
+ if (priv) {                                         \
+  const reh_config *cbs = priv->cbs;                 \
+  if (cbs) {                                         \
+   const reh_config *end = cbs + priv->count;        \
+   for (; cbs < end; ++cbs) {                        \
+    (C);                                             \
+   }                                                 \
+  }                                                  \
+ }                                                   \
+ REH_UNLOCK(&reh_private_map_mutex);                 \
+} STMT_END
+
+STATIC reh_private *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);
+ ptable_private_store(reh_private_map, ri, priv);
+ REH_UNLOCK(&reh_private_map_mutex);
+
+ return;
+}
+
+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);
+ 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);
+}
+
+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);
+ ptable_private_delete(reh_private_map, ri);
+ REH_UNLOCK(&reh_private_map_mutex);
+
+ return;
+}
+
+void reh_call_comp_begin_hook(pTHX_ regexp *rx) {
+ SV *hint = reh_hint();
+
+ if (hint && SvPOK(hint)) {
+  STRLEN      len;
+  const char *keys  = SvPV_const(hint, len);
+  size_t      count = 0;
+
+  reh_private *priv;
+  reh_config  *cbs = NULL;
+  reh_action  *a, *root;
+
+  REH_LOCK(&reh_action_list_mutex);
+  root = reh_action_list;
+  REH_UNLOCK(&reh_action_list_mutex);
+
+  for (a = root; a; a = a->next) {
+   char *p = strstr(keys, a->key);
+
+   if (p && (p + a->klen <= keys + len) && p[a->klen] == ' ')
+    ++count;
+  }
+
+  if (count) {
+   size_t i = 0;
+
+   cbs = PerlMemShared_malloc(count * sizeof *cbs);
+
+   for (a = root; a; a = a->next) {
+    char *p = strstr(keys, a->key);
+
+    if (p && (p + a->klen <= keys + len) && p[a->klen] == ' ')
+     cbs[i++] = a->cbs;
+   }
+  }
+
+  priv = PerlMemShared_malloc(sizeof *priv);
+  priv->count    = count;
+  priv->cbs      = cbs;
+  priv->refcount = 1;
+
+  rx->engine = &reh_regexp_engine;
+
+  reh_private_map_store(rx->pprivate, priv);
+ }
+}
+
+void reh_call_comp_hook(pTHX_ regexp *rx, regnode *node) {
+ REH_PRIVATE_MAP_FOREACH(cbs->comp(aTHX_ rx, node));
+}
+
+void reh_call_exec_hook(pTHX_ regexp *rx, regnode *node, regmatch_info *reginfo, regmatch_state *st) {
+ REH_PRIVATE_MAP_FOREACH(cbs->exec(aTHX_ rx, node, reginfo, st));
+}
+
+void reh_re_free(pTHX_ REGEXP * const RX) {
+ regexp *rx = rxREGEXP(RX);
+
+ reh_private_map_delete(rx->pprivate);
+
+ reh_regfree(aTHX_ RX);
+}
+
+#ifdef USE_ITHREADS
+
+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);
+
+ reh_private_map_copy(rx->pprivate, new_ri);
+
+ return new_ri;
+}
+
+#endif
+
+STATIC void reh_teardown(pTHX_ void *root) {
+#if REH_MULTIPLICITY
+ if (aTHX != root)
+  return;
+#endif
+
+ ptable_private_free(reh_private_map);
+}
+
 /* --- XS ------------------------------------------------------------------ */
 
 MODULE = re::engine::Hooks          PACKAGE = re::engine::Hooks
@@ -225,11 +346,17 @@ 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
 }
 
 void
index 3be4c92a602e83b8d7cff96b36e3977b1af484d7..e81ec6d193d1a1df3a1ebbe33d9a0250c391758e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -7,6 +7,7 @@ Makefile.PL
 README
 configure_test.pl
 lib/re/engine/Hooks.pm
+ptable.h
 re_defs.h
 re_engine_hooks.h
 re_top.h
diff --git a/ptable.h b/ptable.h
new file mode 100644 (file)
index 0000000..30d0df4
--- /dev/null
+++ b/ptable.h
@@ -0,0 +1,251 @@
+/* This file is part of the re::engine::Hooks Perl module.
+ * See http://search.cpan.org/dist/re-engine-Hooks/ */
+
+/* This is a pointer table implementation essentially copied from the ptr_table
+ * implementation in perl's sv.c, except that it has been modified to use memory
+ * shared across threads.
+ * Copyright goes to the original authors, bug reports to me. */
+
+/* This header is designed to be included several times with different
+ * definitions for PTABLE_NAME and PTABLE_VAL_FREE(). */
+
+#undef VOID2
+#ifdef __cplusplus
+# define VOID2(T, P) static_cast<T>(P)
+#else
+# define VOID2(T, P) (P)
+#endif
+
+#undef pPTBLMS
+#undef pPTBLMS_
+#undef aPTBLMS
+#undef aPTBLMS_
+
+/* Context for PerlMemShared_* functions */
+
+#ifdef PERL_IMPLICIT_SYS
+# define pPTBLMS  pTHX
+# define pPTBLMS_ pTHX_
+# define aPTBLMS  aTHX
+# define aPTBLMS_ aTHX_
+#else
+# define pPTBLMS  void
+# define pPTBLMS_
+# define aPTBLMS
+# define aPTBLMS_
+#endif
+
+#ifndef pPTBL
+# define pPTBL  pPTBLMS
+#endif
+#ifndef pPTBL_
+# define pPTBL_ pPTBLMS_
+#endif
+#ifndef aPTBL
+# define aPTBL  aPTBLMS
+#endif
+#ifndef aPTBL_
+# define aPTBL_ aPTBLMS_
+#endif
+
+#ifndef PTABLE_NAME
+# define PTABLE_NAME ptable
+#endif
+
+#ifndef PTABLE_VAL_FREE
+# define PTABLE_VAL_FREE(V)
+#endif
+
+#ifndef PTABLE_JOIN
+# define PTABLE_PASTE(A, B) A ## B
+# define PTABLE_JOIN(A, B)  PTABLE_PASTE(A, B)
+#endif
+
+#ifndef PTABLE_PREFIX
+# define PTABLE_PREFIX(X) PTABLE_JOIN(PTABLE_NAME, X)
+#endif
+
+#ifndef ptable_ent
+typedef struct ptable_ent {
+ struct ptable_ent *next;
+ const void *       key;
+ void *             val;
+} ptable_ent;
+#define ptable_ent ptable_ent
+#endif /* !ptable_ent */
+
+#ifndef ptable
+typedef struct ptable {
+ ptable_ent **ary;
+ size_t       max;
+ size_t       items;
+} ptable;
+#define ptable ptable
+#endif /* !ptable */
+
+#ifndef ptable_new
+STATIC ptable *ptable_new(pPTBLMS) {
+#define ptable_new() ptable_new(aPTBLMS)
+ ptable *t = VOID2(ptable *, PerlMemShared_malloc(sizeof *t));
+ t->max    = 15;
+ t->items  = 0;
+ t->ary    = VOID2(ptable_ent **,
+                              PerlMemShared_calloc(t->max + 1, sizeof *t->ary));
+ return t;
+}
+#endif /* !ptable_new */
+
+#ifndef PTABLE_HASH
+# define PTABLE_HASH(ptr) \
+     ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))
+#endif
+
+#ifndef ptable_find
+STATIC ptable_ent *ptable_find(const ptable * const t, const void * const key) {
+#define ptable_find ptable_find
+ ptable_ent *ent;
+ const UV hash = PTABLE_HASH(key);
+
+ ent = t->ary[hash & t->max];
+ for (; ent; ent = ent->next) {
+  if (ent->key == key)
+   return ent;
+ }
+
+ return NULL;
+}
+#endif /* !ptable_find */
+
+#ifndef ptable_fetch
+STATIC void *ptable_fetch(const ptable * const t, const void * const key) {
+#define ptable_fetch ptable_fetch
+ const ptable_ent *const ent = ptable_find(t, key);
+
+ return ent ? ent->val : NULL;
+}
+#endif /* !ptable_fetch */
+
+#ifndef ptable_split
+STATIC void ptable_split(pPTBLMS_ ptable * const t) {
+#define ptable_split(T) ptable_split(aPTBLMS_ (T))
+ ptable_ent **ary = t->ary;
+ const size_t oldsize = t->max + 1;
+ size_t newsize = oldsize * 2;
+ size_t i;
+
+ ary = VOID2(ptable_ent **, PerlMemShared_realloc(ary, newsize * sizeof(*ary)));
+ Zero(&ary[oldsize], newsize - oldsize, sizeof(*ary));
+ t->max = --newsize;
+ t->ary = ary;
+
+ for (i = 0; i < oldsize; i++, ary++) {
+  ptable_ent **curentp, **entp, *ent;
+  if (!*ary)
+   continue;
+  curentp = ary + oldsize;
+  for (entp = ary, ent = *ary; ent; ent = *entp) {
+   if ((newsize & PTABLE_HASH(ent->key)) != i) {
+    *entp     = ent->next;
+    ent->next = *curentp;
+    *curentp  = ent;
+    continue;
+   } else
+    entp = &ent->next;
+  }
+ }
+}
+#endif /* !ptable_split */
+
+STATIC void PTABLE_PREFIX(_store)(pPTBL_ ptable * const t, const void * const key, void * const val) {
+ ptable_ent *ent = ptable_find(t, key);
+
+ if (ent) {
+  void *oldval = ent->val;
+  PTABLE_VAL_FREE(oldval);
+  ent->val = val;
+ } else if (val) {
+  const size_t i = PTABLE_HASH(key) & t->max;
+  ent = VOID2(ptable_ent *, PerlMemShared_malloc(sizeof *ent));
+  ent->key  = key;
+  ent->val  = val;
+  ent->next = t->ary[i];
+  t->ary[i] = ent;
+  t->items++;
+  if (ent->next && t->items > t->max)
+   ptable_split(t);
+ }
+}
+
+STATIC void PTABLE_PREFIX(_delete)(pPTBL_ ptable * const t, const void * const key) {
+ ptable_ent *prev, *ent;
+ const size_t i = PTABLE_HASH(key) & t->max;
+
+ prev = NULL;
+ ent  = t->ary[i];
+ for (; ent; prev = ent, ent = ent->next) {
+  if (ent->key == key)
+   break;
+ }
+
+ if (ent) {
+  if (prev)
+   prev->next = ent->next;
+  else
+   t->ary[i]  = ent->next;
+  PTABLE_VAL_FREE(ent->val);
+  PerlMemShared_free(ent);
+ }
+}
+
+#ifndef ptable_walk
+STATIC void ptable_walk(pTHX_ ptable * const t, void (*cb)(pTHX_ ptable_ent *ent, void *userdata), void *userdata) {
+#define ptable_walk(T, CB, UD) ptable_walk(aTHX_ (T), (CB), (UD))
+ if (t && t->items) {
+  register ptable_ent ** const array = t->ary;
+  size_t i = t->max;
+  do {
+   ptable_ent *entry;
+   for (entry = array[i]; entry; entry = entry->next)
+    if (entry->val)
+     cb(aTHX_ entry, userdata);
+  } while (i--);
+ }
+}
+#endif /* !ptable_walk */
+
+STATIC void PTABLE_PREFIX(_clear)(pPTBL_ ptable * const t) {
+ if (t && t->items) {
+  register ptable_ent ** const array = t->ary;
+  size_t i = t->max;
+
+  do {
+   ptable_ent *entry = array[i];
+   while (entry) {
+    ptable_ent * const oentry = entry;
+    void *val = oentry->val;
+    entry = entry->next;
+    PTABLE_VAL_FREE(val);
+    PerlMemShared_free(oentry);
+   }
+   array[i] = NULL;
+  } while (i--);
+
+  t->items = 0;
+ }
+}
+
+STATIC void PTABLE_PREFIX(_free)(pPTBL_ ptable * const t) {
+ if (!t)
+  return;
+ PTABLE_PREFIX(_clear)(aPTBL_ t);
+ PerlMemShared_free(t->ary);
+ PerlMemShared_free(t);
+}
+
+#undef pPTBL
+#undef pPTBL_
+#undef aPTBL
+#undef aPTBL_
+
+#undef PTABLE_NAME
+#undef PTABLE_VAL_FREE
index 23c83a11116344f0dfd154e2e54ad805c0e549ac..f9510b8d216e01e820ef4b02ad618b2caaf4f0fc 100644 (file)
--- a/re_defs.h
+++ b/re_defs.h
@@ -1,6 +1,8 @@
+EXTERN_C void reh_call_comp_begin_hook(pTHX_ regexp *);
 EXTERN_C void reh_call_comp_hook(pTHX_ regexp *, regnode *);
 EXTERN_C void reh_call_exec_hook(pTHX_ regexp *, regnode *, regmatch_info *, regmatch_state *);
 
+#define REH_CALL_COMP_BEGIN_HOOK(a)       reh_call_comp_begin_hook(aTHX_ (a))
 #define REH_CALL_REGCOMP_HOOK(a, b)       reh_call_comp_hook(aTHX_ (a), (b))
 #define REH_CALL_REGEXEC_HOOK(a, b, c, d) reh_call_exec_hook(aTHX_ (a), (b), (c), (d))
 
index afe92f1b850f6b54eee75bbdbe07ceab97899558..ccbe60edd86e885536cc2310258fb10d4015cbfb 100644 (file)
@@ -4394,6 +4394,7 @@ redo_first_pass:
     SetProgLen(ri,RExC_size);
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index d2a14736e9837a227c5b709b82877d2e0e3254ae..497219f4653e19f7f23ad588c8e743ade8047405 100644 (file)
@@ -4400,6 +4400,7 @@ redo_first_pass:
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 10c64d315c8955f526c9250b60d84fbff0b21578..dbd9339d357d429e822a4751f42ff86e185a6fe9 100644 (file)
@@ -4410,6 +4410,7 @@ redo_first_pass:
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index c56137be6401abef340358dc7cd472db914a0f01..5584b73446bf9bb5fa03760e9336896c84558889 100644 (file)
@@ -4415,6 +4415,7 @@ redo_first_pass:
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 3c5418d97c843bc5d65c0e234be38d71b10b5354..94db01af9c0e9932be1e7ec1479ee03b9e5b3960 100644 (file)
@@ -4415,6 +4415,7 @@ redo_first_pass:
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 3c5418d97c843bc5d65c0e234be38d71b10b5354..94db01af9c0e9932be1e7ec1479ee03b9e5b3960 100644 (file)
@@ -4415,6 +4415,7 @@ redo_first_pass:
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index e32224d7437db06aa6b9c722c495052ce7ec8252..319f34454312fddf81792d7ff7ea43a39b342b3c 100644 (file)
@@ -4412,6 +4412,7 @@ redo_first_pass:
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index b4d9b28bf6c6a85fbfb62d21fd642e83c635470c..8b43a227a839a674759b145bc910e929626b8225 100644 (file)
@@ -4412,6 +4412,7 @@ redo_first_pass:
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 157366ced303271dff66c06a66f90bb8af5999c4..2dce0500ff05676f197e285270ff5c51a5b05563 100644 (file)
@@ -4412,6 +4412,7 @@ redo_first_pass:
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 157366ced303271dff66c06a66f90bb8af5999c4..2dce0500ff05676f197e285270ff5c51a5b05563 100644 (file)
@@ -4412,6 +4412,7 @@ redo_first_pass:
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 157366ced303271dff66c06a66f90bb8af5999c4..2dce0500ff05676f197e285270ff5c51a5b05563 100644 (file)
@@ -4412,6 +4412,7 @@ redo_first_pass:
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 157366ced303271dff66c06a66f90bb8af5999c4..2dce0500ff05676f197e285270ff5c51a5b05563 100644 (file)
@@ -4412,6 +4412,7 @@ redo_first_pass:
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index b4d9b28bf6c6a85fbfb62d21fd642e83c635470c..8b43a227a839a674759b145bc910e929626b8225 100644 (file)
@@ -4412,6 +4412,7 @@ redo_first_pass:
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index d1485296774c3c075d7bdcb722565921e8b53dc2..e7c4882db9374c9bba5bc06426d209907fa64a37 100644 (file)
@@ -4460,6 +4460,7 @@ redo_first_pass:
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index e23858a442adccfeadfc5e93167c02596168210a..a2bf54f149e007a7147d935f56ad95b70413e8ab 100644 (file)
@@ -4460,6 +4460,7 @@ redo_first_pass:
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 0eeb521fff8637605193f89192c37adbc9ca49d5..f2ff7b9e5c0569e14080dc2a95cdb74f02b89eeb 100644 (file)
@@ -4460,6 +4460,7 @@ redo_first_pass:
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index e1e3136e60a315475b2caf8f4ab31ccbb0de1490..223c096820f08bf733eee66ac576039916b6c180 100644 (file)
@@ -4458,6 +4458,7 @@ redo_first_pass:
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 04b365c947ff3295b122e62b5f73c5d0d9cf444e..b5354df863f601de538fc8428ffe0ec996495d28 100644 (file)
@@ -4490,6 +4490,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 2ab318d4e9c7b366fabf601bb436b76f60c236cc..bb60c70f7ad1aeb56ea72609150cccee9fba2025 100644 (file)
@@ -4583,6 +4583,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 0f9fae90d5a16f11f0269982364ac7c57603e13c..f5adb4b344a52284d89e099387116fb9f1928020 100644 (file)
@@ -4601,6 +4601,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index c72c58af506304f1a3f33d82f29b0257dc666a82..93a77d0d99c6cc622ea7b43d7d9cacaddd1beac9 100644 (file)
@@ -4649,6 +4649,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 971a24afb107a68e996a99d2813912c77ef10282..b2c0607d4ba8e3a40e1a981b33bb82d44b1d2ee6 100644 (file)
@@ -4627,6 +4627,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 5a1e788221a3a725b11140d01994e7177325ba23..fccce8e5beddf49b27d6fbd665e6514d6f2edfd7 100644 (file)
@@ -4674,6 +4674,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index fa013ba87e850fe38513d40cb29139340ffc8cfb..b56b32aed271416988e55a962ec8875e12bd9b98 100644 (file)
@@ -4782,6 +4782,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 1410c21ba13381330d69f20c07119f1d83ed1849..ac152715dbb3bd7a0e67966a690fa83b63a76ec8 100644 (file)
@@ -4808,6 +4808,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 5b1f846eab6577812d0844589715b71bda9d124d..5322b32fe3dfb4de735fa408b71a698507f51b8a 100644 (file)
@@ -4805,6 +4805,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 5b1f846eab6577812d0844589715b71bda9d124d..5322b32fe3dfb4de735fa408b71a698507f51b8a 100644 (file)
@@ -4805,6 +4805,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 472560f192c38f457f63a7f2daa28318edfd9145..47470b3c8244076274b1b246c79f708d69662fd1 100644 (file)
@@ -4805,6 +4805,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 5831e094bb46db60716c9b056e0793b204972946..07aacf6f44a1f467625d65d454887c2cf357c2b5 100644 (file)
@@ -4805,6 +4805,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 8e6465e4a8514936ef7c33d7055da324fd5b3502..8f577e445ec5c038108fb1b5184a57299e0e2ae9 100644 (file)
@@ -4805,6 +4805,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 8e6465e4a8514936ef7c33d7055da324fd5b3502..8f577e445ec5c038108fb1b5184a57299e0e2ae9 100644 (file)
@@ -4805,6 +4805,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index e1236b8034f93f78fca698418e09ffd16a1e2664..a84ecdc99ceb0eda78919b0ab0fc0d4e6cb4a743 100644 (file)
@@ -4805,6 +4805,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 4f1f6cdbc7afe8fc737c8e7b8a31692e5686e201..6078f356e37b91e153998897039d5436d77ee9cf 100644 (file)
@@ -4809,6 +4809,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 40f1739f94e2aeddd676d03daae86fdd7c3c7c43..6cf72e1407bd7ed1bdd47c36d0a3905105628776 100644 (file)
@@ -4809,6 +4809,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 3f03824279a94004ab3fd078cec1eef3f8182a39..3c0137936e636799f9a27a0ab664fb3d973dccaa 100644 (file)
@@ -5073,6 +5073,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 644fb31a98179045ffc0bc90f9b03502f64de075..36f7e97616385f97b8329a9af297f54843dfeb45 100644 (file)
@@ -5134,6 +5134,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 2213a2dddebb49dec589bc04d7305e517b3f64ca..dda0f1f891cee613a22a7bb71c1e196d79a83008 100644 (file)
@@ -5218,6 +5218,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
     RExC_rx_sv = rx;
     RExC_rx = r;
     RExC_rxi = ri;
+    REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);
 
     /* Second pass: emit code. */
     RExC_flags = pm_flags;     /* don't let top level (?i) bleed */
index 0517d37462d41b44d90fc06c05034db66a7c3925..53836074173c9ee5dff477bb602bbd77427f60f1 100644 (file)
@@ -221,6 +221,8 @@ sub patch_regcomp {
 
  if ($line =~ /#\s*include\s+"INTERN\.h"/) {
   return "#include \"re_defs.h\"\n";
+ } elsif ($line =~ /^(\s*)RExC_rxi\s*=\s*ri\s*;\s*$/) {
+  return $line, "$1REH_CALL_COMP_BEGIN_HOOK(pRExC_state->rx);\n";
  } elsif ($line =~ /FILL_ADVANCE_NODE(_ARG)?\(\s*([^\s,\)]+)/) {
   my $shift = $1 ? 2 : 1;
   return $line, "    REH_CALL_REGCOMP_HOOK(pRExC_state->rx, ($2) - $shift);\n"