This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use new regnodes for /[[:ascii:]]/
authorKarl Williamson <khw@cpan.org>
Fri, 29 Dec 2017 20:35:00 +0000 (13:35 -0700)
committerKarl Williamson <khw@cpan.org>
Sat, 30 Dec 2017 05:45:14 +0000 (22:45 -0700)
Prior to this commit, the ASCII Posix class was treated as any other
Posix class under /a.  It turns out that by making separate nodes for it
(and its complement), the performance gains can be astronomical on ASCII
platforms.  This is mainly due to the fact that scanning can be done
word-at-a-time, but also because various conditionals can be skipped.

Below are some measurements from Porting/bench.pl on a 64-bit Linux g++
-O2 system.The numbers are for very long strings, as otherwise, the
delta due solely to this change is masked by the overhead around pattern
matching in general.  These numbers are for finding an ASCII character
at the end of a very long string of non-ASCII ones.

All 1-byte (non-utf8) characters improvement ratio
    Ir      1990.8
    Dr      2995.4
    Dw      17296.7
  COND      786.0

All 2-byte characters improvement ratio
    Ir      242.2
    Dr      232.9
    Dw      17237.8
  COND      100.0

The numbers for three and more bytes per character are essentially the
same as for two bytes.

As an example, the Dw for strings consisting entirely of 2-byte
characters (before the terminal ASCII one) now take 584 instructions,
and previously 100,582

The gain would be less for a 32-bit system.

bench.pl returns other measurements which I omitted above, because they
either have unchanged performance or involve a trivial number of total
instructions.

embed.fnc
embed.h
inline.h
proto.h
regcomp.c
regexec.c

index ecec8cd..e339f6c 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2521,6 +2521,8 @@ ERp       |bool   |_is_grapheme   |NN const U8 * strbeg|NN const U8 * s|NN const U8 *stren
 
 #if defined(PERL_IN_REGEXEC_C)
 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
 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 2f2f93a..9d061fb 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define backup_one_SB(a,b,c)   S_backup_one_SB(aTHX_ a,b,c)
 #define backup_one_WB(a,b,c,d) S_backup_one_WB(aTHX_ a,b,c,d)
 #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 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)
index 40c3f89..1abee4f 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -539,10 +539,12 @@ S_variant_under_utf8_count(const U8* const s, const U8* const e)
 
 #endif
 
-#undef PERL_WORDSIZE
-#undef PERL_COUNT_MULTIPLIER
-#undef PERL_WORD_BOUNDARY_MASK
-#undef PERL_VARIANTS_WORD_MASK
+#ifndef PERL_IN_REGEXEC_C   /* Keep  these around for that file */
+#  undef PERL_WORDSIZE
+#  undef PERL_COUNT_MULTIPLIER
+#  undef PERL_WORD_BOUNDARY_MASK
+#  undef PERL_VARIANTS_WORD_MASK
+#endif
 
 /*
 =for apidoc is_utf8_string
diff --git a/proto.h b/proto.h
index 9c50197..3e4032b 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5553,6 +5553,16 @@ STATIC char*     S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, cons
 #define PERL_ARGS_ASSERT_FIND_BYCLASS  \
        assert(prog); assert(c); assert(s); assert(strend)
 
+STATIC char *  S_find_next_ascii(char* s, const char * send, const bool is_utf8)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_FIND_NEXT_ASCII       \
+       assert(s); assert(send)
+
+STATIC char *  S_find_next_non_ascii(char* s, const char * send, const bool is_utf8)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_FIND_NEXT_NON_ASCII   \
+       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 645d090..f9764e1 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5556,20 +5556,25 @@ Perl_re_printf( aTHX_  "LHS=%" UVuf " RHS=%" UVuf "\n",
                     }
                     break;
 
+                case NASCII:
+                    invert = 1;
+                    /* FALLTHROUGH */
+               case ASCII:
+                    my_invlist = invlist_clone(PL_XPosix_ptrs[_CC_ASCII]);
+
+                    /* This can be handled as a Posix class */
+                    goto join_posix_and_ascii;
+
                 case NPOSIXA:   /* For these, we always know the exact set of
                                    what's matched */
                     invert = 1;
                     /* FALLTHROUGH */
                case POSIXA:
-                    if (FLAGS(scan) == _CC_ASCII) {
-                        my_invlist = invlist_clone(PL_XPosix_ptrs[_CC_ASCII]);
-                    }
-                    else {
-                        _invlist_intersection(PL_XPosix_ptrs[FLAGS(scan)],
-                                              PL_XPosix_ptrs[_CC_ASCII],
-                                              &my_invlist);
-                    }
-                    goto join_posix;
+                    assert(FLAGS(scan) != _CC_ASCII);
+                    _invlist_intersection(PL_XPosix_ptrs[FLAGS(scan)],
+                                          PL_XPosix_ptrs[_CC_ASCII],
+                                          &my_invlist);
+                    goto join_posix_and_ascii;
 
                case NPOSIXD:
                case NPOSIXU:
@@ -5589,7 +5594,7 @@ Perl_re_printf( aTHX_  "LHS=%" UVuf " RHS=%" UVuf "\n",
                                           &my_invlist);
                     }
 
-                  join_posix:
+                  join_posix_and_ascii:
 
                     if (flags & SCF_DO_STCLASS_AND) {
                         ssc_intersection(data->start_class, my_invlist, invert);
@@ -17377,14 +17382,20 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
                 /* The actual POSIXish node for all the rest depends on the
                  * charset modifier.  The ones in the first set depend only on
                  * ASCII or, if available on this platform, also locale */
+
                 case ANYOF_ASCII:
                 case ANYOF_NASCII:
+
 #ifdef HAS_ISASCII
-                    op = (LOC) ? POSIXL : POSIXA;
-#else
-                    op = POSIXA;
+                    if (LOC) {
+                        op = POSIXL;
+                        goto join_posix;
+                    }
 #endif
-                    goto join_posix;
+                    /* (named_class - ANY_OF_ASCII) is 0 or 1. xor'ing with
+                     * invert converts that to 1 or 0 */
+                    op = ASCII + ((namedclass - ANYOF_ASCII) ^ invert);
+                    break;
 
                 /* The following don't have any matches in the upper Latin1
                  * range, hence /d is equivalent to /u for them.  Making it /u
@@ -17526,6 +17537,9 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
                                            TRUE /* downgradable to EXACT */
                                            );
             }
+            else {
+                *flagp |= HASWIDTH|SIMPLE;
+            }
 
             RExC_parse = (char *) cur_parse;
 
index 774d7d3..98421e1 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -552,6 +552,116 @@ S_isFOO_utf8_lc(pTHX_ const U8 classnum, const U8* character)
     return FALSE; /* Things like CNTRL are always below 256 */
 }
 
+STATIC char *
+S_find_next_ascii(char * s, const char * send, const bool utf8_target)
+{
+    /* Returns the position of the first ASCII byte in the sequence between 's'
+     * and 'send-1' inclusive; returns 'send' if none found */
+
+    PERL_ARGS_ASSERT_FIND_NEXT_ASCII;
+
+#ifndef EBCDIC
+
+    if ((STRLEN) (send - s) >= PERL_WORDSIZE
+
+                            /* This term is wordsize if subword; 0 if not */
+                          + PERL_WORDSIZE * PERL_IS_SUBWORD_ADDR(s)
+
+                            /* 'offset' */
+                          - (PTR2nat(s) & PERL_WORD_BOUNDARY_MASK))
+    {
+
+        /* 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 (isASCII(*s)) {
+                return s;
+            }
+            s++;    /* khw didn't bother creating a separate loop for
+                       utf8_target */
+        }
+
+        /* Here, we know we have at least one full word to process.  Process
+         * per-word as long as we have at least a full word left */
+        do {
+            if ((* (PERL_UINTMAX_T *) s) & ~ PERL_VARIANTS_WORD_MASK)  {
+                break;
+            }
+            s += PERL_WORDSIZE;
+        } while (s + PERL_WORDSIZE <= send);
+    }
+
+#endif
+
+    /* Process per-character */
+    if (utf8_target) {
+        while (s < send) {
+            if (isASCII(*s)) {
+                return s;
+            }
+            s += UTF8SKIP(s);
+        }
+    }
+    else {
+        while (s < send) {
+            if (isASCII(*s)) {
+                return s;
+            }
+            s++;
+        }
+    }
+
+    return s;
+}
+
+STATIC char *
+S_find_next_non_ascii(char * s, const char * send, const bool utf8_target)
+{
+    /* Returns the position of the first non-ASCII byte in the sequence between
+     * 's' and 'send-1' inclusive; returns 'send' if none found */
+
+#ifdef EBCDIC
+
+    PERL_ARGS_ASSERT_FIND_NEXT_NON_ASCII;
+
+    if (utf8_target) {
+        while (s < send) {
+            if ( ! isASCII(*s)) {
+                return s;
+            }
+            s += UTF8SKIP(s);
+        }
+    }
+    else {
+        while (s < send) {
+            if ( ! isASCII(*s)) {
+                return s;
+            }
+            s++;
+        }
+    }
+
+    return s;
+
+#else
+
+    const U8 * next_non_ascii = NULL;
+
+    PERL_ARGS_ASSERT_FIND_NEXT_NON_ASCII;
+    PERL_UNUSED_ARG(utf8_target);
+
+    /* On ASCII platforms invariants and ASCII are identical, so if the string
+     * is entirely invariants, there is no non-ASCII character */
+    return (is_utf8_invariant_string_loc((U8 *) s,
+                                         (STRLEN) (send - s),
+                                         &next_non_ascii))
+            ? (char *) send
+            : (char *) next_non_ascii;
+
+#endif
+
+}
+
 /*
  * pregexec and friends
  */
@@ -2379,6 +2489,22 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
         );
         break;
 
+    case ASCII:
+        s = find_next_ascii(s, strend, utf8_target);
+        if (s < strend && (reginfo->intuit || regtry(reginfo, &s))) {
+            goto got_it;
+        }
+
+        break;
+
+    case NASCII:
+        s = find_next_non_ascii(s, strend, utf8_target);
+        if (s < strend && (reginfo->intuit || regtry(reginfo, &s))) {
+            goto got_it;
+        }
+
+        break;
+
     /* The argument to all the POSIX node types is the class number to pass to
      * _generic_isCC() to build a mask for searching in PL_charclass[] */
 
@@ -6382,6 +6508,22 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
            }
            break;
 
+        case ASCII:
+            if (NEXTCHR_IS_EOS || ! isASCII(UCHARAT(locinput))) {
+                sayNO;
+            }
+
+            locinput++;     /* ASCII is always single byte */
+            break;
+
+        case NASCII:
+            if (NEXTCHR_IS_EOS || isASCII(UCHARAT(locinput))) {
+                sayNO;
+            }
+
+            goto increment_locinput;
+            break;
+
         /* The argument (FLAGS) to all the POSIX node types is the class number
          * */
 
@@ -9394,6 +9536,33 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
        }
        break;
 
+    case ASCII:
+        if (utf8_target && loceol - scan > max) {
+
+            /* We didn't adjust <loceol> at the beginning of this routine
+             * because is UTF-8, but it is actually ok to do so, since here, to
+             * match, 1 char == 1 byte. */
+            loceol = scan + max;
+        }
+
+        scan = find_next_non_ascii(scan, loceol, utf8_target);
+       break;
+
+    case NASCII:
+       if (utf8_target) {
+           while (     hardcount < max
+                   &&   scan < loceol
+                  && ! isASCII_utf8_safe(scan, loceol))
+           {
+               scan += UTF8SKIP(scan);
+               hardcount++;
+           }
+       }
+        else {
+            scan = find_next_ascii(scan, loceol, utf8_target);
+       }
+       break;
+
     /* The argument (FLAGS) to all the POSIX node types is the class number */
 
     case NPOSIXL: