This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PATCH: [perl #127599] Fix regcomp.c assertion
[perl5.git] / regcomp.c
CommitLineData
a0d0e21e
LW
1/* regcomp.c
2 */
3
4/*
4ac71550
TC
5 * 'A fair jaw-cracker dwarf-language must be.' --Samwise Gamgee
6 *
7 * [p.285 of _The Lord of the Rings_, II/iii: "The Ring Goes South"]
a0d0e21e
LW
8 */
9
61296642
DM
10/* This file contains functions for compiling a regular expression. See
11 * also regexec.c which funnily enough, contains functions for executing
166f8a29 12 * a regular expression.
e4a054ea
DM
13 *
14 * This file is also copied at build time to ext/re/re_comp.c, where
15 * it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
16 * This causes the main functions to be compiled under new names and with
17 * debugging support added, which makes "use re 'debug'" work.
166f8a29
DM
18 */
19
a687059c
LW
20/* NOTE: this is derived from Henry Spencer's regexp code, and should not
21 * confused with the original package (see point 3 below). Thanks, Henry!
22 */
23
24/* Additional note: this code is very heavily munged from Henry's version
25 * in places. In some spots I've traded clarity for efficiency, so don't
26 * blame Henry for some of the lack of readability.
27 */
28
e50aee73 29/* The names of the functions have been changed from regcomp and
3b753521 30 * regexec to pregcomp and pregexec in order to avoid conflicts
e50aee73
AD
31 * with the POSIX routines of the same names.
32*/
33
b9d5759e 34#ifdef PERL_EXT_RE_BUILD
54df2634 35#include "re_top.h"
b81d288d 36#endif
56953603 37
a687059c 38/*
e50aee73 39 * pregcomp and pregexec -- regsub and regerror are not used in perl
a687059c
LW
40 *
41 * Copyright (c) 1986 by University of Toronto.
42 * Written by Henry Spencer. Not derived from licensed software.
43 *
44 * Permission is granted to anyone to use this software for any
45 * purpose on any computer system, and to redistribute it freely,
46 * subject to the following restrictions:
47 *
48 * 1. The author is not responsible for the consequences of use of
49 * this software, no matter how awful, even if they arise
50 * from defects in it.
51 *
52 * 2. The origin of this software must not be misrepresented, either
53 * by explicit claim or by omission.
54 *
55 * 3. Altered versions must be plainly marked as such, and must not
56 * be misrepresented as being the original software.
57 *
58 *
59 **** Alterations to Henry's code are...
60 ****
4bb101f2 61 **** Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
1129b882
NC
62 **** 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
63 **** by Larry Wall and others
a687059c 64 ****
9ef589d8
LW
65 **** You may distribute under the terms of either the GNU General Public
66 **** License or the Artistic License, as specified in the README file.
67
a687059c
LW
68 *
69 * Beware that some of this code is subtly aware of the way operator
70 * precedence is structured in regular expressions. Serious changes in
71 * regular-expression syntax might require a total rethink.
72 */
73#include "EXTERN.h"
864dbfa3 74#define PERL_IN_REGCOMP_C
a687059c 75#include "perl.h"
d06ea78c 76
acfe0abc 77#ifndef PERL_IN_XSUB_RE
d06ea78c
GS
78# include "INTERN.h"
79#endif
c277df42
IZ
80
81#define REG_COMP_C
54df2634
NC
82#ifdef PERL_IN_XSUB_RE
83# include "re_comp.h"
afda64e8 84EXTERN_C const struct regexp_engine my_reg_engine;
54df2634
NC
85#else
86# include "regcomp.h"
87#endif
a687059c 88
f7e03a10 89#include "dquote_inline.h"
b992490d 90#include "invlist_inline.h"
1b0f46bf 91#include "unicode_constants.h"
04e98a4d 92
538e84ed
KW
93#define HAS_NONLATIN1_FOLD_CLOSURE(i) \
94 _HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)
f12c0118
KW
95#define HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE(i) \
96 _HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)
26faadbd 97#define IS_NON_FINAL_FOLD(c) _IS_NON_FINAL_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c)
2c61f163 98#define IS_IN_SOME_FOLD_L1(c) _IS_IN_SOME_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c)
94dc5c2d 99
a687059c
LW
100#ifndef STATIC
101#define STATIC static
102#endif
103
dea37815
KW
104#ifndef MIN
105#define MIN(a,b) ((a) < (b) ? (a) : (b))
106#endif
b1603ef8 107
3001ef3e
KW
108#ifndef MAX
109#define MAX(a,b) ((a) > (b) ? (a) : (b))
110#endif
111
3f910e62
YO
112/* this is a chain of data about sub patterns we are processing that
113 need to be handled separately/specially in study_chunk. Its so
114 we can simulate recursion without losing state. */
115struct scan_frame;
116typedef struct scan_frame {
117 regnode *last_regnode; /* last node to process in this frame */
118 regnode *next_regnode; /* next node to process when last is reached */
119 U32 prev_recursed_depth;
120 I32 stopparen; /* what stopparen do we use */
121 U32 is_top_frame; /* what flags do we use? */
122
123 struct scan_frame *this_prev_frame; /* this previous frame */
124 struct scan_frame *prev_frame; /* previous frame */
125 struct scan_frame *next_frame; /* next frame */
126} scan_frame;
127
f4ae5a27
KW
128/* Certain characters are output as a sequence with the first being a
129 * backslash. */
130#define isBACKSLASHED_PUNCT(c) \
131 ((c) == '-' || (c) == ']' || (c) == '\\' || (c) == '^')
132
133
09b2b2e6 134struct RExC_state_t {
514a91f1
DM
135 U32 flags; /* RXf_* are we folding, multilining? */
136 U32 pm_flags; /* PMf_* stuff from the calling PMOP */
830247a4 137 char *precomp; /* uncompiled string. */
711b303b 138 char *precomp_end; /* pointer to end of uncompiled string. */
288b8c02 139 REGEXP *rx_sv; /* The SV that is the regexp. */
f8fc2ecf 140 regexp *rx; /* perl core regexp structure */
538e84ed
KW
141 regexp_internal *rxi; /* internal data for regexp object
142 pprivate field */
fac92740 143 char *start; /* Start of input for compile */
830247a4
IZ
144 char *end; /* End of input for compile */
145 char *parse; /* Input-scan pointer. */
285b5ca0
KW
146 char *adjusted_start; /* 'start', adjusted. See code use */
147 STRLEN precomp_adj; /* an offset beyond precomp. See code use */
ea3daa5d 148 SSize_t whilem_seen; /* number of WHILEM in this expr */
fac92740 149 regnode *emit_start; /* Start of emitted-code area */
538e84ed
KW
150 regnode *emit_bound; /* First regnode outside of the
151 allocated space */
f7c7e32a
DM
152 regnode *emit; /* Code-emit pointer; if = &emit_dummy,
153 implies compiling, so don't emit */
9a81a976
KW
154 regnode_ssc emit_dummy; /* placeholder for emit to point to;
155 large enough for the largest
156 non-EXACTish node, so can use it as
157 scratch in pass1 */
830247a4
IZ
158 I32 naughty; /* How bad is this pattern? */
159 I32 sawback; /* Did we see \1, ...? */
160 U32 seen;
ea3daa5d 161 SSize_t size; /* Code size. */
538e84ed
KW
162 I32 npar; /* Capture buffer count, (OPEN) plus
163 one. ("par" 0 is the whole
164 pattern)*/
165 I32 nestroot; /* root parens we are in - used by
166 accept */
830247a4
IZ
167 I32 extralen;
168 I32 seen_zerolen;
40d049e4
YO
169 regnode **open_parens; /* pointers to open parens */
170 regnode **close_parens; /* pointers to close parens */
171 regnode *opend; /* END node in program */
02daf0ab
YO
172 I32 utf8; /* whether the pattern is utf8 or not */
173 I32 orig_utf8; /* whether the pattern was originally in utf8 */
174 /* XXX use this for future optimisation of case
175 * where pattern must be upgraded to utf8. */
e40e74fe
KW
176 I32 uni_semantics; /* If a d charset modifier should use unicode
177 rules, even if the pattern is not in
178 utf8 */
81714fb9 179 HV *paren_names; /* Paren names */
538e84ed 180
40d049e4
YO
181 regnode **recurse; /* Recurse regops */
182 I32 recurse_count; /* Number of recurse regops */
4286711a 183 U8 *study_chunk_recursed; /* bitmap of which subs we have moved
538e84ed 184 through */
09a65838 185 U32 study_chunk_recursed_bytes; /* bytes in bitmap */
b57e4118 186 I32 in_lookbehind;
4624b182 187 I32 contains_locale;
cfafade5 188 I32 contains_i;
bb3f3ed2 189 I32 override_recoding;
b6d67071
KW
190#ifdef EBCDIC
191 I32 recode_x_to_native;
192#endif
9d53c457 193 I32 in_multi_char_class;
3d2bd50a 194 struct reg_code_block *code_blocks; /* positions of literal (?{})
68e2671b 195 within pattern */
b1603ef8
DM
196 int num_code_blocks; /* size of code_blocks[] */
197 int code_index; /* next code_blocks[] slot */
ee273784 198 SSize_t maxlen; /* mininum possible number of chars in string to match */
3f910e62
YO
199 scan_frame *frame_head;
200 scan_frame *frame_last;
201 U32 frame_count;
dc6d7f5c 202#ifdef ADD_TO_REGEXEC
830247a4
IZ
203 char *starttry; /* -Dr: where regtry was called. */
204#define RExC_starttry (pRExC_state->starttry)
205#endif
d24ca0c5 206 SV *runtime_code_qr; /* qr with the runtime code blocks */
3dab1dad 207#ifdef DEBUGGING
be8e71aa 208 const char *lastparse;
3dab1dad 209 I32 lastnum;
1f1031fe 210 AV *paren_name_list; /* idx -> name */
d9a72fcc 211 U32 study_chunk_recursed_count;
c9f0d54c
YO
212 SV *mysv1;
213 SV *mysv2;
3dab1dad
YO
214#define RExC_lastparse (pRExC_state->lastparse)
215#define RExC_lastnum (pRExC_state->lastnum)
1f1031fe 216#define RExC_paren_name_list (pRExC_state->paren_name_list)
d9a72fcc 217#define RExC_study_chunk_recursed_count (pRExC_state->study_chunk_recursed_count)
c9f0d54c
YO
218#define RExC_mysv (pRExC_state->mysv1)
219#define RExC_mysv1 (pRExC_state->mysv1)
220#define RExC_mysv2 (pRExC_state->mysv2)
221
3dab1dad 222#endif
512c0f5a 223 bool seen_unfolded_sharp_s;
911bd04e 224 bool strict;
09b2b2e6 225};
830247a4 226
e2509266 227#define RExC_flags (pRExC_state->flags)
514a91f1 228#define RExC_pm_flags (pRExC_state->pm_flags)
830247a4 229#define RExC_precomp (pRExC_state->precomp)
285b5ca0
KW
230#define RExC_precomp_adj (pRExC_state->precomp_adj)
231#define RExC_adjusted_start (pRExC_state->adjusted_start)
711b303b 232#define RExC_precomp_end (pRExC_state->precomp_end)
288b8c02 233#define RExC_rx_sv (pRExC_state->rx_sv)
830247a4 234#define RExC_rx (pRExC_state->rx)
f8fc2ecf 235#define RExC_rxi (pRExC_state->rxi)
fac92740 236#define RExC_start (pRExC_state->start)
830247a4
IZ
237#define RExC_end (pRExC_state->end)
238#define RExC_parse (pRExC_state->parse)
239#define RExC_whilem_seen (pRExC_state->whilem_seen)
512c0f5a
KW
240
241/* Set during the sizing pass when there is a LATIN SMALL LETTER SHARP S in any
242 * EXACTF node, hence was parsed under /di rules. If later in the parse,
243 * something forces the pattern into using /ui rules, the sharp s should be
244 * folded into the sequence 'ss', which takes up more space than previously
245 * calculated. This means that the sizing pass needs to be restarted. (The
246 * node also becomes an EXACTFU_SS.) For all other characters, an EXACTF node
247 * that gets converted to /ui (and EXACTFU) occupies the same amount of space,
248 * so there is no need to resize [perl #125990]. */
249#define RExC_seen_unfolded_sharp_s (pRExC_state->seen_unfolded_sharp_s)
250
7122b237 251#ifdef RE_TRACK_PATTERN_OFFSETS
538e84ed
KW
252#define RExC_offsets (pRExC_state->rxi->u.offsets) /* I am not like the
253 others */
7122b237 254#endif
830247a4 255#define RExC_emit (pRExC_state->emit)
f7c7e32a 256#define RExC_emit_dummy (pRExC_state->emit_dummy)
fac92740 257#define RExC_emit_start (pRExC_state->emit_start)
3b57cd43 258#define RExC_emit_bound (pRExC_state->emit_bound)
830247a4
IZ
259#define RExC_sawback (pRExC_state->sawback)
260#define RExC_seen (pRExC_state->seen)
261#define RExC_size (pRExC_state->size)
ee273784 262#define RExC_maxlen (pRExC_state->maxlen)
830247a4 263#define RExC_npar (pRExC_state->npar)
e2e6a0f1 264#define RExC_nestroot (pRExC_state->nestroot)
830247a4
IZ
265#define RExC_extralen (pRExC_state->extralen)
266#define RExC_seen_zerolen (pRExC_state->seen_zerolen)
1aa99e6b 267#define RExC_utf8 (pRExC_state->utf8)
e40e74fe 268#define RExC_uni_semantics (pRExC_state->uni_semantics)
02daf0ab 269#define RExC_orig_utf8 (pRExC_state->orig_utf8)
40d049e4
YO
270#define RExC_open_parens (pRExC_state->open_parens)
271#define RExC_close_parens (pRExC_state->close_parens)
272#define RExC_opend (pRExC_state->opend)
81714fb9 273#define RExC_paren_names (pRExC_state->paren_names)
40d049e4
YO
274#define RExC_recurse (pRExC_state->recurse)
275#define RExC_recurse_count (pRExC_state->recurse_count)
09a65838 276#define RExC_study_chunk_recursed (pRExC_state->study_chunk_recursed)
538e84ed
KW
277#define RExC_study_chunk_recursed_bytes \
278 (pRExC_state->study_chunk_recursed_bytes)
b57e4118 279#define RExC_in_lookbehind (pRExC_state->in_lookbehind)
4624b182 280#define RExC_contains_locale (pRExC_state->contains_locale)
cfafade5 281#define RExC_contains_i (pRExC_state->contains_i)
9d53c457 282#define RExC_override_recoding (pRExC_state->override_recoding)
b6d67071
KW
283#ifdef EBCDIC
284# define RExC_recode_x_to_native (pRExC_state->recode_x_to_native)
285#endif
9d53c457 286#define RExC_in_multi_char_class (pRExC_state->in_multi_char_class)
3f910e62
YO
287#define RExC_frame_head (pRExC_state->frame_head)
288#define RExC_frame_last (pRExC_state->frame_last)
289#define RExC_frame_count (pRExC_state->frame_count)
67cdf558 290#define RExC_strict (pRExC_state->strict)
830247a4 291
99807a43
HS
292/* Heuristic check on the complexity of the pattern: if TOO_NAUGHTY, we set
293 * a flag to disable back-off on the fixed/floating substrings - if it's
294 * a high complexity pattern we assume the benefit of avoiding a full match
295 * is worth the cost of checking for the substrings even if they rarely help.
296 */
297#define RExC_naughty (pRExC_state->naughty)
298#define TOO_NAUGHTY (10)
299#define MARK_NAUGHTY(add) \
300 if (RExC_naughty < TOO_NAUGHTY) \
301 RExC_naughty += (add)
302#define MARK_NAUGHTY_EXP(exp, add) \
303 if (RExC_naughty < TOO_NAUGHTY) \
304 RExC_naughty += RExC_naughty / (exp) + (add)
cde0cee5 305
a687059c
LW
306#define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?')
307#define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
412f55bb 308 ((*s) == '{' && regcurly(s)))
a687059c
LW
309
310/*
311 * Flags to be passed up and down.
312 */
a687059c 313#define WORST 0 /* Worst case. */
a3b492c3 314#define HASWIDTH 0x01 /* Known to match non-null strings. */
fda99bee 315
e64f369d 316/* Simple enough to be STAR/PLUS operand; in an EXACTish node must be a single
2fd92675
KW
317 * character. (There needs to be a case: in the switch statement in regexec.c
318 * for any node marked SIMPLE.) Note that this is not the same thing as
319 * REGNODE_SIMPLE */
fda99bee 320#define SIMPLE 0x02
e64f369d 321#define SPSTART 0x04 /* Starts with * or + */
8d9c2815
NC
322#define POSTPONED 0x08 /* (?1),(?&name), (??{...}) or similar */
323#define TRYAGAIN 0x10 /* Weeded out a declaration. */
b97943f7
KW
324#define RESTART_PASS1 0x20 /* Need to restart sizing pass */
325#define NEED_UTF8 0x40 /* In conjunction with RESTART_PASS1, need to
326 calcuate sizes as UTF-8 */
a687059c 327
3dab1dad
YO
328#define REG_NODE_NUM(x) ((x) ? (int)((x)-RExC_emit_start) : -1)
329
07be1b83
YO
330/* whether trie related optimizations are enabled */
331#if PERL_ENABLE_EXTENDED_TRIE_OPTIMISATION
332#define TRIE_STUDY_OPT
786e8c11 333#define FULL_TRIE_STUDY
07be1b83
YO
334#define TRIE_STCLASS
335#endif
1de06328
YO
336
337
40d049e4
YO
338
339#define PBYTE(u8str,paren) ((U8*)(u8str))[(paren) >> 3]
340#define PBITVAL(paren) (1 << ((paren) & 7))
341#define PAREN_TEST(u8str,paren) ( PBYTE(u8str,paren) & PBITVAL(paren))
342#define PAREN_SET(u8str,paren) PBYTE(u8str,paren) |= PBITVAL(paren)
343#define PAREN_UNSET(u8str,paren) PBYTE(u8str,paren) &= (~PBITVAL(paren))
344
82a6ada4 345#define REQUIRE_UTF8(flagp) STMT_START { \
8d9c2815 346 if (!UTF) { \
82a6ada4
KW
347 assert(PASS1); \
348 *flagp = RESTART_PASS1|NEED_UTF8; \
8d9c2815
NC
349 return NULL; \
350 } \
82a6ada4 351 } STMT_END
40d049e4 352
512c0f5a
KW
353/* Change from /d into /u rules, and restart the parse if we've already seen
354 * something whose size would increase as a result, by setting *flagp and
355 * returning 'restart_retval'. RExC_uni_semantics is a flag that indicates
356 * we've change to /u during the parse. */
357#define REQUIRE_UNI_RULES(flagp, restart_retval) \
358 STMT_START { \
359 if (DEPENDS_SEMANTICS) { \
360 assert(PASS1); \
361 set_regex_charset(&RExC_flags, REGEX_UNICODE_CHARSET); \
362 RExC_uni_semantics = 1; \
363 if (RExC_seen_unfolded_sharp_s) { \
364 *flagp |= RESTART_PASS1; \
365 return restart_retval; \
366 } \
367 } \
368 } STMT_END
369
f19b1a63
KW
370/* This converts the named class defined in regcomp.h to its equivalent class
371 * number defined in handy.h. */
372#define namedclass_to_classnum(class) ((int) ((class) / 2))
373#define classnum_to_namedclass(classnum) ((classnum) * 2)
374
de92f5e6
KW
375#define _invlist_union_complement_2nd(a, b, output) \
376 _invlist_union_maybe_complement_2nd(a, b, TRUE, output)
377#define _invlist_intersection_complement_2nd(a, b, output) \
378 _invlist_intersection_maybe_complement_2nd(a, b, TRUE, output)
379
1de06328
YO
380/* About scan_data_t.
381
382 During optimisation we recurse through the regexp program performing
383 various inplace (keyhole style) optimisations. In addition study_chunk
384 and scan_commit populate this data structure with information about
538e84ed 385 what strings MUST appear in the pattern. We look for the longest
3b753521 386 string that must appear at a fixed location, and we look for the
1de06328
YO
387 longest string that may appear at a floating location. So for instance
388 in the pattern:
538e84ed 389
1de06328 390 /FOO[xX]A.*B[xX]BAR/
538e84ed 391
1de06328
YO
392 Both 'FOO' and 'A' are fixed strings. Both 'B' and 'BAR' are floating
393 strings (because they follow a .* construct). study_chunk will identify
394 both FOO and BAR as being the longest fixed and floating strings respectively.
538e84ed 395
1de06328 396 The strings can be composites, for instance
538e84ed 397
1de06328 398 /(f)(o)(o)/
538e84ed 399
1de06328 400 will result in a composite fixed substring 'foo'.
538e84ed 401
1de06328 402 For each string some basic information is maintained:
538e84ed 403
1de06328
YO
404 - offset or min_offset
405 This is the position the string must appear at, or not before.
406 It also implicitly (when combined with minlenp) tells us how many
3b753521
FN
407 characters must match before the string we are searching for.
408 Likewise when combined with minlenp and the length of the string it
538e84ed 409 tells us how many characters must appear after the string we have
1de06328 410 found.
538e84ed 411
1de06328
YO
412 - max_offset
413 Only used for floating strings. This is the rightmost point that
ea3daa5d 414 the string can appear at. If set to SSize_t_MAX it indicates that the
1de06328 415 string can occur infinitely far to the right.
538e84ed 416
1de06328 417 - minlenp
2d608413
KW
418 A pointer to the minimum number of characters of the pattern that the
419 string was found inside. This is important as in the case of positive
538e84ed 420 lookahead or positive lookbehind we can have multiple patterns
1de06328 421 involved. Consider
538e84ed 422
1de06328 423 /(?=FOO).*F/
538e84ed 424
1de06328
YO
425 The minimum length of the pattern overall is 3, the minimum length
426 of the lookahead part is 3, but the minimum length of the part that
538e84ed 427 will actually match is 1. So 'FOO's minimum length is 3, but the
1de06328 428 minimum length for the F is 1. This is important as the minimum length
538e84ed 429 is used to determine offsets in front of and behind the string being
1de06328 430 looked for. Since strings can be composites this is the length of the
486ec47a 431 pattern at the time it was committed with a scan_commit. Note that
1de06328 432 the length is calculated by study_chunk, so that the minimum lengths
538e84ed 433 are not known until the full pattern has been compiled, thus the
1de06328 434 pointer to the value.
538e84ed 435
1de06328 436 - lookbehind
538e84ed 437
1de06328 438 In the case of lookbehind the string being searched for can be
538e84ed 439 offset past the start point of the final matching string.
1de06328
YO
440 If this value was just blithely removed from the min_offset it would
441 invalidate some of the calculations for how many chars must match
442 before or after (as they are derived from min_offset and minlen and
538e84ed 443 the length of the string being searched for).
1de06328
YO
444 When the final pattern is compiled and the data is moved from the
445 scan_data_t structure into the regexp structure the information
538e84ed
KW
446 about lookbehind is factored in, with the information that would
447 have been lost precalculated in the end_shift field for the
1de06328
YO
448 associated string.
449
450 The fields pos_min and pos_delta are used to store the minimum offset
538e84ed 451 and the delta to the maximum offset at the current point in the pattern.
1de06328
YO
452
453*/
2c2d71f5
JH
454
455typedef struct scan_data_t {
1de06328
YO
456 /*I32 len_min; unused */
457 /*I32 len_delta; unused */
49f55535 458 SSize_t pos_min;
ea3daa5d 459 SSize_t pos_delta;
2c2d71f5 460 SV *last_found;
ea3daa5d 461 SSize_t last_end; /* min value, <0 unless valid. */
49f55535 462 SSize_t last_start_min;
ea3daa5d 463 SSize_t last_start_max;
1de06328
YO
464 SV **longest; /* Either &l_fixed, or &l_float. */
465 SV *longest_fixed; /* longest fixed string found in pattern */
49f55535 466 SSize_t offset_fixed; /* offset where it starts */
ea3daa5d 467 SSize_t *minlen_fixed; /* pointer to the minlen relevant to the string */
1de06328
YO
468 I32 lookbehind_fixed; /* is the position of the string modfied by LB */
469 SV *longest_float; /* longest floating string found in pattern */
49f55535 470 SSize_t offset_float_min; /* earliest point in string it can appear */
ea3daa5d
FC
471 SSize_t offset_float_max; /* latest point in string it can appear */
472 SSize_t *minlen_float; /* pointer to the minlen relevant to the string */
49f55535 473 SSize_t lookbehind_float; /* is the pos of the string modified by LB */
2c2d71f5
JH
474 I32 flags;
475 I32 whilem_c;
49f55535 476 SSize_t *last_closep;
b8f7bb16 477 regnode_ssc *start_class;
2c2d71f5
JH
478} scan_data_t;
479
a687059c 480/*
e50aee73 481 * Forward declarations for pregcomp()'s friends.
a687059c 482 */
a0d0e21e 483
27da23d5 484static const scan_data_t zero_scan_data =
1de06328 485 { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ,0};
c277df42
IZ
486
487#define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
07be1b83
YO
488#define SF_BEFORE_SEOL 0x0001
489#define SF_BEFORE_MEOL 0x0002
c277df42
IZ
490#define SF_FIX_BEFORE_EOL (SF_FIX_BEFORE_SEOL|SF_FIX_BEFORE_MEOL)
491#define SF_FL_BEFORE_EOL (SF_FL_BEFORE_SEOL|SF_FL_BEFORE_MEOL)
492
44e3dfd2
BF
493#define SF_FIX_SHIFT_EOL (+2)
494#define SF_FL_SHIFT_EOL (+4)
c277df42
IZ
495
496#define SF_FIX_BEFORE_SEOL (SF_BEFORE_SEOL << SF_FIX_SHIFT_EOL)
497#define SF_FIX_BEFORE_MEOL (SF_BEFORE_MEOL << SF_FIX_SHIFT_EOL)
498
499#define SF_FL_BEFORE_SEOL (SF_BEFORE_SEOL << SF_FL_SHIFT_EOL)
500#define SF_FL_BEFORE_MEOL (SF_BEFORE_MEOL << SF_FL_SHIFT_EOL) /* 0x20 */
07be1b83
YO
501#define SF_IS_INF 0x0040
502#define SF_HAS_PAR 0x0080
503#define SF_IN_PAR 0x0100
504#define SF_HAS_EVAL 0x0200
505#define SCF_DO_SUBSTR 0x0400
653099ff
GS
506#define SCF_DO_STCLASS_AND 0x0800
507#define SCF_DO_STCLASS_OR 0x1000
508#define SCF_DO_STCLASS (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR)
e1901655 509#define SCF_WHILEM_VISITED_POS 0x2000
c277df42 510
786e8c11 511#define SCF_TRIE_RESTUDY 0x4000 /* Do restudy? */
538e84ed 512#define SCF_SEEN_ACCEPT 0x8000
688e0391 513#define SCF_TRIE_DOING_RESTUDY 0x10000
4286711a
YO
514#define SCF_IN_DEFINE 0x20000
515
516
517
07be1b83 518
43fead97 519#define UTF cBOOL(RExC_utf8)
00b27cfc
KW
520
521/* The enums for all these are ordered so things work out correctly */
a62b1201 522#define LOC (get_regex_charset(RExC_flags) == REGEX_LOCALE_CHARSET)
538e84ed
KW
523#define DEPENDS_SEMANTICS (get_regex_charset(RExC_flags) \
524 == REGEX_DEPENDS_CHARSET)
00b27cfc 525#define UNI_SEMANTICS (get_regex_charset(RExC_flags) == REGEX_UNICODE_CHARSET)
538e84ed
KW
526#define AT_LEAST_UNI_SEMANTICS (get_regex_charset(RExC_flags) \
527 >= REGEX_UNICODE_CHARSET)
528#define ASCII_RESTRICTED (get_regex_charset(RExC_flags) \
529 == REGEX_ASCII_RESTRICTED_CHARSET)
530#define AT_LEAST_ASCII_RESTRICTED (get_regex_charset(RExC_flags) \
531 >= REGEX_ASCII_RESTRICTED_CHARSET)
532#define ASCII_FOLD_RESTRICTED (get_regex_charset(RExC_flags) \
533 == REGEX_ASCII_MORE_RESTRICTED_CHARSET)
a62b1201 534
43fead97 535#define FOLD cBOOL(RExC_flags & RXf_PMf_FOLD)
a0ed51b3 536
f2c2a6ab
KW
537/* For programs that want to be strictly Unicode compatible by dying if any
538 * attempt is made to match a non-Unicode code point against a Unicode
539 * property. */
540#define ALWAYS_WARN_SUPER ckDEAD(packWARN(WARN_NON_UNICODE))
541
93733859 542#define OOB_NAMEDCLASS -1
b8c5462f 543
8e661ac5
KW
544/* There is no code point that is out-of-bounds, so this is problematic. But
545 * its only current use is to initialize a variable that is always set before
546 * looked at. */
547#define OOB_UNICODE 0xDEADBEEF
548
a0ed51b3
LW
549#define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
550#define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
551
8615cb43 552
b45f050a
JF
553/* length of regex to show in messages that don't mark a position within */
554#define RegexLengthToShowInErrorMessages 127
555
556/*
557 * If MARKER[12] are adjusted, be sure to adjust the constants at the top
558 * of t/op/regmesg.t, the tests in t/op/re_tests, and those in
559 * op/pragma/warn/regcomp.
560 */
7253e4e3
RK
561#define MARKER1 "<-- HERE" /* marker as it appears in the description */
562#define MARKER2 " <-- HERE " /* marker as it appears within the regex */
b81d288d 563
538e84ed
KW
564#define REPORT_LOCATION " in regex; marked by " MARKER1 \
565 " in m/%"UTF8f MARKER2 "%"UTF8f"/"
b45f050a 566
285b5ca0
KW
567/* The code in this file in places uses one level of recursion with parsing
568 * rebased to an alternate string constructed by us in memory. This can take
569 * the form of something that is completely different from the input, or
570 * something that uses the input as part of the alternate. In the first case,
571 * there should be no possibility of an error, as we are in complete control of
572 * the alternate string. But in the second case we don't control the input
573 * portion, so there may be errors in that. Here's an example:
574 * /[abc\x{DF}def]/ui
575 * is handled specially because \x{df} folds to a sequence of more than one
576 * character, 'ss'. What is done is to create and parse an alternate string,
577 * which looks like this:
578 * /(?:\x{DF}|[abc\x{DF}def])/ui
579 * where it uses the input unchanged in the middle of something it constructs,
580 * which is a branch for the DF outside the character class, and clustering
581 * parens around the whole thing. (It knows enough to skip the DF inside the
582 * class while in this substitute parse.) 'abc' and 'def' may have errors that
583 * need to be reported. The general situation looks like this:
584 *
585 * sI tI xI eI
586 * Input: ----------------------------------------------------
587 * Constructed: ---------------------------------------------------
588 * sC tC xC eC EC
589 *
590 * The input string sI..eI is the input pattern. The string sC..EC is the
591 * constructed substitute parse string. The portions sC..tC and eC..EC are
592 * constructed by us. The portion tC..eC is an exact duplicate of the input
593 * pattern tI..eI. In the diagram, these are vertically aligned. Suppose that
594 * while parsing, we find an error at xC. We want to display a message showing
595 * the real input string. Thus we need to find the point xI in it which
596 * corresponds to xC. xC >= tC, since the portion of the string sC..tC has
597 * been constructed by us, and so shouldn't have errors. We get:
598 *
599 * xI = sI + (tI - sI) + (xC - tC)
600 *
601 * and, the offset into sI is:
602 *
603 * (xI - sI) = (tI - sI) + (xC - tC)
604 *
605 * When the substitute is constructed, we save (tI -sI) as RExC_precomp_adj,
606 * and we save tC as RExC_adjusted_start.
903c858a
KW
607 *
608 * During normal processing of the input pattern, everything points to that,
609 * with RExC_precomp_adj set to 0, and RExC_adjusted_start set to sI.
285b5ca0
KW
610 */
611
612#define tI_sI RExC_precomp_adj
613#define tC RExC_adjusted_start
614#define sC RExC_precomp
615#define xI_offset(xC) ((IV) (tI_sI + (xC - tC)))
616#define xI(xC) (sC + xI_offset(xC))
617#define eC RExC_precomp_end
618
619#define REPORT_LOCATION_ARGS(xC) \
620 UTF8fARG(UTF, \
621 (xI(xC) > eC) /* Don't run off end */ \
622 ? eC - sC /* Length before the <--HERE */ \
623 : xI_offset(xC), \
624 sC), /* The input pattern printed up to the <--HERE */ \
625 UTF8fARG(UTF, \
626 (xI(xC) > eC) ? 0 : eC - xI(xC), /* Length after <--HERE */ \
627 (xI(xC) > eC) ? eC : xI(xC)) /* pattern after <--HERE */
c1d900c3 628
8a6d8ec6
HS
629/* Used to point after bad bytes for an error message, but avoid skipping
630 * past a nul byte. */
631#define SKIP_IF_CHAR(s) (!*(s) ? 0 : UTF ? UTF8SKIP(s) : 1)
632
b45f050a
JF
633/*
634 * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
635 * arg. Show regex, up to a maximum length. If it's too long, chop and add
636 * "...".
637 */
58e23c8d 638#define _FAIL(code) STMT_START { \
bfed75c6 639 const char *ellipses = ""; \
711b303b 640 IV len = RExC_precomp_end - RExC_precomp; \
ccb2c380
MP
641 \
642 if (!SIZE_ONLY) \
a5e7bc51 643 SAVEFREESV(RExC_rx_sv); \
ccb2c380
MP
644 if (len > RegexLengthToShowInErrorMessages) { \
645 /* chop 10 shorter than the max, to ensure meaning of "..." */ \
646 len = RegexLengthToShowInErrorMessages - 10; \
647 ellipses = "..."; \
648 } \
58e23c8d 649 code; \
ccb2c380 650} STMT_END
8615cb43 651
58e23c8d 652#define FAIL(msg) _FAIL( \
c1d900c3
BF
653 Perl_croak(aTHX_ "%s in regex m/%"UTF8f"%s/", \
654 msg, UTF8fARG(UTF, len, RExC_precomp), ellipses))
58e23c8d
YO
655
656#define FAIL2(msg,arg) _FAIL( \
c1d900c3
BF
657 Perl_croak(aTHX_ msg " in regex m/%"UTF8f"%s/", \
658 arg, UTF8fARG(UTF, len, RExC_precomp), ellipses))
58e23c8d 659
b45f050a 660/*
b45f050a
JF
661 * Simple_vFAIL -- like FAIL, but marks the current location in the scan
662 */
ccb2c380 663#define Simple_vFAIL(m) STMT_START { \
ccb2c380 664 Perl_croak(aTHX_ "%s" REPORT_LOCATION, \
d528642a 665 m, REPORT_LOCATION_ARGS(RExC_parse)); \
ccb2c380 666} STMT_END
b45f050a
JF
667
668/*
669 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL()
670 */
ccb2c380
MP
671#define vFAIL(m) STMT_START { \
672 if (!SIZE_ONLY) \
a5e7bc51 673 SAVEFREESV(RExC_rx_sv); \
ccb2c380
MP
674 Simple_vFAIL(m); \
675} STMT_END
b45f050a
JF
676
677/*
678 * Like Simple_vFAIL(), but accepts two arguments.
679 */
ccb2c380 680#define Simple_vFAIL2(m,a1) STMT_START { \
d528642a
KW
681 S_re_croak2(aTHX_ UTF, m, REPORT_LOCATION, a1, \
682 REPORT_LOCATION_ARGS(RExC_parse)); \
ccb2c380 683} STMT_END
b45f050a
JF
684
685/*
686 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL2().
687 */
ccb2c380
MP
688#define vFAIL2(m,a1) STMT_START { \
689 if (!SIZE_ONLY) \
a5e7bc51 690 SAVEFREESV(RExC_rx_sv); \
ccb2c380
MP
691 Simple_vFAIL2(m, a1); \
692} STMT_END
b45f050a
JF
693
694
695/*
696 * Like Simple_vFAIL(), but accepts three arguments.
697 */
ccb2c380 698#define Simple_vFAIL3(m, a1, a2) STMT_START { \
c1d900c3 699 S_re_croak2(aTHX_ UTF, m, REPORT_LOCATION, a1, a2, \
d528642a 700 REPORT_LOCATION_ARGS(RExC_parse)); \
ccb2c380 701} STMT_END
b45f050a
JF
702
703/*
704 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL3().
705 */
ccb2c380
MP
706#define vFAIL3(m,a1,a2) STMT_START { \
707 if (!SIZE_ONLY) \
a5e7bc51 708 SAVEFREESV(RExC_rx_sv); \
ccb2c380
MP
709 Simple_vFAIL3(m, a1, a2); \
710} STMT_END
b45f050a
JF
711
712/*
713 * Like Simple_vFAIL(), but accepts four arguments.
714 */
ccb2c380 715#define Simple_vFAIL4(m, a1, a2, a3) STMT_START { \
d528642a
KW
716 S_re_croak2(aTHX_ UTF, m, REPORT_LOCATION, a1, a2, a3, \
717 REPORT_LOCATION_ARGS(RExC_parse)); \
ccb2c380 718} STMT_END
b45f050a 719
95db3ffa
KW
720#define vFAIL4(m,a1,a2,a3) STMT_START { \
721 if (!SIZE_ONLY) \
722 SAVEFREESV(RExC_rx_sv); \
723 Simple_vFAIL4(m, a1, a2, a3); \
724} STMT_END
725
946095af 726/* A specialized version of vFAIL2 that works with UTF8f */
d528642a
KW
727#define vFAIL2utf8f(m, a1) STMT_START { \
728 if (!SIZE_ONLY) \
729 SAVEFREESV(RExC_rx_sv); \
730 S_re_croak2(aTHX_ UTF, m, REPORT_LOCATION, a1, \
731 REPORT_LOCATION_ARGS(RExC_parse)); \
946095af
BF
732} STMT_END
733
3ba22297 734#define vFAIL3utf8f(m, a1, a2) STMT_START { \
3ba22297
KW
735 if (!SIZE_ONLY) \
736 SAVEFREESV(RExC_rx_sv); \
737 S_re_croak2(aTHX_ UTF, m, REPORT_LOCATION, a1, a2, \
d528642a 738 REPORT_LOCATION_ARGS(RExC_parse)); \
3ba22297
KW
739} STMT_END
740
499333dc
KW
741/* These have asserts in them because of [perl #122671] Many warnings in
742 * regcomp.c can occur twice. If they get output in pass1 and later in that
743 * pass, the pattern has to be converted to UTF-8 and the pass restarted, they
744 * would get output again. So they should be output in pass2, and these
745 * asserts make sure new warnings follow that paradigm. */
946095af 746
5e0a247b
KW
747/* m is not necessarily a "literal string", in this macro */
748#define reg_warn_non_literal_string(loc, m) STMT_START { \
d528642a
KW
749 __ASSERT_(PASS2) Perl_warner(aTHX_ packWARN(WARN_REGEXP), \
750 "%s" REPORT_LOCATION, \
751 m, REPORT_LOCATION_ARGS(loc)); \
5e0a247b
KW
752} STMT_END
753
668c081a 754#define ckWARNreg(loc,m) STMT_START { \
d528642a
KW
755 __ASSERT_(PASS2) Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \
756 m REPORT_LOCATION, \
757 REPORT_LOCATION_ARGS(loc)); \
ccb2c380
MP
758} STMT_END
759
b927b7e9 760#define vWARN(loc, m) STMT_START { \
d528642a
KW
761 __ASSERT_(PASS2) Perl_warner(aTHX_ packWARN(WARN_REGEXP), \
762 m REPORT_LOCATION, \
763 REPORT_LOCATION_ARGS(loc)); \
b927b7e9
KW
764} STMT_END
765
0d6106aa 766#define vWARN_dep(loc, m) STMT_START { \
d528642a
KW
767 __ASSERT_(PASS2) Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), \
768 m REPORT_LOCATION, \
769 REPORT_LOCATION_ARGS(loc)); \
0d6106aa
KW
770} STMT_END
771
147508a2 772#define ckWARNdep(loc,m) STMT_START { \
d528642a
KW
773 __ASSERT_(PASS2) Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), \
774 m REPORT_LOCATION, \
775 REPORT_LOCATION_ARGS(loc)); \
147508a2
KW
776} STMT_END
777
d528642a
KW
778#define ckWARNregdep(loc,m) STMT_START { \
779 __ASSERT_(PASS2) Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, \
780 WARN_REGEXP), \
781 m REPORT_LOCATION, \
782 REPORT_LOCATION_ARGS(loc)); \
ccb2c380
MP
783} STMT_END
784
d528642a
KW
785#define ckWARN2reg_d(loc,m, a1) STMT_START { \
786 __ASSERT_(PASS2) Perl_ck_warner_d(aTHX_ packWARN(WARN_REGEXP), \
787 m REPORT_LOCATION, \
788 a1, REPORT_LOCATION_ARGS(loc)); \
2335b3d3
KW
789} STMT_END
790
d528642a
KW
791#define ckWARN2reg(loc, m, a1) STMT_START { \
792 __ASSERT_(PASS2) Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \
793 m REPORT_LOCATION, \
794 a1, REPORT_LOCATION_ARGS(loc)); \
ccb2c380
MP
795} STMT_END
796
d528642a
KW
797#define vWARN3(loc, m, a1, a2) STMT_START { \
798 __ASSERT_(PASS2) Perl_warner(aTHX_ packWARN(WARN_REGEXP), \
799 m REPORT_LOCATION, \
800 a1, a2, REPORT_LOCATION_ARGS(loc)); \
ccb2c380
MP
801} STMT_END
802
d528642a
KW
803#define ckWARN3reg(loc, m, a1, a2) STMT_START { \
804 __ASSERT_(PASS2) Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \
805 m REPORT_LOCATION, \
806 a1, a2, \
807 REPORT_LOCATION_ARGS(loc)); \
668c081a
NC
808} STMT_END
809
ccb2c380 810#define vWARN4(loc, m, a1, a2, a3) STMT_START { \
d528642a
KW
811 __ASSERT_(PASS2) Perl_warner(aTHX_ packWARN(WARN_REGEXP), \
812 m REPORT_LOCATION, \
813 a1, a2, a3, \
814 REPORT_LOCATION_ARGS(loc)); \
ccb2c380
MP
815} STMT_END
816
668c081a 817#define ckWARN4reg(loc, m, a1, a2, a3) STMT_START { \
d528642a
KW
818 __ASSERT_(PASS2) Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \
819 m REPORT_LOCATION, \
820 a1, a2, a3, \
821 REPORT_LOCATION_ARGS(loc)); \
668c081a
NC
822} STMT_END
823
ccb2c380 824#define vWARN5(loc, m, a1, a2, a3, a4) STMT_START { \
d528642a
KW
825 __ASSERT_(PASS2) Perl_warner(aTHX_ packWARN(WARN_REGEXP), \
826 m REPORT_LOCATION, \
827 a1, a2, a3, a4, \
828 REPORT_LOCATION_ARGS(loc)); \
ccb2c380 829} STMT_END
9d1d55b5 830
538e84ed 831/* Macros for recording node offsets. 20001227 mjd@plover.com
fac92740
MJD
832 * Nodes are numbered 1, 2, 3, 4. Node #n's position is recorded in
833 * element 2*n-1 of the array. Element #2n holds the byte length node #n.
834 * Element 0 holds the number n.
07be1b83 835 * Position is 1 indexed.
fac92740 836 */
7122b237
YO
837#ifndef RE_TRACK_PATTERN_OFFSETS
838#define Set_Node_Offset_To_R(node,byte)
839#define Set_Node_Offset(node,byte)
840#define Set_Cur_Node_Offset
841#define Set_Node_Length_To_R(node,len)
842#define Set_Node_Length(node,len)
6a86c6ad 843#define Set_Node_Cur_Length(node,start)
538e84ed
KW
844#define Node_Offset(n)
845#define Node_Length(n)
7122b237
YO
846#define Set_Node_Offset_Length(node,offset,len)
847#define ProgLen(ri) ri->u.proglen
848#define SetProgLen(ri,x) ri->u.proglen = x
849#else
850#define ProgLen(ri) ri->u.offsets[0]
851#define SetProgLen(ri,x) ri->u.offsets[0] = x
ccb2c380
MP
852#define Set_Node_Offset_To_R(node,byte) STMT_START { \
853 if (! SIZE_ONLY) { \
854 MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n", \
2a49f0f5 855 __LINE__, (int)(node), (int)(byte))); \
ccb2c380 856 if((node) < 0) { \
538e84ed
KW
857 Perl_croak(aTHX_ "value of node is %d in Offset macro", \
858 (int)(node)); \
ccb2c380
MP
859 } else { \
860 RExC_offsets[2*(node)-1] = (byte); \
861 } \
862 } \
863} STMT_END
864
865#define Set_Node_Offset(node,byte) \
866 Set_Node_Offset_To_R((node)-RExC_emit_start, (byte)-RExC_start)
867#define Set_Cur_Node_Offset Set_Node_Offset(RExC_emit, RExC_parse)
868
869#define Set_Node_Length_To_R(node,len) STMT_START { \
870 if (! SIZE_ONLY) { \
871 MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n", \
551405c4 872 __LINE__, (int)(node), (int)(len))); \
ccb2c380 873 if((node) < 0) { \
538e84ed
KW
874 Perl_croak(aTHX_ "value of node is %d in Length macro", \
875 (int)(node)); \
ccb2c380
MP
876 } else { \
877 RExC_offsets[2*(node)] = (len); \
878 } \
879 } \
880} STMT_END
881
882#define Set_Node_Length(node,len) \
883 Set_Node_Length_To_R((node)-RExC_emit_start, len)
6a86c6ad
NC
884#define Set_Node_Cur_Length(node, start) \
885 Set_Node_Length(node, RExC_parse - start)
fac92740
MJD
886
887/* Get offsets and lengths */
888#define Node_Offset(n) (RExC_offsets[2*((n)-RExC_emit_start)-1])
889#define Node_Length(n) (RExC_offsets[2*((n)-RExC_emit_start)])
890
07be1b83
YO
891#define Set_Node_Offset_Length(node,offset,len) STMT_START { \
892 Set_Node_Offset_To_R((node)-RExC_emit_start, (offset)); \
893 Set_Node_Length_To_R((node)-RExC_emit_start, (len)); \
894} STMT_END
7122b237 895#endif
07be1b83
YO
896
897#if PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS
898#define EXPERIMENTAL_INPLACESCAN
f427392e 899#endif /*PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS*/
07be1b83 900
9e9ecfdf 901#define DEBUG_RExC_seen() \
538e84ed
KW
902 DEBUG_OPTIMISE_MORE_r({ \
903 PerlIO_printf(Perl_debug_log,"RExC_seen: "); \
904 \
e384d5c1
YO
905 if (RExC_seen & REG_ZERO_LEN_SEEN) \
906 PerlIO_printf(Perl_debug_log,"REG_ZERO_LEN_SEEN "); \
538e84ed 907 \
e384d5c1
YO
908 if (RExC_seen & REG_LOOKBEHIND_SEEN) \
909 PerlIO_printf(Perl_debug_log,"REG_LOOKBEHIND_SEEN "); \
538e84ed 910 \
e384d5c1
YO
911 if (RExC_seen & REG_GPOS_SEEN) \
912 PerlIO_printf(Perl_debug_log,"REG_GPOS_SEEN "); \
538e84ed 913 \
e384d5c1
YO
914 if (RExC_seen & REG_RECURSE_SEEN) \
915 PerlIO_printf(Perl_debug_log,"REG_RECURSE_SEEN "); \
538e84ed 916 \
e384d5c1
YO
917 if (RExC_seen & REG_TOP_LEVEL_BRANCHES_SEEN) \
918 PerlIO_printf(Perl_debug_log,"REG_TOP_LEVEL_BRANCHES_SEEN "); \
538e84ed 919 \
e384d5c1
YO
920 if (RExC_seen & REG_VERBARG_SEEN) \
921 PerlIO_printf(Perl_debug_log,"REG_VERBARG_SEEN "); \
538e84ed 922 \
e384d5c1
YO
923 if (RExC_seen & REG_CUTGROUP_SEEN) \
924 PerlIO_printf(Perl_debug_log,"REG_CUTGROUP_SEEN "); \
538e84ed 925 \
e384d5c1
YO
926 if (RExC_seen & REG_RUN_ON_COMMENT_SEEN) \
927 PerlIO_printf(Perl_debug_log,"REG_RUN_ON_COMMENT_SEEN "); \
538e84ed 928 \
e384d5c1
YO
929 if (RExC_seen & REG_UNFOLDED_MULTI_SEEN) \
930 PerlIO_printf(Perl_debug_log,"REG_UNFOLDED_MULTI_SEEN "); \
538e84ed 931 \
e384d5c1
YO
932 if (RExC_seen & REG_GOSTART_SEEN) \
933 PerlIO_printf(Perl_debug_log,"REG_GOSTART_SEEN "); \
538e84ed 934 \
ee273784
YO
935 if (RExC_seen & REG_UNBOUNDED_QUANTIFIER_SEEN) \
936 PerlIO_printf(Perl_debug_log,"REG_UNBOUNDED_QUANTIFIER_SEEN "); \
937 \
538e84ed 938 PerlIO_printf(Perl_debug_log,"\n"); \
9e9ecfdf
YO
939 });
940
fdfb4f21
YO
941#define DEBUG_SHOW_STUDY_FLAG(flags,flag) \
942 if ((flags) & flag) PerlIO_printf(Perl_debug_log, "%s ", #flag)
943
944#define DEBUG_SHOW_STUDY_FLAGS(flags,open_str,close_str) \
945 if ( ( flags ) ) { \
946 PerlIO_printf(Perl_debug_log, "%s", open_str); \
947 DEBUG_SHOW_STUDY_FLAG(flags,SF_FL_BEFORE_SEOL); \
948 DEBUG_SHOW_STUDY_FLAG(flags,SF_FL_BEFORE_MEOL); \
949 DEBUG_SHOW_STUDY_FLAG(flags,SF_IS_INF); \
950 DEBUG_SHOW_STUDY_FLAG(flags,SF_HAS_PAR); \
951 DEBUG_SHOW_STUDY_FLAG(flags,SF_IN_PAR); \
952 DEBUG_SHOW_STUDY_FLAG(flags,SF_HAS_EVAL); \
953 DEBUG_SHOW_STUDY_FLAG(flags,SCF_DO_SUBSTR); \
954 DEBUG_SHOW_STUDY_FLAG(flags,SCF_DO_STCLASS_AND); \
955 DEBUG_SHOW_STUDY_FLAG(flags,SCF_DO_STCLASS_OR); \
956 DEBUG_SHOW_STUDY_FLAG(flags,SCF_DO_STCLASS); \
957 DEBUG_SHOW_STUDY_FLAG(flags,SCF_WHILEM_VISITED_POS); \
958 DEBUG_SHOW_STUDY_FLAG(flags,SCF_TRIE_RESTUDY); \
959 DEBUG_SHOW_STUDY_FLAG(flags,SCF_SEEN_ACCEPT); \
960 DEBUG_SHOW_STUDY_FLAG(flags,SCF_TRIE_DOING_RESTUDY); \
961 DEBUG_SHOW_STUDY_FLAG(flags,SCF_IN_DEFINE); \
962 PerlIO_printf(Perl_debug_log, "%s", close_str); \
963 }
964
965
304ee84b
YO
966#define DEBUG_STUDYDATA(str,data,depth) \
967DEBUG_OPTIMISE_MORE_r(if(data){ \
1de06328 968 PerlIO_printf(Perl_debug_log, \
304ee84b 969 "%*s" str "Pos:%"IVdf"/%"IVdf \
fdfb4f21 970 " Flags: 0x%"UVXf, \
1de06328
YO
971 (int)(depth)*2, "", \
972 (IV)((data)->pos_min), \
973 (IV)((data)->pos_delta), \
fdfb4f21
YO
974 (UV)((data)->flags) \
975 ); \
976 DEBUG_SHOW_STUDY_FLAGS((data)->flags," [ ","]"); \
977 PerlIO_printf(Perl_debug_log, \
978 " Whilem_c: %"IVdf" Lcp: %"IVdf" %s", \
1de06328 979 (IV)((data)->whilem_c), \
304ee84b
YO
980 (IV)((data)->last_closep ? *((data)->last_closep) : -1), \
981 is_inf ? "INF " : "" \
1de06328
YO
982 ); \
983 if ((data)->last_found) \
984 PerlIO_printf(Perl_debug_log, \
985 "Last:'%s' %"IVdf":%"IVdf"/%"IVdf" %sFixed:'%s' @ %"IVdf \
986 " %sFloat: '%s' @ %"IVdf"/%"IVdf"", \
987 SvPVX_const((data)->last_found), \
988 (IV)((data)->last_end), \
989 (IV)((data)->last_start_min), \
990 (IV)((data)->last_start_max), \
991 ((data)->longest && \
992 (data)->longest==&((data)->longest_fixed)) ? "*" : "", \
993 SvPVX_const((data)->longest_fixed), \
994 (IV)((data)->offset_fixed), \
995 ((data)->longest && \
996 (data)->longest==&((data)->longest_float)) ? "*" : "", \
997 SvPVX_const((data)->longest_float), \
998 (IV)((data)->offset_float_min), \
999 (IV)((data)->offset_float_max) \
1000 ); \
1001 PerlIO_printf(Perl_debug_log,"\n"); \
1002});
1003
c6871b76
KW
1004/* =========================================================
1005 * BEGIN edit_distance stuff.
1006 *
1007 * This calculates how many single character changes of any type are needed to
1008 * transform a string into another one. It is taken from version 3.1 of
1009 *
1010 * https://metacpan.org/pod/Text::Levenshtein::Damerau::XS
1011 */
1012
1013/* Our unsorted dictionary linked list. */
1014/* Note we use UVs, not chars. */
1015
1016struct dictionary{
1017 UV key;
1018 UV value;
1019 struct dictionary* next;
1020};
1021typedef struct dictionary item;
1022
1023
1024PERL_STATIC_INLINE item*
1025push(UV key,item* curr)
1026{
1027 item* head;
1028 Newxz(head, 1, item);
1029 head->key = key;
1030 head->value = 0;
1031 head->next = curr;
1032 return head;
1033}
1034
1035
1036PERL_STATIC_INLINE item*
1037find(item* head, UV key)
1038{
1039 item* iterator = head;
1040 while (iterator){
1041 if (iterator->key == key){
1042 return iterator;
1043 }
1044 iterator = iterator->next;
1045 }
1046
1047 return NULL;
1048}
1049
1050PERL_STATIC_INLINE item*
1051uniquePush(item* head,UV key)
1052{
1053 item* iterator = head;
1054
1055 while (iterator){
1056 if (iterator->key == key) {
1057 return head;
1058 }
1059 iterator = iterator->next;
1060 }
1061
1062 return push(key,head);
1063}
1064
1065PERL_STATIC_INLINE void
1066dict_free(item* head)
1067{
1068 item* iterator = head;
1069
1070 while (iterator) {
1071 item* temp = iterator;
1072 iterator = iterator->next;
1073 Safefree(temp);
1074 }
1075
1076 head = NULL;
1077}
1078
1079/* End of Dictionary Stuff */
1080
1081/* All calculations/work are done here */
1082STATIC int
1083S_edit_distance(const UV* src,
1084 const UV* tgt,
1085 const STRLEN x, /* length of src[] */
1086 const STRLEN y, /* length of tgt[] */
1087 const SSize_t maxDistance
1088)
1089{
1090 item *head = NULL;
1091 UV swapCount,swapScore,targetCharCount,i,j;
1092 UV *scores;
1093 UV score_ceil = x + y;
1094
1095 PERL_ARGS_ASSERT_EDIT_DISTANCE;
1096
1097 /* intialize matrix start values */
1098 Newxz(scores, ( (x + 2) * (y + 2)), UV);
1099 scores[0] = score_ceil;
1100 scores[1 * (y + 2) + 0] = score_ceil;
1101 scores[0 * (y + 2) + 1] = score_ceil;
1102 scores[1 * (y + 2) + 1] = 0;
1103 head = uniquePush(uniquePush(head,src[0]),tgt[0]);
1104
1105 /* work loops */
1106 /* i = src index */
1107 /* j = tgt index */
1108 for (i=1;i<=x;i++) {
1109 if (i < x)
1110 head = uniquePush(head,src[i]);
1111 scores[(i+1) * (y + 2) + 1] = i;
1112 scores[(i+1) * (y + 2) + 0] = score_ceil;
1113 swapCount = 0;
1114
1115 for (j=1;j<=y;j++) {
1116 if (i == 1) {
1117 if(j < y)
1118 head = uniquePush(head,tgt[j]);
1119 scores[1 * (y + 2) + (j + 1)] = j;
1120 scores[0 * (y + 2) + (j + 1)] = score_ceil;
1121 }
1122
1123 targetCharCount = find(head,tgt[j-1])->value;
1124 swapScore = scores[targetCharCount * (y + 2) + swapCount] + i - targetCharCount - 1 + j - swapCount;
1125
1126 if (src[i-1] != tgt[j-1]){
1127 scores[(i+1) * (y + 2) + (j + 1)] = MIN(swapScore,(MIN(scores[i * (y + 2) + j], MIN(scores[(i+1) * (y + 2) + j], scores[i * (y + 2) + (j + 1)])) + 1));
1128 }
1129 else {
1130 swapCount = j;
1131 scores[(i+1) * (y + 2) + (j + 1)] = MIN(scores[i * (y + 2) + j], swapScore);
1132 }
1133 }
1134
1135 find(head,src[i-1])->value = i;
1136 }
1137
1138 {
1139 IV score = scores[(x+1) * (y + 2) + (y + 1)];
1140 dict_free(head);
1141 Safefree(scores);
1142 return (maxDistance != 0 && maxDistance < score)?(-1):score;
1143 }
1144}
1145
1146/* END of edit_distance() stuff
1147 * ========================================================= */
1148
8e35b056
KW
1149/* is c a control character for which we have a mnemonic? */
1150#define isMNEMONIC_CNTRL(c) _IS_MNEMONIC_CNTRL_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c)
1151
549b4e78
KW
1152STATIC const char *
1153S_cntrl_to_mnemonic(const U8 c)
1154{
1155 /* Returns the mnemonic string that represents character 'c', if one
1156 * exists; NULL otherwise. The only ones that exist for the purposes of
1157 * this routine are a few control characters */
1158
1159 switch (c) {
1160 case '\a': return "\\a";
1161 case '\b': return "\\b";
1162 case ESC_NATIVE: return "\\e";
1163 case '\f': return "\\f";
1164 case '\n': return "\\n";
1165 case '\r': return "\\r";
1166 case '\t': return "\\t";
1167 }
1168
1169 return NULL;
1170}
1171
653099ff 1172/* Mark that we cannot extend a found fixed substring at this point.
786e8c11 1173 Update the longest found anchored substring and the longest found
653099ff
GS
1174 floating substrings if needed. */
1175
4327152a 1176STATIC void
ea3daa5d
FC
1177S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data,
1178 SSize_t *minlenp, int is_inf)
c277df42 1179{
e1ec3a88
AL
1180 const STRLEN l = CHR_SVLEN(data->last_found);
1181 const STRLEN old_l = CHR_SVLEN(*data->longest);
1de06328 1182 GET_RE_DEBUG_FLAGS_DECL;
b81d288d 1183
7918f24d
NC
1184 PERL_ARGS_ASSERT_SCAN_COMMIT;
1185
c277df42 1186 if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
6b43b216 1187 SvSetMagicSV(*data->longest, data->last_found);
c277df42
IZ
1188 if (*data->longest == data->longest_fixed) {
1189 data->offset_fixed = l ? data->last_start_min : data->pos_min;
1190 if (data->flags & SF_BEFORE_EOL)
b81d288d 1191 data->flags
c277df42
IZ
1192 |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL);
1193 else
1194 data->flags &= ~SF_FIX_BEFORE_EOL;
686b73d4 1195 data->minlen_fixed=minlenp;
1de06328 1196 data->lookbehind_fixed=0;
a0ed51b3 1197 }
304ee84b 1198 else { /* *data->longest == data->longest_float */
c277df42 1199 data->offset_float_min = l ? data->last_start_min : data->pos_min;
b81d288d 1200 data->offset_float_max = (l
646e8787
DM
1201 ? data->last_start_max
1202 : (data->pos_delta > SSize_t_MAX - data->pos_min
ea3daa5d
FC
1203 ? SSize_t_MAX
1204 : data->pos_min + data->pos_delta));
1205 if (is_inf
1206 || (STRLEN)data->offset_float_max > (STRLEN)SSize_t_MAX)
1207 data->offset_float_max = SSize_t_MAX;
c277df42 1208 if (data->flags & SF_BEFORE_EOL)
b81d288d 1209 data->flags
c277df42
IZ
1210 |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL);
1211 else
1212 data->flags &= ~SF_FL_BEFORE_EOL;
1de06328
YO
1213 data->minlen_float=minlenp;
1214 data->lookbehind_float=0;
c277df42
IZ
1215 }
1216 }
1217 SvCUR_set(data->last_found, 0);
0eda9292 1218 {
a28509cc 1219 SV * const sv = data->last_found;
097eb12c
AL
1220 if (SvUTF8(sv) && SvMAGICAL(sv)) {
1221 MAGIC * const mg = mg_find(sv, PERL_MAGIC_utf8);
1222 if (mg)
1223 mg->mg_len = 0;
1224 }
0eda9292 1225 }
c277df42
IZ
1226 data->last_end = -1;
1227 data->flags &= ~SF_BEFORE_EOL;
bcdf7404 1228 DEBUG_STUDYDATA("commit: ",data,0);
c277df42
IZ
1229}
1230
cdd87c1d
KW
1231/* An SSC is just a regnode_charclass_posix with an extra field: the inversion
1232 * list that describes which code points it matches */
1233
653099ff 1234STATIC void
3420edd7 1235S_ssc_anything(pTHX_ regnode_ssc *ssc)
653099ff 1236{
cdd87c1d
KW
1237 /* Set the SSC 'ssc' to match an empty string or any code point */
1238
557bd3fb 1239 PERL_ARGS_ASSERT_SSC_ANYTHING;
7918f24d 1240
71068078 1241 assert(is_ANYOF_SYNTHETIC(ssc));
3fffb88a 1242
cdd87c1d
KW
1243 ssc->invlist = sv_2mortal(_new_invlist(2)); /* mortalize so won't leak */
1244 _append_range_to_invlist(ssc->invlist, 0, UV_MAX);
93e92956 1245 ANYOF_FLAGS(ssc) |= SSC_MATCHES_EMPTY_STRING; /* Plus matches empty */
653099ff
GS
1246}
1247
653099ff 1248STATIC int
dc3bf405 1249S_ssc_is_anything(const regnode_ssc *ssc)
653099ff 1250{
c144baaa
KW
1251 /* Returns TRUE if the SSC 'ssc' can match the empty string and any code
1252 * point; FALSE otherwise. Thus, this is used to see if using 'ssc' buys
1253 * us anything: if the function returns TRUE, 'ssc' hasn't been restricted
1254 * in any way, so there's no point in using it */
cdd87c1d
KW
1255
1256 UV start, end;
1257 bool ret;
653099ff 1258
557bd3fb 1259 PERL_ARGS_ASSERT_SSC_IS_ANYTHING;
7918f24d 1260
71068078 1261 assert(is_ANYOF_SYNTHETIC(ssc));
cdd87c1d 1262
93e92956 1263 if (! (ANYOF_FLAGS(ssc) & SSC_MATCHES_EMPTY_STRING)) {
cdd87c1d
KW
1264 return FALSE;
1265 }
1266
1267 /* See if the list consists solely of the range 0 - Infinity */
1268 invlist_iterinit(ssc->invlist);
1269 ret = invlist_iternext(ssc->invlist, &start, &end)
1270 && start == 0
1271 && end == UV_MAX;
1272
1273 invlist_iterfinish(ssc->invlist);
1274
1275 if (ret) {
1276 return TRUE;
1277 }
1278
1279 /* If e.g., both \w and \W are set, matches everything */
e0e1be5f 1280 if (ANYOF_POSIXL_SSC_TEST_ANY_SET(ssc)) {
cdd87c1d
KW
1281 int i;
1282 for (i = 0; i < ANYOF_POSIXL_MAX; i += 2) {
1283 if (ANYOF_POSIXL_TEST(ssc, i) && ANYOF_POSIXL_TEST(ssc, i+1)) {
1284 return TRUE;
1285 }
1286 }
1287 }
1288
1289 return FALSE;
653099ff
GS
1290}
1291
653099ff 1292STATIC void
cdd87c1d 1293S_ssc_init(pTHX_ const RExC_state_t *pRExC_state, regnode_ssc *ssc)
653099ff 1294{
cdd87c1d
KW
1295 /* Initializes the SSC 'ssc'. This includes setting it to match an empty
1296 * string, any code point, or any posix class under locale */
1297
557bd3fb 1298 PERL_ARGS_ASSERT_SSC_INIT;
7918f24d 1299
557bd3fb 1300 Zero(ssc, 1, regnode_ssc);
71068078 1301 set_ANYOF_SYNTHETIC(ssc);
93e92956 1302 ARG_SET(ssc, ANYOF_ONLY_HAS_BITMAP);
3420edd7 1303 ssc_anything(ssc);
cdd87c1d 1304
2f306ab9
KW
1305 /* If any portion of the regex is to operate under locale rules that aren't
1306 * fully known at compile time, initialization includes it. The reason
1307 * this isn't done for all regexes is that the optimizer was written under
1308 * the assumption that locale was all-or-nothing. Given the complexity and
1309 * lack of documentation in the optimizer, and that there are inadequate
1310 * test cases for locale, many parts of it may not work properly, it is
1311 * safest to avoid locale unless necessary. */
cdd87c1d
KW
1312 if (RExC_contains_locale) {
1313 ANYOF_POSIXL_SETALL(ssc);
cdd87c1d
KW
1314 }
1315 else {
1316 ANYOF_POSIXL_ZERO(ssc);
1317 }
653099ff
GS
1318}
1319
b423522f 1320STATIC int
dc3bf405
BF
1321S_ssc_is_cp_posixl_init(const RExC_state_t *pRExC_state,
1322 const regnode_ssc *ssc)
b423522f
KW
1323{
1324 /* Returns TRUE if the SSC 'ssc' is in its initial state with regard only
1325 * to the list of code points matched, and locale posix classes; hence does
1326 * not check its flags) */
1327
1328 UV start, end;
1329 bool ret;
1330
1331 PERL_ARGS_ASSERT_SSC_IS_CP_POSIXL_INIT;
1332
71068078 1333 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW
1334
1335 invlist_iterinit(ssc->invlist);
1336 ret = invlist_iternext(ssc->invlist, &start, &end)
1337 && start == 0
1338 && end == UV_MAX;
1339
1340 invlist_iterfinish(ssc->invlist);
1341
1342 if (! ret) {
1343 return FALSE;
1344 }
1345
e0e1be5f 1346 if (RExC_contains_locale && ! ANYOF_POSIXL_SSC_TEST_ALL_SET(ssc)) {
31f05a37 1347 return FALSE;
b423522f
KW
1348 }
1349
1350 return TRUE;
1351}
1352
1353STATIC SV*
1354S_get_ANYOF_cp_list_for_ssc(pTHX_ const RExC_state_t *pRExC_state,
5c0f85ef 1355 const regnode_charclass* const node)
b423522f
KW
1356{
1357 /* Returns a mortal inversion list defining which code points are matched
1358 * by 'node', which is of type ANYOF. Handles complementing the result if
1359 * appropriate. If some code points aren't knowable at this time, the
31f05a37
KW
1360 * returned list must, and will, contain every code point that is a
1361 * possibility. */
b423522f 1362
e2506fa7 1363 SV* invlist = NULL;
1ee208c4 1364 SV* only_utf8_locale_invlist = NULL;
b423522f
KW
1365 unsigned int i;
1366 const U32 n = ARG(node);
31f05a37 1367 bool new_node_has_latin1 = FALSE;
b423522f
KW
1368
1369 PERL_ARGS_ASSERT_GET_ANYOF_CP_LIST_FOR_SSC;
1370
1371 /* Look at the data structure created by S_set_ANYOF_arg() */
93e92956 1372 if (n != ANYOF_ONLY_HAS_BITMAP) {
b423522f
KW
1373 SV * const rv = MUTABLE_SV(RExC_rxi->data->data[n]);
1374 AV * const av = MUTABLE_AV(SvRV(rv));
1375 SV **const ary = AvARRAY(av);
1376 assert(RExC_rxi->data->what[n] == 's');
1377
1378 if (ary[1] && ary[1] != &PL_sv_undef) { /* Has compile-time swash */
1379 invlist = sv_2mortal(invlist_clone(_get_swash_invlist(ary[1])));
1380 }
1381 else if (ary[0] && ary[0] != &PL_sv_undef) {
1382
1383 /* Here, no compile-time swash, and there are things that won't be
1384 * known until runtime -- we have to assume it could be anything */
e2506fa7 1385 invlist = sv_2mortal(_new_invlist(1));
b423522f
KW
1386 return _add_range_to_invlist(invlist, 0, UV_MAX);
1387 }
1ee208c4 1388 else if (ary[3] && ary[3] != &PL_sv_undef) {
b423522f
KW
1389
1390 /* Here no compile-time swash, and no run-time only data. Use the
1391 * node's inversion list */
1ee208c4
KW
1392 invlist = sv_2mortal(invlist_clone(ary[3]));
1393 }
1394
1395 /* Get the code points valid only under UTF-8 locales */
037715a6 1396 if ((ANYOF_FLAGS(node) & ANYOFL_FOLD)
1ee208c4
KW
1397 && ary[2] && ary[2] != &PL_sv_undef)
1398 {
1399 only_utf8_locale_invlist = ary[2];
b423522f
KW
1400 }
1401 }
1402
e2506fa7
KW
1403 if (! invlist) {
1404 invlist = sv_2mortal(_new_invlist(0));
1405 }
1406
dcb20b36
KW
1407 /* An ANYOF node contains a bitmap for the first NUM_ANYOF_CODE_POINTS
1408 * code points, and an inversion list for the others, but if there are code
1409 * points that should match only conditionally on the target string being
1410 * UTF-8, those are placed in the inversion list, and not the bitmap.
1411 * Since there are circumstances under which they could match, they are
1412 * included in the SSC. But if the ANYOF node is to be inverted, we have
1413 * to exclude them here, so that when we invert below, the end result
1414 * actually does include them. (Think about "\xe0" =~ /[^\xc0]/di;). We
1415 * have to do this here before we add the unconditionally matched code
1416 * points */
b423522f
KW
1417 if (ANYOF_FLAGS(node) & ANYOF_INVERT) {
1418 _invlist_intersection_complement_2nd(invlist,
1419 PL_UpperLatin1,
1420 &invlist);
1421 }
1422
1423 /* Add in the points from the bit map */
dcb20b36 1424 for (i = 0; i < NUM_ANYOF_CODE_POINTS; i++) {
b423522f
KW
1425 if (ANYOF_BITMAP_TEST(node, i)) {
1426 invlist = add_cp_to_invlist(invlist, i);
31f05a37 1427 new_node_has_latin1 = TRUE;
b423522f
KW
1428 }
1429 }
1430
1431 /* If this can match all upper Latin1 code points, have to add them
ac33c516
KW
1432 * as well. But don't add them if inverting, as when that gets done below,
1433 * it would exclude all these characters, including the ones it shouldn't
1434 * that were added just above */
1435 if (! (ANYOF_FLAGS(node) & ANYOF_INVERT) && OP(node) == ANYOFD
f240c685
KW
1436 && (ANYOF_FLAGS(node) & ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER))
1437 {
b423522f
KW
1438 _invlist_union(invlist, PL_UpperLatin1, &invlist);
1439 }
1440
1441 /* Similarly for these */
93e92956 1442 if (ANYOF_FLAGS(node) & ANYOF_MATCHES_ALL_ABOVE_BITMAP) {
e0a1ff7a 1443 _invlist_union_complement_2nd(invlist, PL_InBitmap, &invlist);
b423522f
KW
1444 }
1445
1446 if (ANYOF_FLAGS(node) & ANYOF_INVERT) {
1447 _invlist_invert(invlist);
1448 }
037715a6 1449 else if (new_node_has_latin1 && ANYOF_FLAGS(node) & ANYOFL_FOLD) {
31f05a37
KW
1450
1451 /* Under /li, any 0-255 could fold to any other 0-255, depending on the
1452 * locale. We can skip this if there are no 0-255 at all. */
1453 _invlist_union(invlist, PL_Latin1, &invlist);
1454 }
1455
1ee208c4
KW
1456 /* Similarly add the UTF-8 locale possible matches. These have to be
1457 * deferred until after the non-UTF-8 locale ones are taken care of just
1458 * above, or it leads to wrong results under ANYOF_INVERT */
1459 if (only_utf8_locale_invlist) {
31f05a37 1460 _invlist_union_maybe_complement_2nd(invlist,
1ee208c4 1461 only_utf8_locale_invlist,
31f05a37
KW
1462 ANYOF_FLAGS(node) & ANYOF_INVERT,
1463 &invlist);
1464 }
b423522f
KW
1465
1466 return invlist;
1467}
1468
1051e1c4 1469/* These two functions currently do the exact same thing */
557bd3fb 1470#define ssc_init_zero ssc_init
653099ff 1471
cdd87c1d
KW
1472#define ssc_add_cp(ssc, cp) ssc_add_range((ssc), (cp), (cp))
1473#define ssc_match_all_cp(ssc) ssc_add_range(ssc, 0, UV_MAX)
1474
557bd3fb 1475/* 'AND' a given class with another one. Can create false positives. 'ssc'
93e92956
KW
1476 * should not be inverted. 'and_with->flags & ANYOF_MATCHES_POSIXL' should be
1477 * 0 if 'and_with' is a regnode_charclass instead of a regnode_ssc. */
cdd87c1d 1478
653099ff 1479STATIC void
b423522f 1480S_ssc_and(pTHX_ const RExC_state_t *pRExC_state, regnode_ssc *ssc,
7dcac5f6 1481 const regnode_charclass *and_with)
653099ff 1482{
cdd87c1d
KW
1483 /* Accumulate into SSC 'ssc' its 'AND' with 'and_with', which is either
1484 * another SSC or a regular ANYOF class. Can create false positives. */
40d049e4 1485
a0dd4231
KW
1486 SV* anded_cp_list;
1487 U8 anded_flags;
1e6ade67 1488
cdd87c1d 1489 PERL_ARGS_ASSERT_SSC_AND;
653099ff 1490
71068078 1491 assert(is_ANYOF_SYNTHETIC(ssc));
a0dd4231
KW
1492
1493 /* 'and_with' is used as-is if it too is an SSC; otherwise have to extract
1494 * the code point inversion list and just the relevant flags */
71068078 1495 if (is_ANYOF_SYNTHETIC(and_with)) {
7dcac5f6 1496 anded_cp_list = ((regnode_ssc *)and_with)->invlist;
a0dd4231 1497 anded_flags = ANYOF_FLAGS(and_with);
e9b08962
KW
1498
1499 /* XXX This is a kludge around what appears to be deficiencies in the
1500 * optimizer. If we make S_ssc_anything() add in the WARN_SUPER flag,
1501 * there are paths through the optimizer where it doesn't get weeded
1502 * out when it should. And if we don't make some extra provision for
1503 * it like the code just below, it doesn't get added when it should.
1504 * This solution is to add it only when AND'ing, which is here, and
1505 * only when what is being AND'ed is the pristine, original node
1506 * matching anything. Thus it is like adding it to ssc_anything() but
1507 * only when the result is to be AND'ed. Probably the same solution
1508 * could be adopted for the same problem we have with /l matching,
1509 * which is solved differently in S_ssc_init(), and that would lead to
1510 * fewer false positives than that solution has. But if this solution
1511 * creates bugs, the consequences are only that a warning isn't raised
1512 * that should be; while the consequences for having /l bugs is
1513 * incorrect matches */
7dcac5f6 1514 if (ssc_is_anything((regnode_ssc *)and_with)) {
f240c685 1515 anded_flags |= ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER;
e9b08962 1516 }
a0dd4231
KW
1517 }
1518 else {
5c0f85ef 1519 anded_cp_list = get_ANYOF_cp_list_for_ssc(pRExC_state, and_with);
f240c685
KW
1520 if (OP(and_with) == ANYOFD) {
1521 anded_flags = ANYOF_FLAGS(and_with) & ANYOF_COMMON_FLAGS;
1522 }
1523 else {
1524 anded_flags = ANYOF_FLAGS(and_with)
1525 &( ANYOF_COMMON_FLAGS
108316fb
KW
1526 |ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER
1527 |ANYOF_SHARED_d_UPPER_LATIN1_UTF8_STRING_MATCHES_non_d_RUNTIME_USER_PROP);
d1c40ef5
KW
1528 if (ANYOFL_UTF8_LOCALE_REQD(ANYOF_FLAGS(and_with))) {
1529 anded_flags &=
1530 ANYOFL_SHARED_UTF8_LOCALE_fold_HAS_MATCHES_nonfold_REQD;
1531 }
f240c685 1532 }
a0dd4231
KW
1533 }
1534
1535 ANYOF_FLAGS(ssc) &= anded_flags;
cdd87c1d
KW
1536
1537 /* Below, C1 is the list of code points in 'ssc'; P1, its posix classes.
1538 * C2 is the list of code points in 'and-with'; P2, its posix classes.
1539 * 'and_with' may be inverted. When not inverted, we have the situation of
1540 * computing:
1541 * (C1 | P1) & (C2 | P2)
1542 * = (C1 & (C2 | P2)) | (P1 & (C2 | P2))
1543 * = ((C1 & C2) | (C1 & P2)) | ((P1 & C2) | (P1 & P2))
1544 * <= ((C1 & C2) | P2)) | ( P1 | (P1 & P2))
1545 * <= ((C1 & C2) | P1 | P2)
1546 * Alternatively, the last few steps could be:
1547 * = ((C1 & C2) | (C1 & P2)) | ((P1 & C2) | (P1 & P2))
1548 * <= ((C1 & C2) | C1 ) | ( C2 | (P1 & P2))
1549 * <= (C1 | C2 | (P1 & P2))
1550 * We favor the second approach if either P1 or P2 is non-empty. This is
1551 * because these components are a barrier to doing optimizations, as what
1552 * they match cannot be known until the moment of matching as they are
1553 * dependent on the current locale, 'AND"ing them likely will reduce or
1554 * eliminate them.
1555 * But we can do better if we know that C1,P1 are in their initial state (a
1556 * frequent occurrence), each matching everything:
1557 * (<everything>) & (C2 | P2) = C2 | P2
1558 * Similarly, if C2,P2 are in their initial state (again a frequent
1559 * occurrence), the result is a no-op
1560 * (C1 | P1) & (<everything>) = C1 | P1
1561 *
1562 * Inverted, we have
1563 * (C1 | P1) & ~(C2 | P2) = (C1 | P1) & (~C2 & ~P2)
1564 * = (C1 & (~C2 & ~P2)) | (P1 & (~C2 & ~P2))
1565 * <= (C1 & ~C2) | (P1 & ~P2)
1566 * */
1aa99e6b 1567
a0dd4231 1568 if ((ANYOF_FLAGS(and_with) & ANYOF_INVERT)
71068078 1569 && ! is_ANYOF_SYNTHETIC(and_with))
a0dd4231 1570 {
cdd87c1d 1571 unsigned int i;
8951c461 1572
cdd87c1d
KW
1573 ssc_intersection(ssc,
1574 anded_cp_list,
1575 FALSE /* Has already been inverted */
1576 );
c6b76537 1577
cdd87c1d
KW
1578 /* If either P1 or P2 is empty, the intersection will be also; can skip
1579 * the loop */
93e92956 1580 if (! (ANYOF_FLAGS(and_with) & ANYOF_MATCHES_POSIXL)) {
cdd87c1d
KW
1581 ANYOF_POSIXL_ZERO(ssc);
1582 }
e0e1be5f 1583 else if (ANYOF_POSIXL_SSC_TEST_ANY_SET(ssc)) {
cdd87c1d
KW
1584
1585 /* Note that the Posix class component P from 'and_with' actually
1586 * looks like:
1587 * P = Pa | Pb | ... | Pn
1588 * where each component is one posix class, such as in [\w\s].
1589 * Thus
1590 * ~P = ~(Pa | Pb | ... | Pn)
1591 * = ~Pa & ~Pb & ... & ~Pn
1592 * <= ~Pa | ~Pb | ... | ~Pn
1593 * The last is something we can easily calculate, but unfortunately
1594 * is likely to have many false positives. We could do better
1595 * in some (but certainly not all) instances if two classes in
1596 * P have known relationships. For example
1597 * :lower: <= :alpha: <= :alnum: <= \w <= :graph: <= :print:
1598 * So
1599 * :lower: & :print: = :lower:
1600 * And similarly for classes that must be disjoint. For example,
1601 * since \s and \w can have no elements in common based on rules in
1602 * the POSIX standard,
1603 * \w & ^\S = nothing
1604 * Unfortunately, some vendor locales do not meet the Posix
1605 * standard, in particular almost everything by Microsoft.
1606 * The loop below just changes e.g., \w into \W and vice versa */
1607
1ee208c4 1608 regnode_charclass_posixl temp;
cdd87c1d
KW
1609 int add = 1; /* To calculate the index of the complement */
1610
1611 ANYOF_POSIXL_ZERO(&temp);
1612 for (i = 0; i < ANYOF_MAX; i++) {
1613 assert(i % 2 != 0
7dcac5f6
KW
1614 || ! ANYOF_POSIXL_TEST((regnode_charclass_posixl*) and_with, i)
1615 || ! ANYOF_POSIXL_TEST((regnode_charclass_posixl*) and_with, i + 1));
cdd87c1d 1616
7dcac5f6 1617 if (ANYOF_POSIXL_TEST((regnode_charclass_posixl*) and_with, i)) {
cdd87c1d
KW
1618 ANYOF_POSIXL_SET(&temp, i + add);
1619 }
1620 add = 0 - add; /* 1 goes to -1; -1 goes to 1 */
1621 }
1622 ANYOF_POSIXL_AND(&temp, ssc);
c6b76537 1623
cdd87c1d
KW
1624 } /* else ssc already has no posixes */
1625 } /* else: Not inverted. This routine is a no-op if 'and_with' is an SSC
1626 in its initial state */
71068078 1627 else if (! is_ANYOF_SYNTHETIC(and_with)
7dcac5f6 1628 || ! ssc_is_cp_posixl_init(pRExC_state, (regnode_ssc *)and_with))
cdd87c1d
KW
1629 {
1630 /* But if 'ssc' is in its initial state, the result is just 'and_with';
1631 * copy it over 'ssc' */
1632 if (ssc_is_cp_posixl_init(pRExC_state, ssc)) {
71068078 1633 if (is_ANYOF_SYNTHETIC(and_with)) {
cdd87c1d
KW
1634 StructCopy(and_with, ssc, regnode_ssc);
1635 }
1636 else {
1637 ssc->invlist = anded_cp_list;
1638 ANYOF_POSIXL_ZERO(ssc);
93e92956 1639 if (ANYOF_FLAGS(and_with) & ANYOF_MATCHES_POSIXL) {
7dcac5f6 1640 ANYOF_POSIXL_OR((regnode_charclass_posixl*) and_with, ssc);
cdd87c1d
KW
1641 }
1642 }
1643 }
e0e1be5f 1644 else if (ANYOF_POSIXL_SSC_TEST_ANY_SET(ssc)
93e92956 1645 || (ANYOF_FLAGS(and_with) & ANYOF_MATCHES_POSIXL))
cdd87c1d
KW
1646 {
1647 /* One or the other of P1, P2 is non-empty. */
93e92956 1648 if (ANYOF_FLAGS(and_with) & ANYOF_MATCHES_POSIXL) {
1ea8b7fe
KW
1649 ANYOF_POSIXL_AND((regnode_charclass_posixl*) and_with, ssc);
1650 }
cdd87c1d
KW
1651 ssc_union(ssc, anded_cp_list, FALSE);
1652 }
1653 else { /* P1 = P2 = empty */
1654 ssc_intersection(ssc, anded_cp_list, FALSE);
1655 }
137165a6 1656 }
653099ff
GS
1657}
1658
653099ff 1659STATIC void
cdd87c1d 1660S_ssc_or(pTHX_ const RExC_state_t *pRExC_state, regnode_ssc *ssc,
7dcac5f6 1661 const regnode_charclass *or_with)
653099ff 1662{
cdd87c1d
KW
1663 /* Accumulate into SSC 'ssc' its 'OR' with 'or_with', which is either
1664 * another SSC or a regular ANYOF class. Can create false positives if
1665 * 'or_with' is to be inverted. */
7918f24d 1666
a0dd4231
KW
1667 SV* ored_cp_list;
1668 U8 ored_flags;
c6b76537 1669
cdd87c1d 1670 PERL_ARGS_ASSERT_SSC_OR;
c6b76537 1671
71068078 1672 assert(is_ANYOF_SYNTHETIC(ssc));
a0dd4231
KW
1673
1674 /* 'or_with' is used as-is if it too is an SSC; otherwise have to extract
1675 * the code point inversion list and just the relevant flags */
71068078 1676 if (is_ANYOF_SYNTHETIC(or_with)) {
7dcac5f6 1677 ored_cp_list = ((regnode_ssc*) or_with)->invlist;
a0dd4231
KW
1678 ored_flags = ANYOF_FLAGS(or_with);
1679 }
1680 else {
5c0f85ef 1681 ored_cp_list = get_ANYOF_cp_list_for_ssc(pRExC_state, or_with);
eff8b7dc 1682 ored_flags = ANYOF_FLAGS(or_with) & ANYOF_COMMON_FLAGS;
f240c685
KW
1683 if (OP(or_with) != ANYOFD) {
1684 ored_flags
1685 |= ANYOF_FLAGS(or_with)
108316fb
KW
1686 & ( ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER
1687 |ANYOF_SHARED_d_UPPER_LATIN1_UTF8_STRING_MATCHES_non_d_RUNTIME_USER_PROP);
d1c40ef5
KW
1688 if (ANYOFL_UTF8_LOCALE_REQD(ANYOF_FLAGS(or_with))) {
1689 ored_flags |=
1690 ANYOFL_SHARED_UTF8_LOCALE_fold_HAS_MATCHES_nonfold_REQD;
1691 }
f240c685 1692 }
a0dd4231
KW
1693 }
1694
1695 ANYOF_FLAGS(ssc) |= ored_flags;
cdd87c1d
KW
1696
1697 /* Below, C1 is the list of code points in 'ssc'; P1, its posix classes.
1698 * C2 is the list of code points in 'or-with'; P2, its posix classes.
1699 * 'or_with' may be inverted. When not inverted, we have the simple
1700 * situation of computing:
1701 * (C1 | P1) | (C2 | P2) = (C1 | C2) | (P1 | P2)
1702 * If P1|P2 yields a situation with both a class and its complement are
1703 * set, like having both \w and \W, this matches all code points, and we
1704 * can delete these from the P component of the ssc going forward. XXX We
1705 * might be able to delete all the P components, but I (khw) am not certain
1706 * about this, and it is better to be safe.
1707 *
1708 * Inverted, we have
1709 * (C1 | P1) | ~(C2 | P2) = (C1 | P1) | (~C2 & ~P2)
1710 * <= (C1 | P1) | ~C2
1711 * <= (C1 | ~C2) | P1
1712 * (which results in actually simpler code than the non-inverted case)
1713 * */
9826f543 1714
a0dd4231 1715 if ((ANYOF_FLAGS(or_with) & ANYOF_INVERT)
71068078 1716 && ! is_ANYOF_SYNTHETIC(or_with))
a0dd4231 1717 {
cdd87c1d 1718 /* We ignore P2, leaving P1 going forward */
1ea8b7fe 1719 } /* else Not inverted */
93e92956 1720 else if (ANYOF_FLAGS(or_with) & ANYOF_MATCHES_POSIXL) {
7dcac5f6 1721 ANYOF_POSIXL_OR((regnode_charclass_posixl*)or_with, ssc);
e0e1be5f 1722 if (ANYOF_POSIXL_SSC_TEST_ANY_SET(ssc)) {
cdd87c1d
KW
1723 unsigned int i;
1724 for (i = 0; i < ANYOF_MAX; i += 2) {
1725 if (ANYOF_POSIXL_TEST(ssc, i) && ANYOF_POSIXL_TEST(ssc, i + 1))
1726 {
1727 ssc_match_all_cp(ssc);
1728 ANYOF_POSIXL_CLEAR(ssc, i);
1729 ANYOF_POSIXL_CLEAR(ssc, i+1);
cdd87c1d
KW
1730 }
1731 }
1732 }
1aa99e6b 1733 }
cdd87c1d
KW
1734
1735 ssc_union(ssc,
1736 ored_cp_list,
1737 FALSE /* Already has been inverted */
1738 );
653099ff
GS
1739}
1740
b423522f
KW
1741PERL_STATIC_INLINE void
1742S_ssc_union(pTHX_ regnode_ssc *ssc, SV* const invlist, const bool invert2nd)
1743{
1744 PERL_ARGS_ASSERT_SSC_UNION;
1745
71068078 1746 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW
1747
1748 _invlist_union_maybe_complement_2nd(ssc->invlist,
1749 invlist,
1750 invert2nd,
1751 &ssc->invlist);
1752}
1753
1754PERL_STATIC_INLINE void
1755S_ssc_intersection(pTHX_ regnode_ssc *ssc,
1756 SV* const invlist,
1757 const bool invert2nd)
1758{
1759 PERL_ARGS_ASSERT_SSC_INTERSECTION;
1760
71068078 1761 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW
1762
1763 _invlist_intersection_maybe_complement_2nd(ssc->invlist,
1764 invlist,
1765 invert2nd,
1766 &ssc->invlist);
1767}
1768
1769PERL_STATIC_INLINE void
1770S_ssc_add_range(pTHX_ regnode_ssc *ssc, const UV start, const UV end)
1771{
1772 PERL_ARGS_ASSERT_SSC_ADD_RANGE;
1773
71068078 1774 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW
1775
1776 ssc->invlist = _add_range_to_invlist(ssc->invlist, start, end);
1777}
1778
1779PERL_STATIC_INLINE void
1780S_ssc_cp_and(pTHX_ regnode_ssc *ssc, const UV cp)
1781{
1782 /* AND just the single code point 'cp' into the SSC 'ssc' */
1783
1784 SV* cp_list = _new_invlist(2);
1785
1786 PERL_ARGS_ASSERT_SSC_CP_AND;
1787
71068078 1788 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW
1789
1790 cp_list = add_cp_to_invlist(cp_list, cp);
1791 ssc_intersection(ssc, cp_list,
1792 FALSE /* Not inverted */
1793 );
1794 SvREFCNT_dec_NN(cp_list);
1795}
1796
1797PERL_STATIC_INLINE void
dc3bf405 1798S_ssc_clear_locale(regnode_ssc *ssc)
b423522f
KW
1799{
1800 /* Set the SSC 'ssc' to not match any locale things */
b423522f
KW
1801 PERL_ARGS_ASSERT_SSC_CLEAR_LOCALE;
1802
71068078 1803 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW
1804
1805 ANYOF_POSIXL_ZERO(ssc);
1806 ANYOF_FLAGS(ssc) &= ~ANYOF_LOCALE_FLAGS;
1807}
1808
b35552de
KW
1809#define NON_OTHER_COUNT NON_OTHER_COUNT_FOR_USE_ONLY_BY_REGCOMP_DOT_C
1810
1811STATIC bool
1812S_is_ssc_worth_it(const RExC_state_t * pRExC_state, const regnode_ssc * ssc)
1813{
1814 /* The synthetic start class is used to hopefully quickly winnow down
1815 * places where a pattern could start a match in the target string. If it
1816 * doesn't really narrow things down that much, there isn't much point to
1817 * having the overhead of using it. This function uses some very crude
1818 * heuristics to decide if to use the ssc or not.
1819 *
1820 * It returns TRUE if 'ssc' rules out more than half what it considers to
1821 * be the "likely" possible matches, but of course it doesn't know what the
1822 * actual things being matched are going to be; these are only guesses
1823 *
1824 * For /l matches, it assumes that the only likely matches are going to be
1825 * in the 0-255 range, uniformly distributed, so half of that is 127
1826 * For /a and /d matches, it assumes that the likely matches will be just
1827 * the ASCII range, so half of that is 63
1828 * For /u and there isn't anything matching above the Latin1 range, it
1829 * assumes that that is the only range likely to be matched, and uses
1830 * half that as the cut-off: 127. If anything matches above Latin1,
1831 * it assumes that all of Unicode could match (uniformly), except for
1832 * non-Unicode code points and things in the General Category "Other"
1833 * (unassigned, private use, surrogates, controls and formats). This
1834 * is a much large number. */
1835
b35552de
KW
1836 U32 count = 0; /* Running total of number of code points matched by
1837 'ssc' */
1838 UV start, end; /* Start and end points of current range in inversion
1839 list */
72400949
KW
1840 const U32 max_code_points = (LOC)
1841 ? 256
1842 : (( ! UNI_SEMANTICS
1843 || invlist_highest(ssc->invlist) < 256)
1844 ? 128
1845 : NON_OTHER_COUNT);
1846 const U32 max_match = max_code_points / 2;
b35552de
KW
1847
1848 PERL_ARGS_ASSERT_IS_SSC_WORTH_IT;
1849
1850 invlist_iterinit(ssc->invlist);
1851 while (invlist_iternext(ssc->invlist, &start, &end)) {
72400949
KW
1852 if (start >= max_code_points) {
1853 break;
b35552de 1854 }
72400949 1855 end = MIN(end, max_code_points - 1);
b35552de 1856 count += end - start + 1;
72400949 1857 if (count >= max_match) {
b35552de
KW
1858 invlist_iterfinish(ssc->invlist);
1859 return FALSE;
1860 }
1861 }
1862
1863 return TRUE;
1864}
1865
1866
b423522f
KW
1867STATIC void
1868S_ssc_finalize(pTHX_ RExC_state_t *pRExC_state, regnode_ssc *ssc)
1869{
1870 /* The inversion list in the SSC is marked mortal; now we need a more
1871 * permanent copy, which is stored the same way that is done in a regular
dcb20b36
KW
1872 * ANYOF node, with the first NUM_ANYOF_CODE_POINTS code points in a bit
1873 * map */
b423522f
KW
1874
1875 SV* invlist = invlist_clone(ssc->invlist);
1876
1877 PERL_ARGS_ASSERT_SSC_FINALIZE;
1878
71068078 1879 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f 1880
a0dd4231 1881 /* The code in this file assumes that all but these flags aren't relevant
93e92956
KW
1882 * to the SSC, except SSC_MATCHES_EMPTY_STRING, which should be cleared
1883 * by the time we reach here */
f240c685
KW
1884 assert(! (ANYOF_FLAGS(ssc)
1885 & ~( ANYOF_COMMON_FLAGS
108316fb
KW
1886 |ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER
1887 |ANYOF_SHARED_d_UPPER_LATIN1_UTF8_STRING_MATCHES_non_d_RUNTIME_USER_PROP)));
a0dd4231 1888
b423522f
KW
1889 populate_ANYOF_from_invlist( (regnode *) ssc, &invlist);
1890
1ee208c4
KW
1891 set_ANYOF_arg(pRExC_state, (regnode *) ssc, invlist,
1892 NULL, NULL, NULL, FALSE);
b423522f 1893
85c8e306
KW
1894 /* Make sure is clone-safe */
1895 ssc->invlist = NULL;
1896
e0e1be5f 1897 if (ANYOF_POSIXL_SSC_TEST_ANY_SET(ssc)) {
93e92956 1898 ANYOF_FLAGS(ssc) |= ANYOF_MATCHES_POSIXL;
e0e1be5f 1899 }
1462525b 1900
b2e90ddf
KW
1901 if (RExC_contains_locale) {
1902 OP(ssc) = ANYOFL;
1903 }
1904
1462525b 1905 assert(! (ANYOF_FLAGS(ssc) & ANYOF_LOCALE_FLAGS) || RExC_contains_locale);
b423522f
KW
1906}
1907
a3621e74
YO
1908#define TRIE_LIST_ITEM(state,idx) (trie->states[state].trans.list)[ idx ]
1909#define TRIE_LIST_CUR(state) ( TRIE_LIST_ITEM( state, 0 ).forid )
1910#define TRIE_LIST_LEN(state) ( TRIE_LIST_ITEM( state, 0 ).newstate )
538e84ed
KW
1911#define TRIE_LIST_USED(idx) ( trie->states[state].trans.list \
1912 ? (TRIE_LIST_CUR( idx ) - 1) \
1913 : 0 )
a3621e74 1914
3dab1dad
YO
1915
1916#ifdef DEBUGGING
07be1b83 1917/*
2b8b4781
NC
1918 dump_trie(trie,widecharmap,revcharmap)
1919 dump_trie_interim_list(trie,widecharmap,revcharmap,next_alloc)
1920 dump_trie_interim_table(trie,widecharmap,revcharmap,next_alloc)
3dab1dad
YO
1921
1922 These routines dump out a trie in a somewhat readable format.
07be1b83
YO
1923 The _interim_ variants are used for debugging the interim
1924 tables that are used to generate the final compressed
1925 representation which is what dump_trie expects.
1926
486ec47a 1927 Part of the reason for their existence is to provide a form
3dab1dad 1928 of documentation as to how the different representations function.
07be1b83
YO
1929
1930*/
3dab1dad
YO
1931
1932/*
3dab1dad
YO
1933 Dumps the final compressed table form of the trie to Perl_debug_log.
1934 Used for debugging make_trie().
1935*/
b9a59e08 1936
3dab1dad 1937STATIC void
2b8b4781
NC
1938S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap,
1939 AV *revcharmap, U32 depth)
3dab1dad
YO
1940{
1941 U32 state;
ab3bbdeb 1942 SV *sv=sv_newmortal();
55eed653 1943 int colwidth= widecharmap ? 6 : 4;
2e64971a 1944 U16 word;
3dab1dad
YO
1945 GET_RE_DEBUG_FLAGS_DECL;
1946
7918f24d 1947 PERL_ARGS_ASSERT_DUMP_TRIE;
ab3bbdeb 1948
3dab1dad
YO
1949 PerlIO_printf( Perl_debug_log, "%*sChar : %-6s%-6s%-4s ",
1950 (int)depth * 2 + 2,"",
1951 "Match","Base","Ofs" );
1952
1953 for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
2b8b4781 1954 SV ** const tmp = av_fetch( revcharmap, state, 0);
3dab1dad 1955 if ( tmp ) {
538e84ed 1956 PerlIO_printf( Perl_debug_log, "%*s",
ab3bbdeb 1957 colwidth,
538e84ed 1958 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
ab3bbdeb
YO
1959 PL_colors[0], PL_colors[1],
1960 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
538e84ed
KW
1961 PERL_PV_ESCAPE_FIRSTCHAR
1962 )
ab3bbdeb 1963 );
3dab1dad
YO
1964 }
1965 }
1966 PerlIO_printf( Perl_debug_log, "\n%*sState|-----------------------",
1967 (int)depth * 2 + 2,"");
1968
1969 for( state = 0 ; state < trie->uniquecharcount ; state++ )
ab3bbdeb 1970 PerlIO_printf( Perl_debug_log, "%.*s", colwidth, "--------");
3dab1dad
YO
1971 PerlIO_printf( Perl_debug_log, "\n");
1972
1e2e3d02 1973 for( state = 1 ; state < trie->statecount ; state++ ) {
be8e71aa 1974 const U32 base = trie->states[ state ].trans.base;
3dab1dad 1975
538e84ed
KW
1976 PerlIO_printf( Perl_debug_log, "%*s#%4"UVXf"|",
1977 (int)depth * 2 + 2,"", (UV)state);
3dab1dad
YO
1978
1979 if ( trie->states[ state ].wordnum ) {
538e84ed
KW
1980 PerlIO_printf( Perl_debug_log, " W%4X",
1981 trie->states[ state ].wordnum );
3dab1dad
YO
1982 } else {
1983 PerlIO_printf( Perl_debug_log, "%6s", "" );
1984 }
1985
1986 PerlIO_printf( Perl_debug_log, " @%4"UVXf" ", (UV)base );
1987
1988 if ( base ) {
1989 U32 ofs = 0;
1990
1991 while( ( base + ofs < trie->uniquecharcount ) ||
1992 ( base + ofs - trie->uniquecharcount < trie->lasttrans
538e84ed
KW
1993 && trie->trans[ base + ofs - trie->uniquecharcount ].check
1994 != state))
3dab1dad
YO
1995 ofs++;
1996
1997 PerlIO_printf( Perl_debug_log, "+%2"UVXf"[ ", (UV)ofs);
1998
1999 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
538e84ed
KW
2000 if ( ( base + ofs >= trie->uniquecharcount )
2001 && ( base + ofs - trie->uniquecharcount
2002 < trie->lasttrans )
2003 && trie->trans[ base + ofs
2004 - trie->uniquecharcount ].check == state )
3dab1dad 2005 {
ab3bbdeb
YO
2006 PerlIO_printf( Perl_debug_log, "%*"UVXf,
2007 colwidth,
538e84ed
KW
2008 (UV)trie->trans[ base + ofs
2009 - trie->uniquecharcount ].next );
3dab1dad 2010 } else {
ab3bbdeb 2011 PerlIO_printf( Perl_debug_log, "%*s",colwidth," ." );
3dab1dad
YO
2012 }
2013 }
2014
2015 PerlIO_printf( Perl_debug_log, "]");
2016
2017 }
2018 PerlIO_printf( Perl_debug_log, "\n" );
2019 }
538e84ed
KW
2020 PerlIO_printf(Perl_debug_log, "%*sword_info N:(prev,len)=",
2021 (int)depth*2, "");
2e64971a
DM
2022 for (word=1; word <= trie->wordcount; word++) {
2023 PerlIO_printf(Perl_debug_log, " %d:(%d,%d)",
2024 (int)word, (int)(trie->wordinfo[word].prev),
2025 (int)(trie->wordinfo[word].len));
2026 }
2027 PerlIO_printf(Perl_debug_log, "\n" );
538e84ed 2028}
3dab1dad 2029/*
3dab1dad 2030 Dumps a fully constructed but uncompressed trie in list form.
538e84ed 2031 List tries normally only are used for construction when the number of
3dab1dad
YO
2032 possible chars (trie->uniquecharcount) is very high.
2033 Used for debugging make_trie().
2034*/
2035STATIC void
55eed653 2036S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie,
2b8b4781
NC
2037 HV *widecharmap, AV *revcharmap, U32 next_alloc,
2038 U32 depth)
3dab1dad
YO
2039{
2040 U32 state;
ab3bbdeb 2041 SV *sv=sv_newmortal();
55eed653 2042 int colwidth= widecharmap ? 6 : 4;
3dab1dad 2043 GET_RE_DEBUG_FLAGS_DECL;
7918f24d
NC
2044
2045 PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_LIST;
2046
3dab1dad 2047 /* print out the table precompression. */
ab3bbdeb
YO
2048 PerlIO_printf( Perl_debug_log, "%*sState :Word | Transition Data\n%*s%s",
2049 (int)depth * 2 + 2,"", (int)depth * 2 + 2,"",
2050 "------:-----+-----------------\n" );
538e84ed 2051
3dab1dad
YO
2052 for( state=1 ; state < next_alloc ; state ++ ) {
2053 U16 charid;
538e84ed 2054
ab3bbdeb 2055 PerlIO_printf( Perl_debug_log, "%*s %4"UVXf" :",
3dab1dad
YO
2056 (int)depth * 2 + 2,"", (UV)state );
2057 if ( ! trie->states[ state ].wordnum ) {
2058 PerlIO_printf( Perl_debug_log, "%5s| ","");
2059 } else {
2060 PerlIO_printf( Perl_debug_log, "W%4x| ",
2061 trie->states[ state ].wordnum
2062 );
2063 }
2064 for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
538e84ed
KW
2065 SV ** const tmp = av_fetch( revcharmap,
2066 TRIE_LIST_ITEM(state,charid).forid, 0);
ab3bbdeb
YO
2067 if ( tmp ) {
2068 PerlIO_printf( Perl_debug_log, "%*s:%3X=%4"UVXf" | ",
2069 colwidth,
538e84ed
KW
2070 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp),
2071 colwidth,
2072 PL_colors[0], PL_colors[1],
2073 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)
2074 | PERL_PV_ESCAPE_FIRSTCHAR
ab3bbdeb 2075 ) ,
1e2e3d02
YO
2076 TRIE_LIST_ITEM(state,charid).forid,
2077 (UV)TRIE_LIST_ITEM(state,charid).newstate
2078 );
538e84ed 2079 if (!(charid % 10))
664e119d
RGS
2080 PerlIO_printf(Perl_debug_log, "\n%*s| ",
2081 (int)((depth * 2) + 14), "");
1e2e3d02 2082 }
ab3bbdeb
YO
2083 }
2084 PerlIO_printf( Perl_debug_log, "\n");
3dab1dad 2085 }
538e84ed 2086}
3dab1dad
YO
2087
2088/*
3dab1dad 2089 Dumps a fully constructed but uncompressed trie in table form.
538e84ed
KW
2090 This is the normal DFA style state transition table, with a few
2091 twists to facilitate compression later.
3dab1dad
YO
2092 Used for debugging make_trie().
2093*/
2094STATIC void
55eed653 2095S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie,
2b8b4781
NC
2096 HV *widecharmap, AV *revcharmap, U32 next_alloc,
2097 U32 depth)
3dab1dad
YO
2098{
2099 U32 state;
2100 U16 charid;
ab3bbdeb 2101 SV *sv=sv_newmortal();
55eed653 2102 int colwidth= widecharmap ? 6 : 4;
3dab1dad 2103 GET_RE_DEBUG_FLAGS_DECL;
7918f24d
NC
2104
2105 PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_TABLE;
538e84ed 2106
3dab1dad
YO
2107 /*
2108 print out the table precompression so that we can do a visual check
2109 that they are identical.
2110 */
538e84ed 2111
3dab1dad
YO
2112 PerlIO_printf( Perl_debug_log, "%*sChar : ",(int)depth * 2 + 2,"" );
2113
2114 for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
2b8b4781 2115 SV ** const tmp = av_fetch( revcharmap, charid, 0);
3dab1dad 2116 if ( tmp ) {
538e84ed 2117 PerlIO_printf( Perl_debug_log, "%*s",
ab3bbdeb 2118 colwidth,
538e84ed 2119 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
ab3bbdeb
YO
2120 PL_colors[0], PL_colors[1],
2121 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
538e84ed
KW
2122 PERL_PV_ESCAPE_FIRSTCHAR
2123 )
ab3bbdeb 2124 );
3dab1dad
YO
2125 }
2126 }
2127
2128 PerlIO_printf( Perl_debug_log, "\n%*sState+-",(int)depth * 2 + 2,"" );
2129
2130 for( charid=0 ; charid < trie->uniquecharcount ; charid++ ) {
ab3bbdeb 2131 PerlIO_printf( Perl_debug_log, "%.*s", colwidth,"--------");
3dab1dad
YO
2132 }
2133
2134 PerlIO_printf( Perl_debug_log, "\n" );
2135
2136 for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
2137
538e84ed 2138 PerlIO_printf( Perl_debug_log, "%*s%4"UVXf" : ",
3dab1dad
YO
2139 (int)depth * 2 + 2,"",
2140 (UV)TRIE_NODENUM( state ) );
2141
2142 for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
ab3bbdeb
YO
2143 UV v=(UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next );
2144 if (v)
2145 PerlIO_printf( Perl_debug_log, "%*"UVXf, colwidth, v );
2146 else
2147 PerlIO_printf( Perl_debug_log, "%*s", colwidth, "." );
3dab1dad
YO
2148 }
2149 if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
538e84ed
KW
2150 PerlIO_printf( Perl_debug_log, " (%4"UVXf")\n",
2151 (UV)trie->trans[ state ].check );
3dab1dad 2152 } else {
538e84ed
KW
2153 PerlIO_printf( Perl_debug_log, " (%4"UVXf") W%4X\n",
2154 (UV)trie->trans[ state ].check,
3dab1dad
YO
2155 trie->states[ TRIE_NODENUM( state ) ].wordnum );
2156 }
2157 }
07be1b83 2158}
3dab1dad
YO
2159
2160#endif
2161
2e64971a 2162
786e8c11
YO
2163/* make_trie(startbranch,first,last,tail,word_count,flags,depth)
2164 startbranch: the first branch in the whole branch sequence
2165 first : start branch of sequence of branch-exact nodes.
2166 May be the same as startbranch
2167 last : Thing following the last branch.
2168 May be the same as tail.
2169 tail : item following the branch sequence
2170 count : words in the sequence
a4525e78 2171 flags : currently the OP() type we will be building one of /EXACT(|F|FA|FU|FU_SS|L|FLU8)/
786e8c11 2172 depth : indent depth
3dab1dad 2173
786e8c11 2174Inplace optimizes a sequence of 2 or more Branch-Exact nodes into a TRIE node.
07be1b83 2175
786e8c11
YO
2176A trie is an N'ary tree where the branches are determined by digital
2177decomposition of the key. IE, at the root node you look up the 1st character and
2178follow that branch repeat until you find the end of the branches. Nodes can be
2179marked as "accepting" meaning they represent a complete word. Eg:
07be1b83 2180
786e8c11 2181 /he|she|his|hers/
72f13be8 2182
786e8c11
YO
2183would convert into the following structure. Numbers represent states, letters
2184following numbers represent valid transitions on the letter from that state, if
2185the number is in square brackets it represents an accepting state, otherwise it
2186will be in parenthesis.
07be1b83 2187
786e8c11
YO
2188 +-h->+-e->[3]-+-r->(8)-+-s->[9]
2189 | |
2190 | (2)
2191 | |
2192 (1) +-i->(6)-+-s->[7]
2193 |
2194 +-s->(3)-+-h->(4)-+-e->[5]
07be1b83 2195
786e8c11
YO
2196 Accept Word Mapping: 3=>1 (he),5=>2 (she), 7=>3 (his), 9=>4 (hers)
2197
2198This shows that when matching against the string 'hers' we will begin at state 1
2199read 'h' and move to state 2, read 'e' and move to state 3 which is accepting,
2200then read 'r' and go to state 8 followed by 's' which takes us to state 9 which
2201is also accepting. Thus we know that we can match both 'he' and 'hers' with a
2202single traverse. We store a mapping from accepting to state to which word was
2203matched, and then when we have multiple possibilities we try to complete the
b8fda935 2204rest of the regex in the order in which they occurred in the alternation.
786e8c11
YO
2205
2206The only prior NFA like behaviour that would be changed by the TRIE support is
2207the silent ignoring of duplicate alternations which are of the form:
2208
2209 / (DUPE|DUPE) X? (?{ ... }) Y /x
2210
4b714af6 2211Thus EVAL blocks following a trie may be called a different number of times with
786e8c11 2212and without the optimisation. With the optimisations dupes will be silently
486ec47a 2213ignored. This inconsistent behaviour of EVAL type nodes is well established as
786e8c11
YO
2214the following demonstrates:
2215
2216 'words'=~/(word|word|word)(?{ print $1 })[xyz]/
2217
2218which prints out 'word' three times, but
2219
2220 'words'=~/(word|word|word)(?{ print $1 })S/
2221
2222which doesnt print it out at all. This is due to other optimisations kicking in.
2223
2224Example of what happens on a structural level:
2225
486ec47a 2226The regexp /(ac|ad|ab)+/ will produce the following debug output:
786e8c11
YO
2227
2228 1: CURLYM[1] {1,32767}(18)
2229 5: BRANCH(8)
2230 6: EXACT <ac>(16)
2231 8: BRANCH(11)
2232 9: EXACT <ad>(16)
2233 11: BRANCH(14)
2234 12: EXACT <ab>(16)
2235 16: SUCCEED(0)
2236 17: NOTHING(18)
2237 18: END(0)
2238
2239This would be optimizable with startbranch=5, first=5, last=16, tail=16
2240and should turn into:
2241
2242 1: CURLYM[1] {1,32767}(18)
2243 5: TRIE(16)
2244 [Words:3 Chars Stored:6 Unique Chars:4 States:5 NCP:1]
2245 <ac>
2246 <ad>
2247 <ab>
2248 16: SUCCEED(0)
2249 17: NOTHING(18)
2250 18: END(0)
2251
2252Cases where tail != last would be like /(?foo|bar)baz/:
2253
2254 1: BRANCH(4)
2255 2: EXACT <foo>(8)
2256 4: BRANCH(7)
2257 5: EXACT <bar>(8)
2258 7: TAIL(8)
2259 8: EXACT <baz>(10)
2260 10: END(0)
2261
2262which would be optimizable with startbranch=1, first=1, last=7, tail=8
2263and would end up looking like:
2264
2265 1: TRIE(8)
2266 [Words:2 Chars Stored:6 Unique Chars:5 States:7 NCP:1]
2267 <foo>
2268 <bar>
2269 7: TAIL(8)
2270 8: EXACT <baz>(10)
2271 10: END(0)
2272
c80e42f3 2273 d = uvchr_to_utf8_flags(d, uv, 0);
786e8c11
YO
2274
2275is the recommended Unicode-aware way of saying
2276
2277 *(d++) = uv;
2278*/
2279
fab2782b 2280#define TRIE_STORE_REVCHAR(val) \
786e8c11 2281 STMT_START { \
73031816 2282 if (UTF) { \
668fcfea 2283 SV *zlopp = newSV(UTF8_MAXBYTES); \
88c9ea1e 2284 unsigned char *flrbbbbb = (unsigned char *) SvPVX(zlopp); \
c80e42f3 2285 unsigned const char *const kapow = uvchr_to_utf8(flrbbbbb, val); \
73031816
NC
2286 SvCUR_set(zlopp, kapow - flrbbbbb); \
2287 SvPOK_on(zlopp); \
2288 SvUTF8_on(zlopp); \
2289 av_push(revcharmap, zlopp); \
2290 } else { \
fab2782b 2291 char ooooff = (char)val; \
73031816
NC
2292 av_push(revcharmap, newSVpvn(&ooooff, 1)); \
2293 } \
2294 } STMT_END
786e8c11 2295
914a25d5
KW
2296/* This gets the next character from the input, folding it if not already
2297 * folded. */
2298#define TRIE_READ_CHAR STMT_START { \
2299 wordlen++; \
2300 if ( UTF ) { \
2301 /* if it is UTF then it is either already folded, or does not need \
2302 * folding */ \
1c1d615a 2303 uvc = valid_utf8_to_uvchr( (const U8*) uc, &len); \
914a25d5
KW
2304 } \
2305 else if (folder == PL_fold_latin1) { \
7d006b13
KW
2306 /* This folder implies Unicode rules, which in the range expressible \
2307 * by not UTF is the lower case, with the two exceptions, one of \
2308 * which should have been taken care of before calling this */ \
2309 assert(*uc != LATIN_SMALL_LETTER_SHARP_S); \
2310 uvc = toLOWER_L1(*uc); \
2311 if (UNLIKELY(uvc == MICRO_SIGN)) uvc = GREEK_SMALL_LETTER_MU; \
2312 len = 1; \
914a25d5
KW
2313 } else { \
2314 /* raw data, will be folded later if needed */ \
2315 uvc = (U32)*uc; \
2316 len = 1; \
2317 } \
786e8c11
YO
2318} STMT_END
2319
2320
2321
2322#define TRIE_LIST_PUSH(state,fid,ns) STMT_START { \
2323 if ( TRIE_LIST_CUR( state ) >=TRIE_LIST_LEN( state ) ) { \
f9003953
NC
2324 U32 ging = TRIE_LIST_LEN( state ) *= 2; \
2325 Renew( trie->states[ state ].trans.list, ging, reg_trie_trans_le ); \
786e8c11
YO
2326 } \
2327 TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).forid = fid; \
2328 TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).newstate = ns; \
2329 TRIE_LIST_CUR( state )++; \
2330} STMT_END
07be1b83 2331
786e8c11
YO
2332#define TRIE_LIST_NEW(state) STMT_START { \
2333 Newxz( trie->states[ state ].trans.list, \
2334 4, reg_trie_trans_le ); \
2335 TRIE_LIST_CUR( state ) = 1; \
2336 TRIE_LIST_LEN( state ) = 4; \
2337} STMT_END
07be1b83 2338
786e8c11
YO
2339#define TRIE_HANDLE_WORD(state) STMT_START { \
2340 U16 dupe= trie->states[ state ].wordnum; \
2341 regnode * const noper_next = regnext( noper ); \
2342 \
786e8c11
YO
2343 DEBUG_r({ \
2344 /* store the word for dumping */ \
2345 SV* tmp; \
2346 if (OP(noper) != NOTHING) \
740cce10 2347 tmp = newSVpvn_utf8(STRING(noper), STR_LEN(noper), UTF); \
786e8c11 2348 else \
740cce10 2349 tmp = newSVpvn_utf8( "", 0, UTF ); \
2b8b4781 2350 av_push( trie_words, tmp ); \
786e8c11
YO
2351 }); \
2352 \
2353 curword++; \
2e64971a
DM
2354 trie->wordinfo[curword].prev = 0; \
2355 trie->wordinfo[curword].len = wordlen; \
2356 trie->wordinfo[curword].accept = state; \
786e8c11
YO
2357 \
2358 if ( noper_next < tail ) { \
2359 if (!trie->jump) \
538e84ed
KW
2360 trie->jump = (U16 *) PerlMemShared_calloc( word_count + 1, \
2361 sizeof(U16) ); \
7f69552c 2362 trie->jump[curword] = (U16)(noper_next - convert); \
786e8c11
YO
2363 if (!jumper) \
2364 jumper = noper_next; \
2365 if (!nextbranch) \
2366 nextbranch= regnext(cur); \
2367 } \
2368 \
2369 if ( dupe ) { \
2e64971a
DM
2370 /* It's a dupe. Pre-insert into the wordinfo[].prev */\
2371 /* chain, so that when the bits of chain are later */\
2372 /* linked together, the dups appear in the chain */\
2373 trie->wordinfo[curword].prev = trie->wordinfo[dupe].prev; \
2374 trie->wordinfo[dupe].prev = curword; \
786e8c11
YO
2375 } else { \
2376 /* we haven't inserted this word yet. */ \
2377 trie->states[ state ].wordnum = curword; \
2378 } \
2379} STMT_END
07be1b83 2380
3dab1dad 2381
786e8c11
YO
2382#define TRIE_TRANS_STATE(state,base,ucharcount,charid,special) \
2383 ( ( base + charid >= ucharcount \
2384 && base + charid < ubound \
2385 && state == trie->trans[ base - ucharcount + charid ].check \
2386 && trie->trans[ base - ucharcount + charid ].next ) \
2387 ? trie->trans[ base - ucharcount + charid ].next \
2388 : ( state==1 ? special : 0 ) \
2389 )
3dab1dad 2390
786e8c11
YO
2391#define MADE_TRIE 1
2392#define MADE_JUMP_TRIE 2
2393#define MADE_EXACT_TRIE 4
3dab1dad 2394
a3621e74 2395STATIC I32
538e84ed
KW
2396S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch,
2397 regnode *first, regnode *last, regnode *tail,
2398 U32 word_count, U32 flags, U32 depth)
a3621e74
YO
2399{
2400 /* first pass, loop through and scan words */
2401 reg_trie_data *trie;
55eed653 2402 HV *widecharmap = NULL;
2b8b4781 2403 AV *revcharmap = newAV();
a3621e74 2404 regnode *cur;
a3621e74
YO
2405 STRLEN len = 0;
2406 UV uvc = 0;
2407 U16 curword = 0;
2408 U32 next_alloc = 0;
786e8c11
YO
2409 regnode *jumper = NULL;
2410 regnode *nextbranch = NULL;
7f69552c 2411 regnode *convert = NULL;
2e64971a 2412 U32 *prev_states; /* temp array mapping each state to previous one */
a3621e74 2413 /* we just use folder as a flag in utf8 */
1e696034 2414 const U8 * folder = NULL;
a3621e74 2415
2b8b4781 2416#ifdef DEBUGGING
cf78de0b 2417 const U32 data_slot = add_data( pRExC_state, STR_WITH_LEN("tuuu"));
2b8b4781
NC
2418 AV *trie_words = NULL;
2419 /* along with revcharmap, this only used during construction but both are
2420 * useful during debugging so we store them in the struct when debugging.
8e11feef 2421 */
2b8b4781 2422#else
cf78de0b 2423 const U32 data_slot = add_data( pRExC_state, STR_WITH_LEN("tu"));
3dab1dad 2424 STRLEN trie_charcount=0;
3dab1dad 2425#endif
2b8b4781 2426 SV *re_trie_maxbuff;
a3621e74 2427 GET_RE_DEBUG_FLAGS_DECL;
7918f24d
NC
2428
2429 PERL_ARGS_ASSERT_MAKE_TRIE;
72f13be8
YO
2430#ifndef DEBUGGING
2431 PERL_UNUSED_ARG(depth);
2432#endif
a3621e74 2433
1e696034 2434 switch (flags) {
a4525e78 2435 case EXACT: case EXACTL: break;
2f7f8cb1 2436 case EXACTFA:
fab2782b 2437 case EXACTFU_SS:
a4525e78
KW
2438 case EXACTFU:
2439 case EXACTFLU8: folder = PL_fold_latin1; break;
1e696034 2440 case EXACTF: folder = PL_fold; break;
fab2782b 2441 default: Perl_croak( aTHX_ "panic! In trie construction, unknown node type %u %s", (unsigned) flags, PL_reg_name[flags] );
1e696034
KW
2442 }
2443
c944940b 2444 trie = (reg_trie_data *) PerlMemShared_calloc( 1, sizeof(reg_trie_data) );
a3621e74 2445 trie->refcount = 1;
3dab1dad 2446 trie->startstate = 1;
786e8c11 2447 trie->wordcount = word_count;
f8fc2ecf 2448 RExC_rxi->data->data[ data_slot ] = (void*)trie;
c944940b 2449 trie->charmap = (U16 *) PerlMemShared_calloc( 256, sizeof(U16) );
a4525e78 2450 if (flags == EXACT || flags == EXACTL)
c944940b 2451 trie->bitmap = (char *) PerlMemShared_calloc( ANYOF_BITMAP_SIZE, 1 );
2e64971a
DM
2452 trie->wordinfo = (reg_trie_wordinfo *) PerlMemShared_calloc(
2453 trie->wordcount+1, sizeof(reg_trie_wordinfo));
2454
a3621e74 2455 DEBUG_r({
2b8b4781 2456 trie_words = newAV();
a3621e74 2457 });
a3621e74 2458
0111c4fd 2459 re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
316ebaf2 2460 assert(re_trie_maxbuff);
a3621e74 2461 if (!SvIOK(re_trie_maxbuff)) {
0111c4fd 2462 sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
a3621e74 2463 }
df826430 2464 DEBUG_TRIE_COMPILE_r({
538e84ed
KW
2465 PerlIO_printf( Perl_debug_log,
2466 "%*smake_trie start==%d, first==%d, last==%d, tail==%d depth=%d\n",
2467 (int)depth * 2 + 2, "",
2468 REG_NODE_NUM(startbranch),REG_NODE_NUM(first),
2469 REG_NODE_NUM(last), REG_NODE_NUM(tail), (int)depth);
3dab1dad 2470 });
538e84ed 2471
7f69552c
YO
2472 /* Find the node we are going to overwrite */
2473 if ( first == startbranch && OP( last ) != BRANCH ) {
2474 /* whole branch chain */
2475 convert = first;
2476 } else {
2477 /* branch sub-chain */
2478 convert = NEXTOPER( first );
2479 }
538e84ed 2480
a3621e74
YO
2481 /* -- First loop and Setup --
2482
2483 We first traverse the branches and scan each word to determine if it
2484 contains widechars, and how many unique chars there are, this is
2485 important as we have to build a table with at least as many columns as we
2486 have unique chars.
2487
2488 We use an array of integers to represent the character codes 0..255
538e84ed
KW
2489 (trie->charmap) and we use a an HV* to store Unicode characters. We use
2490 the native representation of the character value as the key and IV's for
2491 the coded index.
a3621e74
YO
2492
2493 *TODO* If we keep track of how many times each character is used we can
2494 remap the columns so that the table compression later on is more
3b753521 2495 efficient in terms of memory by ensuring the most common value is in the
a3621e74
YO
2496 middle and the least common are on the outside. IMO this would be better
2497 than a most to least common mapping as theres a decent chance the most
2498 common letter will share a node with the least common, meaning the node
486ec47a 2499 will not be compressible. With a middle is most common approach the worst
a3621e74
YO
2500 case is when we have the least common nodes twice.
2501
2502 */
2503
a3621e74 2504 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
df826430 2505 regnode *noper = NEXTOPER( cur );
e1ec3a88 2506 const U8 *uc = (U8*)STRING( noper );
df826430 2507 const U8 *e = uc + STR_LEN( noper );
bc031a7d 2508 int foldlen = 0;
07be1b83 2509 U32 wordlen = 0; /* required init */
bc031a7d
KW
2510 STRLEN minchars = 0;
2511 STRLEN maxchars = 0;
538e84ed
KW
2512 bool set_bit = trie->bitmap ? 1 : 0; /*store the first char in the
2513 bitmap?*/
a3621e74 2514
3dab1dad 2515 if (OP(noper) == NOTHING) {
df826430
YO
2516 regnode *noper_next= regnext(noper);
2517 if (noper_next != tail && OP(noper_next) == flags) {
2518 noper = noper_next;
2519 uc= (U8*)STRING(noper);
2520 e= uc + STR_LEN(noper);
2521 trie->minlen= STR_LEN(noper);
2522 } else {
2523 trie->minlen= 0;
2524 continue;
2525 }
3dab1dad 2526 }
df826430 2527
fab2782b 2528 if ( set_bit ) { /* bitmap only alloced when !(UTF&&Folding) */
02daf0ab
YO
2529 TRIE_BITMAP_SET(trie,*uc); /* store the raw first byte
2530 regardless of encoding */
fab2782b
YO
2531 if (OP( noper ) == EXACTFU_SS) {
2532 /* false positives are ok, so just set this */
0dc4a61d 2533 TRIE_BITMAP_SET(trie, LATIN_SMALL_LETTER_SHARP_S);
fab2782b
YO
2534 }
2535 }
bc031a7d
KW
2536 for ( ; uc < e ; uc += len ) { /* Look at each char in the current
2537 branch */
3dab1dad 2538 TRIE_CHARCOUNT(trie)++;
a3621e74 2539 TRIE_READ_CHAR;
645de4ce 2540
bc031a7d
KW
2541 /* TRIE_READ_CHAR returns the current character, or its fold if /i
2542 * is in effect. Under /i, this character can match itself, or
2543 * anything that folds to it. If not under /i, it can match just
2544 * itself. Most folds are 1-1, for example k, K, and KELVIN SIGN
2545 * all fold to k, and all are single characters. But some folds
2546 * expand to more than one character, so for example LATIN SMALL
2547 * LIGATURE FFI folds to the three character sequence 'ffi'. If
2548 * the string beginning at 'uc' is 'ffi', it could be matched by
2549 * three characters, or just by the one ligature character. (It
2550 * could also be matched by two characters: LATIN SMALL LIGATURE FF
2551 * followed by 'i', or by 'f' followed by LATIN SMALL LIGATURE FI).
2552 * (Of course 'I' and/or 'F' instead of 'i' and 'f' can also
2553 * match.) The trie needs to know the minimum and maximum number
2554 * of characters that could match so that it can use size alone to
2555 * quickly reject many match attempts. The max is simple: it is
2556 * the number of folded characters in this branch (since a fold is
2557 * never shorter than what folds to it. */
2558
2559 maxchars++;
2560
2561 /* And the min is equal to the max if not under /i (indicated by
2562 * 'folder' being NULL), or there are no multi-character folds. If
2563 * there is a multi-character fold, the min is incremented just
2564 * once, for the character that folds to the sequence. Each
2565 * character in the sequence needs to be added to the list below of
2566 * characters in the trie, but we count only the first towards the
2567 * min number of characters needed. This is done through the
2568 * variable 'foldlen', which is returned by the macros that look
2569 * for these sequences as the number of bytes the sequence
2570 * occupies. Each time through the loop, we decrement 'foldlen' by
2571 * how many bytes the current char occupies. Only when it reaches
2572 * 0 do we increment 'minchars' or look for another multi-character
2573 * sequence. */
2574 if (folder == NULL) {
2575 minchars++;
2576 }
2577 else if (foldlen > 0) {
2578 foldlen -= (UTF) ? UTF8SKIP(uc) : 1;
645de4ce
KW
2579 }
2580 else {
bc031a7d
KW
2581 minchars++;
2582
2583 /* See if *uc is the beginning of a multi-character fold. If
2584 * so, we decrement the length remaining to look at, to account
2585 * for the current character this iteration. (We can use 'uc'
2586 * instead of the fold returned by TRIE_READ_CHAR because for
2587 * non-UTF, the latin1_safe macro is smart enough to account
2588 * for all the unfolded characters, and because for UTF, the
2589 * string will already have been folded earlier in the
2590 * compilation process */
2591 if (UTF) {
2592 if ((foldlen = is_MULTI_CHAR_FOLD_utf8_safe(uc, e))) {
2593 foldlen -= UTF8SKIP(uc);
645de4ce
KW
2594 }
2595 }
bc031a7d
KW
2596 else if ((foldlen = is_MULTI_CHAR_FOLD_latin1_safe(uc, e))) {
2597 foldlen--;
2598 }
645de4ce 2599 }
bc031a7d
KW
2600
2601 /* The current character (and any potential folds) should be added
2602 * to the possible matching characters for this position in this
2603 * branch */
a3621e74 2604 if ( uvc < 256 ) {
fab2782b
YO
2605 if ( folder ) {
2606 U8 folded= folder[ (U8) uvc ];
2607 if ( !trie->charmap[ folded ] ) {
2608 trie->charmap[ folded ]=( ++trie->uniquecharcount );
2609 TRIE_STORE_REVCHAR( folded );
2610 }
2611 }
a3621e74
YO
2612 if ( !trie->charmap[ uvc ] ) {
2613 trie->charmap[ uvc ]=( ++trie->uniquecharcount );
fab2782b 2614 TRIE_STORE_REVCHAR( uvc );
a3621e74 2615 }
02daf0ab 2616 if ( set_bit ) {
62012aee
KW
2617 /* store the codepoint in the bitmap, and its folded
2618 * equivalent. */
fab2782b 2619 TRIE_BITMAP_SET(trie, uvc);
0921ee73
T
2620
2621 /* store the folded codepoint */
fab2782b 2622 if ( folder ) TRIE_BITMAP_SET(trie, folder[(U8) uvc ]);
0921ee73
T
2623
2624 if ( !UTF ) {
2625 /* store first byte of utf8 representation of
acdf4139 2626 variant codepoints */
6f2d5cbc 2627 if (! UVCHR_IS_INVARIANT(uvc)) {
acdf4139 2628 TRIE_BITMAP_SET(trie, UTF8_TWO_BYTE_HI(uvc));
0921ee73
T
2629 }
2630 }
02daf0ab
YO
2631 set_bit = 0; /* We've done our bit :-) */
2632 }
a3621e74 2633 } else {
bc031a7d
KW
2634
2635 /* XXX We could come up with the list of code points that fold
2636 * to this using PL_utf8_foldclosures, except not for
2637 * multi-char folds, as there may be multiple combinations
2638 * there that could work, which needs to wait until runtime to
2639 * resolve (The comment about LIGATURE FFI above is such an
2640 * example */
2641
a3621e74 2642 SV** svpp;
55eed653
NC
2643 if ( !widecharmap )
2644 widecharmap = newHV();
a3621e74 2645
55eed653 2646 svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 1 );
a3621e74
YO
2647
2648 if ( !svpp )
e4584336 2649 Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%"UVXf, uvc );
a3621e74
YO
2650
2651 if ( !SvTRUE( *svpp ) ) {
2652 sv_setiv( *svpp, ++trie->uniquecharcount );
fab2782b 2653 TRIE_STORE_REVCHAR(uvc);
a3621e74
YO
2654 }
2655 }
bc031a7d
KW
2656 } /* end loop through characters in this branch of the trie */
2657
2658 /* We take the min and max for this branch and combine to find the min
2659 * and max for all branches processed so far */
3dab1dad 2660 if( cur == first ) {
bc031a7d
KW
2661 trie->minlen = minchars;
2662 trie->maxlen = maxchars;
2663 } else if (minchars < trie->minlen) {
2664 trie->minlen = minchars;
2665 } else if (maxchars > trie->maxlen) {
2666 trie->maxlen = maxchars;
fab2782b 2667 }
a3621e74
YO
2668 } /* end first pass */
2669 DEBUG_TRIE_COMPILE_r(
538e84ed
KW
2670 PerlIO_printf( Perl_debug_log,
2671 "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
3dab1dad 2672 (int)depth * 2 + 2,"",
55eed653 2673 ( widecharmap ? "UTF8" : "NATIVE" ), (int)word_count,
be8e71aa
YO
2674 (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount,
2675 (int)trie->minlen, (int)trie->maxlen )
a3621e74 2676 );
a3621e74
YO
2677
2678 /*
2679 We now know what we are dealing with in terms of unique chars and
2680 string sizes so we can calculate how much memory a naive
0111c4fd
RGS
2681 representation using a flat table will take. If it's over a reasonable
2682 limit (as specified by ${^RE_TRIE_MAXBUF}) we use a more memory
a3621e74
YO
2683 conservative but potentially much slower representation using an array
2684 of lists.
2685
2686 At the end we convert both representations into the same compressed
2687 form that will be used in regexec.c for matching with. The latter
2688 is a form that cannot be used to construct with but has memory
2689 properties similar to the list form and access properties similar
2690 to the table form making it both suitable for fast searches and
2691 small enough that its feasable to store for the duration of a program.
2692
2693 See the comment in the code where the compressed table is produced
2694 inplace from the flat tabe representation for an explanation of how
2695 the compression works.
2696
2697 */
2698
2699
2e64971a
DM
2700 Newx(prev_states, TRIE_CHARCOUNT(trie) + 2, U32);
2701 prev_states[1] = 0;
2702
538e84ed
KW
2703 if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1)
2704 > SvIV(re_trie_maxbuff) )
2705 {
a3621e74
YO
2706 /*
2707 Second Pass -- Array Of Lists Representation
2708
2709 Each state will be represented by a list of charid:state records
2710 (reg_trie_trans_le) the first such element holds the CUR and LEN
2711 points of the allocated array. (See defines above).
2712
2713 We build the initial structure using the lists, and then convert
2714 it into the compressed table form which allows faster lookups
2715 (but cant be modified once converted).
a3621e74
YO
2716 */
2717
a3621e74
YO
2718 STRLEN transcount = 1;
2719
538e84ed 2720 DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
1e2e3d02
YO
2721 "%*sCompiling trie using list compiler\n",
2722 (int)depth * 2 + 2, ""));
686b73d4 2723
c944940b
JH
2724 trie->states = (reg_trie_state *)
2725 PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
2726 sizeof(reg_trie_state) );
a3621e74
YO
2727 TRIE_LIST_NEW(1);
2728 next_alloc = 2;
2729
2730 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
2731
df826430 2732 regnode *noper = NEXTOPER( cur );
c445ea15 2733 U8 *uc = (U8*)STRING( noper );
df826430 2734 const U8 *e = uc + STR_LEN( noper );
c445ea15
AL
2735 U32 state = 1; /* required init */
2736 U16 charid = 0; /* sanity init */
07be1b83 2737 U32 wordlen = 0; /* required init */
c445ea15 2738
df826430
YO
2739 if (OP(noper) == NOTHING) {
2740 regnode *noper_next= regnext(noper);
2741 if (noper_next != tail && OP(noper_next) == flags) {
2742 noper = noper_next;
2743 uc= (U8*)STRING(noper);
2744 e= uc + STR_LEN(noper);
2745 }
2746 }
2747
3dab1dad 2748 if (OP(noper) != NOTHING) {
786e8c11 2749 for ( ; uc < e ; uc += len ) {
c445ea15 2750
786e8c11 2751 TRIE_READ_CHAR;
c445ea15 2752
786e8c11
YO
2753 if ( uvc < 256 ) {
2754 charid = trie->charmap[ uvc ];
c445ea15 2755 } else {
538e84ed
KW
2756 SV** const svpp = hv_fetch( widecharmap,
2757 (char*)&uvc,
2758 sizeof( UV ),
2759 0);
786e8c11
YO
2760 if ( !svpp ) {
2761 charid = 0;
2762 } else {
2763 charid=(U16)SvIV( *svpp );
2764 }
c445ea15 2765 }
538e84ed
KW
2766 /* charid is now 0 if we dont know the char read, or
2767 * nonzero if we do */
786e8c11 2768 if ( charid ) {
a3621e74 2769
786e8c11
YO
2770 U16 check;
2771 U32 newstate = 0;
a3621e74 2772
786e8c11
YO
2773 charid--;
2774 if ( !trie->states[ state ].trans.list ) {
2775 TRIE_LIST_NEW( state );
c445ea15 2776 }
538e84ed
KW
2777 for ( check = 1;
2778 check <= TRIE_LIST_USED( state );
2779 check++ )
2780 {
2781 if ( TRIE_LIST_ITEM( state, check ).forid
2782 == charid )
2783 {
786e8c11
YO
2784 newstate = TRIE_LIST_ITEM( state, check ).newstate;
2785 break;
2786 }
2787 }
2788 if ( ! newstate ) {
2789 newstate = next_alloc++;
2e64971a 2790 prev_states[newstate] = state;
786e8c11
YO
2791 TRIE_LIST_PUSH( state, charid, newstate );
2792 transcount++;
2793 }
2794 state = newstate;
2795 } else {
2796 Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
c445ea15 2797 }
a28509cc 2798 }
c445ea15 2799 }
3dab1dad 2800 TRIE_HANDLE_WORD(state);
a3621e74
YO
2801
2802 } /* end second pass */
2803
1e2e3d02 2804 /* next alloc is the NEXT state to be allocated */
538e84ed 2805 trie->statecount = next_alloc;
c944940b
JH
2806 trie->states = (reg_trie_state *)
2807 PerlMemShared_realloc( trie->states,
2808 next_alloc
2809 * sizeof(reg_trie_state) );
a3621e74 2810
3dab1dad 2811 /* and now dump it out before we compress it */
2b8b4781
NC
2812 DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_list(trie, widecharmap,
2813 revcharmap, next_alloc,
2814 depth+1)
1e2e3d02 2815 );
a3621e74 2816
c944940b
JH
2817 trie->trans = (reg_trie_trans *)
2818 PerlMemShared_calloc( transcount, sizeof(reg_trie_trans) );
a3621e74
YO
2819 {
2820 U32 state;
a3621e74
YO
2821 U32 tp = 0;
2822 U32 zp = 0;
2823
2824
2825 for( state=1 ; state < next_alloc ; state ++ ) {
2826 U32 base=0;
2827
2828 /*
2829 DEBUG_TRIE_COMPILE_MORE_r(
2830 PerlIO_printf( Perl_debug_log, "tp: %d zp: %d ",tp,zp)
2831 );
2832 */
2833
2834 if (trie->states[state].trans.list) {
2835 U16 minid=TRIE_LIST_ITEM( state, 1).forid;
2836 U16 maxid=minid;
a28509cc 2837 U16 idx;
a3621e74
YO
2838
2839 for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
c445ea15
AL
2840 const U16 forid = TRIE_LIST_ITEM( state, idx).forid;
2841 if ( forid < minid ) {
2842 minid=forid;
2843 } else if ( forid > maxid ) {
2844 maxid=forid;
2845 }
a3621e74
YO
2846 }
2847 if ( transcount < tp + maxid - minid + 1) {
2848 transcount *= 2;
c944940b
JH
2849 trie->trans = (reg_trie_trans *)
2850 PerlMemShared_realloc( trie->trans,
446bd890
NC
2851 transcount
2852 * sizeof(reg_trie_trans) );
538e84ed
KW
2853 Zero( trie->trans + (transcount / 2),
2854 transcount / 2,
2855 reg_trie_trans );
a3621e74
YO
2856 }
2857 base = trie->uniquecharcount + tp - minid;
2858 if ( maxid == minid ) {
2859 U32 set = 0;
2860 for ( ; zp < tp ; zp++ ) {
2861 if ( ! trie->trans[ zp ].next ) {
2862 base = trie->uniquecharcount + zp - minid;
538e84ed
KW
2863 trie->trans[ zp ].next = TRIE_LIST_ITEM( state,
2864 1).newstate;
a3621e74
YO
2865 trie->trans[ zp ].check = state;
2866 set = 1;
2867 break;
2868 }
2869 }
2870 if ( !set ) {
538e84ed
KW
2871 trie->trans[ tp ].next = TRIE_LIST_ITEM( state,
2872 1).newstate;
a3621e74
YO
2873 trie->trans[ tp ].check = state;
2874 tp++;
2875 zp = tp;
2876 }
2877 } else {
2878 for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
538e84ed
KW
2879 const U32 tid = base
2880 - trie->uniquecharcount
2881 + TRIE_LIST_ITEM( state, idx ).forid;
2882 trie->trans[ tid ].next = TRIE_LIST_ITEM( state,
2883 idx ).newstate;
a3621e74
YO
2884 trie->trans[ tid ].check = state;
2885 }
2886 tp += ( maxid - minid + 1 );
2887 }
2888 Safefree(trie->states[ state ].trans.list);
2889 }
2890 /*
2891 DEBUG_TRIE_COMPILE_MORE_r(
2892 PerlIO_printf( Perl_debug_log, " base: %d\n",base);
2893 );
2894 */
2895 trie->states[ state ].trans.base=base;
2896 }
cc601c31 2897 trie->lasttrans = tp + 1;
a3621e74
YO
2898 }
2899 } else {
2900 /*
2901 Second Pass -- Flat Table Representation.
2902
b423522f
KW
2903 we dont use the 0 slot of either trans[] or states[] so we add 1 to
2904 each. We know that we will need Charcount+1 trans at most to store
2905 the data (one row per char at worst case) So we preallocate both
2906 structures assuming worst case.
a3621e74
YO
2907
2908 We then construct the trie using only the .next slots of the entry
2909 structs.
2910
b423522f
KW
2911 We use the .check field of the first entry of the node temporarily
2912 to make compression both faster and easier by keeping track of how
2913 many non zero fields are in the node.
a3621e74
YO
2914
2915 Since trans are numbered from 1 any 0 pointer in the table is a FAIL
2916 transition.
2917
b423522f
KW
2918 There are two terms at use here: state as a TRIE_NODEIDX() which is
2919 a number representing the first entry of the node, and state as a
2920 TRIE_NODENUM() which is the trans number. state 1 is TRIE_NODEIDX(1)
2921 and TRIE_NODENUM(1), state 2 is TRIE_NODEIDX(2) and TRIE_NODENUM(3)
2922 if there are 2 entrys per node. eg:
a3621e74
YO
2923
2924 A B A B
2925 1. 2 4 1. 3 7
2926 2. 0 3 3. 0 5
2927 3. 0 0 5. 0 0
2928 4. 0 0 7. 0 0
2929
b423522f
KW
2930 The table is internally in the right hand, idx form. However as we
2931 also have to deal with the states array which is indexed by nodenum
2932 we have to use TRIE_NODENUM() to convert.
a3621e74
YO
2933
2934 */
538e84ed 2935 DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
1e2e3d02
YO
2936 "%*sCompiling trie using table compiler\n",
2937 (int)depth * 2 + 2, ""));
3dab1dad 2938
c944940b
JH
2939 trie->trans = (reg_trie_trans *)
2940 PerlMemShared_calloc( ( TRIE_CHARCOUNT(trie) + 1 )
2941 * trie->uniquecharcount + 1,
2942 sizeof(reg_trie_trans) );
2943 trie->states = (reg_trie_state *)
2944 PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
2945 sizeof(reg_trie_state) );
a3621e74
YO
2946 next_alloc = trie->uniquecharcount + 1;
2947
3dab1dad 2948
a3621e74
YO
2949 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
2950
df826430 2951 regnode *noper = NEXTOPER( cur );
a28509cc 2952 const U8 *uc = (U8*)STRING( noper );
df826430 2953 const U8 *e = uc + STR_LEN( noper );
a3621e74
YO
2954
2955 U32 state = 1; /* required init */
2956
2957 U16 charid = 0; /* sanity init */
2958 U32 accept_state = 0; /* sanity init */
a3621e74 2959
07be1b83 2960 U32 wordlen = 0; /* required init */
a3621e74 2961
df826430
YO
2962 if (OP(noper) == NOTHING) {
2963 regnode *noper_next= regnext(noper);
2964 if (noper_next != tail && OP(noper_next) == flags) {
2965 noper = noper_next;
2966 uc= (U8*)STRING(noper);
2967 e= uc + STR_LEN(noper);
2968 }
2969 }
fab2782b 2970
3dab1dad 2971 if ( OP(noper) != NOTHING ) {
786e8c11 2972 for ( ; uc < e ; uc += len ) {
a3621e74 2973
786e8c11 2974 TRIE_READ_CHAR;
a3621e74 2975
786e8c11
YO
2976 if ( uvc < 256 ) {
2977 charid = trie->charmap[ uvc ];
2978 } else {
538e84ed
KW
2979 SV* const * const svpp = hv_fetch( widecharmap,
2980 (char*)&uvc,
2981 sizeof( UV ),
2982 0);
786e8c11 2983 charid = svpp ? (U16)SvIV(*svpp) : 0;
a3621e74 2984 }
786e8c11
YO
2985 if ( charid ) {
2986 charid--;
2987 if ( !trie->trans[ state + charid ].next ) {
2988 trie->trans[ state + charid ].next = next_alloc;
2989 trie->trans[ state ].check++;
2e64971a
DM
2990 prev_states[TRIE_NODENUM(next_alloc)]
2991 = TRIE_NODENUM(state);
786e8c11
YO
2992 next_alloc += trie->uniquecharcount;
2993 }
2994 state = trie->trans[ state + charid ].next;
2995 } else {
2996 Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
2997 }
538e84ed
KW
2998 /* charid is now 0 if we dont know the char read, or
2999 * nonzero if we do */
a3621e74 3000 }
a3621e74 3001 }
3dab1dad
YO
3002 accept_state = TRIE_NODENUM( state );
3003 TRIE_HANDLE_WORD(accept_state);
a3621e74
YO
3004
3005 } /* end second pass */
3006
3dab1dad 3007 /* and now dump it out before we compress it */
2b8b4781
NC
3008 DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_table(trie, widecharmap,
3009 revcharmap,
3010 next_alloc, depth+1));
a3621e74 3011
a3621e74
YO
3012 {
3013 /*
3014 * Inplace compress the table.*
3015
3016 For sparse data sets the table constructed by the trie algorithm will
3017 be mostly 0/FAIL transitions or to put it another way mostly empty.
3018 (Note that leaf nodes will not contain any transitions.)
3019
3020 This algorithm compresses the tables by eliminating most such
3021 transitions, at the cost of a modest bit of extra work during lookup:
3022
3023 - Each states[] entry contains a .base field which indicates the
3024 index in the state[] array wheres its transition data is stored.
3025
3b753521 3026 - If .base is 0 there are no valid transitions from that node.
a3621e74
YO
3027
3028 - If .base is nonzero then charid is added to it to find an entry in
3029 the trans array.
3030
3031 -If trans[states[state].base+charid].check!=state then the
3032 transition is taken to be a 0/Fail transition. Thus if there are fail
3033 transitions at the front of the node then the .base offset will point
3034 somewhere inside the previous nodes data (or maybe even into a node
3035 even earlier), but the .check field determines if the transition is
3036 valid.
3037
786e8c11 3038 XXX - wrong maybe?
a3621e74 3039 The following process inplace converts the table to the compressed
3b753521 3040 table: We first do not compress the root node 1,and mark all its
a3621e74 3041 .check pointers as 1 and set its .base pointer as 1 as well. This
3b753521
FN
3042 allows us to do a DFA construction from the compressed table later,
3043 and ensures that any .base pointers we calculate later are greater
3044 than 0.
a3621e74
YO
3045
3046 - We set 'pos' to indicate the first entry of the second node.
3047
3048 - We then iterate over the columns of the node, finding the first and
3049 last used entry at l and m. We then copy l..m into pos..(pos+m-l),
3050 and set the .check pointers accordingly, and advance pos
3051 appropriately and repreat for the next node. Note that when we copy
3052 the next pointers we have to convert them from the original
3053 NODEIDX form to NODENUM form as the former is not valid post
3054 compression.
3055
3056 - If a node has no transitions used we mark its base as 0 and do not
3057 advance the pos pointer.
3058
3059 - If a node only has one transition we use a second pointer into the
3060 structure to fill in allocated fail transitions from other states.
3061 This pointer is independent of the main pointer and scans forward
3062 looking for null transitions that are allocated to a state. When it
3063 finds one it writes the single transition into the "hole". If the
786e8c11 3064 pointer doesnt find one the single transition is appended as normal.
a3621e74
YO
3065
3066 - Once compressed we can Renew/realloc the structures to release the
3067 excess space.
3068
3069 See "Table-Compression Methods" in sec 3.9 of the Red Dragon,
3070 specifically Fig 3.47 and the associated pseudocode.
3071
3072 demq
3073 */
a3b680e6 3074 const U32 laststate = TRIE_NODENUM( next_alloc );
a28509cc 3075 U32 state, charid;
a3621e74 3076 U32 pos = 0, zp=0;
1e2e3d02 3077 trie->statecount = laststate;
a3621e74
YO
3078
3079 for ( state = 1 ; state < laststate ; state++ ) {
3080 U8 flag = 0;
a28509cc
AL
3081 const U32 stateidx = TRIE_NODEIDX( state );
3082 const U32 o_used = trie->trans[ stateidx ].check;
3083 U32 used = trie->trans[ stateidx ].check;
a3621e74
YO
3084 trie->trans[ stateidx ].check = 0;
3085
538e84ed
KW
3086 for ( charid = 0;
3087 used && charid < trie->uniquecharcount;
3088 charid++ )
3089 {
a3621e74
YO
3090 if ( flag || trie->trans[ stateidx + charid ].next ) {
3091 if ( trie->trans[ stateidx + charid ].next ) {
3092 if (o_used == 1) {
3093 for ( ; zp < pos ; zp++ ) {
3094 if ( ! trie->trans[ zp ].next ) {
3095 break;
3096 }
3097 }
538e84ed
KW
3098 trie->states[ state ].trans.base
3099 = zp
3100 + trie->uniquecharcount
3101 - charid ;
3102 trie->trans[ zp ].next
3103 = SAFE_TRIE_NODENUM( trie->trans[ stateidx
3104 + charid ].next );
a3621e74
YO
3105 trie->trans[ zp ].check = state;
3106 if ( ++zp > pos ) pos = zp;
3107 break;
3108 }
3109 used--;
3110 }
3111 if ( !flag ) {
3112 flag = 1;
538e84ed
KW
3113 trie->states[ state ].trans.base
3114 = pos + trie->uniquecharcount - charid ;
a3621e74 3115 }
538e84ed
KW
3116 trie->trans[ pos ].next
3117 = SAFE_TRIE_NODENUM(
3118 trie->trans[ stateidx + charid ].next );
a3621e74
YO
3119 trie->trans[ pos ].check = state;
3120 pos++;
3121 }
3122 }
3123 }
cc601c31 3124 trie->lasttrans = pos + 1;
c944940b
JH
3125 trie->states = (reg_trie_state *)
3126 PerlMemShared_realloc( trie->states, laststate
3127 * sizeof(reg_trie_state) );
a3621e74 3128 DEBUG_TRIE_COMPILE_MORE_r(
538e84ed
KW
3129 PerlIO_printf( Perl_debug_log,
3130 "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
3131 (int)depth * 2 + 2,"",
3132 (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount
3133 + 1 ),
3134 (IV)next_alloc,
3135 (IV)pos,
3136 ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
a3621e74
YO
3137 );
3138
3139 } /* end table compress */
3140 }
1e2e3d02 3141 DEBUG_TRIE_COMPILE_MORE_r(
538e84ed
KW
3142 PerlIO_printf(Perl_debug_log,
3143 "%*sStatecount:%"UVxf" Lasttrans:%"UVxf"\n",
1e2e3d02
YO
3144 (int)depth * 2 + 2, "",
3145 (UV)trie->statecount,
3146 (UV)trie->lasttrans)
3147 );
cc601c31 3148 /* resize the trans array to remove unused space */
c944940b
JH
3149 trie->trans = (reg_trie_trans *)
3150 PerlMemShared_realloc( trie->trans, trie->lasttrans
3151 * sizeof(reg_trie_trans) );
a3621e74 3152
538e84ed 3153 { /* Modify the program and insert the new TRIE node */
3dab1dad
YO
3154 U8 nodetype =(U8)(flags & 0xFF);
3155 char *str=NULL;
538e84ed 3156
07be1b83 3157#ifdef DEBUGGING
e62cc96a 3158 regnode *optimize = NULL;
7122b237
YO
3159#ifdef RE_TRACK_PATTERN_OFFSETS
3160
b57a0404
JH
3161 U32 mjd_offset = 0;
3162 U32 mjd_nodelen = 0;
7122b237
YO
3163#endif /* RE_TRACK_PATTERN_OFFSETS */
3164#endif /* DEBUGGING */
a3621e74 3165 /*
3dab1dad
YO
3166 This means we convert either the first branch or the first Exact,
3167 depending on whether the thing following (in 'last') is a branch
3168 or not and whther first is the startbranch (ie is it a sub part of
3169 the alternation or is it the whole thing.)
3b753521 3170 Assuming its a sub part we convert the EXACT otherwise we convert
3dab1dad 3171 the whole branch sequence, including the first.
a3621e74 3172 */
3dab1dad 3173 /* Find the node we are going to overwrite */
7f69552c 3174 if ( first != startbranch || OP( last ) == BRANCH ) {
07be1b83 3175 /* branch sub-chain */
3dab1dad 3176 NEXT_OFF( first ) = (U16)(last - first);
7122b237 3177#ifdef RE_TRACK_PATTERN_OFFSETS
07be1b83
YO
3178 DEBUG_r({
3179 mjd_offset= Node_Offset((convert));
3180 mjd_nodelen= Node_Length((convert));
3181 });
7122b237 3182#endif
7f69552c 3183 /* whole branch chain */
7122b237
YO
3184 }
3185#ifdef RE_TRACK_PATTERN_OFFSETS
3186 else {
7f69552c
YO
3187 DEBUG_r({
3188 const regnode *nop = NEXTOPER( convert );
3189 mjd_offset= Node_Offset((nop));
3190 mjd_nodelen= Node_Length((nop));
3191 });
07be1b83
YO
3192 }
3193 DEBUG_OPTIMISE_r(
538e84ed
KW
3194 PerlIO_printf(Perl_debug_log,
3195 "%*sMJD offset:%"UVuf" MJD length:%"UVuf"\n",
07be1b83 3196 (int)depth * 2 + 2, "",
786e8c11 3197 (UV)mjd_offset, (UV)mjd_nodelen)
07be1b83 3198 );
7122b237 3199#endif
538e84ed 3200 /* But first we check to see if there is a common prefix we can
3dab1dad
YO
3201 split out as an EXACT and put in front of the TRIE node. */
3202 trie->startstate= 1;
55eed653 3203 if ( trie->bitmap && !widecharmap && !trie->jump ) {
3dab1dad 3204 U32 state;
1e2e3d02 3205 for ( state = 1 ; state < trie->statecount-1 ; state++ ) {
a3621e74 3206 U32 ofs = 0;
8e11feef
RGS
3207 I32 idx = -1;
3208 U32 count = 0;
3209 const U32 base = trie->states[ state ].trans.base;
a3621e74 3210
3dab1dad 3211 if ( trie->states[state].wordnum )
8e11feef 3212 count = 1;
a3621e74 3213
8e11feef 3214 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
cc601c31
YO
3215 if ( ( base + ofs >= trie->uniquecharcount ) &&
3216 ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
a3621e74
YO
3217 trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
3218 {
3dab1dad 3219 if ( ++count > 1 ) {
2b8b4781 3220 SV **tmp = av_fetch( revcharmap, ofs, 0);
07be1b83 3221 const U8 *ch = (U8*)SvPV_nolen_const( *tmp );
8e11feef 3222 if ( state == 1 ) break;
3dab1dad
YO
3223 if ( count == 2 ) {
3224 Zero(trie->bitmap, ANYOF_BITMAP_SIZE, char);
3225 DEBUG_OPTIMISE_r(
8e11feef
RGS
3226 PerlIO_printf(Perl_debug_log,
3227 "%*sNew Start State=%"UVuf" Class: [",
3228 (int)depth * 2 + 2, "",
786e8c11 3229 (UV)state));
be8e71aa 3230 if (idx >= 0) {
2b8b4781 3231 SV ** const tmp = av_fetch( revcharmap, idx, 0);
be8e71aa 3232 const U8 * const ch = (U8*)SvPV_nolen_const( *tmp );
8e11feef 3233
3dab1dad 3234 TRIE_BITMAP_SET(trie,*ch);
8e11feef
RGS
3235 if ( folder )
3236 TRIE_BITMAP_SET(trie, folder[ *ch ]);
3dab1dad 3237 DEBUG_OPTIMISE_r(
f1f66076 3238 PerlIO_printf(Perl_debug_log, "%s", (char*)ch)
3dab1dad 3239 );
8e11feef
RGS
3240 }
3241 }
3242 TRIE_BITMAP_SET(trie,*ch);
3243 if ( folder )
3244 TRIE_BITMAP_SET(trie,folder[ *ch ]);
3245 DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"%s", ch));
3246 }
3247 idx = ofs;
3248 }
3dab1dad
YO
3249 }
3250 if ( count == 1 ) {
2b8b4781 3251 SV **tmp = av_fetch( revcharmap, idx, 0);
c490c714
YO
3252 STRLEN len;
3253 char *ch = SvPV( *tmp, len );
de734bd5
A
3254 DEBUG_OPTIMISE_r({
3255 SV *sv=sv_newmortal();
8e11feef
RGS
3256 PerlIO_printf( Perl_debug_log,
3257 "%*sPrefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
3258 (int)depth * 2 + 2, "",
538e84ed
KW
3259 (UV)state, (UV)idx,
3260 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6,
de734bd5
A
3261 PL_colors[0], PL_colors[1],
3262 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
538e84ed 3263 PERL_PV_ESCAPE_FIRSTCHAR
de734bd5
A
3264 )
3265 );
3266 });
3dab1dad
YO
3267 if ( state==1 ) {
3268 OP( convert ) = nodetype;
3269 str=STRING(convert);
3270 STR_LEN(convert)=0;
3271 }
c490c714
YO
3272 STR_LEN(convert) += len;
3273 while (len--)
de734bd5 3274 *str++ = *ch++;
8e11feef 3275 } else {
538e84ed 3276#ifdef DEBUGGING
8e11feef
RGS
3277 if (state>1)
3278 DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"]\n"));
f9049ba1 3279#endif
8e11feef
RGS
3280 break;
3281 }
3282 }
2e64971a 3283 trie->prefixlen = (state-1);
3dab1dad 3284 if (str) {
8e11feef 3285 regnode *n = convert+NODE_SZ_STR(convert);
07be1b83 3286 NEXT_OFF(convert) = NODE_SZ_STR(convert);
8e11feef 3287 trie->startstate = state;
07be1b83
YO
3288 trie->minlen -= (state - 1);
3289 trie->maxlen -= (state - 1);
33809eae
JH
3290#ifdef DEBUGGING
3291 /* At least the UNICOS C compiler choked on this
3292 * being argument to DEBUG_r(), so let's just have
3293 * it right here. */
3294 if (
3295#ifdef PERL_EXT_RE_BUILD
3296 1
3297#else
3298 DEBUG_r_TEST
3299#endif
3300 ) {
3301 regnode *fix = convert;
3302 U32 word = trie->wordcount;
3303 mjd_nodelen++;
3304 Set_Node_Offset_Length(convert, mjd_offset, state - 1);
3305 while( ++fix < n ) {
3306 Set_Node_Offset_Length(fix, 0, 0);
3307 }
3308 while (word--) {
3309 SV ** const tmp = av_fetch( trie_words, word, 0 );
3310 if (tmp) {
3311 if ( STR_LEN(convert) <= SvCUR(*tmp) )
3312 sv_chop(*tmp, SvPV_nolen(*tmp) + STR_LEN(convert));
3313 else
3314 sv_chop(*tmp, SvPV_nolen(*tmp) + SvCUR(*tmp));
3315 }
3316 }
3317 }
3318#endif
8e11feef
RGS
3319 if (trie->maxlen) {
3320 convert = n;
3321 } else {
3dab1dad 3322 NEXT_OFF(convert) = (U16)(tail - convert);
a5ca303d 3323 DEBUG_r(optimize= n);
3dab1dad
YO
3324 }
3325 }
3326 }
538e84ed
KW
3327 if (!jumper)
3328 jumper = last;
3dab1dad 3329 if ( trie->maxlen ) {
8e11feef
RGS
3330 NEXT_OFF( convert ) = (U16)(tail - convert);
3331 ARG_SET( convert, data_slot );
538e84ed
KW
3332 /* Store the offset to the first unabsorbed branch in
3333 jump[0], which is otherwise unused by the jump logic.
786e8c11 3334 We use this when dumping a trie and during optimisation. */
538e84ed 3335 if (trie->jump)
7f69552c 3336 trie->jump[0] = (U16)(nextbranch - convert);
538e84ed 3337
6c48061a
YO
3338 /* If the start state is not accepting (meaning there is no empty string/NOTHING)
3339 * and there is a bitmap
3340 * and the first "jump target" node we found leaves enough room
3341 * then convert the TRIE node into a TRIEC node, with the bitmap
3342 * embedded inline in the opcode - this is hypothetically faster.
3343 */
3344 if ( !trie->states[trie->startstate].wordnum
3345 && trie->bitmap
3346 && ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) )
786e8c11
YO
3347 {
3348 OP( convert ) = TRIEC;
3349 Copy(trie->bitmap, ((struct regnode_charclass *)convert)->bitmap, ANYOF_BITMAP_SIZE, char);
446bd890 3350 PerlMemShared_free(trie->bitmap);
786e8c11 3351 trie->bitmap= NULL;
538e84ed 3352 } else
786e8c11 3353 OP( convert ) = TRIE;
a3621e74 3354
3dab1dad
YO
3355 /* store the type in the flags */
3356 convert->flags = nodetype;
a5ca303d 3357 DEBUG_r({
538e84ed
KW
3358 optimize = convert
3359 + NODE_STEP_REGNODE
a5ca303d
YO
3360 + regarglen[ OP( convert ) ];
3361 });
538e84ed 3362 /* XXX We really should free up the resource in trie now,
a5ca303d 3363 as we won't use them - (which resources?) dmq */
3dab1dad 3364 }
a3621e74 3365 /* needed for dumping*/
e62cc96a 3366 DEBUG_r(if (optimize) {
07be1b83 3367 regnode *opt = convert;
bcdf7404 3368
e62cc96a 3369 while ( ++opt < optimize) {
07be1b83
YO
3370 Set_Node_Offset_Length(opt,0,0);
3371 }
538e84ed
KW
3372 /*
3373 Try to clean up some of the debris left after the
786e8c11 3374 optimisation.
a3621e74 3375 */
786e8c11 3376 while( optimize < jumper ) {
07be1b83 3377 mjd_nodelen += Node_Length((optimize));
a3621e74 3378 OP( optimize ) = OPTIMIZED;
07be1b83 3379 Set_Node_Offset_Length(optimize,0,0);
a3621e74
YO
3380 optimize++;
3381 }
07be1b83 3382 Set_Node_Offset_Length(convert,mjd_offset,mjd_nodelen);
a3621e74
YO
3383 });
3384 } /* end node insert */
2e64971a
DM
3385
3386 /* Finish populating the prev field of the wordinfo array. Walk back
3387 * from each accept state until we find another accept state, and if
3388 * so, point the first word's .prev field at the second word. If the
3389 * second already has a .prev field set, stop now. This will be the
3390 * case either if we've already processed that word's accept state,
3b753521
FN
3391 * or that state had multiple words, and the overspill words were
3392 * already linked up earlier.
2e64971a
DM
3393 */
3394 {
3395 U16 word;
3396 U32 state;
3397 U16 prev;
3398
3399 for (word=1; word <= trie->wordcount; word++) {
3400 prev = 0;
3401 if (trie->wordinfo[word].prev)
3402 continue;
3403 state = trie->wordinfo[word].accept;
3404 while (state) {
3405 state = prev_states[state];
3406 if (!state)
3407 break;
3408 prev = trie->states[state].wordnum;
3409 if (prev)
3410 break;
3411 }
3412 trie->wordinfo[word].prev = prev;
3413 }
3414 Safefree(prev_states);
3415 }
3416
3417
3418 /* and now dump out the compressed format */
3419 DEBUG_TRIE_COMPILE_r(dump_trie(trie, widecharmap, revcharmap, depth+1));
3420
55eed653 3421 RExC_rxi->data->data[ data_slot + 1 ] = (void*)widecharmap;
2b8b4781
NC
3422#ifdef DEBUGGING
3423 RExC_rxi->data->data[ data_slot + TRIE_WORDS_OFFSET ] = (void*)trie_words;
3424 RExC_rxi->data->data[ data_slot + 3 ] = (void*)revcharmap;
3425#else
03e70be4 3426 SvREFCNT_dec_NN(revcharmap);
07be1b83 3427#endif
538e84ed
KW
3428 return trie->jump
3429 ? MADE_JUMP_TRIE
3430 : trie->startstate>1
3431 ? MADE_EXACT_TRIE
786e8c11
YO
3432 : MADE_TRIE;
3433}
3434
615a2e7f
YO
3435STATIC regnode *
3436S_construct_ahocorasick_from_trie(pTHX_ RExC_state_t *pRExC_state, regnode *source, U32 depth)
786e8c11 3437{
b423522f
KW
3438/* The Trie is constructed and compressed now so we can build a fail array if
3439 * it's needed
786e8c11 3440
b423522f
KW
3441 This is basically the Aho-Corasick algorithm. Its from exercise 3.31 and
3442 3.32 in the
3443 "Red Dragon" -- Compilers, principles, techniques, and tools. Aho, Sethi,
3444 Ullman 1985/88
786e8c11
YO
3445 ISBN 0-201-10088-6
3446
b423522f
KW
3447 We find the fail state for each state in the trie, this state is the longest
3448 proper suffix of the current state's 'word' that is also a proper prefix of
3449 another word in our trie. State 1 represents the word '' and is thus the
3450 default fail state. This allows the DFA not to have to restart after its
3451 tried and failed a word at a given point, it simply continues as though it
3452 had been matching the other word in the first place.
786e8c11
YO
3453 Consider
3454 'abcdgu'=~/abcdefg|cdgu/
b423522f
KW
3455 When we get to 'd' we are still matching the first word, we would encounter
3456 'g' which would fail, which would bring us to the state representing 'd' in
3457 the second word where we would try 'g' and succeed, proceeding to match
3458 'cdgu'.
786e8c11
YO
3459 */
3460 /* add a fail transition */
3251b653
NC
3461 const U32 trie_offset = ARG(source);
3462 reg_trie_data *trie=(reg_trie_data *)RExC_rxi->data->data[trie_offset];
786e8c11
YO
3463 U32 *q;
3464 const U32 ucharcount = trie->uniquecharcount;
1e2e3d02 3465 const U32 numstates = trie->statecount;
786e8c11
YO
3466 const U32 ubound = trie->lasttrans + ucharcount;
3467 U32 q_read = 0;
3468 U32 q_write = 0;
3469 U32 charid;
3470 U32 base = trie->states[ 1 ].trans.base;
3471 U32 *fail;
3472 reg_ac_data *aho;
cf78de0b 3473 const U32 data_slot = add_data( pRExC_state, STR_WITH_LEN("T"));
615a2e7f 3474 regnode *stclass;
786e8c11 3475 GET_RE_DEBUG_FLAGS_DECL;
7918f24d 3476
615a2e7f 3477 PERL_ARGS_ASSERT_CONSTRUCT_AHOCORASICK_FROM_TRIE;
81611534 3478 PERL_UNUSED_CONTEXT;
786e8c11
YO
3479#ifndef DEBUGGING
3480 PERL_UNUSED_ARG(depth);
3481#endif
3482
615a2e7f
YO
3483 if ( OP(source) == TRIE ) {
3484 struct regnode_1 *op = (struct regnode_1 *)
3485 PerlMemShared_calloc(1, sizeof(struct regnode_1));
3486 StructCopy(source,op,struct regnode_1);
3487 stclass = (regnode *)op;
3488 } else {
3489 struct regnode_charclass *op = (struct regnode_charclass *)
3490 PerlMemShared_calloc(1, sizeof(struct regnode_charclass));
3491 StructCopy(source,op,struct regnode_charclass);
3492 stclass = (regnode *)op;
3493 }
2f306ab9 3494 OP(stclass)+=2; /* convert the TRIE type to its AHO-CORASICK equivalent */
786e8c11
YO
3495
3496 ARG_SET( stclass, data_slot );
c944940b 3497 aho = (reg_ac_data *) PerlMemShared_calloc( 1, sizeof(reg_ac_data) );
f8fc2ecf 3498 RExC_rxi->data->data[ data_slot ] = (void*)aho;
3251b653 3499 aho->trie=trie_offset;
446bd890
NC
3500 aho->states=(reg_trie_state *)PerlMemShared_malloc( numstates * sizeof(reg_trie_state) );
3501 Copy( trie->states, aho->states, numstates, reg_trie_state );
786e8c11 3502 Newxz( q, numstates, U32);
c944940b 3503 aho->fail = (U32 *) PerlMemShared_calloc( numstates, sizeof(U32) );
786e8c11
YO
3504 aho->refcount = 1;
3505 fail = aho->fail;
3506 /* initialize fail[0..1] to be 1 so that we always have
3507 a valid final fail state */
3508 fail[ 0 ] = fail[ 1 ] = 1;
3509
3510 for ( charid = 0; charid < ucharcount ; charid++ ) {
3511 const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 );
3512 if ( newstate ) {
3513 q[ q_write ] = newstate;
3514 /* set to point at the root */
3515 fail[ q[ q_write++ ] ]=1;
3516 }
3517 }
3518 while ( q_read < q_write) {
3519 const U32 cur = q[ q_read++ % numstates ];
3520 base = trie->states[ cur ].trans.base;
3521
3522 for ( charid = 0 ; charid < ucharcount ; charid++ ) {
3523 const U32 ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 );
3524 if (ch_state) {
3525