make /fixed-substr/ much faster.

TL;DR: on platforms with a libc memchr() implementation which makes good
use of underlying hardware support, patterns which include fixed
substrings will now often be much faster; for example with glibc on on a
recent x86_64 CPU, this:

    $s = "a" x 1000 . "wxyz";
    $s =~ /wxyz/ for 1..30000

is now about 7 times faster. On systems with slow memchr(), e.g. 32-bit
ARM Raspberry Pi, there will be a small or little speedup. Conversely,
some pathological cases, such as "ab" x 1000 =~ /aa/ will be slower now;
up to 3 times slower on the rPi, 1.5x slower on x86_64.

In detail:

The perl core includes a Boyer-Moore substring matcher, Perl_fbm_instr(),
which is used to quickly find a fixed substring within a longer string,
where a table of lookups is pre-computed from the substring. As well as
being used in index() when the substring is a constant, its main use
is in patterns. When the regex engine compiles a pattern, it typically
takes note of the two longest fixed substrings within the pattern; for
example in

    /[01]abc\w+de\d+fghij+/

the two longest are "abc" and "fghij". The engine uses Perl_fbm_instr() to
scan for these two strings before running the full NFA. This often allows
the string to be quickly rejected, or to find a suitable minimum starting
point to run the NFA.

However, Perl_fbm_instr() was written about 16 years ago and has been
virtually untouched since, so it could do with some love.

It currently special-cases strings of length 1 and 2, using roll-your-own
loops along the lines of

    while (s < end) { if (*s++ = c1) ... }

while strings of length 3+ use the Boyer-Moore algorithm. The big
advantage of BM is that in a best-case, where none of the characters from
the substring are found in this region of the string, it only has to test
every N'th char, where N is length of the substring. For example when
searching for wxyz in abcdefghikl..., it just reads and tests d,h,l,..

However these days some platforms have decent memchr() implementations.
For example, glibc has assembly-level implementations for i386, x86_64,
sparc32/64, powerpc32/64, s390-32/64, arm, m68k and ia64 by the looks of
it. These can often be substantially faster than a C-level implementation.

This commit makes Perl_fbm_instr() use memchr() where possible.

For the length == 1 special case, it just calls memchr() directly rather
than using a loop as previously.

For the length == 2 special case, it continues to distinguish the cases
where the two chars of the substring are the same or differ. For the
former it calls memchr() after an initial direct failure, i.e.

    if (*s != c) { s++; s = memchr(....); ... }

For the latter case it does a similar direct test first (to avoid the
costly overhead of a call to memchr() when the next char is the one we
seek anyway), but in addition, on each failure to find the second char
following a found first char, it swaps which char it's searching for.
This means that in something like "aaaaaaa..." =~ /ab/, it wont keep
hopping 1 char position with memchar(s,'a'); after the first hop it
will do memchr(s,'b') and skip lots of chars in one go. This helps reduce
the number of pathological cases.

For the length >= 3 cases (normal BM), it keeps using BM, but after each
iteration where the pointer has been incremented by the skip determined by
the BM algorithm, it now does an additional

    if (*s != c) { s++; s = memchr(....); ... }

step before running the next iteration of BM.

1 files changed, 102 insertions, 69 deletions

diff --git a/util.c b/util.c
index 315a04c3ee..0800f381ac 100644
--- a/util.c
+++ b/util.c
@@ -784,82 +784,100 @@ Perl_fbm_instr(pTHX_ unsigned char *big, unsigned char *bigend, SV *littlestr, U
 	return (char*)big;		/* Cannot be SvTAIL! */
 
     case 1:
-	    if (SvTAIL(littlestr) && !multiline) { /* Anchor only! */
-		/* Know that bigend != big.  */
-		if (bigend[-1] == '\n')
-		    return (char *)(bigend - 1);
-		return (char *) bigend;
-	    }
-	    s = big;
-	    while (s < bigend) {
-		if (*s == *little)
-		    return (char *)s;
-		s++;
-	    }
+	    if (SvTAIL(littlestr) && !multiline) /* Anchor only! */
+		/* [-1] is safe because we know that bigend != big.  */
+		return (char *) (bigend - (bigend[-1] == '\n'));
+
+	    s = (unsigned char *)memchr((void*)big, *little, bigend-big);
+            if (s)
+                return (char *)s;
 	    if (SvTAIL(littlestr))
 		return (char *) bigend;
 	    return NULL;
 
     case 2:
 	if (SvTAIL(littlestr) && !multiline) {
-	    if (bigend[-1] == '\n' && bigend[-2] == *little)
+            /* a littlestr with SvTAIL must be of the form "X\n" (where X
+             * is a single char). It is anchored, and can only match
+             * "....X\n"  or  "....X" */
+            if (bigend[-2] == *little && bigend[-1] == '\n')
 		return (char*)bigend - 2;
 	    if (bigend[-1] == *little)
 		return (char*)bigend - 1;
 	    return NULL;
 	}
+
 	{
-	    /* This should be better than FBM if c1 == c2, and almost
-	       as good otherwise: maybe better since we do less indirection.
-	       And we save a lot of memory by caching no table. */
-	    const unsigned char c1 = little[0];
-	    const unsigned char c2 = little[1];
-
-	    s = big + 1;
-	    bigend--;
-	    if (c1 != c2) {
-		while (s <= bigend) {
-		    if (s[0] == c2) {
-			if (s[-1] == c1)
-			    return (char*)s - 1;
-			s += 2;
-			continue;
-		    }
-		  next_chars:
-		    if (s[0] == c1) {
-			if (s == bigend)
-			    goto check_1char_anchor;
-			if (s[1] == c2)
-			    return (char*)s;
-			else {
-			    s++;
-			    goto next_chars;
-			}
-		    }
-		    else
-			s += 2;
-		}
-		goto check_1char_anchor;
-	    }
-	    /* Now c1 == c2 */
-	    while (s <= bigend) {
-		if (s[0] == c1) {
-		    if (s[-1] == c1)
-			return (char*)s - 1;
-		    if (s == bigend)
-			goto check_1char_anchor;
-		    if (s[1] == c1)
-			return (char*)s;
-		    s += 3;
-		}
-		else
-		    s += 2;
-	    }
-	}
-      check_1char_anchor:		/* One char and anchor! */
-	if (SvTAIL(littlestr) && (*bigend == *little))
-	    return (char *)bigend;	/* bigend is already decremented. */
-	return NULL;
+            /* memchr() is likely to be very fast, possibly using whatever
+             * hardware support is available, such as checking a whole
+             * cache line in one instruction.
+             * So for a 2 char pattern, calling memchr() is likely to be
+             * faster than running FBM, or rolling our own. The previous
+             * version of this code was roll-your-own which typically
+             * only needed to read every 2nd char, which was good back in
+             * the day, but no longer.
+             */
+	    unsigned char c1 = little[0];
+	    unsigned char c2 = little[1];
+
+            /* *** for all this case, bigend points to the last char,
+             * not the trailing \0: this makes the conditions slightly
+             * simpler */
+            bigend--;
+	    s = big;
+            if (c1 != c2) {
+                while (s < bigend) {
+                    /* do a quick test for c1 before calling memchr();
+                     * this avoids the expensive fn call overhead when
+                     * there are lots of c1's */
+                    if (LIKELY(*s != c1)) {
+                        s++;
+                        s = (unsigned char *)memchr((void*)s, c1, bigend - s);
+                        if (!s)
+                            break;
+                    }
+                    if (s[1] == c2)
+                        return (char*)s;
+
+                    /* failed; try searching for c2 this time; that way
+                     * we don't go pathologically slow when the string
+                     * consists mostly of c1's or vice versa.
+                     */
+                    s += 2;
+                    if (s > bigend)
+                        break;
+                    s = (unsigned char *)memchr((void*)s, c2, bigend - s + 1);
+                    if (!s)
+                        break;
+                    if (s[-1] == c1)
+                        return (char*)s - 1;
+                }
+            }
+            else {
+                /* c1, c2 the same */
+                while (s < bigend) {
+                    if (s[0] == c1) {
+                      got_1char:
+                        if (s[1] == c1)
+                            return (char*)s;
+                        s += 2;
+                    }
+                    else {
+                        s++;
+                        s = (unsigned char *)memchr((void*)s, c1, bigend - s);
+                        if (!s || s >= bigend)
+                            break;
+                        goto got_1char;
+                    }
+                }
+            }
+
+            /* failed to find 2 chars; try anchored match at end without
+             * the \n */
+            if (SvTAIL(littlestr) && bigend[0] == little[0])
+                return (char *)bigend;
+            return NULL;
+        }
 
     default:
 	break; /* Only lengths 0 1 and 2 have special-case code.  */
@@ -881,8 +899,8 @@ Perl_fbm_instr(pTHX_ unsigned char *big, unsigned char *bigend, SV *littlestr, U
 	return NULL;
     }
 
-    /* not compiled; use Perl_ninstr() instead */
     if (!SvVALID(littlestr)) {
+        /* not compiled; use Perl_ninstr() instead */
 	char * const b = ninstr((char*)big,(char*)bigend,
 			 (char*)little, (char*)little + littlelen);
 
@@ -916,15 +934,30 @@ Perl_fbm_instr(pTHX_ unsigned char *big, unsigned char *bigend, SV *littlestr, U
 	oldlittle = little;
 	if (s < bigend) {
 	    const unsigned char * const table = (const unsigned char *) mg->mg_ptr;
+            const unsigned char lastc = *little;
 	    I32 tmp;
 
 	  top2:
 	    if ((tmp = table[*s])) {
-		if ((s += tmp) < bigend)
-		    goto top2;
-		goto check_end;
+                /* *s != lastc; earliest position it could match now is
+                 * tmp slots further on */
+		if ((s += tmp) >= bigend)
+                    goto check_end;
+                if (LIKELY(*s != lastc)) {
+                    s++;
+                    s = (unsigned char *)memchr((void*)s, lastc, bigend - s);
+                    if (!s) {
+                        s = bigend;
+                        goto check_end;
+                    }
+                    goto top2;
+                }
 	    }
-	    else {		/* less expensive than calling strncmp() */
+
+
+            /* hand-rolled strncmp(): less expensive than calling the
+             * real function (maybe???) */
+	    {
 		unsigned char * const olds = s;
 
 		tmp = littlelen;