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 a single byte pattern
authorKarl Williamson <khw@cpan.org>
Fri, 29 Dec 2017 22:17:41 +0000 (15:17 -0700)
committerKarl Williamson <khw@cpan.org>
Tue, 30 Jan 2018 18:38:12 +0000 (11:38 -0700)
There is special code in the function regrepeat() to handle instances
where the pattern to repeat is a single byte.  These all can be done
word-at-a-time to significantly increase the performance of long
repeats.

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

index b0aef42..c06d1b8 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2532,6 +2532,7 @@ ERp       |bool   |_is_grapheme   |NN const U8 * strbeg|NN const U8 * s|NN const U8 *stren
 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
 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 f8cc703..48715cd 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define find_byclass(a,b,c,d,e)        S_find_byclass(aTHX_ a,b,c,d,e)
 #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 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 b1b7987..427f676 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5577,6 +5577,11 @@ STATIC char *    S_find_next_non_ascii(char* s, const char * send, const bool is_ut
 #define PERL_ARGS_ASSERT_FIND_NEXT_NON_ASCII   \
        assert(s); assert(send)
 
+STATIC char *  S_find_span_end(char* s, const char * send, const char span_byte)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_FIND_SPAN_END \
+       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 ac8b15e..01c4b2f 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -676,6 +676,71 @@ S_find_next_non_ascii(char * s, const char * send, const bool utf8_target)
 
 }
 
+STATIC char *
+S_find_span_end(char * s, const char * send, const char span_byte)
+{
+    /* Returns the position of the first byte in the sequence between 's' and
+     * 'send-1' inclusive that isn't 'span_byte'; returns 'send' if none found.
+     * */
+
+    PERL_ARGS_ASSERT_FIND_SPAN_END;
+
+    assert(send >= s);
+
+    if ((STRLEN) (send - s) >= PERL_WORDSIZE
+                          + PERL_WORDSIZE * PERL_IS_SUBWORD_ADDR(s)
+                          - (PTR2nat(s) & PERL_WORD_BOUNDARY_MASK))
+    {
+        PERL_UINTMAX_T span_word;
+
+        /* Process per-byte until reach word boundary.  XXX This loop could be
+         * eliminated if we knew that this platform had fast unaligned reads */
+        while (PTR2nat(s) & PERL_WORD_BOUNDARY_MASK) {
+            if (*s != span_byte) {
+                return s;
+            }
+            s++;
+        }
+
+        /* Create a word filled with the bytes we are spanning */
+        span_word = PERL_COUNT_MULTIPLIER * span_byte;
+
+        /* Process per-word as long as we have at least a full word left */
+        do {
+
+            /* Keep going if the whole word is composed of 'span_byte's */
+            if ((* (PERL_UINTMAX_T *) s) == span_word)  {
+                s += PERL_WORDSIZE;
+                continue;
+            }
+
+            /* Here, at least one byte in the word isn't 'span_byte'.  This xor
+             * leaves 1 bits only in those non-matching bytes */
+            span_word ^= * (PERL_UINTMAX_T *) s;
+
+            /* Make sure the upper bit of each non-matching byte is set.  This
+             * makes each such byte look like an ASCII platform variant byte */
+            span_word |= span_word << 1;
+            span_word |= span_word << 2;
+            span_word |= span_word << 4;
+
+            /* That reduces the problem to what this function solves */
+            return s + _variant_byte_number(span_word);
+
+        } while (s + PERL_WORDSIZE <= send);
+    }
+
+    /* Process the straggler bytes beyond the final word boundary */
+    while (s < send) {
+        if (*s != span_byte) {
+            return s;
+        }
+        s++;
+    }
+
+    return s;
+}
+
 /*
  * pregexec and friends
  */
@@ -9030,7 +9095,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
 
        c = (U8)*STRING(p);
 
-        /* Can use a simple loop if the pattern char to match on is invariant
+        /* Can use a simple find if the pattern char to match on is invariant
          * under UTF-8, or both target and pattern aren't UTF-8.  Note that we
          * can use UTF8_IS_INVARIANT() even if the pattern isn't UTF-8, as it's
          * true iff it doesn't matter if the argument is in UTF-8 or not */
@@ -9040,9 +9105,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
                  * since here, to match at all, 1 char == 1 byte */
                 loceol = scan + max;
             }
-           while (scan < loceol && UCHARAT(scan) == c) {
-               scan++;
-           }
+            scan = find_span_end(scan, loceol, (U8) c);
        }
        else if (reginfo->is_utf8_pat) {
             if (utf8_target) {
@@ -9062,11 +9125,9 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
             else if (! UTF8_IS_ABOVE_LATIN1(c)) {
 
                 /* Target isn't utf8; convert the character in the UTF-8
-                 * pattern to non-UTF8, and do a simple loop */
+                 * pattern to non-UTF8, and do a simple find */
                 c = EIGHT_BIT_UTF8_TO_NATIVE(c, *(STRING(p) + 1));
-                while (scan < loceol && UCHARAT(scan) == c) {
-                    scan++;
-                }
+                scan = find_span_end(scan, loceol, (U8) c);
             } /* else pattern char is above Latin1, can't possibly match the
                  non-UTF-8 target */
         }
@@ -9164,9 +9225,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
                 }
             }
             else if (c1 == c2) {
-                while (scan < loceol && UCHARAT(scan) == c1) {
-                    scan++;
-                }
+                scan = find_span_end(scan, loceol, c1);
             }
             else {
                 /* See comments in regmatch() CURLY_B_min_known_fail.  We avoid