Commit 6bc86d4d6f for perl

commit 6bc86d4d6f08caf6a0a373a46c1d133f381f0dfd
Author: Yves Orton <demerphq@gmail.com>
Date:   Fri Oct 16 23:44:28 2026 +0200

    regex: reduce Aho-Corasick position and scan overhead

    For nonfolded native matches, each input byte is one character. We can
    find the start by subtracting the word length from the current pointer,
    without recording every input position in a ring.

    Keep the ring for UTF-8 and folded matches, but wrap its index with a
    comparison instead of a remainder operation. Calculate where the initial
    scan reaches a UV boundary once, rather than checking alignment for
    every rejected octet.

    The AC construction queue holds each state once, so its indexes need not
    wrap either.

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 745ff34ec4..0d79c45d3e 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -108,6 +108,10 @@ includes their possible folds.  They do not use the shift tables, because
 folding can change encoded lengths.  Locale-dependent folding uses the
 existing scanner.

+The scanner also reduces the cost of tracking match positions, especially
+for case-sensitive matching against non-UTF-8 targets, and avoids repeated
+alignment checks while finding a rejected block of octets.
+
 =back

 =head1 Modules and Pragmata
diff --git a/regcomp_trie.c b/regcomp_trie.c
index 626e701d6e..82ddebfd0b 100644
--- a/regcomp_trie.c
+++ b/regcomp_trie.c
@@ -2140,9 +2140,9 @@ Perl_construct_ahocorasick_from_trie(pTHX_ RExC_state_t *pRExC_state, regnode *s
         SvREFCNT_dec(first_folds);
         DEBUG_TRIE_COMPILE_r(S_dump_ac_prefilters(aTHX_ aho, depth));
     }
-    /* The breadth-first work queue can contain each state at most once, so
-     * numstates entries suffice.  q_read and q_write address it as a
-     * circular queue while q_write advances monotonically. */
+    /* Each non-root trie state has exactly one parent and is enqueued once.
+     * Thus the entire breadth-first traversal fits in numstates entries;
+     * both indexes can advance linearly without wrapping or division. */
     Newx( q, numstates, U32);
     aho->fail = (U32 *) PerlMemShared_calloc( numstates, sizeof(U32) );
     fail = aho->fail;
@@ -2159,6 +2159,7 @@ Perl_construct_ahocorasick_from_trie(pTHX_ RExC_state_t *pRExC_state, regnode *s
               octet <= trie->states[1].max_octet; octet++ ) {
             const U32 newstate = S_trie_trans_state(trie, 1, base, octet, 0);
             if ( newstate ) {
+                assert(q_write < numstates);
                 q[ q_write ] = newstate;
                 /* set to point at the root */
                 fail[ q[ q_write++ ] ]=1;
@@ -2166,7 +2167,7 @@ Perl_construct_ahocorasick_from_trie(pTHX_ RExC_state_t *pRExC_state, regnode *s
         }
     }
     while ( q_read < q_write) {
-        const U32 cur = q[ q_read++ % numstates ];
+        const U32 cur = q[ q_read++ ];
         base = trie->states[ cur ].trans.base;

         if (base) {
@@ -2190,7 +2191,8 @@ Perl_construct_ahocorasick_from_trie(pTHX_ RExC_state_t *pRExC_state, regnode *s
                     {
                             aho->states[ ch_state ].wordnum =  aho->states[ fail_state ].wordnum;
                     }
-                    q[ q_write++ % numstates] = ch_state;
+                    assert(q_write < numstates);
+                    q[ q_write++ ] = ch_state;
                 }
             }
         }
diff --git a/regexec.c b/regexec.c
index 3461560e16..9edc55130e 100644
--- a/regexec.c
+++ b/regexec.c
@@ -2396,21 +2396,21 @@ S_scan_repeated_uv_blocks(const U8 *p, const U8 *end, const U8 *last_start,
 {
     const STRLEN block_size = sizeof(UV);
     const U8 * const start_limit = last_start + 1;
-    const U8 * const scan_start = p;
+    /* The next aligned point with a complete rejected window behind it
+     * is between block_size and 2 * block_size - 1 octets away.  Bound
+     * that initial scan once, instead of testing alignment at every octet.
+     * Clamp the count before pointer arithmetic near the target's end. */
+    const STRLEN checked_len = MIN((STRLEN)(start_limit - p),
+        block_size + (block_size - PTR2UV(p) % block_size) % block_size);
+    const U8 * const checked_end = p + checked_len;
     UV pattern;
     UV value;

-    /* The caller has already rejected p.  Keep checking starts until p is
-     * aligned and a complete checked window lies behind it. */
+    /* The caller has already rejected p. */
     p++;
-    while (p < start_limit) {
-        if ((STRLEN)(p - scan_start) >= block_size
-            && PTR2UV(p) % block_size == 0)
-        {
-            break;
-        }
-        if ((!utf8_target || !UTF8_IS_CONTINUATION(*p))
-            && (start_map[*p] & start_mask))
+    while (p < checked_end) {
+        if ((start_map[*p] & start_mask)
+            && (!utf8_target || !UTF8_IS_CONTINUATION(*p)))
         {
             return p;
         }
@@ -3465,12 +3465,18 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
             const bool has_bmh = prefilter && bmh_minlen;

             /* Every literal path requires a codepoint above Latin-1, so
-             * an unflagged target cannot match this start-of-program trie. */
+             * an unflagged target cannot match this start-of-program trie.
+             * Test that uncommon property before checking the trie shape.
+             * The startstate and prefix checks defensively record AC
+             * eligibility: an extracted prefix precedes the trie, so the
+             * trie cannot be first and is not a candidate for AC conversion.
+             * An accepting root denotes an empty alternative; such an
+             * alternative already prevents NO_LATIN1_WORDS from being set. */
             if (!utf8_target && FLAGS(c) == EXACT
+                && (trie->prop_flags & TRIE_CP_NO_LATIN1_WORDS)
                 && trie->startstate == 1
                 && !trie->states[1].wordnum
-                && !trie->prefixlen_octets && !trie->prefixlen_chars
-                && (trie->prop_flags & TRIE_CP_NO_LATIN1_WORDS))
+                && !trie->prefixlen_octets && !trie->prefixlen_chars)
             {
                 break;
             }
@@ -3486,11 +3492,13 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
 #ifndef DEBUGGING
             const U32 root_base = aho->states[1].trans.base;
 #endif
-            U8 **points; /* map of where we were in the input string
-                            when reading a given char. For ASCII this
-                            is unnecessary overhead as the relationship
-                            is always 1:1, but for Unicode, especially
-                            case folded Unicode this is not true. */
+            /* Native, non-folded characters each occupy one target byte.
+             * An accepting state follows a complete encoded character, so
+             * uc - wordlen gives the original start even when reading that
+             * character required several trie octets.  UTF-8 and folded
+             * targets need a ring mapping characters to target positions. */
+            const bool need_points = utf8_target || TRIE_IS_FOLDED(trie);
+            U8 **points;

             /* For a shorter maxlen, points are stored in a stack buffer. */
             /* The choice of STACK_POINTS_MAX here is rather arbitrary.
@@ -3510,7 +3518,9 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,

             DECLARE_AND_GET_RE_DEBUG_FLAGS;

-            if (maxlen <= STACK_POINTS_MAX) {
+            if (!need_points) {
+                points = NULL;
+            } else if (maxlen <= STACK_POINTS_MAX) {
                 points = points_stack;
             } else {
                 used_heap = true;
@@ -3551,7 +3561,9 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
 #ifdef DEBUGGING
                 U32 accepted_word = 0;
 #endif
-                U32 pointpos = 0;
+                /* Index of the next slot in the character-position ring.
+                 * Keep it below maxlen so writes need no runtime division. */
+                STRLEN pointpos = 0;

                 while (state && (foldlen || octets_remaining
                                  || uc < (U8*)strend)) {
@@ -3620,12 +3632,16 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
                     /* The prefilter may have moved uc to a later candidate.
                      * Record that position if the root transition succeeds. */
                     point = uc;
-                    point_may_be_start = !octets_remaining
+                    point_may_be_start = need_points && !octets_remaining
                         && (!utf8_target || !UTF8_IS_CONTINUATION(*uc));

                     if ( word ) {
-                        U8 *lpos = points[ (pointpos - trie->wordinfo[word].len)
-                                                                    % maxlen ];
+                        const STRLEN wordlen = trie->wordinfo[word].len;
+                        assert(wordlen <= maxlen);
+                        U8 *lpos = !need_points ? uc - wordlen
+                            : points[pointpos >= wordlen
+                                     ? pointpos - wordlen
+                                     : maxlen - (wordlen - pointpos)];
                         if (!leftmost || lpos < leftmost) {
                             DEBUG_r(accepted_word = word);
                             leftmost = lpos;
@@ -3722,7 +3738,9 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
                     if (!failed && state && point_may_be_start) {
                         if (transitioned_from_root)
                             pointpos = 0;
-                        points[pointpos++ % maxlen] = point;
+                        points[pointpos] = point;
+                        if (++pointpos == maxlen)
+                            pointpos = 0;
                     }
                     uc += len;
                     if (failed) {
@@ -3732,9 +3750,13 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
                     }
                 }
                 if ( aho->states[ state ].wordnum ) {
-                    U8 *lpos = points[ (pointpos
-                                      - trie->wordinfo[aho->states[ state ]
-                                                    .wordnum].len) % maxlen ];
+                    const STRLEN wordlen
+                        = trie->wordinfo[aho->states[state].wordnum].len;
+                    assert(wordlen <= maxlen);
+                    U8 *lpos = !need_points ? uc - wordlen
+                        : points[pointpos >= wordlen
+                                 ? pointpos - wordlen
+                                 : maxlen - (wordlen - pointpos)];
                     if (!leftmost || lpos < leftmost) {
                         DEBUG_r(accepted_word = aho->states[ state ].wordnum);
                         leftmost = lpos;
@@ -7283,7 +7305,12 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
                     = (reg_trie_data*)rexi->data->data[ TRIE_DATA_SLOT(scan) ];

                 /* These literal paths all require codepoints that cannot
-                 * occur in a non-UTF-8 target. */
+                 * occur in a non-UTF-8 target.  NO_LATIN1_WORDS describes the
+                 * complete source literals, including any extracted prefix.
+                 * Thus this test needs no restriction on startstate: even
+                 * if that state accepts an empty suffix, the prefix still
+                 * had to match.  An original empty alternative would have
+                 * prevented NO_LATIN1_WORDS from being set. */
                 if (!utf8_target
                     && (FLAGS(scan) == EXACT || FLAGS(scan) == EXACT_REQ8)
                     && (trie->prop_flags & TRIE_CP_NO_LATIN1_WORDS))
@@ -7312,9 +7339,14 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
                                                                reginfo->strend);
                     }
                 }
-                /* Start-class filtering is disabled while trie prefix
-                 * extraction is being brought into alignment with the
-                 * executable start state. */
+                /* The AC start maps describe unprefixed tries rooted at state
+                 * 1: an extracted prefix precedes the trie and prevents AC
+                 * conversion.  Filtering here would need a map for the
+                 * executable trie->startstate, which can follow a prefix,
+                 * and must allow an accepting start state.  For example,
+                 * extracting "ab" from (?:ab|abc) leaves an empty suffix as
+                 * one alternative, so rejecting the next octet could discard
+                 * a match that needs no more input. */

             {
                 U8 *uc = ( U8* )locinput;
diff --git a/t/re/pat.t b/t/re/pat.t
index 376061ca89..2aa9f6b75e 100644
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -28,7 +28,7 @@ skip_all_without_unicode_tables();
 my $has_locales = locales_enabled('LC_CTYPE');
 my $utf8_locale = find_utf8_ctype_locale();

-plan tests => 2218;  # Update this when adding/deleting tests.
+plan tests => 2290 + 6 * $Config{uvsize};  # Update when adding/deleting tests.

 run_tests() unless caller;

@@ -36,6 +36,123 @@ run_tests() unless caller;
 # Tests start here.
 #
 sub run_tests {
+    {
+        # Vary the offsets of rejected windows and their lengths around the
+        # machine-word boundary, including truncated windows near the end.
+        my $pattern = 'aaaa|bbbbbb|ccccccccccc';
+        my ( $plain, $trie );
+        { local ${^RE_TRIE_MAXBUF} = -1;    $plain = qr/$pattern/; }
+        { local ${^RE_TRIE_MAXBUF} = 65536; $trie  = qr/$pattern/; }
+        for my $encoding (qw(native utf8-latin1 utf8-wide)) {
+            for my $lead ( 0 .. 2 * $Config{uvsize} - 1 ) {
+                my ( @expected, @actual );
+                for my $gap ( 0 .. 3 * $Config{uvsize} ) {
+                    my $noise = $gap % 2 ? ' ' : "\t\x{e9}";
+                    $noise .= "\x{100}" if $encoding eq 'utf8-wide';
+                    my $text =
+                        ( '!' x $lead ) . 'aaaa'
+                      . ( $noise x $gap )
+                      . 'bbbbbb'
+                      . ( $noise x ( 2 * $Config{uvsize} + $gap ) )
+                      . 'cccccccccccccc';
+                    utf8::upgrade($text) if $encoding ne 'native';
+                    my @results;
+                    for my $re ( $plain, $trie ) {
+                        pos($text) = 0;
+                        my @spans;
+                        push @spans,   "$-[0]:$+[0]" while $text =~ /$re/g;
+                        push @results, join( ',', @spans );
+                    }
+                    push @expected, "$gap=$results[0]";
+                    push @actual,   "$gap=$results[1]";
+                }
+                is(
+                    join( ';', @actual ),
+                    join( ';', @expected ),
+                    "AC rejected windows: $encoding, leading offset $lead"
+                );
+            }
+        }
+    }
+    {
+        my @cases = (
+            [ 'failure links',  'abac|bac',        'ababacbac' ],
+            [ 'Latin-1 octets', "\x{e9}x|\x{f1}y", "\x{e9}\x{e9}x\x{f1}y" ],
+            [ 'wide octets', "\x{100}x|\x{200}y",  "\x{100}\x{100}x\x{200}y" ],
+            [ 'fold expansions',  'ssx|ffiy',      "\x{df}\x{df}x\x{fb03}y" ],
+            [ 'accepting states', 'ab|bcd',        'xabcdab' ],
+            [
+                'extracted prefix', "\x{100}x|\x{100}y",
+                "\x{100}z\x{100}x\x{100}y"
+            ],
+            [ 'empty alternative',      "\x{100}x|",         'abc' ],
+            [ 'wide-only alternatives', "\x{100}x|\x{200}y", 'plain' ],
+            [ 'mixed alternatives',     "\x{100}x|cat",      'catcat' ],
+            [ 'ring wraps', 'aaaaab|baaaac', ( 'a' x 100 ) . 'baaaac' ],
+            [ 'short word after wraps', 'abababx|babc', ( 'ab' x 100 ) . 'c' ],
+            [
+                'Latin-1 ring wraps',
+                ( "\x{e9}" x 5 ) . 'x|' . ( "\x{f1}" x 4 ) . 'y',
+                ( "\x{e9}" x 100 ) . 'x'
+            ],
+            [
+                'folded ring wraps', 'ssssssX|ffiffiY',
+                ( "\x{df}" x 100 ) . 'X'
+            ],
+            [
+                'heap ring wraps',
+                ( 'a' x 40 ) . 'b|b' . ( 'a' x 39 ) . 'c',
+                ( 'a' x 160 ) . 'b' . ( 'a' x 39 ) . 'c'
+            ],
+            [
+                'heap ring short word',
+                'aaaaab|b' . ( 'a' x 39 ) . 'c',
+                ( 'a' x 160 ) . 'b' . ( 'a' x 39 ) . 'c'
+            ],
+            [
+                'rejected candidate',
+                'aaaaab(?=X)|baaaac(?=Y)',
+                ( 'a' x 100 ) . 'bZbaaaacY'
+            ],
+            [ 'accepting prefix continuation', 'ab(?=X)|abcd', 'abcdabX' ],
+            [
+                'Latin-1 continuation', "\x{e9}x(?=A)|\x{f1}y(?=B)",
+                "\x{e9}xZ\x{f1}yB"
+            ],
+        );
+
+        for my $case (@cases) {
+            my ( $name, $pattern, $input ) = @$case;
+            for my $mods ( 'u', 'iu' ) {
+                my ( $trie_re, $plain_re );
+                {
+                    local ${^RE_TRIE_MAXBUF} = 65536;
+                    $trie_re = qr/(?$mods:$pattern)(?#AC positions)/;
+                }
+                {
+                    local ${^RE_TRIE_MAXBUF} = -1;
+                    $plain_re = qr/(?$mods:$pattern)(?#branch positions)/;
+                }
+                for my $upgrade ( 0, 1 ) {
+                    my $target = $input;
+                    utf8::upgrade($target) if $upgrade;
+                    my ( @expected, @got );
+                    while ( $target =~ /$plain_re/g ) {
+                        push @expected, "$-[0]:$+[0]";
+                    }
+                    while ( $target =~ /$trie_re/g ) {
+                        push @got, "$-[0]:$+[0]";
+                    }
+                    is(
+                        join( ',', @got ),
+                        join( ',', @expected ),
+"AC match positions agree with branches: $name, /$mods, upgrade=$upgrade"
+                    );
+                }
+            }
+        }
+    }
+
     {
         my @folded_starts = (
             ['ssx', "sSx"],