Commit 0461c487a1 for perl
commit 0461c487a11a925e8794c74e3da5ccdcf3ca98c7
Author: David Mitchell <davem@iabyn.nospamdeletethisbit.com>
Date: Wed Sep 9 16:19:15 2026 +0100
regex: improve counting SLC WHILEM nodes
Some WHILEM nodes participate in the super-linear cache (SLC). This
commit improves and simplifies the code which generates the ids for
those nodes during compilation, along with a count of the total number
of such nodes.
The main visible difference from this commit is that the SLC is no
longer sometimes over-allocated. Consider this example on normal and
modified perls:
$ perl -Dr -e'qr/(aa?)*(bb?)*(cc?){1,5}(dd?)*/' 2>&1 | grep WHILEM
17: WHILEM[1/4] (0)
35: WHILEM[2/4] (0)
53: WHILEM (0)
71: WHILEM[3/4] (0)
$ ./perl -Dr -e'qr/(aa?)*(bb?)*(cc?){1,5}(dd?)*/' 2>&1 | grep WHILEM
17: WHILEM[1/3] (0)
35: WHILEM[2/3] (0)
53: WHILEM (0)
71: WHILEM[3/3] (0)
In this pattern there are four WHILEM nodes, but only three of them can
participate in the SLC. Previously the SLC code allocated (string
length) x 4 bits for the cache, even though only x 3 was needed.
The simplification is that there is a new field slc_whilem_seen added to
the regexp_internal struct which, during compilation, is incremented
each time an SLC-capable WHILEM node is identified, and then at run-time
is used in the calculation for allocating the cache.
Formerly, the U8 FLAGS() field of the WHILEM node stored two 4-bit
values: the node id and the total - i.e. the two values displayed in
'WHILEM[2/4]'.
But there is no point storing the *same* total value in every FLAGS()
field - just store it once in the regex_internal struct. So now the
FLAGS() field only holds the id, which in principle is now limited to
255 rather than 15 nodes (although this commit doesn't change that
limit).
Formerly, a count of the total number of WHILEM nodes seen was
accumulated in RExC_whilem_seen during parsing by reg(), which was then
capped to 15, and was subsequently used by study_chunk() as the value to
stuff into every FLAGS() field. Separately, study_chunk() maintained an
id count in the whilem_c field of the scan_data_t struct, which was also
copied to and from other scan_data_t structs when doing sub-scans. Both
of those fields have been eliminated.
diff --git a/pod/perlreguts.pod b/pod/perlreguts.pod
index 898879aebd..a11ac235fe 100644
--- a/pod/perlreguts.pod
+++ b/pod/perlreguts.pod
@@ -1308,15 +1308,17 @@ heading 'RT #79152'.
=item *
-The number of cache-participating C<WHILEM> nodes is stored in the upper 4
-bits of each C<WHILEM>'s C<FLAGS()> field, while the identity of the
-particular C<WHILEM> (used as part of the index into the bit cache) is
-stored in the lower 4 bits. This means that a pattern can have a maximum
-of 16 participating C<WHILEM>s. If the flags field is zero, it indicates
-that this C<WHILEM> node won't participate in the cache mechanism.
+There is currently a hard limit of 15 cache-participating C<WHILEM> nodes
+per regex.
=back
+In a compiled regex, a node id in the range 1-15 is stored in the
+C<FLAGS()> field of each participating C<WHILEM> node (a value of 0
+indicates that the node isn't suitable for the SLC). The field
+C<slc_whilem_seen> in the C<regexp_internal> structure indicates the total
+number of such C<WHILEM> nodes.
+
The runtime state of the SLC is mainly stored in various fields of the
C<reginfo> struct, which is initialised at the start of a match.
diff --git a/regcomp.c b/regcomp.c
index 396d2eec47..9b0388396c 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -1710,7 +1710,6 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
RExC_start = RExC_copy_start_in_constructed = RExC_copy_start_in_input = RExC_precomp = exp;
RExC_precomp_end = RExC_end = exp + plen;
RExC_nestroot = 0;
- RExC_whilem_seen = 0;
RExC_end_op = NULL;
RExC_recurse = NULL;
RExC_study_chunk_recursed = NULL;
@@ -1903,10 +1902,6 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
RExC_rx->nparens = RExC_total_parens - 1;
RExC_rx->logical_nparens = RExC_logical_total_parens - 1;
- /* Uses the upper 4 bits of the FLAGS field, so keep within that size */
- if (RExC_whilem_seen > 15)
- RExC_whilem_seen = 15;
-
DEBUG_PARSE_r({
re_printf(
"Required size %zd nodes\n", RExC_size);
@@ -2164,7 +2159,6 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
/* search for "restudy" in this file for a detailed explanation
* of 'restudied' and SCF_TRIE_DOING_RESTUDY */
-
CHECK_RESTUDY_GOTO_butfirst(LEAVE_with_name("study_chunk"));
@@ -5214,7 +5208,6 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
{
REQUIRE_BRANCHJ(flagp, 0);
}
- RExC_whilem_seen++;
MARK_NAUGHTY_EXP(1, 4); /* compound interest */
}
@@ -14284,6 +14277,7 @@ Perl_regdupe_internal(pTHX_ REGEXP * const rx, CLONE_PARAMS *param)
reti->name_list_idx = ri->name_list_idx;
+ reti->slc_whilem_seen = ri->slc_whilem_seen;
SetProgLen(reti, len);
diff --git a/regcomp.h b/regcomp.h
index 011ed94b47..252623c02a 100644
--- a/regcomp.h
+++ b/regcomp.h
@@ -132,6 +132,8 @@ typedef struct regexp_internal {
only valid when RXp_PAREN_NAMES(prog) is true,
0 means "no value" like any other index into the
data array.*/
+ U8 slc_whilem_seen; /* Num of WHILEMs using super-linear cache.
+ Same type as FLAGS() */
regnode program[1]; /* Unwarranted chumminess with compiler. */
} regexp_internal;
diff --git a/regcomp_debug.c b/regcomp_debug.c
index 91c5bf4ae4..e243292f1f 100644
--- a/regcomp_debug.c
+++ b/regcomp_debug.c
@@ -109,8 +109,7 @@ Perl_debug_studydata(pTHX_ const char *where, scan_data_t *data,
debug_show_study_flags(data->flags," [","]");
re_printf(
- " Whilem_c: %" IVdf " Lcp: %" IVdf " %s",
- (IV)data->whilem_c,
+ "Lcp: %" IVdf " %s",
(IV)(data->last_closep ? *((data)->last_closep) : -1),
is_inf ? "INF " : ""
);
@@ -647,7 +646,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_
sv_catpvs(sv, "}");
}
else if (k == WHILEM && FLAGS(o)) /* Ordinal/of */
- sv_catpvf(sv, "[%d/%d]", FLAGS(o) & 0xf, FLAGS(o)>>4);
+ sv_catpvf(sv, "[%d/%d]", (int)FLAGS(o), (int)progi->slc_whilem_seen);
else if (k == REF || k == OPEN || k == CLOSE
|| k == GROUPP || op == ACCEPT)
{
diff --git a/regcomp_internal.h b/regcomp_internal.h
index 7148a09d8b..53c2225ff8 100644
--- a/regcomp_internal.h
+++ b/regcomp_internal.h
@@ -49,7 +49,6 @@ struct RExC_state_t {
and restoring 'copy_start' */
char *copy_start_in_input; /* Position in input string
corresponding to copy_start */
- SSize_t whilem_seen; /* number of WHILEM in this expr */
regnode *emit_start; /* Start of emitted-code area */
regnode_offset emit; /* Code-emit pointer */
I32 naughty; /* How bad is this pattern? */
@@ -206,7 +205,6 @@ struct RExC_state_t {
#define RExC_end (pRExC_state->end)
#define RExC_parse (pRExC_state->parse)
#define RExC_latest_warn_offset (pRExC_state->latest_warn_offset )
-#define RExC_whilem_seen (pRExC_state->whilem_seen)
#define RExC_seen_d_op (pRExC_state->seen_d_op) /* Seen something that differs
under /d from /u ? */
@@ -691,7 +689,6 @@ struct scan_data_t {
struct scan_data_substrs substrs[2];
I32 flags; /* common SF_* and SCF_* flags */
- I32 whilem_c;
SSize_t *last_closep;
regnode **last_close_opp; /* pointer to pointer to last CLOSE regop
seen. DO NOT DEREFERENCE the regnode
@@ -710,7 +707,7 @@ static const scan_data_t zero_scan_data = {
{ NULL, 0, 0, 0, 0, 0 },
{ NULL, 0, 0, 0, 0, 0 },
},
- 0, 0, NULL, NULL, NULL
+ 0, NULL, NULL, NULL
};
diff --git a/regcomp_study.c b/regcomp_study.c
index 14781588ea..77ff2d4a1e 100644
--- a/regcomp_study.c
+++ b/regcomp_study.c
@@ -1682,7 +1682,6 @@ Perl_study_chunk(pTHX_
num++;
StructCopy(&zero_scan_data, &data_fake, scan_data_t);
if (data) {
- data_fake.whilem_c = data->whilem_c;
data_fake.last_closep = data->last_closep;
data_fake.last_close_opp = data->last_close_opp;
}
@@ -1731,7 +1730,6 @@ Perl_study_chunk(pTHX_
if (data) {
if (data_fake.flags & SF_HAS_EVAL)
data->flags |= SF_HAS_EVAL;
- data->whilem_c = data_fake.whilem_c;
}
if (flags & SCF_DO_STCLASS)
ssc_or(pRExC_state, &accum, (regnode_charclass*)&this_class);
@@ -2786,12 +2784,15 @@ Perl_study_chunk(pTHX_
if (OP(REGNODE_BEFORE(nxt)) == NOTHING) /* LONGJMP */
nxt += ARG1u(nxt);
nxt = REGNODE_BEFORE(nxt);
- if (FLAGS(nxt) & 0xf) {
- /* we've already set whilem count on this node */
- } else if (++data->whilem_c < 16) {
- assert(data->whilem_c <= RExC_whilem_seen);
- FLAGS(nxt) = (U8)(data->whilem_c
- | (RExC_whilem_seen << 4)); /* On WHILEM */
+ if (
+ /* we've not already set WHILEM count on this node */
+ !FLAGS(nxt)
+ /* max supported number of WHILEM nodes that can
+ * participate in super-linear cache */
+ && RExC_rxi->slc_whilem_seen < 15)
+ {
+ ++RExC_rxi->slc_whilem_seen;
+ FLAGS(nxt) = RExC_rxi->slc_whilem_seen; /* On WHILEM */
}
}
if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
@@ -3204,7 +3205,6 @@ Perl_study_chunk(pTHX_
StructCopy(&zero_scan_data, &data_fake, scan_data_t);
if (data) {
- data_fake.whilem_c = data->whilem_c;
data_fake.last_closep = data->last_closep;
data_fake.last_close_opp = data->last_close_opp;
}
@@ -3275,7 +3275,6 @@ Perl_study_chunk(pTHX_
pars++;
if (data_fake.flags & SF_HAS_EVAL)
data->flags |= SF_HAS_EVAL;
- data->whilem_c = data_fake.whilem_c;
}
if (f & SCF_DO_STCLASS_AND) {
if (flags & SCF_DO_STCLASS_OR) {
@@ -3385,7 +3384,6 @@ Perl_study_chunk(pTHX_
pars++;
if (data_fake.flags & SF_HAS_EVAL)
data->flags |= SF_HAS_EVAL;
- data->whilem_c = data_fake.whilem_c;
if ((flags & SCF_DO_SUBSTR) && data_fake.last_found) {
int i;
if (RExC_rx->minlen < *minnextp)
@@ -3516,7 +3514,6 @@ Perl_study_chunk(pTHX_
StructCopy(&zero_scan_data, &data_fake, scan_data_t);
if (data) {
- data_fake.whilem_c = data->whilem_c;
data_fake.last_closep = data->last_closep;
data_fake.last_close_opp = data->last_close_opp;
}
@@ -3571,7 +3568,6 @@ Perl_study_chunk(pTHX_
if (data) {
if (data_fake.flags & SF_HAS_EVAL)
data->flags |= SF_HAS_EVAL;
- data->whilem_c = data_fake.whilem_c;
}
if (flags & SCF_DO_STCLASS)
ssc_or(pRExC_state, &accum, (regnode_charclass *) &this_class);
diff --git a/regexec.c b/regexec.c
index a41a7ae512..2160788c32 100644
--- a/regexec.c
+++ b/regexec.c
@@ -6489,7 +6489,7 @@ S_backup_one_WB_but_over_Extend_FO(pTHX_ WB_enum * previous,
REGNODE_BEFORE(regnext(cur_curlyx->u.curlyx.me)); \
re_exec_indentf( \
"WHILEM[%d/%d]: (cache) marking failure at pos %" UVuf "\n", \
- depth, (FLAGS(whilem) & 0xf), (FLAGS(whilem)>>4), \
+ depth, (int)FLAGS(whilem), (int)rexi->slc_whilem_seen, \
(UV)(locinput - reginfo->strbeg)); \
}); \
reginfo->info_aux->poscache[ST.cache_offset] |= ST.cache_mask; \
@@ -9166,7 +9166,8 @@ NULL
* know the match is not *that* much linear. */
STRLEN len = reginfo->strend - reginfo->strbeg;
/* number of participating WHILEMs */
- U8 n = (FLAGS(scan)>>4);
+ U8 n = rexi->slc_whilem_seen;
+ assert(FLAGS(scan) <= n);
/* Only do the calculations and enable the cache if it
* won't overflow. This test is equivalent to:
@@ -9223,15 +9224,16 @@ NULL
/* have we already failed at this position? */
SSize_t offset, mask;
- offset = (FLAGS(scan) & 0xf) - 1
+ offset = FLAGS(scan) - 1
+ (locinput - reginfo->strbeg)
- * (FLAGS(scan)>>4);
+ * rexi->slc_whilem_seen;
mask = 1 << (offset % 8);
offset /= 8;
if (reginfo->info_aux->poscache[offset] & mask) {
DEBUG_EXECUTE_r( re_exec_indentf(
"WHILEM[%d/%d]: (cache) already failed at pos %" UVuf "\n",
- depth, (FLAGS(scan) & 0xf), (FLAGS(scan)>>4),
+ depth, (int)FLAGS(scan),
+ (int)rexi->slc_whilem_seen,
(UV)(locinput - reginfo->strbeg));
);
cur_curlyx->u.curlyx.count--;
diff --git a/t/re/pat.t b/t/re/pat.t
index 5315553244..dcac176824 100644
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -2157,7 +2157,8 @@ EOP
}
{
# [perl #129281] buffer write overflow, detected by ASAN, valgrind
- fresh_perl_is('/0(?0)|^*0(?0)|^*(^*())0|/', '', {}, "don't bump whilem_c too much");
+ fresh_perl_is('/0(?0)|^*0(?0)|^*(^*())0|/', '', {},
+ "don't bump slc_whilem_seen too much");
}
{
# RT #131893 - fails with ASAN -fsanitize=undefined