From: Vincent Pit <vince@profvince.com>
Date: Sat, 31 Mar 2012 12:48:27 +0000 (+0200)
Subject: Attach the callbacks to every regexps in a thread-safe way
X-Git-Tag: v0.02~7
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fre-engine-Hooks.git;a=commitdiff_plain;h=be51951333b8f0da55af1243a039e74bb15dedcd

Attach the callbacks to every regexps in a thread-safe way

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.
---

diff --git a/Hooks.xs b/Hooks.xs
index ef0c508..b312223 100644
--- a/Hooks.xs
+++ b/Hooks.xs
@@ -17,6 +17,16 @@
 # 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
diff --git a/MANIFEST b/MANIFEST
index 3be4c92..e81ec6d 100644
--- 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
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
diff --git a/re_defs.h b/re_defs.h
index 23c83a1..f9510b8 100644
--- 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))
 
diff --git a/src/5010001/regcomp.c b/src/5010001/regcomp.c
index afe92f1..ccbe60e 100644
--- a/src/5010001/regcomp.c
+++ b/src/5010001/regcomp.c
@@ -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 */
diff --git a/src/5011000/regcomp.c b/src/5011000/regcomp.c
index d2a1473..497219f 100644
--- a/src/5011000/regcomp.c
+++ b/src/5011000/regcomp.c
@@ -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 */
diff --git a/src/5011001/regcomp.c b/src/5011001/regcomp.c
index 10c64d3..dbd9339 100644
--- a/src/5011001/regcomp.c
+++ b/src/5011001/regcomp.c
@@ -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 */
diff --git a/src/5011002/regcomp.c b/src/5011002/regcomp.c
index c56137b..5584b73 100644
--- a/src/5011002/regcomp.c
+++ b/src/5011002/regcomp.c
@@ -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 */
diff --git a/src/5011003/regcomp.c b/src/5011003/regcomp.c
index 3c5418d..94db01a 100644
--- a/src/5011003/regcomp.c
+++ b/src/5011003/regcomp.c
@@ -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 */
diff --git a/src/5011004/regcomp.c b/src/5011004/regcomp.c
index 3c5418d..94db01a 100644
--- a/src/5011004/regcomp.c
+++ b/src/5011004/regcomp.c
@@ -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 */
diff --git a/src/5011005/regcomp.c b/src/5011005/regcomp.c
index e32224d..319f344 100644
--- a/src/5011005/regcomp.c
+++ b/src/5011005/regcomp.c
@@ -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 */
diff --git a/src/5012000/regcomp.c b/src/5012000/regcomp.c
index b4d9b28..8b43a22 100644
--- a/src/5012000/regcomp.c
+++ b/src/5012000/regcomp.c
@@ -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 */
diff --git a/src/5012001/regcomp.c b/src/5012001/regcomp.c
index 157366c..2dce050 100644
--- a/src/5012001/regcomp.c
+++ b/src/5012001/regcomp.c
@@ -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 */
diff --git a/src/5012002/regcomp.c b/src/5012002/regcomp.c
index 157366c..2dce050 100644
--- a/src/5012002/regcomp.c
+++ b/src/5012002/regcomp.c
@@ -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 */
diff --git a/src/5012003/regcomp.c b/src/5012003/regcomp.c
index 157366c..2dce050 100644
--- a/src/5012003/regcomp.c
+++ b/src/5012003/regcomp.c
@@ -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 */
diff --git a/src/5012004/regcomp.c b/src/5012004/regcomp.c
index 157366c..2dce050 100644
--- a/src/5012004/regcomp.c
+++ b/src/5012004/regcomp.c
@@ -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 */
diff --git a/src/5013000/regcomp.c b/src/5013000/regcomp.c
index b4d9b28..8b43a22 100644
--- a/src/5013000/regcomp.c
+++ b/src/5013000/regcomp.c
@@ -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 */
diff --git a/src/5013001/regcomp.c b/src/5013001/regcomp.c
index d148529..e7c4882 100644
--- a/src/5013001/regcomp.c
+++ b/src/5013001/regcomp.c
@@ -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 */
diff --git a/src/5013002/regcomp.c b/src/5013002/regcomp.c
index e23858a..a2bf54f 100644
--- a/src/5013002/regcomp.c
+++ b/src/5013002/regcomp.c
@@ -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 */
diff --git a/src/5013003/regcomp.c b/src/5013003/regcomp.c
index 0eeb521..f2ff7b9 100644
--- a/src/5013003/regcomp.c
+++ b/src/5013003/regcomp.c
@@ -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 */
diff --git a/src/5013004/regcomp.c b/src/5013004/regcomp.c
index e1e3136..223c096 100644
--- a/src/5013004/regcomp.c
+++ b/src/5013004/regcomp.c
@@ -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 */
diff --git a/src/5013005/regcomp.c b/src/5013005/regcomp.c
index 04b365c..b5354df 100644
--- a/src/5013005/regcomp.c
+++ b/src/5013005/regcomp.c
@@ -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 */
diff --git a/src/5013006/regcomp.c b/src/5013006/regcomp.c
index 2ab318d..bb60c70 100644
--- a/src/5013006/regcomp.c
+++ b/src/5013006/regcomp.c
@@ -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 */
diff --git a/src/5013007/regcomp.c b/src/5013007/regcomp.c
index 0f9fae9..f5adb4b 100644
--- a/src/5013007/regcomp.c
+++ b/src/5013007/regcomp.c
@@ -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 */
diff --git a/src/5013008/regcomp.c b/src/5013008/regcomp.c
index c72c58a..93a77d0 100644
--- a/src/5013008/regcomp.c
+++ b/src/5013008/regcomp.c
@@ -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 */
diff --git a/src/5013009/regcomp.c b/src/5013009/regcomp.c
index 971a24a..b2c0607 100644
--- a/src/5013009/regcomp.c
+++ b/src/5013009/regcomp.c
@@ -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 */
diff --git a/src/5013010/regcomp.c b/src/5013010/regcomp.c
index 5a1e788..fccce8e 100644
--- a/src/5013010/regcomp.c
+++ b/src/5013010/regcomp.c
@@ -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 */
diff --git a/src/5013011/regcomp.c b/src/5013011/regcomp.c
index fa013ba..b56b32a 100644
--- a/src/5013011/regcomp.c
+++ b/src/5013011/regcomp.c
@@ -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 */
diff --git a/src/5014000/regcomp.c b/src/5014000/regcomp.c
index 1410c21..ac15271 100644
--- a/src/5014000/regcomp.c
+++ b/src/5014000/regcomp.c
@@ -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 */
diff --git a/src/5014001/regcomp.c b/src/5014001/regcomp.c
index 5b1f846..5322b32 100644
--- a/src/5014001/regcomp.c
+++ b/src/5014001/regcomp.c
@@ -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 */
diff --git a/src/5014002/regcomp.c b/src/5014002/regcomp.c
index 5b1f846..5322b32 100644
--- a/src/5014002/regcomp.c
+++ b/src/5014002/regcomp.c
@@ -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 */
diff --git a/src/5015000/regcomp.c b/src/5015000/regcomp.c
index 472560f..47470b3 100644
--- a/src/5015000/regcomp.c
+++ b/src/5015000/regcomp.c
@@ -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 */
diff --git a/src/5015001/regcomp.c b/src/5015001/regcomp.c
index 5831e09..07aacf6 100644
--- a/src/5015001/regcomp.c
+++ b/src/5015001/regcomp.c
@@ -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 */
diff --git a/src/5015002/regcomp.c b/src/5015002/regcomp.c
index 8e6465e..8f577e4 100644
--- a/src/5015002/regcomp.c
+++ b/src/5015002/regcomp.c
@@ -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 */
diff --git a/src/5015003/regcomp.c b/src/5015003/regcomp.c
index 8e6465e..8f577e4 100644
--- a/src/5015003/regcomp.c
+++ b/src/5015003/regcomp.c
@@ -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 */
diff --git a/src/5015004/regcomp.c b/src/5015004/regcomp.c
index e1236b8..a84ecdc 100644
--- a/src/5015004/regcomp.c
+++ b/src/5015004/regcomp.c
@@ -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 */
diff --git a/src/5015005/regcomp.c b/src/5015005/regcomp.c
index 4f1f6cd..6078f35 100644
--- a/src/5015005/regcomp.c
+++ b/src/5015005/regcomp.c
@@ -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 */
diff --git a/src/5015006/regcomp.c b/src/5015006/regcomp.c
index 40f1739..6cf72e1 100644
--- a/src/5015006/regcomp.c
+++ b/src/5015006/regcomp.c
@@ -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 */
diff --git a/src/5015007/regcomp.c b/src/5015007/regcomp.c
index 3f03824..3c01379 100644
--- a/src/5015007/regcomp.c
+++ b/src/5015007/regcomp.c
@@ -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 */
diff --git a/src/5015008/regcomp.c b/src/5015008/regcomp.c
index 644fb31..36f7e97 100644
--- a/src/5015008/regcomp.c
+++ b/src/5015008/regcomp.c
@@ -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 */
diff --git a/src/5015009/regcomp.c b/src/5015009/regcomp.c
index 2213a2d..dda0f1f 100644
--- a/src/5015009/regcomp.c
+++ b/src/5015009/regcomp.c
@@ -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 */
diff --git a/src/update.pl b/src/update.pl
index 0517d37..5383607 100644
--- a/src/update.pl
+++ b/src/update.pl
@@ -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"