regcomp.c: Add ability to have compiled-in inversion lists

This adds a routine that will take a C array and quickly create an
inversion list that points to that array.  Thus the array had better be
exactly the internal form that is required for an inversion list.  To
make sure that this doesn't get out of sync, a new field in the list's
header is created that is a combination of
version-number/inversion-list-type.

diff --git a/embed.fnc b/embed.fnc
index 4f0206c..ac31607 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1034,6 +1034,7 @@ Ap        |SV*    |regclass_swash |NULLOK const regexp *prog \
 EMi    |U8     |set_regclass_bit|NN struct RExC_state_t* pRExC_state|NN regnode* node|const U8 value|NN SV** invlist_ptr|NN AV** alternate_ptr
 EMs    |U8     |set_regclass_bit_fold|NN struct RExC_state_t *pRExC_state|NN regnode* node|const U8 value|NN SV** invlist_ptr|NN AV** alternate_ptr
 EMs    |void   |add_alternate  |NN AV** alternate_ptr|NN U8* string|STRLEN len
+EMsR   |SV*    |_new_invlist_C_array|NN UV* list
 #endif
 Ap     |I32    |pregexec       |NN REGEXP * const prog|NN char* stringarg \
                                |NN char* strend|NN char* strbeg|I32 minend \
@@ -1371,6 +1372,7 @@ EiM       |void   |invlist_set_len        |NN SV* const invlist|const UV len
 EiM    |void   |invlist_trim   |NN SV* const invlist
 EiMR   |SV*    |invlist_clone  |NN SV* const invlist
 EiMR   |UV*    |get_invlist_iter_addr  |NN SV* invlist
+EiMR   |UV*    |get_invlist_version_id_addr    |NN SV* invlist
 EiM    |void   |invlist_iterinit|NN SV* invlist
 EsMR   |bool   |invlist_iternext|NN SV* invlist|NN UV* start|NN UV* end
 EsMR   |IV     |invlist_search |NN SV* const invlist|const UV cp

diff --git a/embed.h b/embed.h
index e41be49..a8c0172 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -895,6 +895,7 @@
 #  endif
 #  if defined(PERL_IN_REGCOMP_C)
 #define _invlist_array_init(a,b)       S__invlist_array_init(aTHX_ a,b)
+#define _new_invlist_C_array(a)        S__new_invlist_C_array(aTHX_ a)
 #define add_alternate(a,b,c)   S_add_alternate(aTHX_ a,b,c)
 #define add_cp_to_invlist(a,b) S_add_cp_to_invlist(aTHX_ a,b)
 #define add_data               S_add_data
@@ -907,6 +908,7 @@
 #define cl_or                  S_cl_or
 #define get_invlist_iter_addr(a)       S_get_invlist_iter_addr(aTHX_ a)
 #define get_invlist_len_addr(a)        S_get_invlist_len_addr(aTHX_ a)
+#define get_invlist_version_id_addr(a) S_get_invlist_version_id_addr(aTHX_ a)
 #define get_invlist_zero_addr(a)       S_get_invlist_zero_addr(aTHX_ a)
 #define invlist_array(a)       S_invlist_array(aTHX_ a)
 #define invlist_clone(a)       S_invlist_clone(aTHX_ a)

diff --git a/proto.h b/proto.h
index bae0f9d..77746f7 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6239,6 +6239,12 @@ PERL_STATIC_INLINE UV*   S__invlist_array_init(pTHX_ SV* const invlist, const bool
 #define PERL_ARGS_ASSERT__INVLIST_ARRAY_INIT   \
        assert(invlist)
 
+STATIC SV*     S__new_invlist_C_array(pTHX_ UV* list)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT__NEW_INVLIST_C_ARRAY  \
+       assert(list)
+
 STATIC void    S_add_alternate(pTHX_ AV** alternate_ptr, U8* string, STRLEN len)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
@@ -6306,6 +6312,12 @@ PERL_STATIC_INLINE UV*   S_get_invlist_len_addr(pTHX_ SV* invlist)
 #define PERL_ARGS_ASSERT_GET_INVLIST_LEN_ADDR  \
        assert(invlist)
 
+PERL_STATIC_INLINE UV* S_get_invlist_version_id_addr(pTHX_ SV* invlist)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_GET_INVLIST_VERSION_ID_ADDR   \
+       assert(invlist)
+
 PERL_STATIC_INLINE UV* S_get_invlist_zero_addr(pTHX_ SV* invlist)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);

diff --git a/regcomp.c b/regcomp.c
index c7fe209..d809b17 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -6140,7 +6140,19 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags)
 #define INVLIST_LEN_OFFSET 0   /* Number of elements in the inversion list */
 #define INVLIST_ITER_OFFSET 1  /* Current iteration position */
 
-#define INVLIST_ZERO_OFFSET 2  /* 0 or 1; must be last element in header */
+/* This is a combination of a version and data structure type, so that one
+ * being passed in can be validated to be an inversion list of the correct
+ * vintage.  When the structure of the header is changed, a new random number
+ * in the range 2**31-1 should be generated and the new() method changed to
+ * insert that at this location.  Then, if an auxiliary program doesn't change
+ * correspondingly, it will be discovered immediately */
+#define INVLIST_VERSION_ID_OFFSET 2
+#define INVLIST_VERSION_ID 1064334010
+
+/* For safety, when adding new elements, remember to #undef them at the end of
+ * the inversion list code section */
+
+#define INVLIST_ZERO_OFFSET 3  /* 0 or 1; must be last element in header */
 /* The UV at position ZERO contains either 0 or 1.  If 0, the inversion list
  * contains the code point U+00000, and begins here.  If 1, the inversion list
  * doesn't contain U+0000, and it begins at the next UV in the array.
@@ -6300,10 +6312,39 @@ Perl__new_invlist(pTHX_ IV initial_size)
      * properly */
     *get_invlist_zero_addr(new_list) = UV_MAX;
 
+    *get_invlist_version_id_addr(new_list) = INVLIST_VERSION_ID;
+#if HEADER_LENGTH != 4
+#   error Need to regenerate VERSION_ID by running perl -E 'say int(rand 2**31-1)', and then changing the #if to the new length
+#endif
+
     return new_list;
 }
 #endif
 
+STATIC SV*
+S__new_invlist_C_array(pTHX_ UV* list)
+{
+    /* Return a pointer to a newly constructed inversion list, initialized to
+     * point to <list>, which has to be in the exact correct inversion list
+     * form, including internal fields.  Thus this is a dangerous routine that
+     * should not be used in the wrong hands */
+
+    SV* invlist = newSV_type(SVt_PV);
+
+    PERL_ARGS_ASSERT__NEW_INVLIST_C_ARRAY;
+
+    SvPV_set(invlist, (char *) list);
+    SvLEN_set(invlist, 0);  /* Means we own the contents, and the system
+                              shouldn't touch it */
+    SvCUR_set(invlist, TO_INTERNAL_SIZE(invlist_len(invlist)));
+
+    if (*get_invlist_version_id_addr(invlist) != INVLIST_VERSION_ID) {
+        Perl_croak(aTHX_ "panic: Incorrect version for previously generated inversion list");
+    }
+
+    return invlist;
+}
+
 STATIC void
 S_invlist_extend(pTHX_ SV* const invlist, const UV new_max)
 {
@@ -7146,6 +7187,16 @@ S_get_invlist_iter_addr(pTHX_ SV* invlist)
     return (UV *) (SvPVX(invlist) + (INVLIST_ITER_OFFSET * sizeof (UV)));
 }
 
+PERL_STATIC_INLINE UV*
+S_get_invlist_version_id_addr(pTHX_ SV* invlist)
+{
+    /* Return the address of the UV that contains the version id. */
+
+    PERL_ARGS_ASSERT_GET_INVLIST_VERSION_ID_ADDR;
+
+    return (UV *) (SvPVX(invlist) + (INVLIST_VERSION_ID_OFFSET * sizeof (UV)));
+}
+
 PERL_STATIC_INLINE void
 S_invlist_iterinit(pTHX_ SV* invlist)  /* Initialize iterator for invlist */
 {
@@ -7251,6 +7302,7 @@ S_invlist_dump(pTHX_ SV* const invlist, const char * const header)
 #undef INVLIST_LEN_OFFSET
 #undef INVLIST_ZERO_OFFSET
 #undef INVLIST_ITER_OFFSET
+#undef INVLIST_VERSION_ID
 
 /* End of inversion list object */