This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regexec.c: Use word-at-a-time to repeat /i single byte pattern
authorKarl Williamson <khw@cpan.org>
Fri, 29 Dec 2017 22:45:38 +0000 (15:45 -0700)
committerKarl Williamson <khw@cpan.org>
Tue, 30 Jan 2018 18:38:12 +0000 (11:38 -0700)
For most of the case folding pairs, like [Aa], it is possible to use a
mask to match them word-at-a-time in regrepeat(), so that long sequences
of them are handled with significantly better performance.

embed.fnc
embed.h
proto.h
regexec.c

index c06d1b8..1f70b42 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2533,6 +2533,8 @@ ERs       |bool   |isFOO_utf8_lc  |const U8 classnum|NN const U8* character
 ERns   |char *|find_next_ascii|NN char* s|NN const char * send|const bool is_utf8
 ERns   |char *|find_next_non_ascii|NN char* s|NN const char * send|const bool is_utf8
 ERns   |char *|find_span_end   |NN char* s|NN const char * send|const char span_byte
+ERns   |U8 *|find_span_end_mask|NN U8 * s|NN const U8 * send   \
+                               |const U8 span_byte|const U8 mask
 ERs    |SSize_t|regmatch       |NN regmatch_info *reginfo|NN char *startpos|NN regnode *prog
 WERs   |I32    |regrepeat      |NN regexp *prog|NN char **startposp \
                                |NN const regnode *p \
diff --git a/embed.h b/embed.h
index 48715cd..6208033 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define find_next_ascii                S_find_next_ascii
 #define find_next_non_ascii    S_find_next_non_ascii
 #define find_span_end          S_find_span_end
+#define find_span_end_mask     S_find_span_end_mask
 #define isFOO_utf8_lc(a,b)     S_isFOO_utf8_lc(aTHX_ a,b)
 #define isGCB(a,b,c,d,e)       S_isGCB(aTHX_ a,b,c,d,e)
 #define isLB(a,b,c,d,e,f)      S_isLB(aTHX_ a,b,c,d,e,f)
diff --git a/proto.h b/proto.h
index 427f676..5d8fc15 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5582,6 +5582,11 @@ STATIC char *    S_find_span_end(char* s, const char * send, const char span_byte)
 #define PERL_ARGS_ASSERT_FIND_SPAN_END \
        assert(s); assert(send)
 
+STATIC U8 *    S_find_span_end_mask(U8 * s, const U8 * send, const U8 span_byte, const U8 mask)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_FIND_SPAN_END_MASK    \
+       assert(s); assert(send)
+
 STATIC bool    S_isFOO_utf8_lc(pTHX_ const U8 classnum, const U8* character)
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_ISFOO_UTF8_LC \
index 01c4b2f..2fcfd2e 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -741,6 +741,63 @@ S_find_span_end(char * s, const char * send, const char span_byte)
     return s;
 }
 
+STATIC U8 *
+S_find_span_end_mask(U8 * s, const U8 * send, const U8 span_byte, const U8 mask)
+{
+    /* Returns the position of the first byte in the sequence between 's' and
+     * 'send-1' inclusive that when ANDed with 'mask' isn't 'span_byte'.
+     * 'span_byte' should have been ANDed with 'mask' in the call of this
+     * function.  Returns 'send' if none found.  Works like find_span_end(),
+     * except for the AND */
+
+    PERL_ARGS_ASSERT_FIND_SPAN_END_MASK;
+
+    assert(send >= s);
+    assert((span_byte & mask) == span_byte);
+
+    if ((STRLEN) (send - s) >= PERL_WORDSIZE
+                          + PERL_WORDSIZE * PERL_IS_SUBWORD_ADDR(s)
+                          - (PTR2nat(s) & PERL_WORD_BOUNDARY_MASK))
+    {
+        PERL_UINTMAX_T span_word, mask_word;
+
+        while (PTR2nat(s) & PERL_WORD_BOUNDARY_MASK) {
+            if (((* (U8 *) s) & mask) != span_byte) {
+                return s;
+            }
+            s++;
+        }
+
+        span_word = PERL_COUNT_MULTIPLIER * span_byte;
+        mask_word = PERL_COUNT_MULTIPLIER * mask;
+
+        do {
+            PERL_UINTMAX_T masked = (* (PERL_UINTMAX_T *) s) & mask_word;
+
+            if (masked == span_word) {
+                s += PERL_WORDSIZE;
+                continue;
+            }
+
+            masked ^= span_word;
+            masked |= masked << 1;
+            masked |= masked << 2;
+            masked |= masked << 4;
+            return s + _variant_byte_number(masked);
+
+        } while (s + PERL_WORDSIZE <= send);
+    }
+
+    while (s < send) {
+        if (((* (U8 *) s) & mask) != span_byte) {
+            return s;
+        }
+        s++;
+    }
+
+    return s;
+}
+
 /*
  * pregexec and friends
  */
@@ -9234,14 +9291,12 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
                 U8 c1_c2_bits_differing = c1 ^ c2;
 
                 if (isPOWER_OF_2(c1_c2_bits_differing)) {
-                    U8 c1_masked = c1 & ~ c1_c2_bits_differing;
                     U8 c1_c2_mask = ~ c1_c2_bits_differing;
 
-                    while (   scan < loceol
-                           && (UCHARAT(scan) & c1_c2_mask) == c1_masked)
-                    {
-                        scan++;
-                    }
+                    scan = (char *) find_span_end_mask((U8 *) scan,
+                                                       (U8 *) loceol,
+                                                       c1 & c1_c2_mask,
+                                                       c1_c2_mask);
                 }
                 else {
                     while (    scan < loceol