Commit 4e186fe1a9 for perl
commit 4e186fe1a90b2d140654346e9bbbf07ef69c03ee
Author: Yves Orton <demerphq@gmail.com>
Date: Sun Oct 18 14:07:13 2026 +0200
regex: consume both native trie octets in one iteration
For nonfolded native input, consume both encoded octets in the same
iteration. We need not return to the general reader between them. Keep
both ownership checks, but only check for accepting words after the
whole character. A word cannot end inside its encoding.
Each native character is one input byte, so derive its position from the
input pointer instead of counting characters in the loop. Tracing uses
this same loop and shows the intermediate state on the character's
diagnostic line.
Together with packing, this saves about 8-13% of cycles on synthetic
forty-character high-byte native match and miss cases, compared with the
previous reader. These are nonthreaded GCC -O2 builds on an i7-1185G7.
Some short folded and wide UTF-8 controls cost 1-2% more.
diff --git a/ext/re/t/lexical_debug.t b/ext/re/t/lexical_debug.t
index 4c8b47d54f..908a43d496 100644
--- a/ext/re/t/lexical_debug.t
+++ b/ext/re/t/lexical_debug.t
@@ -15,7 +15,7 @@ use strict;
BEGIN { require "../../t/test.pl"; }
my $out = runperl(progfile => "t/lexical_debug.pl", stderr => 1 );
-print "1..12\n";
+print "1..19\n";
# Each pattern will produce an EXACT node with a specific string in
# it, so we will look for that. We can't just look for the string
@@ -35,3 +35,31 @@ ok( $out =~ /<zap>/, "Got 'zap'" ); # in a TRIE so no EXACT
ok( $out =~ /Count=9\n/, "Count is 9")
or diag($out);
+my $native = runperl(prog => <<'PROG', stderr => 1);
+use re Debug => qw(TRIEE);
+my ($e, $f, $bad) = map { chr utf8::unicode_to_native($_) } (0xe9, 0xef, 0xea);
+my $re = qr/\A.(?:${e}a|${f}b)\z/;
+my @matched;
+for my $target (q(X).$e.q(a), q(X).$bad.q(a), q(Xqa)) {
+ push @matched, $target =~ $re ? 1 : 0;
+}
+print qq(matched: @matched\n);
+PROG
+
+is(scalar(() = $native =~ /native input, fused octet transitions/g), 3,
+ 'tracing executes the fused native loop for each target');
+my $e = sprintf '%X', utf8::unicode_to_native(0xe9);
+like($native, qr/TRIE: Char:0x$e\s+CP:0x$e\s+.* - good ->.* via St:0x[1-9A-F]/,
+ 'trace shows a successful two-octet character and its middle state');
+my $bad = sprintf '%X', utf8::unicode_to_native(0xea);
+like($native, qr/TRIE: Char:0x$bad\s+CP:0x$bad\s+.* - fail ->.* via St:0x[1-9A-F]/,
+ 'trace shows a failed continuation transition and its middle state');
+my $q = sprintf '%X', ord 'q';
+like($native, qr/TRIE: Char:0x$q\s+.* - fail ->/,
+ 'trace shows a failed first transition');
+my $a = sprintf '%X', ord 'a';
+like($native, qr/TRIE: Char:0x$a\s+.* - good ->/,
+ 'trace shows an invariant native character');
+unlike($native, qr/TRIE: Octet:/,
+ 'native trace reports characters rather than individual UTF octets');
+like($native, qr/matched: 1 0 0/, 'traced matches give the expected results');
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 310d0b9108..140a835aa5 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -97,6 +97,12 @@ L<[GH #19953]|https://github.com/Perl/perl5/issues/19953>
=item *
+Non-folded trie matching against native byte strings now consumes a
+character's encoded octets in one iteration. This reduces reader bookkeeping
+when the character requires two UTF-8 or UTF-EBCDIC octets.
+
+=item *
+
The Aho-Corasick regex scanner uses Boyer-Moore-Horspool shift tables to skip
positions where no literal alternative can start. It can also skip repeated
blocks of octets that cannot start an alternative. These filters apply to
diff --git a/regexec.c b/regexec.c
index e367dfaa1d..3c9fa3574d 100644
--- a/regexec.c
+++ b/regexec.c
@@ -2006,6 +2006,24 @@ STMT_START { \
dump_exec_pos(li,s,(reginfo->strend),(reginfo->strbeg), \
startpos, doutf8, depth)
+#define REXEC_TRIE_TRACE(pos, from, via, to, word, kind, octet, cp) \
+ DEBUG_TRIE_EXECUTE_r( \
+ DUMP_EXEC_POS((char *)(pos), scan, utf8_target, depth); \
+ re_printf("%sTRIE: %s:0x%-2" UVXf " CP:0x%-4" UVXf " ", \
+ PL_colors[4], (kind), (UV)(octet), (UV)(cp)); \
+ if (isPRINT_A(cp)) \
+ re_printf("'%c' ", (int)(cp)); \
+ else \
+ re_printf(" "); \
+ re_printf("St:0x%-4" UVXf " W:0x%-2" UVXf \
+ " - %s -> St: 0x%-4" UVXf, \
+ (UV)(from), (UV)(word), (to) ? "good" : "fail", \
+ (UV)(to)); \
+ if (via) \
+ re_printf(" via St:0x%" UVXf, (UV)(via)); \
+ re_printf("%s\n", PL_colors[5]); \
+ )
+
#define GET_ANYOFH_INVLIST(prog, n) \
GET_REGCLASS_AUX_DATA(prog, n, true, 0, NULL, NULL)
@@ -7364,6 +7382,75 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
ST.longfold = false; /* char longer if folded => it's harder */
ST.nextword = 0;
+ /* Native input needs at most two encoded octets. Consume
+ * both transitions here instead of revisiting the general
+ * reader for the second octet. No accepting word can end
+ * between the octets of one encoded character. */
+ const bool native_encoded = !utf8_target && !TRIE_IS_FOLDED(trie)
+ && (trie->prop_flags & TRIE_CP_WIDE);
+ if (native_encoded) {
+ DEBUG_TRIE_EXECUTE_r(re_exec_indentf(
+ "TRIE: native input, fused octet transitions\n", depth));
+ while (state) {
+ PERL_DEB(U32 old_state = state);
+ PERL_DEB(U32 middle_state = 0);
+ const U32 wordnum = trie->states[state].wordnum;
+ U32 base = trie->states[state].trans.base;
+ if (wordnum) {
+ if (!accepted) {
+ accepted = 1;
+ ST.firstpos = uc;
+ ST.firstchars = (U32)(uc - (U8 *)locinput);
+ }
+ if (!ST.nextword || wordnum < ST.nextword)
+ ST.nextword = wordnum;
+ ST.topword = wordnum;
+ }
+ /* Stop at a leaf or the end of the input. */
+ if (!base || uc >= (U8 *)loceol) {
+ REXEC_TRIE_TRACE(uc, state, 0, 0, wordnum,
+ "Char", 0, 0);
+ break;
+ }
+
+ /* A U16 packs the native byte's UTF octets, low first. */
+ const native_octet_utf8_t encoded
+ = PL_native_octet_utf8[*uc];
+ U32 offset = base + (U8)encoded;
+
+ /* Shared slots must belong to the current state. */
+ if (trie->trans[offset].check != state) {
+ REXEC_TRIE_TRACE(uc + 1, old_state, 0, 0, wordnum,
+ "Char", *uc, *uc);
+ break;
+ }
+ state = trie->trans[offset].next;
+ assert(state && state < trie->statecount);
+
+ /* A nonzero high octet means a two-octet UTF encoding. */
+ if (encoded > 0xFF) {
+ PERL_DEB(middle_state = state);
+ base = trie->states[state].trans.base;
+ offset = base + (encoded >> 8);
+ if (!base || trie->trans[offset].check != state) {
+ REXEC_TRIE_TRACE(uc + 1, old_state,
+ middle_state, 0, wordnum,
+ "Char", *uc, *uc);
+ break;
+ }
+ state = trie->trans[offset].next;
+ assert(state && state < trie->statecount);
+ }
+
+ /* Both transitions consume just one native character. */
+ uc++;
+ REXEC_TRIE_TRACE(uc, old_state, middle_state,
+ state, wordnum,
+ "Char", uc[-1], uc[-1]);
+ }
+ goto trie_traversed;
+ }
+
/* fully traverse the TRIE; note the position of the
shortest accept state and the wordnum of the longest
accept state */
@@ -7423,24 +7510,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
else {
state = 0;
}
- DEBUG_TRIE_EXECUTE_r(
- DUMP_EXEC_POS( (char *)uc, scan, utf8_target, depth );
- re_printf(
- "%sTRIE: Octet:0x%-2" UVXf " CP:0x%-4" UVXf " ",
- PL_colors[4], (UV)octet, uvc);
- if (isPRINT_A(uvc))
- re_printf("'%c' ", (int)uvc );
- else
- re_printf(" " ); /* four spaces to match "'x' " */
- re_printf(
- "St:0x%-4" UVXf " W:0x%-2" UVXf " - %s -> St: 0x%-4" UVXf "%s\n",
- (UV)old_state, (UV)wordnum,
- state ? "good" : "fail",
- (UV)state, PL_colors[5]
-
- );
- );
+ REXEC_TRIE_TRACE(uc, old_state, 0, state, wordnum,
+ "Octet", octet, uvc);
}
+ trie_traversed:
if (!accepted)
sayNO;