This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Reinstate "PATCH: {perl #127582] Over eager warning for /[.foo.]/""
[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 1425 if (ANYOF_BITMAP_TEST(node, i)) {
6f8848d5
TC
1426 unsigned int start = i++;
1427
1428 for (; i < NUM_ANYOF_CODE_POINTS && ANYOF_BITMAP_TEST(node, i); ++i) {
1429 /* empty */
1430 }
1431 invlist = _add_range_to_invlist(invlist, start, i-1);
31f05a37 1432 new_node_has_latin1 = TRUE;
b423522f
KW
1433 }
1434 }
1435
1436 /* If this can match all upper Latin1 code points, have to add them
ac33c516
KW
1437 * as well. But don't add them if inverting, as when that gets done below,
1438 * it would exclude all these characters, including the ones it shouldn't
1439 * that were added just above */
1440 if (! (ANYOF_FLAGS(node) & ANYOF_INVERT) && OP(node) == ANYOFD
f240c685
KW
1441 && (ANYOF_FLAGS(node) & ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER))
1442 {
b423522f
KW
1443 _invlist_union(invlist, PL_UpperLatin1, &invlist);
1444 }
1445
1446 /* Similarly for these */
93e92956 1447 if (ANYOF_FLAGS(node) & ANYOF_MATCHES_ALL_ABOVE_BITMAP) {
e0a1ff7a 1448 _invlist_union_complement_2nd(invlist, PL_InBitmap, &invlist);
b423522f
KW
1449 }
1450
1451 if (ANYOF_FLAGS(node) & ANYOF_INVERT) {
1452 _invlist_invert(invlist);
1453 }
037715a6 1454 else if (new_node_has_latin1 && ANYOF_FLAGS(node) & ANYOFL_FOLD) {
31f05a37
KW
1455
1456 /* Under /li, any 0-255 could fold to any other 0-255, depending on the
1457 * locale. We can skip this if there are no 0-255 at all. */
1458 _invlist_union(invlist, PL_Latin1, &invlist);
1459 }
1460
1ee208c4
KW
1461 /* Similarly add the UTF-8 locale possible matches. These have to be
1462 * deferred until after the non-UTF-8 locale ones are taken care of just
1463 * above, or it leads to wrong results under ANYOF_INVERT */
1464 if (only_utf8_locale_invlist) {
31f05a37 1465 _invlist_union_maybe_complement_2nd(invlist,
1ee208c4 1466 only_utf8_locale_invlist,
31f05a37
KW
1467 ANYOF_FLAGS(node) & ANYOF_INVERT,
1468 &invlist);
1469 }
b423522f
KW
1470
1471 return invlist;
1472}
1473
1051e1c4 1474/* These two functions currently do the exact same thing */
557bd3fb 1475#define ssc_init_zero ssc_init
653099ff 1476
cdd87c1d
KW
1477#define ssc_add_cp(ssc, cp) ssc_add_range((ssc), (cp), (cp))
1478#define ssc_match_all_cp(ssc) ssc_add_range(ssc, 0, UV_MAX)
1479
557bd3fb 1480/* 'AND' a given class with another one. Can create false positives. 'ssc'
93e92956
KW
1481 * should not be inverted. 'and_with->flags & ANYOF_MATCHES_POSIXL' should be
1482 * 0 if 'and_with' is a regnode_charclass instead of a regnode_ssc. */
cdd87c1d 1483
653099ff 1484STATIC void
b423522f 1485S_ssc_and(pTHX_ const RExC_state_t *pRExC_state, regnode_ssc *ssc,
7dcac5f6 1486 const regnode_charclass *and_with)
653099ff 1487{
cdd87c1d
KW
1488 /* Accumulate into SSC 'ssc' its 'AND' with 'and_with', which is either
1489 * another SSC or a regular ANYOF class. Can create false positives. */
40d049e4 1490
a0dd4231
KW
1491 SV* anded_cp_list;
1492 U8 anded_flags;
1e6ade67 1493
cdd87c1d 1494 PERL_ARGS_ASSERT_SSC_AND;
653099ff 1495
71068078 1496 assert(is_ANYOF_SYNTHETIC(ssc));
a0dd4231
KW
1497
1498 /* 'and_with' is used as-is if it too is an SSC; otherwise have to extract
1499 * the code point inversion list and just the relevant flags */
71068078 1500 if (is_ANYOF_SYNTHETIC(and_with)) {
7dcac5f6 1501 anded_cp_list = ((regnode_ssc *)and_with)->invlist;
a0dd4231 1502 anded_flags = ANYOF_FLAGS(and_with);
e9b08962
KW
1503
1504 /* XXX This is a kludge around what appears to be deficiencies in the
1505 * optimizer. If we make S_ssc_anything() add in the WARN_SUPER flag,
1506 * there are paths through the optimizer where it doesn't get weeded
1507 * out when it should. And if we don't make some extra provision for
1508 * it like the code just below, it doesn't get added when it should.
1509 * This solution is to add it only when AND'ing, which is here, and
1510 * only when what is being AND'ed is the pristine, original node
1511 * matching anything. Thus it is like adding it to ssc_anything() but
1512 * only when the result is to be AND'ed. Probably the same solution
1513 * could be adopted for the same problem we have with /l matching,
1514 * which is solved differently in S_ssc_init(), and that would lead to
1515 * fewer false positives than that solution has. But if this solution
1516 * creates bugs, the consequences are only that a warning isn't raised
1517 * that should be; while the consequences for having /l bugs is
1518 * incorrect matches */
7dcac5f6 1519 if (ssc_is_anything((regnode_ssc *)and_with)) {
f240c685 1520 anded_flags |= ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER;
e9b08962 1521 }
a0dd4231
KW
1522 }
1523 else {
5c0f85ef 1524 anded_cp_list = get_ANYOF_cp_list_for_ssc(pRExC_state, and_with);
f240c685
KW
1525 if (OP(and_with) == ANYOFD) {
1526 anded_flags = ANYOF_FLAGS(and_with) & ANYOF_COMMON_FLAGS;
1527 }
1528 else {
1529 anded_flags = ANYOF_FLAGS(and_with)
1530 &( ANYOF_COMMON_FLAGS
108316fb
KW
1531 |ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER
1532 |ANYOF_SHARED_d_UPPER_LATIN1_UTF8_STRING_MATCHES_non_d_RUNTIME_USER_PROP);
d1c40ef5
KW
1533 if (ANYOFL_UTF8_LOCALE_REQD(ANYOF_FLAGS(and_with))) {
1534 anded_flags &=
1535 ANYOFL_SHARED_UTF8_LOCALE_fold_HAS_MATCHES_nonfold_REQD;
1536 }
f240c685 1537 }
a0dd4231
KW
1538 }
1539
1540 ANYOF_FLAGS(ssc) &= anded_flags;
cdd87c1d
KW
1541
1542 /* Below, C1 is the list of code points in 'ssc'; P1, its posix classes.
1543 * C2 is the list of code points in 'and-with'; P2, its posix classes.
1544 * 'and_with' may be inverted. When not inverted, we have the situation of
1545 * computing:
1546 * (C1 | P1) & (C2 | P2)
1547 * = (C1 & (C2 | P2)) | (P1 & (C2 | P2))
1548 * = ((C1 & C2) | (C1 & P2)) | ((P1 & C2) | (P1 & P2))
1549 * <= ((C1 & C2) | P2)) | ( P1 | (P1 & P2))
1550 * <= ((C1 & C2) | P1 | P2)
1551 * Alternatively, the last few steps could be:
1552 * = ((C1 & C2) | (C1 & P2)) | ((P1 & C2) | (P1 & P2))
1553 * <= ((C1 & C2) | C1 ) | ( C2 | (P1 & P2))
1554 * <= (C1 | C2 | (P1 & P2))
1555 * We favor the second approach if either P1 or P2 is non-empty. This is
1556 * because these components are a barrier to doing optimizations, as what
1557 * they match cannot be known until the moment of matching as they are
1558 * dependent on the current locale, 'AND"ing them likely will reduce or
1559 * eliminate them.
1560 * But we can do better if we know that C1,P1 are in their initial state (a
1561 * frequent occurrence), each matching everything:
1562 * (<everything>) & (C2 | P2) = C2 | P2
1563 * Similarly, if C2,P2 are in their initial state (again a frequent
1564 * occurrence), the result is a no-op
1565 * (C1 | P1) & (<everything>) = C1 | P1
1566 *
1567 * Inverted, we have
1568 * (C1 | P1) & ~(C2 | P2) = (C1 | P1) & (~C2 & ~P2)
1569 * = (C1 & (~C2 & ~P2)) | (P1 & (~C2 & ~P2))
1570 * <= (C1 & ~C2) | (P1 & ~P2)
1571 * */
1aa99e6b 1572
a0dd4231 1573 if ((ANYOF_FLAGS(and_with) & ANYOF_INVERT)
71068078 1574 && ! is_ANYOF_SYNTHETIC(and_with))
a0dd4231 1575 {
cdd87c1d 1576 unsigned int i;
8951c461 1577
cdd87c1d
KW
1578 ssc_intersection(ssc,
1579 anded_cp_list,
1580 FALSE /* Has already been inverted */
1581 );
c6b76537 1582
cdd87c1d
KW
1583 /* If either P1 or P2 is empty, the intersection will be also; can skip
1584 * the loop */
93e92956 1585 if (! (ANYOF_FLAGS(and_with) & ANYOF_MATCHES_POSIXL)) {
cdd87c1d
KW
1586 ANYOF_POSIXL_ZERO(ssc);
1587 }
e0e1be5f 1588 else if (ANYOF_POSIXL_SSC_TEST_ANY_SET(ssc)) {
cdd87c1d
KW
1589
1590 /* Note that the Posix class component P from 'and_with' actually
1591 * looks like:
1592 * P = Pa | Pb | ... | Pn
1593 * where each component is one posix class, such as in [\w\s].
1594 * Thus
1595 * ~P = ~(Pa | Pb | ... | Pn)
1596 * = ~Pa & ~Pb & ... & ~Pn
1597 * <= ~Pa | ~Pb | ... | ~Pn
1598 * The last is something we can easily calculate, but unfortunately
1599 * is likely to have many false positives. We could do better
1600 * in some (but certainly not all) instances if two classes in
1601 * P have known relationships. For example
1602 * :lower: <= :alpha: <= :alnum: <= \w <= :graph: <= :print:
1603 * So
1604 * :lower: & :print: = :lower:
1605 * And similarly for classes that must be disjoint. For example,
1606 * since \s and \w can have no elements in common based on rules in
1607 * the POSIX standard,
1608 * \w & ^\S = nothing
1609 * Unfortunately, some vendor locales do not meet the Posix
1610 * standard, in particular almost everything by Microsoft.
1611 * The loop below just changes e.g., \w into \W and vice versa */
1612
1ee208c4 1613 regnode_charclass_posixl temp;
cdd87c1d
KW
1614 int add = 1; /* To calculate the index of the complement */
1615
1616 ANYOF_POSIXL_ZERO(&temp);
1617 for (i = 0; i < ANYOF_MAX; i++) {
1618 assert(i % 2 != 0
7dcac5f6
KW
1619 || ! ANYOF_POSIXL_TEST((regnode_charclass_posixl*) and_with, i)
1620 || ! ANYOF_POSIXL_TEST((regnode_charclass_posixl*) and_with, i + 1));
cdd87c1d 1621
7dcac5f6 1622 if (ANYOF_POSIXL_TEST((regnode_charclass_posixl*) and_with, i)) {
cdd87c1d
KW
1623 ANYOF_POSIXL_SET(&temp, i + add);
1624 }
1625 add = 0 - add; /* 1 goes to -1; -1 goes to 1 */
1626 }
1627 ANYOF_POSIXL_AND(&temp, ssc);
c6b76537 1628
cdd87c1d
KW
1629 } /* else ssc already has no posixes */
1630 } /* else: Not inverted. This routine is a no-op if 'and_with' is an SSC
1631 in its initial state */
71068078 1632 else if (! is_ANYOF_SYNTHETIC(and_with)
7dcac5f6 1633 || ! ssc_is_cp_posixl_init(pRExC_state, (regnode_ssc *)and_with))
cdd87c1d
KW
1634 {
1635 /* But if 'ssc' is in its initial state, the result is just 'and_with';
1636 * copy it over 'ssc' */
1637 if (ssc_is_cp_posixl_init(pRExC_state, ssc)) {
71068078 1638 if (is_ANYOF_SYNTHETIC(and_with)) {
cdd87c1d
KW
1639 StructCopy(and_with, ssc, regnode_ssc);
1640 }
1641 else {
1642 ssc->invlist = anded_cp_list;
1643 ANYOF_POSIXL_ZERO(ssc);
93e92956 1644 if (ANYOF_FLAGS(and_with) & ANYOF_MATCHES_POSIXL) {
7dcac5f6 1645 ANYOF_POSIXL_OR((regnode_charclass_posixl*) and_with, ssc);
cdd87c1d
KW
1646 }
1647 }
1648 }
e0e1be5f 1649 else if (ANYOF_POSIXL_SSC_TEST_ANY_SET(ssc)
93e92956 1650 || (ANYOF_FLAGS(and_with) & ANYOF_MATCHES_POSIXL))
cdd87c1d
KW
1651 {
1652 /* One or the other of P1, P2 is non-empty. */
93e92956 1653 if (ANYOF_FLAGS(and_with) & ANYOF_MATCHES_POSIXL) {
1ea8b7fe
KW
1654 ANYOF_POSIXL_AND((regnode_charclass_posixl*) and_with, ssc);
1655 }
cdd87c1d
KW
1656 ssc_union(ssc, anded_cp_list, FALSE);
1657 }
1658 else { /* P1 = P2 = empty */
1659 ssc_intersection(ssc, anded_cp_list, FALSE);
1660 }
137165a6 1661 }
653099ff
GS
1662}
1663
653099ff 1664STATIC void
cdd87c1d 1665S_ssc_or(pTHX_ const RExC_state_t *pRExC_state, regnode_ssc *ssc,
7dcac5f6 1666 const regnode_charclass *or_with)
653099ff 1667{
cdd87c1d
KW
1668 /* Accumulate into SSC 'ssc' its 'OR' with 'or_with', which is either
1669 * another SSC or a regular ANYOF class. Can create false positives if
1670 * 'or_with' is to be inverted. */
7918f24d 1671
a0dd4231
KW
1672 SV* ored_cp_list;
1673 U8 ored_flags;
c6b76537 1674
cdd87c1d 1675 PERL_ARGS_ASSERT_SSC_OR;
c6b76537 1676
71068078 1677 assert(is_ANYOF_SYNTHETIC(ssc));
a0dd4231
KW
1678
1679 /* 'or_with' is used as-is if it too is an SSC; otherwise have to extract
1680 * the code point inversion list and just the relevant flags */
71068078 1681 if (is_ANYOF_SYNTHETIC(or_with)) {
7dcac5f6 1682 ored_cp_list = ((regnode_ssc*) or_with)->invlist;
a0dd4231
KW
1683 ored_flags = ANYOF_FLAGS(or_with);
1684 }
1685 else {
5c0f85ef 1686 ored_cp_list = get_ANYOF_cp_list_for_ssc(pRExC_state, or_with);
eff8b7dc 1687 ored_flags = ANYOF_FLAGS(or_with) & ANYOF_COMMON_FLAGS;
f240c685
KW
1688 if (OP(or_with) != ANYOFD) {
1689 ored_flags
1690 |= ANYOF_FLAGS(or_with)
108316fb
KW
1691 & ( ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER
1692 |ANYOF_SHARED_d_UPPER_LATIN1_UTF8_STRING_MATCHES_non_d_RUNTIME_USER_PROP);
d1c40ef5
KW
1693 if (ANYOFL_UTF8_LOCALE_REQD(ANYOF_FLAGS(or_with))) {
1694 ored_flags |=
1695 ANYOFL_SHARED_UTF8_LOCALE_fold_HAS_MATCHES_nonfold_REQD;
1696 }
f240c685 1697 }
a0dd4231
KW
1698 }
1699
1700 ANYOF_FLAGS(ssc) |= ored_flags;
cdd87c1d
KW
1701
1702 /* Below, C1 is the list of code points in 'ssc'; P1, its posix classes.
1703 * C2 is the list of code points in 'or-with'; P2, its posix classes.
1704 * 'or_with' may be inverted. When not inverted, we have the simple
1705 * situation of computing:
1706 * (C1 | P1) | (C2 | P2) = (C1 | C2) | (P1 | P2)
1707 * If P1|P2 yields a situation with both a class and its complement are
1708 * set, like having both \w and \W, this matches all code points, and we
1709 * can delete these from the P component of the ssc going forward. XXX We
1710 * might be able to delete all the P components, but I (khw) am not certain
1711 * about this, and it is better to be safe.
1712 *
1713 * Inverted, we have
1714 * (C1 | P1) | ~(C2 | P2) = (C1 | P1) | (~C2 & ~P2)
1715 * <= (C1 | P1) | ~C2
1716 * <= (C1 | ~C2) | P1
1717 * (which results in actually simpler code than the non-inverted case)
1718 * */
9826f543 1719
a0dd4231 1720 if ((ANYOF_FLAGS(or_with) & ANYOF_INVERT)
71068078 1721 && ! is_ANYOF_SYNTHETIC(or_with))
a0dd4231 1722 {
cdd87c1d 1723 /* We ignore P2, leaving P1 going forward */
1ea8b7fe 1724 } /* else Not inverted */
93e92956 1725 else if (ANYOF_FLAGS(or_with) & ANYOF_MATCHES_POSIXL) {
7dcac5f6 1726 ANYOF_POSIXL_OR((regnode_charclass_posixl*)or_with, ssc);
e0e1be5f 1727 if (ANYOF_POSIXL_SSC_TEST_ANY_SET(ssc)) {
cdd87c1d
KW
1728 unsigned int i;
1729 for (i = 0; i < ANYOF_MAX; i += 2) {
1730 if (ANYOF_POSIXL_TEST(ssc, i) && ANYOF_POSIXL_TEST(ssc, i + 1))
1731 {
1732 ssc_match_all_cp(ssc);
1733 ANYOF_POSIXL_CLEAR(ssc, i);
1734 ANYOF_POSIXL_CLEAR(ssc, i+1);
cdd87c1d
KW
1735 }
1736 }
1737 }
1aa99e6b 1738 }
cdd87c1d
KW
1739
1740 ssc_union(ssc,
1741 ored_cp_list,
1742 FALSE /* Already has been inverted */
1743 );
653099ff
GS
1744}
1745
b423522f
KW
1746PERL_STATIC_INLINE void
1747S_ssc_union(pTHX_ regnode_ssc *ssc, SV* const invlist, const bool invert2nd)
1748{
1749 PERL_ARGS_ASSERT_SSC_UNION;
1750
71068078 1751 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW
1752
1753 _invlist_union_maybe_complement_2nd(ssc->invlist,
1754 invlist,
1755 invert2nd,
1756 &ssc->invlist);
1757}
1758
1759PERL_STATIC_INLINE void
1760S_ssc_intersection(pTHX_ regnode_ssc *ssc,
1761 SV* const invlist,
1762 const bool invert2nd)
1763{
1764 PERL_ARGS_ASSERT_SSC_INTERSECTION;
1765
71068078 1766 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW
1767
1768 _invlist_intersection_maybe_complement_2nd(ssc->invlist,
1769 invlist,
1770 invert2nd,
1771 &ssc->invlist);
1772}
1773
1774PERL_STATIC_INLINE void
1775S_ssc_add_range(pTHX_ regnode_ssc *ssc, const UV start, const UV end)
1776{
1777 PERL_ARGS_ASSERT_SSC_ADD_RANGE;
1778
71068078 1779 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW
1780
1781 ssc->invlist = _add_range_to_invlist(ssc->invlist, start, end);
1782}
1783
1784PERL_STATIC_INLINE void
1785S_ssc_cp_and(pTHX_ regnode_ssc *ssc, const UV cp)
1786{
1787 /* AND just the single code point 'cp' into the SSC 'ssc' */
1788
1789 SV* cp_list = _new_invlist(2);
1790
1791 PERL_ARGS_ASSERT_SSC_CP_AND;
1792
71068078 1793 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW
1794
1795 cp_list = add_cp_to_invlist(cp_list, cp);
1796 ssc_intersection(ssc, cp_list,
1797 FALSE /* Not inverted */
1798 );
1799 SvREFCNT_dec_NN(cp_list);
1800}
1801
1802PERL_STATIC_INLINE void
dc3bf405 1803S_ssc_clear_locale(regnode_ssc *ssc)
b423522f
KW
1804{
1805 /* Set the SSC 'ssc' to not match any locale things */
b423522f
KW
1806 PERL_ARGS_ASSERT_SSC_CLEAR_LOCALE;
1807
71068078 1808 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW
1809
1810 ANYOF_POSIXL_ZERO(ssc);
1811 ANYOF_FLAGS(ssc) &= ~ANYOF_LOCALE_FLAGS;
1812}
1813
b35552de
KW
1814#define NON_OTHER_COUNT NON_OTHER_COUNT_FOR_USE_ONLY_BY_REGCOMP_DOT_C
1815
1816STATIC bool
1817S_is_ssc_worth_it(const RExC_state_t * pRExC_state, const regnode_ssc * ssc)
1818{
1819 /* The synthetic start class is used to hopefully quickly winnow down
1820 * places where a pattern could start a match in the target string. If it
1821 * doesn't really narrow things down that much, there isn't much point to
1822 * having the overhead of using it. This function uses some very crude
1823 * heuristics to decide if to use the ssc or not.
1824 *
1825 * It returns TRUE if 'ssc' rules out more than half what it considers to
1826 * be the "likely" possible matches, but of course it doesn't know what the
1827 * actual things being matched are going to be; these are only guesses
1828 *
1829 * For /l matches, it assumes that the only likely matches are going to be
1830 * in the 0-255 range, uniformly distributed, so half of that is 127
1831 * For /a and /d matches, it assumes that the likely matches will be just
1832 * the ASCII range, so half of that is 63
1833 * For /u and there isn't anything matching above the Latin1 range, it
1834 * assumes that that is the only range likely to be matched, and uses
1835 * half that as the cut-off: 127. If anything matches above Latin1,
1836 * it assumes that all of Unicode could match (uniformly), except for
1837 * non-Unicode code points and things in the General Category "Other"
1838 * (unassigned, private use, surrogates, controls and formats). This
1839 * is a much large number. */
1840
b35552de
KW
1841 U32 count = 0; /* Running total of number of code points matched by
1842 'ssc' */
1843 UV start, end; /* Start and end points of current range in inversion
1844 list */
72400949
KW
1845 const U32 max_code_points = (LOC)
1846 ? 256
1847 : (( ! UNI_SEMANTICS
1848 || invlist_highest(ssc->invlist) < 256)
1849 ? 128
1850 : NON_OTHER_COUNT);
1851 const U32 max_match = max_code_points / 2;
b35552de
KW
1852
1853 PERL_ARGS_ASSERT_IS_SSC_WORTH_IT;
1854
1855 invlist_iterinit(ssc->invlist);
1856 while (invlist_iternext(ssc->invlist, &start, &end)) {
72400949
KW
1857 if (start >= max_code_points) {
1858 break;
b35552de 1859 }
72400949 1860 end = MIN(end, max_code_points - 1);
b35552de 1861 count += end - start + 1;
72400949 1862 if (count >= max_match) {
b35552de
KW
1863 invlist_iterfinish(ssc->invlist);
1864 return FALSE;
1865 }
1866 }
1867
1868 return TRUE;
1869}
1870
1871
b423522f
KW
1872STATIC void
1873S_ssc_finalize(pTHX_ RExC_state_t *pRExC_state, regnode_ssc *ssc)
1874{
1875 /* The inversion list in the SSC is marked mortal; now we need a more
1876 * permanent copy, which is stored the same way that is done in a regular
dcb20b36
KW
1877 * ANYOF node, with the first NUM_ANYOF_CODE_POINTS code points in a bit
1878 * map */
b423522f
KW
1879
1880 SV* invlist = invlist_clone(ssc->invlist);
1881
1882 PERL_ARGS_ASSERT_SSC_FINALIZE;
1883
71068078 1884 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f 1885
a0dd4231 1886 /* The code in this file assumes that all but these flags aren't relevant
93e92956
KW
1887 * to the SSC, except SSC_MATCHES_EMPTY_STRING, which should be cleared
1888 * by the time we reach here */
f240c685
KW
1889 assert(! (ANYOF_FLAGS(ssc)
1890 & ~( ANYOF_COMMON_FLAGS
108316fb
KW
1891 |ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER
1892 |ANYOF_SHARED_d_UPPER_LATIN1_UTF8_STRING_MATCHES_non_d_RUNTIME_USER_PROP)));
a0dd4231 1893
b423522f
KW
1894 populate_ANYOF_from_invlist( (regnode *) ssc, &invlist);
1895
1ee208c4
KW
1896 set_ANYOF_arg(pRExC_state, (regnode *) ssc, invlist,
1897 NULL, NULL, NULL, FALSE);
b423522f 1898
85c8e306
KW
1899 /* Make sure is clone-safe */
1900 ssc->invlist = NULL;
1901
e0e1be5f 1902 if (ANYOF_POSIXL_SSC_TEST_ANY_SET(ssc)) {
93e92956 1903 ANYOF_FLAGS(ssc) |= ANYOF_MATCHES_POSIXL;
e0e1be5f 1904 }
1462525b 1905
b2e90ddf
KW
1906 if (RExC_contains_locale) {
1907 OP(ssc) = ANYOFL;
1908 }
1909
1462525b 1910 assert(! (ANYOF_FLAGS(ssc) & ANYOF_LOCALE_FLAGS) || RExC_contains_locale);
b423522f
KW
1911}
1912
a3621e74
YO
1913#define TRIE_LIST_ITEM(state,idx) (trie->states[state].trans.list)[ idx ]
1914#define TRIE_LIST_CUR(state) ( TRIE_LIST_ITEM( state, 0 ).forid )
1915#define TRIE_LIST_LEN(state) ( TRIE_LIST_ITEM( state, 0 ).newstate )
538e84ed
KW
1916#define TRIE_LIST_USED(idx) ( trie->states[state].trans.list \
1917 ? (TRIE_LIST_CUR( idx ) - 1) \
1918 : 0 )
a3621e74 1919
3dab1dad
YO
1920
1921#ifdef DEBUGGING
07be1b83 1922/*
2b8b4781
NC
1923 dump_trie(trie,widecharmap,revcharmap)
1924 dump_trie_interim_list(trie,widecharmap,revcharmap,next_alloc)
1925 dump_trie_interim_table(trie,widecharmap,revcharmap,next_alloc)
3dab1dad
YO
1926
1927 These routines dump out a trie in a somewhat readable format.
07be1b83
YO
1928 The _interim_ variants are used for debugging the interim
1929 tables that are used to generate the final compressed
1930 representation which is what dump_trie expects.
1931
486ec47a 1932 Part of the reason for their existence is to provide a form
3dab1dad 1933 of documentation as to how the different representations function.
07be1b83
YO
1934
1935*/
3dab1dad
YO
1936
1937/*
3dab1dad
YO
1938 Dumps the final compressed table form of the trie to Perl_debug_log.
1939 Used for debugging make_trie().
1940*/
b9a59e08 1941
3dab1dad 1942STATIC void
2b8b4781
NC
1943S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap,
1944 AV *revcharmap, U32 depth)
3dab1dad
YO
1945{
1946 U32 state;
ab3bbdeb 1947 SV *sv=sv_newmortal();
55eed653 1948 int colwidth= widecharmap ? 6 : 4;
2e64971a 1949 U16 word;
3dab1dad
YO
1950 GET_RE_DEBUG_FLAGS_DECL;
1951
7918f24d 1952 PERL_ARGS_ASSERT_DUMP_TRIE;
ab3bbdeb 1953
3dab1dad
YO
1954 PerlIO_printf( Perl_debug_log, "%*sChar : %-6s%-6s%-4s ",
1955 (int)depth * 2 + 2,"",
1956 "Match","Base","Ofs" );
1957
1958 for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
2b8b4781 1959 SV ** const tmp = av_fetch( revcharmap, state, 0);
3dab1dad 1960 if ( tmp ) {
538e84ed 1961 PerlIO_printf( Perl_debug_log, "%*s",
ab3bbdeb 1962 colwidth,
538e84ed 1963 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
ab3bbdeb
YO
1964 PL_colors[0], PL_colors[1],
1965 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
538e84ed
KW
1966 PERL_PV_ESCAPE_FIRSTCHAR
1967 )
ab3bbdeb 1968 );
3dab1dad
YO
1969 }
1970 }
1971 PerlIO_printf( Perl_debug_log, "\n%*sState|-----------------------",
1972 (int)depth * 2 + 2,"");
1973
1974 for( state = 0 ; state < trie->uniquecharcount ; state++ )
ab3bbdeb 1975 PerlIO_printf( Perl_debug_log, "%.*s", colwidth, "--------");
3dab1dad
YO
1976 PerlIO_printf( Perl_debug_log, "\n");
1977
1e2e3d02 1978 for( state = 1 ; state < trie->statecount ; state++ ) {
be8e71aa 1979 const U32 base = trie->states[ state ].trans.base;
3dab1dad 1980
538e84ed
KW
1981 PerlIO_printf( Perl_debug_log, "%*s#%4"UVXf"|",
1982 (int)depth * 2 + 2,"", (UV)state);
3dab1dad
YO
1983
1984 if ( trie->states[ state ].wordnum ) {
538e84ed
KW
1985 PerlIO_printf( Perl_debug_log, " W%4X",
1986 trie->states[ state ].wordnum );
3dab1dad
YO
1987 } else {
1988 PerlIO_printf( Perl_debug_log, "%6s", "" );
1989 }
1990
1991 PerlIO_printf( Perl_debug_log, " @%4"UVXf" ", (UV)base );
1992
1993 if ( base ) {
1994 U32 ofs = 0;
1995
1996 while( ( base + ofs < trie->uniquecharcount ) ||
1997 ( base + ofs - trie->uniquecharcount < trie->lasttrans
538e84ed
KW
1998 && trie->trans[ base + ofs - trie->uniquecharcount ].check
1999 != state))
3dab1dad
YO
2000 ofs++;
2001
2002 PerlIO_printf( Perl_debug_log, "+%2"UVXf"[ ", (UV)ofs);
2003
2004 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
538e84ed
KW
2005 if ( ( base + ofs >= trie->uniquecharcount )
2006 && ( base + ofs - trie->uniquecharcount
2007 < trie->lasttrans )
2008 && trie->trans[ base + ofs
2009 - trie->uniquecharcount ].check == state )
3dab1dad 2010 {
ab3bbdeb
YO
2011 PerlIO_printf( Perl_debug_log, "%*"UVXf,
2012 colwidth,
538e84ed
KW
2013 (UV)trie->trans[ base + ofs
2014 - trie->uniquecharcount ].next );
3dab1dad 2015 } else {
ab3bbdeb 2016 PerlIO_printf( Perl_debug_log, "%*s",colwidth," ." );
3dab1dad
YO
2017 }
2018 }
2019
2020 PerlIO_printf( Perl_debug_log, "]");
2021
2022 }
2023 PerlIO_printf( Perl_debug_log, "\n" );
2024 }
538e84ed
KW
2025 PerlIO_printf(Perl_debug_log, "%*sword_info N:(prev,len)=",
2026 (int)depth*2, "");
2e64971a
DM
2027 for (word=1; word <= trie->wordcount; word++) {
2028 PerlIO_printf(Perl_debug_log, " %d:(%d,%d)",
2029 (int)word, (int)(trie->wordinfo[word].prev),
2030 (int)(trie->wordinfo[word].len));
2031 }
2032 PerlIO_printf(Perl_debug_log, "\n" );
538e84ed 2033}
3dab1dad 2034/*
3dab1dad 2035 Dumps a fully constructed but uncompressed trie in list form.
538e84ed 2036 List tries normally only are used for construction when the number of
3dab1dad
YO
2037 possible chars (trie->uniquecharcount) is very high.
2038 Used for debugging make_trie().
2039*/
2040STATIC void
55eed653 2041S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie,
2b8b4781
NC
2042 HV *widecharmap, AV *revcharmap, U32 next_alloc,
2043 U32 depth)
3dab1dad
YO
2044{
2045 U32 state;
ab3bbdeb 2046 SV *sv=sv_newmortal();
55eed653 2047 int colwidth= widecharmap ? 6 : 4;
3dab1dad 2048 GET_RE_DEBUG_FLAGS_DECL;
7918f24d
NC
2049
2050 PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_LIST;
2051
3dab1dad 2052 /* print out the table precompression. */
ab3bbdeb
YO
2053 PerlIO_printf( Perl_debug_log, "%*sState :Word | Transition Data\n%*s%s",
2054 (int)depth * 2 + 2,"", (int)depth * 2 + 2,"",
2055 "------:-----+-----------------\n" );
538e84ed 2056
3dab1dad
YO
2057 for( state=1 ; state < next_alloc ; state ++ ) {
2058 U16 charid;
538e84ed 2059
ab3bbdeb 2060 PerlIO_printf( Perl_debug_log, "%*s %4"UVXf" :",
3dab1dad
YO
2061 (int)depth * 2 + 2,"", (UV)state );
2062 if ( ! trie->states[ state ].wordnum ) {
2063 PerlIO_printf( Perl_debug_log, "%5s| ","");
2064 } else {
2065 PerlIO_printf( Perl_debug_log, "W%4x| ",
2066 trie->states[ state ].wordnum
2067 );
2068 }
2069 for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
538e84ed
KW
2070 SV ** const tmp = av_fetch( revcharmap,
2071 TRIE_LIST_ITEM(state,charid).forid, 0);
ab3bbdeb
YO
2072 if ( tmp ) {
2073 PerlIO_printf( Perl_debug_log, "%*s:%3X=%4"UVXf" | ",
2074 colwidth,
538e84ed
KW
2075 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp),
2076 colwidth,
2077 PL_colors[0], PL_colors[1],
2078 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)
2079 | PERL_PV_ESCAPE_FIRSTCHAR
ab3bbdeb 2080 ) ,
1e2e3d02
YO
2081 TRIE_LIST_ITEM(state,charid).forid,
2082 (UV)TRIE_LIST_ITEM(state,charid).newstate
2083 );
538e84ed 2084 if (!(charid % 10))
664e119d
RGS
2085 PerlIO_printf(Perl_debug_log, "\n%*s| ",
2086 (int)((depth * 2) + 14), "");
1e2e3d02 2087 }
ab3bbdeb
YO
2088 }
2089 PerlIO_printf( Perl_debug_log, "\n");
3dab1dad 2090 }
538e84ed 2091}
3dab1dad
YO
2092
2093/*
3dab1dad 2094 Dumps a fully constructed but uncompressed trie in table form.
538e84ed
KW
2095 This is the normal DFA style state transition table, with a few
2096 twists to facilitate compression later.
3dab1dad
YO
2097 Used for debugging make_trie().
2098*/
2099STATIC void
55eed653 2100S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie,
2b8b4781
NC
2101 HV *widecharmap, AV *revcharmap, U32 next_alloc,
2102 U32 depth)
3dab1dad
YO
2103{
2104 U32 state;
2105 U16 charid;
ab3bbdeb 2106 SV *sv=sv_newmortal();
55eed653 2107 int colwidth= widecharmap ? 6 : 4;
3dab1dad 2108 GET_RE_DEBUG_FLAGS_DECL;
7918f24d
NC
2109
2110 PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_TABLE;
538e84ed 2111
3dab1dad
YO
2112 /*
2113 print out the table precompression so that we can do a visual check
2114 that they are identical.
2115 */
538e84ed 2116
3dab1dad
YO
2117 PerlIO_printf( Perl_debug_log, "%*sChar : ",(int)depth * 2 + 2,"" );
2118
2119 for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
2b8b4781 2120 SV ** const tmp = av_fetch( revcharmap, charid, 0);
3dab1dad 2121 if ( tmp ) {
538e84ed 2122 PerlIO_printf( Perl_debug_log, "%*s",
ab3bbdeb 2123 colwidth,
538e84ed 2124 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
ab3bbdeb
YO
2125 PL_colors[0], PL_colors[1],
2126 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
538e84ed
KW
2127 PERL_PV_ESCAPE_FIRSTCHAR
2128 )
ab3bbdeb 2129 );
3dab1dad
YO
2130 }
2131 }
2132
2133 PerlIO_printf( Perl_debug_log, "\n%*sState+-",(int)depth * 2 + 2,"" );
2134
2135 for( charid=0 ; charid < trie->uniquecharcount ; charid++ ) {
ab3bbdeb 2136 PerlIO_printf( Perl_debug_log, "%.*s", colwidth,"--------");
3dab1dad
YO
2137 }
2138
2139 PerlIO_printf( Perl_debug_log, "\n" );
2140
2141 for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
2142
538e84ed 2143 PerlIO_printf( Perl_debug_log, "%*s%4"UVXf" : ",
3dab1dad
YO
2144 (int)depth * 2 + 2,"",
2145 (UV)TRIE_NODENUM( state ) );
2146
2147 for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
ab3bbdeb
YO
2148 UV v=(UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next );
2149 if (v)
2150 PerlIO_printf( Perl_debug_log, "%*"UVXf, colwidth, v );
2151 else
2152 PerlIO_printf( Perl_debug_log, "%*s", colwidth, "." );
3dab1dad
YO
2153 }
2154 if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
538e84ed
KW
2155 PerlIO_printf( Perl_debug_log, " (%4"UVXf")\n",
2156 (UV)trie->trans[ state ].check );
3dab1dad 2157 } else {
538e84ed
KW
2158 PerlIO_printf( Perl_debug_log, " (%4"UVXf") W%4X\n",
2159 (UV)trie->trans[ state ].check,
3dab1dad
YO
2160 trie->states[ TRIE_NODENUM( state ) ].wordnum );
2161 }
2162 }
07be1b83 2163}
3dab1dad
YO
2164
2165#endif
2166
2e64971a 2167
786e8c11
YO
2168/* make_trie(startbranch,first,last,tail,word_count,flags,depth)
2169 startbranch: the first branch in the whole branch sequence
2170 first : start branch of sequence of branch-exact nodes.
2171 May be the same as startbranch
2172 last : Thing following the last branch.
2173 May be the same as tail.
2174 tail : item following the branch sequence
2175 count : words in the sequence
a4525e78 2176 flags : currently the OP() type we will be building one of /EXACT(|F|FA|FU|FU_SS|L|FLU8)/
786e8c11 2177 depth : indent depth
3dab1dad 2178
786e8c11 2179Inplace optimizes a sequence of 2 or more Branch-Exact nodes into a TRIE node.
07be1b83 2180
786e8c11
YO
2181A trie is an N'ary tree where the branches are determined by digital
2182decomposition of the key. IE, at the root node you look up the 1st character and
2183follow that branch repeat until you find the end of the branches. Nodes can be
2184marked as "accepting" meaning they represent a complete word. Eg:
07be1b83 2185
786e8c11 2186 /he|she|his|hers/
72f13be8 2187
786e8c11
YO
2188would convert into the following structure. Numbers represent states, letters
2189following numbers represent valid transitions on the letter from that state, if
2190the number is in square brackets it represents an accepting state, otherwise it
2191will be in parenthesis.
07be1b83 2192
786e8c11
YO
2193 +-h->+-e->[3]-+-r->(8)-+-s->[9]
2194 | |
2195 | (2)
2196 | |
2197 (1) +-i->(6)-+-s->[7]
2198 |
2199 +-s->(3)-+-h->(4)-+-e->[5]
07be1b83 2200
786e8c11
YO
2201 Accept Word Mapping: 3=>1 (he),5=>2 (she), 7=>3 (his), 9=>4 (hers)
2202
2203This shows that when matching against the string 'hers' we will begin at state 1
2204read 'h' and move to state 2, read 'e' and move to state 3 which is accepting,
2205then read 'r' and go to state 8 followed by 's' which takes us to state 9 which
2206is also accepting. Thus we know that we can match both 'he' and 'hers' with a
2207single traverse. We store a mapping from accepting to state to which word was
2208matched, and then when we have multiple possibilities we try to complete the
b8fda935 2209rest of the regex in the order in which they occurred in the alternation.
786e8c11
YO
2210
2211The only prior NFA like behaviour that would be changed by the TRIE support is
2212the silent ignoring of duplicate alternations which are of the form:
2213
2214 / (DUPE|DUPE) X? (?{ ... }) Y /x
2215
4b714af6 2216Thus EVAL blocks following a trie may be called a different number of times with
786e8c11 2217and without the optimisation. With the optimisations dupes will be silently
486ec47a 2218ignored. This inconsistent behaviour of EVAL type nodes is well established as
786e8c11
YO
2219the following demonstrates:
2220
2221 'words'=~/(word|word|word)(?{ print $1 })[xyz]/
2222
2223which prints out 'word' three times, but
2224
2225 'words'=~/(word|word|word)(?{ print $1 })S/
2226
2227which doesnt print it out at all. This is due to other optimisations kicking in.
2228
2229Example of what happens on a structural level:
2230
486ec47a 2231The regexp /(ac|ad|ab)+/ will produce the following debug output:
786e8c11
YO
2232
2233 1: CURLYM[1] {1,32767}(18)
2234 5: BRANCH(8)
2235 6: EXACT <ac>(16)
2236 8: BRANCH(11)
2237 9: EXACT <ad>(16)
2238 11: BRANCH(14)
2239 12: EXACT <ab>(16)
2240 16: SUCCEED(0)
2241 17: NOTHING(18)
2242 18: END(0)
2243
2244This would be optimizable with startbranch=5, first=5, last=16, tail=16
2245and should turn into:
2246
2247 1: CURLYM[1] {1,32767}(18)
2248 5: TRIE(16)
2249 [Words:3 Chars Stored:6 Unique Chars:4 States:5 NCP:1]
2250 <ac>
2251 <ad>
2252 <ab>
2253 16: SUCCEED(0)
2254 17: NOTHING(18)
2255 18: END(0)
2256
2257Cases where tail != last would be like /(?foo|bar)baz/:
2258
2259 1: BRANCH(4)
2260 2: EXACT <foo>(8)
2261 4: BRANCH(7)
2262 5: EXACT <bar>(8)
2263 7: TAIL(8)
2264 8: EXACT <baz>(10)
2265 10: END(0)
2266
2267which would be optimizable with startbranch=1, first=1, last=7, tail=8
2268and would end up looking like:
2269
2270 1: TRIE(8)
2271 [Words:2 Chars Stored:6 Unique Chars:5 States:7 NCP:1]
2272 <foo>
2273 <bar>
2274 7: TAIL(8)
2275 8: EXACT <baz>(10)
2276 10: END(0)
2277
c80e42f3 2278 d = uvchr_to_utf8_flags(d, uv, 0);
786e8c11
YO
2279
2280is the recommended Unicode-aware way of saying
2281
2282 *(d++) = uv;
2283*/
2284
fab2782b 2285#define TRIE_STORE_REVCHAR(val) \
786e8c11 2286 STMT_START { \
73031816 2287 if (UTF) { \
668fcfea 2288 SV *zlopp = newSV(UTF8_MAXBYTES); \
88c9ea1e 2289 unsigned char *flrbbbbb = (unsigned char *) SvPVX(zlopp); \
c80e42f3 2290 unsigned const char *const kapow = uvchr_to_utf8(flrbbbbb, val); \
73031816
NC
2291 SvCUR_set(zlopp, kapow - flrbbbbb); \
2292 SvPOK_on(zlopp); \
2293 SvUTF8_on(zlopp); \
2294 av_push(revcharmap, zlopp); \
2295 } else { \
fab2782b 2296 char ooooff = (char)val; \
73031816
NC
2297 av_push(revcharmap, newSVpvn(&ooooff, 1)); \
2298 } \
2299 } STMT_END
786e8c11 2300
914a25d5
KW
2301/* This gets the next character from the input, folding it if not already
2302 * folded. */
2303#define TRIE_READ_CHAR STMT_START { \
2304 wordlen++; \
2305 if ( UTF ) { \
2306 /* if it is UTF then it is either already folded, or does not need \
2307 * folding */ \
1c1d615a 2308 uvc = valid_utf8_to_uvchr( (const U8*) uc, &len); \
914a25d5
KW
2309 } \
2310 else if (folder == PL_fold_latin1) { \
7d006b13
KW
2311 /* This folder implies Unicode rules, which in the range expressible \
2312 * by not UTF is the lower case, with the two exceptions, one of \
2313 * which should have been taken care of before calling this */ \
2314 assert(*uc != LATIN_SMALL_LETTER_SHARP_S); \
2315 uvc = toLOWER_L1(*uc); \
2316 if (UNLIKELY(uvc == MICRO_SIGN)) uvc = GREEK_SMALL_LETTER_MU; \
2317 len = 1; \
914a25d5
KW
2318 } else { \
2319 /* raw data, will be folded later if needed */ \
2320 uvc = (U32)*uc; \
2321 len = 1; \
2322 } \
786e8c11
YO
2323} STMT_END
2324
2325
2326
2327#define TRIE_LIST_PUSH(state,fid,ns) STMT_START { \
2328 if ( TRIE_LIST_CUR( state ) >=TRIE_LIST_LEN( state ) ) { \
f9003953
NC
2329 U32 ging = TRIE_LIST_LEN( state ) *= 2; \
2330 Renew( trie->states[ state ].trans.list, ging, reg_trie_trans_le ); \
786e8c11
YO
2331 } \
2332 TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).forid = fid; \
2333 TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).newstate = ns; \
2334 TRIE_LIST_CUR( state )++; \
2335} STMT_END
07be1b83 2336
786e8c11
YO
2337#define TRIE_LIST_NEW(state) STMT_START { \
2338 Newxz( trie->states[ state ].trans.list, \
2339 4, reg_trie_trans_le ); \
2340 TRIE_LIST_CUR( state ) = 1; \
2341 TRIE_LIST_LEN( state ) = 4; \
2342} STMT_END
07be1b83 2343
786e8c11
YO
2344#define TRIE_HANDLE_WORD(state) STMT_START { \
2345 U16 dupe= trie->states[ state ].wordnum; \
2346 regnode * const noper_next = regnext( noper ); \
2347 \
786e8c11
YO
2348 DEBUG_r({ \
2349 /* store the word for dumping */ \
2350 SV* tmp; \
2351 if (OP(noper) != NOTHING) \
740cce10 2352 tmp = newSVpvn_utf8(STRING(noper), STR_LEN(noper), UTF); \
786e8c11 2353 else \
740cce10 2354 tmp = newSVpvn_utf8( "", 0, UTF ); \
2b8b4781 2355 av_push( trie_words, tmp ); \
786e8c11
YO
2356 }); \
2357 \
2358 curword++; \
2e64971a
DM
2359 trie->wordinfo[curword].prev = 0; \
2360 trie->wordinfo[curword].len = wordlen; \
2361 trie->wordinfo[curword].accept = state; \
786e8c11
YO
2362 \
2363 if ( noper_next < tail ) { \
2364 if (!trie->jump) \
538e84ed
KW
2365 trie->jump = (U16 *) PerlMemShared_calloc( word_count + 1, \
2366 sizeof(U16) ); \
7f69552c 2367 trie->jump[curword] = (U16)(noper_next - convert); \
786e8c11
YO
2368 if (!jumper) \
2369 jumper = noper_next; \
2370 if (!nextbranch) \
2371 nextbranch= regnext(cur); \
2372 } \
2373 \
2374 if ( dupe ) { \
2e64971a
DM
2375 /* It's a dupe. Pre-insert into the wordinfo[].prev */\
2376 /* chain, so that when the bits of chain are later */\
2377 /* linked together, the dups appear in the chain */\
2378 trie->wordinfo[curword].prev = trie->wordinfo[dupe].prev; \
2379 trie->wordinfo[dupe].prev = curword; \
786e8c11
YO
2380 } else { \
2381 /* we haven't inserted this word yet. */ \
2382 trie->states[ state ].wordnum = curword; \
2383 } \
2384} STMT_END
07be1b83 2385
3dab1dad 2386
786e8c11
YO
2387#define TRIE_TRANS_STATE(state,base,ucharcount,charid,special) \
2388 ( ( base + charid >= ucharcount \
2389 && base + charid < ubound \
2390 && state == trie->trans[ base - ucharcount + charid ].check \
2391 && trie->trans[ base - ucharcount + charid ].next ) \
2392 ? trie->trans[ base - ucharcount + charid ].next \
2393 : ( state==1 ? special : 0 ) \
2394 )
3dab1dad 2395
786e8c11
YO
2396#define MADE_TRIE 1
2397#define MADE_JUMP_TRIE 2
2398#define MADE_EXACT_TRIE 4
3dab1dad 2399
a3621e74 2400STATIC I32
538e84ed
KW
2401S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch,
2402 regnode *first, regnode *last, regnode *tail,
2403 U32 word_count, U32 flags, U32 depth)
a3621e74
YO
2404{
2405 /* first pass, loop through and scan words */
2406 reg_trie_data *trie;
55eed653 2407 HV *widecharmap = NULL;
2b8b4781 2408 AV *revcharmap = newAV();
a3621e74 2409 regnode *cur;
a3621e74
YO
2410 STRLEN len = 0;
2411 UV uvc = 0;
2412 U16 curword = 0;
2413 U32 next_alloc = 0;
786e8c11
YO
2414 regnode *jumper = NULL;
2415 regnode *nextbranch = NULL;
7f69552c 2416 regnode *convert = NULL;
2e64971a 2417 U32 *prev_states; /* temp array mapping each state to previous one */
a3621e74 2418 /* we just use folder as a flag in utf8 */
1e696034 2419 const U8 * folder = NULL;
a3621e74 2420
2b8b4781 2421#ifdef DEBUGGING
cf78de0b 2422 const U32 data_slot = add_data( pRExC_state, STR_WITH_LEN("tuuu"));
2b8b4781
NC
2423 AV *trie_words = NULL;
2424 /* along with revcharmap, this only used during construction but both are
2425 * useful during debugging so we store them in the struct when debugging.
8e11feef 2426 */
2b8b4781 2427#else
cf78de0b 2428 const U32 data_slot = add_data( pRExC_state, STR_WITH_LEN("tu"));
3dab1dad 2429 STRLEN trie_charcount=0;
3dab1dad 2430#endif
2b8b4781 2431 SV *re_trie_maxbuff;
a3621e74 2432 GET_RE_DEBUG_FLAGS_DECL;
7918f24d
NC
2433
2434 PERL_ARGS_ASSERT_MAKE_TRIE;
72f13be8
YO
2435#ifndef DEBUGGING
2436 PERL_UNUSED_ARG(depth);
2437#endif
a3621e74 2438
1e696034 2439 switch (flags) {
a4525e78 2440 case EXACT: case EXACTL: break;
2f7f8cb1 2441 case EXACTFA:
fab2782b 2442 case EXACTFU_SS:
a4525e78
KW
2443 case EXACTFU:
2444 case EXACTFLU8: folder = PL_fold_latin1; break;
1e696034 2445 case EXACTF: folder = PL_fold; break;
fab2782b 2446 default: Perl_croak( aTHX_ "panic! In trie construction, unknown node type %u %s", (unsigned) flags, PL_reg_name[flags] );
1e696034
KW
2447 }
2448
c944940b 2449 trie = (reg_trie_data *) PerlMemShared_calloc( 1, sizeof(reg_trie_data) );
a3621e74 2450 trie->refcount = 1;
3dab1dad 2451 trie->startstate = 1;
786e8c11 2452 trie->wordcount = word_count;
f8fc2ecf 2453 RExC_rxi->data->data[ data_slot ] = (void*)trie;
c944940b 2454 trie->charmap = (U16 *) PerlMemShared_calloc( 256, sizeof(U16) );
a4525e78 2455 if (flags == EXACT || flags == EXACTL)
c944940b 2456 trie->bitmap = (char *) PerlMemShared_calloc( ANYOF_BITMAP_SIZE, 1 );
2e64971a
DM
2457 trie->wordinfo = (reg_trie_wordinfo *) PerlMemShared_calloc(
2458 trie->wordcount+1, sizeof(reg_trie_wordinfo));
2459
a3621e74 2460 DEBUG_r({
2b8b4781 2461 trie_words = newAV();
a3621e74 2462 });
a3621e74 2463
0111c4fd 2464 re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
316ebaf2 2465 assert(re_trie_maxbuff);
a3621e74 2466 if (!SvIOK(re_trie_maxbuff)) {
0111c4fd 2467 sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
a3621e74 2468 }
df826430 2469 DEBUG_TRIE_COMPILE_r({
538e84ed
KW
2470 PerlIO_printf( Perl_debug_log,
2471 "%*smake_trie start==%d, first==%d, last==%d, tail==%d depth=%d\n",
2472 (int)depth * 2 + 2, "",
2473 REG_NODE_NUM(startbranch),REG_NODE_NUM(first),
2474 REG_NODE_NUM(last), REG_NODE_NUM(tail), (int)depth);
3dab1dad 2475 });
538e84ed 2476
7f69552c
YO
2477 /* Find the node we are going to overwrite */
2478 if ( first == startbranch && OP( last ) != BRANCH ) {
2479 /* whole branch chain */
2480 convert = first;
2481 } else {
2482 /* branch sub-chain */
2483 convert = NEXTOPER( first );
2484 }
538e84ed 2485
a3621e74
YO
2486 /* -- First loop and Setup --
2487
2488 We first traverse the branches and scan each word to determine if it
2489 contains widechars, and how many unique chars there are, this is
2490 important as we have to build a table with at least as many columns as we
2491 have unique chars.
2492
2493 We use an array of integers to represent the character codes 0..255
538e84ed
KW
2494 (trie->charmap) and we use a an HV* to store Unicode characters. We use
2495 the native representation of the character value as the key and IV's for
2496 the coded index.
a3621e74
YO
2497
2498 *TODO* If we keep track of how many times each character is used we can
2499 remap the columns so that the table compression later on is more
3b753521 2500 efficient in terms of memory by ensuring the most common value is in the
a3621e74
YO
2501 middle and the least common are on the outside. IMO this would be better
2502 than a most to least common mapping as theres a decent chance the most
2503 common letter will share a node with the least common, meaning the node
486ec47a 2504 will not be compressible. With a middle is most common approach the worst
a3621e74
YO
2505 case is when we have the least common nodes twice.
2506
2507 */
2508
a3621e74 2509 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
df826430 2510 regnode *noper = NEXTOPER( cur );
e1ec3a88 2511 const U8 *uc = (U8*)STRING( noper );
df826430 2512 const U8 *e = uc + STR_LEN( noper );
bc031a7d 2513 int foldlen = 0;
07be1b83 2514 U32 wordlen = 0; /* required init */
bc031a7d
KW
2515 STRLEN minchars = 0;
2516 STRLEN maxchars = 0;
538e84ed
KW
2517 bool set_bit = trie->bitmap ? 1 : 0; /*store the first char in the
2518 bitmap?*/
a3621e74 2519
3dab1dad 2520 if (OP(noper) == NOTHING) {
df826430
YO
2521 regnode *noper_next= regnext(noper);
2522 if (noper_next != tail && OP(noper_next) == flags) {
2523 noper = noper_next;
2524 uc= (U8*)STRING(noper);
2525 e= uc + STR_LEN(noper);
2526 trie->minlen= STR_LEN(noper);
2527 } else {
2528 trie->minlen= 0;
2529 continue;
2530 }
3dab1dad 2531 }
df826430 2532
fab2782b 2533 if ( set_bit ) { /* bitmap only alloced when !(UTF&&Folding) */
02daf0ab
YO
2534 TRIE_BITMAP_SET(trie,*uc); /* store the raw first byte
2535 regardless of encoding */
fab2782b
YO
2536 if (OP( noper ) == EXACTFU_SS) {
2537 /* false positives are ok, so just set this */
0dc4a61d 2538 TRIE_BITMAP_SET(trie, LATIN_SMALL_LETTER_SHARP_S);
fab2782b
YO
2539 }
2540 }
bc031a7d
KW
2541 for ( ; uc < e ; uc += len ) { /* Look at each char in the current
2542 branch */
3dab1dad 2543 TRIE_CHARCOUNT(trie)++;
a3621e74 2544 TRIE_READ_CHAR;
645de4ce 2545
bc031a7d
KW
2546 /* TRIE_READ_CHAR returns the current character, or its fold if /i
2547 * is in effect. Under /i, this character can match itself, or
2548 * anything that folds to it. If not under /i, it can match just
2549 * itself. Most folds are 1-1, for example k, K, and KELVIN SIGN
2550 * all fold to k, and all are single characters. But some folds
2551 * expand to more than one character, so for example LATIN SMALL
2552 * LIGATURE FFI folds to the three character sequence 'ffi'. If
2553 * the string beginning at 'uc' is 'ffi', it could be matched by
2554 * three characters, or just by the one ligature character. (It
2555 * could also be matched by two characters: LATIN SMALL LIGATURE FF
2556 * followed by 'i', or by 'f' followed by LATIN SMALL LIGATURE FI).
2557 * (Of course 'I' and/or 'F' instead of 'i' and 'f' can also
2558 * match.) The trie needs to know the minimum and maximum number
2559 * of characters that could match so that it can use size alone to
2560 * quickly reject many match attempts. The max is simple: it is
2561 * the number of folded characters in this branch (since a fold is
2562 * never shorter than what folds to it. */
2563
2564 maxchars++;
2565
2566 /* And the min is equal to the max if not under /i (indicated by
2567 * 'folder' being NULL), or there are no multi-character folds. If
2568 * there is a multi-character fold, the min is incremented just
2569 * once, for the character that folds to the sequence. Each
2570 * character in the sequence needs to be added to the list below of
2571 * characters in the trie, but we count only the first towards the
2572 * min number of characters needed. This is done through the
2573 * variable 'foldlen', which is returned by the macros that look
2574 * for these sequences as the number of bytes the sequence
2575 * occupies. Each time through the loop, we decrement 'foldlen' by
2576 * how many bytes the current char occupies. Only when it reaches
2577 * 0 do we increment 'minchars' or look for another multi-character
2578 * sequence. */
2579 if (folder == NULL) {
2580 minchars++;
2581 }
2582 else if (foldlen > 0) {
2583 foldlen -= (UTF) ? UTF8SKIP(uc) : 1;
645de4ce
KW
2584 }
2585 else {
bc031a7d
KW
2586 minchars++;
2587
2588 /* See if *uc is the beginning of a multi-character fold. If
2589 * so, we decrement the length remaining to look at, to account
2590 * for the current character this iteration. (We can use 'uc'
2591 * instead of the fold returned by TRIE_READ_CHAR because for
2592 * non-UTF, the latin1_safe macro is smart enough to account
2593 * for all the unfolded characters, and because for UTF, the
2594 * string will already have been folded earlier in the
2595 * compilation process */
2596 if (UTF) {
2597 if ((foldlen = is_MULTI_CHAR_FOLD_utf8_safe(uc, e))) {
2598 foldlen -= UTF8SKIP(uc);
645de4ce
KW
2599 }
2600 }
bc031a7d
KW
2601 else if ((foldlen = is_MULTI_CHAR_FOLD_latin1_safe(uc, e))) {
2602 foldlen--;
2603 }
645de4ce 2604 }
bc031a7d
KW
2605
2606 /* The current character (and any potential folds) should be added
2607 * to the possible matching characters for this position in this
2608 * branch */
a3621e74 2609 if ( uvc < 256 ) {
fab2782b
YO
2610 if ( folder ) {
2611 U8 folded= folder[ (U8) uvc ];
2612 if ( !trie->charmap[ folded ] ) {
2613 trie->charmap[ folded ]=( ++trie->uniquecharcount );
2614 TRIE_STORE_REVCHAR( folded );
2615 }
2616 }
a3621e74
YO
2617 if ( !trie->charmap[ uvc ] ) {
2618 trie->charmap[ uvc ]=( ++trie->uniquecharcount );
fab2782b 2619 TRIE_STORE_REVCHAR( uvc );
a3621e74 2620 }
02daf0ab 2621 if ( set_bit ) {
62012aee
KW
2622 /* store the codepoint in the bitmap, and its folded
2623 * equivalent. */
fab2782b 2624 TRIE_BITMAP_SET(trie, uvc);
0921ee73
T
2625
2626 /* store the folded codepoint */
fab2782b 2627 if ( folder ) TRIE_BITMAP_SET(trie, folder[(U8) uvc ]);
0921ee73
T
2628
2629 if ( !UTF ) {
2630 /* store first byte of utf8 representation of
acdf4139 2631 variant codepoints */
6f2d5cbc 2632 if (! UVCHR_IS_INVARIANT(uvc)) {
acdf4139 2633 TRIE_BITMAP_SET(trie, UTF8_TWO_BYTE_HI(uvc));
0921ee73
T
2634 }
2635 }
02daf0ab
YO
2636 set_bit = 0; /* We've done our bit :-) */
2637 }
a3621e74 2638 } else {
bc031a7d
KW
2639
2640 /* XXX We could come up with the list of code points that fold
2641 * to this using PL_utf8_foldclosures, except not for
2642 * multi-char folds, as there may be multiple combinations
2643 * there that could work, which needs to wait until runtime to
2644 * resolve (The comment about LIGATURE FFI above is such an
2645 * example */
2646
a3621e74 2647 SV** svpp;
55eed653
NC
2648 if ( !widecharmap )
2649 widecharmap = newHV();
a3621e74 2650
55eed653 2651 svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 1 );
a3621e74
YO
2652
2653 if ( !svpp )
e4584336 2654 Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%"UVXf, uvc );
a3621e74
YO
2655
2656 if ( !SvTRUE( *svpp ) ) {
2657 sv_setiv( *svpp, ++trie->uniquecharcount );
fab2782b 2658 TRIE_STORE_REVCHAR(uvc);
a3621e74
YO
2659 }
2660 }
bc031a7d
KW
2661 } /* end loop through characters in this branch of the trie */
2662
2663 /* We take the min and max for this branch and combine to find the min
2664 * and max for all branches processed so far */
3dab1dad 2665 if( cur == first ) {
bc031a7d
KW
2666 trie->minlen = minchars;
2667 trie->maxlen = maxchars;
2668 } else if (minchars < trie->minlen) {
2669 trie->minlen = minchars;
2670 } else if (maxchars > trie->maxlen) {
2671 trie->maxlen = maxchars;
fab2782b 2672 }
a3621e74
YO
2673 } /* end first pass */
2674 DEBUG_TRIE_COMPILE_r(
538e84ed
KW
2675 PerlIO_printf( Perl_debug_log,
2676 "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
3dab1dad 2677 (int)depth * 2 + 2,"",
55eed653 2678 ( widecharmap ? "UTF8" : "NATIVE" ), (int)word_count,
be8e71aa
YO
2679 (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount,
2680 (int)trie->minlen, (int)trie->maxlen )
a3621e74 2681 );
a3621e74
YO
2682
2683 /*
2684 We now know what we are dealing with in terms of unique chars and
2685 string sizes so we can calculate how much memory a naive
0111c4fd
RGS
2686 representation using a flat table will take. If it's over a reasonable
2687 limit (as specified by ${^RE_TRIE_MAXBUF}) we use a more memory
a3621e74
YO
2688 conservative but potentially much slower representation using an array
2689 of lists.
2690
2691 At the end we convert both representations into the same compressed
2692 form that will be used in regexec.c for matching with. The latter
2693 is a form that cannot be used to construct with but has memory
2694 properties similar to the list form and access properties similar
2695 to the table form making it both suitable for fast searches and
2696 small enough that its feasable to store for the duration of a program.
2697
2698 See the comment in the code where the compressed table is produced
2699 inplace from the flat tabe representation for an explanation of how
2700 the compression works.
2701
2702 */
2703
2704
2e64971a
DM
2705 Newx(prev_states, TRIE_CHARCOUNT(trie) + 2, U32);
2706 prev_states[1] = 0;
2707
538e84ed
KW
2708 if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1)
2709 > SvIV(re_trie_maxbuff) )
2710 {
a3621e74
YO
2711 /*
2712 Second Pass -- Array Of Lists Representation
2713
2714 Each state will be represented by a list of charid:state records
2715 (reg_trie_trans_le) the first such element holds the CUR and LEN
2716 points of the allocated array. (See defines above).
2717
2718 We build the initial structure using the lists, and then convert
2719 it into the compressed table form which allows faster lookups
2720 (but cant be modified once converted).
a3621e74
YO
2721 */
2722
a3621e74
YO
2723 STRLEN transcount = 1;
2724
538e84ed 2725 DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
1e2e3d02
YO
2726 "%*sCompiling trie using list compiler\n",
2727 (int)depth * 2 + 2, ""));
686b73d4 2728
c944940b
JH
2729 trie->states = (reg_trie_state *)
2730 PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
2731 sizeof(reg_trie_state) );
a3621e74
YO
2732 TRIE_LIST_NEW(1);
2733 next_alloc = 2;
2734
2735 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
2736
df826430 2737 regnode *noper = NEXTOPER( cur );
c445ea15 2738 U8 *uc = (U8*)STRING( noper );
df826430 2739 const U8 *e = uc + STR_LEN( noper );
c445ea15
AL
2740 U32 state = 1; /* required init */
2741 U16 charid = 0; /* sanity init */
07be1b83 2742 U32 wordlen = 0; /* required init */
c445ea15 2743
df826430
YO
2744 if (OP(noper) == NOTHING) {
2745 regnode *noper_next= regnext(noper);
2746 if (noper_next != tail && OP(noper_next) == flags) {
2747 noper = noper_next;
2748 uc= (U8*)STRING(noper);
2749 e= uc + STR_LEN(noper);
2750 }
2751 }
2752
3dab1dad 2753 if (OP(noper) != NOTHING) {
786e8c11 2754 for ( ; uc < e ; uc += len ) {
c445ea15 2755
786e8c11 2756 TRIE_READ_CHAR;
c445ea15 2757
786e8c11
YO
2758 if ( uvc < 256 ) {
2759 charid = trie->charmap[ uvc ];
c445ea15 2760 } else {
538e84ed
KW
2761 SV** const svpp = hv_fetch( widecharmap,
2762 (char*)&uvc,
2763 sizeof( UV ),
2764 0);
786e8c11
YO
2765 if ( !svpp ) {
2766 charid = 0;
2767 } else {
2768 charid=(U16)SvIV( *svpp );
2769 }
c445ea15 2770 }
538e84ed
KW
2771 /* charid is now 0 if we dont know the char read, or
2772 * nonzero if we do */
786e8c11 2773 if ( charid ) {
a3621e74 2774
786e8c11
YO
2775 U16 check;
2776 U32 newstate = 0;
a3621e74 2777
786e8c11
YO
2778 charid--;
2779 if ( !trie->states[ state ].trans.list ) {
2780 TRIE_LIST_NEW( state );
c445ea15 2781 }
538e84ed
KW
2782 for ( check = 1;
2783 check <= TRIE_LIST_USED( state );
2784 check++ )
2785 {
2786 if ( TRIE_LIST_ITEM( state, check ).forid
2787 == charid )
2788 {
786e8c11
YO
2789 newstate = TRIE_LIST_ITEM( state, check ).newstate;
2790 break;
2791 }
2792 }
2793 if ( ! newstate ) {
2794 newstate = next_alloc++;
2e64971a 2795 prev_states[newstate] = state;
786e8c11
YO
2796 TRIE_LIST_PUSH( state, charid, newstate );
2797 transcount++;
2798 }
2799 state = newstate;
2800 } else {
2801 Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
c445ea15 2802 }
a28509cc 2803 }
c445ea15 2804 }
3dab1dad 2805 TRIE_HANDLE_WORD(state);
a3621e74
YO
2806
2807 } /* end second pass */
2808
1e2e3d02 2809 /* next alloc is the NEXT state to be allocated */
538e84ed 2810 trie->statecount = next_alloc;
c944940b
JH
2811 trie->states = (reg_trie_state *)
2812 PerlMemShared_realloc( trie->states,
2813 next_alloc
2814 * sizeof(reg_trie_state) );
a3621e74 2815
3dab1dad 2816 /* and now dump it out before we compress it */
2b8b4781
NC
2817 DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_list(trie, widecharmap,
2818 revcharmap, next_alloc,
2819 depth+1)
1e2e3d02 2820 );
a3621e74 2821
c944940b
JH
2822 trie->trans = (reg_trie_trans *)
2823 PerlMemShared_calloc( transcount, sizeof(reg_trie_trans) );
a3621e74
YO
2824 {
2825 U32 state;
a3621e74
YO
2826 U32 tp = 0;
2827 U32 zp = 0;
2828
2829
2830 for( state=1 ; state < next_alloc ; state ++ ) {
2831 U32 base=0;
2832
2833 /*
2834 DEBUG_TRIE_COMPILE_MORE_r(
2835 PerlIO_printf( Perl_debug_log, "tp: %d zp: %d ",tp,zp)
2836 );
2837 */
2838
2839 if (trie->states[state].trans.list) {
2840 U16 minid=TRIE_LIST_ITEM( state, 1).forid;
2841 U16 maxid=minid;
a28509cc 2842 U16 idx;
a3621e74
YO
2843
2844 for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
c445ea15
AL
2845 const U16 forid = TRIE_LIST_ITEM( state, idx).forid;
2846 if ( forid < minid ) {
2847 minid=forid;
2848 } else if ( forid > maxid ) {
2849 maxid=forid;
2850 }
a3621e74
YO
2851 }
2852 if ( transcount < tp + maxid - minid + 1) {
2853 transcount *= 2;
c944940b
JH
2854 trie->trans = (reg_trie_trans *)
2855 PerlMemShared_realloc( trie->trans,
446bd890
NC
2856 transcount
2857 * sizeof(reg_trie_trans) );
538e84ed
KW
2858 Zero( trie->trans + (transcount / 2),
2859 transcount / 2,
2860 reg_trie_trans );
a3621e74
YO
2861 }
2862 base = trie->uniquecharcount + tp - minid;
2863 if ( maxid == minid ) {
2864 U32 set = 0;
2865 for ( ; zp < tp ; zp++ ) {
2866 if ( ! trie->trans[ zp ].next ) {
2867 base = trie->uniquecharcount + zp - minid;
538e84ed
KW
2868 trie->trans[ zp ].next = TRIE_LIST_ITEM( state,
2869 1).newstate;
a3621e74
YO
2870 trie->trans[ zp ].check = state;
2871 set = 1;
2872 break;
2873 }
2874 }
2875 if ( !set ) {
538e84ed
KW
2876 trie->trans[ tp ].next = TRIE_LIST_ITEM( state,
2877 1).newstate;
a3621e74
YO
2878 trie->trans[ tp ].check = state;
2879 tp++;
2880 zp = tp;
2881 }
2882 } else {
2883 for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
538e84ed
KW
2884 const U32 tid = base
2885 - trie->uniquecharcount
2886 + TRIE_LIST_ITEM( state, idx ).forid;
2887 trie->trans[ tid ].next = TRIE_LIST_ITEM( state,
2888 idx ).newstate;
a3621e74
YO
2889 trie->trans[ tid ].check = state;
2890 }
2891 tp += ( maxid - minid + 1 );
2892 }
2893 Safefree(trie->states[ state ].trans.list);
2894 }
2895 /*
2896 DEBUG_TRIE_COMPILE_MORE_r(
2897 PerlIO_printf( Perl_debug_log, " base: %d\n",base);
2898 );
2899 */
2900 trie->states[ state ].trans.base=base;
2901 }
cc601c31 2902 trie->lasttrans = tp + 1;
a3621e74
YO
2903 }
2904 } else {
2905 /*
2906 Second Pass -- Flat Table Representation.
2907
b423522f
KW
2908 we dont use the 0 slot of either trans[] or states[] so we add 1 to
2909 each. We know that we will need Charcount+1 trans at most to store
2910 the data (one row per char at worst case) So we preallocate both
2911 structures assuming worst case.
a3621e74
YO
2912
2913 We then construct the trie using only the .next slots of the entry
2914 structs.
2915
b423522f
KW
2916 We use the .check field of the first entry of the node temporarily
2917 to make compression both faster and easier by keeping track of how
2918 many non zero fields are in the node.
a3621e74
YO
2919
2920 Since trans are numbered from 1 any 0 pointer in the table is a FAIL
2921 transition.
2922
b423522f
KW
2923 There are two terms at use here: state as a TRIE_NODEIDX() which is
2924 a number representing the first entry of the node, and state as a
2925 TRIE_NODENUM() which is the trans number. state 1 is TRIE_NODEIDX(1)
2926 and TRIE_NODENUM(1), state 2 is TRIE_NODEIDX(2) and TRIE_NODENUM(3)
2927 if there are 2 entrys per node. eg:
a3621e74
YO
2928
2929 A B A B
2930 1. 2 4 1. 3 7
2931 2. 0 3 3. 0 5
2932 3. 0 0 5. 0 0
2933 4. 0 0 7. 0 0
2934
b423522f
KW
2935 The table is internally in the right hand, idx form. However as we
2936 also have to deal with the states array which is indexed by nodenum
2937 we have to use TRIE_NODENUM() to convert.
a3621e74
YO
2938
2939 */
538e84ed 2940 DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
1e2e3d02
YO
2941 "%*sCompiling trie using table compiler\n",
2942 (int)depth * 2 + 2, ""));
3dab1dad 2943
c944940b
JH
2944 trie->trans = (reg_trie_trans *)
2945 PerlMemShared_calloc( ( TRIE_CHARCOUNT(trie) + 1 )
2946 * trie->uniquecharcount + 1,
2947 sizeof(reg_trie_trans) );
2948 trie->states = (reg_trie_state *)
2949 PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
2950 sizeof(reg_trie_state) );
a3621e74
YO
2951 next_alloc = trie->uniquecharcount + 1;
2952
3dab1dad 2953
a3621e74
YO
2954 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
2955
df826430 2956 regnode *noper = NEXTOPER( cur );
a28509cc 2957 const U8 *uc = (U8*)STRING( noper );
df826430 2958 const U8 *e = uc + STR_LEN( noper );
a3621e74
YO
2959
2960 U32 state = 1; /* required init */
2961
2962 U16 charid = 0; /* sanity init */
2963 U32 accept_state = 0; /* sanity init */
a3621e74 2964
07be1b83 2965 U32 wordlen = 0; /* required init */
a3621e74 2966
df826430
YO
2967 if (OP(noper) == NOTHING) {
2968 regnode *noper_next= regnext(noper);
2969 if (noper_next != tail && OP(noper_next) == flags) {
2970 noper = noper_next;
2971 uc= (U8*)STRING(noper);
2972 e= uc + STR_LEN(noper);
2973 }
2974 }
fab2782b 2975
3dab1dad 2976 if ( OP(noper) != NOTHING ) {
786e8c11 2977 for ( ; uc < e ; uc += len ) {
a3621e74 2978
786e8c11 2979 TRIE_READ_CHAR;
a3621e74 2980
786e8c11
YO
2981 if ( uvc < 256 ) {
2982 charid = trie->charmap[ uvc ];
2983 } else {
538e84ed
KW
2984 SV* const * const svpp = hv_fetch( widecharmap,
2985 (char*)&uvc,
2986 sizeof( UV ),
2987 0);
786e8c11 2988 charid = svpp ? (U16)SvIV(*svpp) : 0;
a3621e74 2989 }
786e8c11
YO
2990 if ( charid ) {
2991 charid--;
2992 if ( !trie->trans[ state + charid ].next ) {
2993 trie->trans[ state + charid ].next = next_alloc;
2994 trie->trans[ state ].check++;
2e64971a
DM
2995 prev_states[TRIE_NODENUM(next_alloc)]
2996 = TRIE_NODENUM(state);
786e8c11
YO
2997 next_alloc += trie->uniquecharcount;
2998 }
2999 state = trie->trans[ state + charid ].next;
3000 } else {
3001 Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
3002 }
538e84ed
KW
3003 /* charid is now 0 if we dont know the char read, or
3004 * nonzero if we do */
a3621e74 3005 }
a3621e74 3006 }
3dab1dad
YO
3007 accept_state = TRIE_NODENUM( state );
3008 TRIE_HANDLE_WORD(accept_state);
a3621e74
YO
3009
3010 } /* end second pass */
3011
3dab1dad 3012 /* and now dump it out before we compress it */
2b8b4781
NC
3013 DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_table(trie, widecharmap,
3014 revcharmap,
3015 next_alloc, depth+1));
a3621e74 3016
a3621e74
YO
3017 {
3018 /*
3019 * Inplace compress the table.*
3020
3021 For sparse data sets the table constructed by the trie algorithm will
3022 be mostly 0/FAIL transitions or to put it another way mostly empty.
3023 (Note that leaf nodes will not contain any transitions.)
3024
3025 This algorithm compresses the tables by eliminating most such
3026 transitions, at the cost of a modest bit of extra work during lookup:
3027
3028 - Each states[] entry contains a .base field which indicates the
3029 index in the state[] array wheres its transition data is stored.
3030
3b753521 3031 - If .base is 0 there are no valid transitions from that node.
a3621e74
YO
3032
3033 - If .base is nonzero then charid is added to it to find an entry in
3034 the trans array.
3035
3036 -If trans[states[state].base+charid].check!=state then the
3037 transition is taken to be a 0/Fail transition. Thus if there are fail
3038 transitions at the front of the node then the .base offset will point
3039 somewhere inside the previous nodes data (or maybe even into a node
3040 even earlier), but the .check field determines if the transition is
3041 valid.
3042
786e8c11 3043 XXX - wrong maybe?
a3621e74 3044 The following process inplace converts the table to the compressed
3b753521 3045 table: We first do not compress the root node 1,and mark all its
a3621e74 3046 .check pointers as 1 and set its .base pointer as 1 as well. This
3b753521
FN
3047 allows us to do a DFA construction from the compressed table later,
3048 and ensures that any .base pointers we calculate later are greater
3049 than 0.
a3621e74
YO
3050
3051 - We set 'pos' to indicate the first entry of the second node.
3052
3053 - We then iterate over the columns of the node, finding the first and
3054 last used entry at l and m. We then copy l..m into pos..(pos+m-l),
3055 and set the .check pointers accordingly, and advance pos
3056 appropriately and repreat for the next node. Note that when we copy
3057 the next pointers we have to convert them from the original
3058 NODEIDX form to NODENUM form as the former is not valid post
3059 compression.
3060
3061 - If a node has no transitions used we mark its base as 0 and do not
3062 advance the pos pointer.
3063
3064 - If a node only has one transition we use a second pointer into the
3065 structure to fill in allocated fail transitions from other states.
3066 This pointer is independent of the main pointer and scans forward
3067 looking for null transitions that are allocated to a state. When it
3068 finds one it writes the single transition into the "hole". If the
786e8c11 3069 pointer doesnt find one the single transition is appended as normal.
a3621e74
YO
3070
3071 - Once compressed we can Renew/realloc the structures to release the
3072 excess space.
3073
3074 See "Table-Compression Methods" in sec 3.9 of the Red Dragon,
3075 specifically Fig 3.47 and the associated pseudocode.
3076
3077 demq
3078 */
a3b680e6 3079 const U32 laststate = TRIE_NODENUM( next_alloc );
a28509cc 3080 U32 state, charid;
a3621e74 3081 U32 pos = 0, zp=0;
1e2e3d02 3082 trie->statecount = laststate;
a3621e74
YO
3083
3084 for ( state = 1 ; state < laststate ; state++ ) {
3085 U8 flag = 0;
a28509cc
AL
3086 const U32 stateidx = TRIE_NODEIDX( state );
3087 const U32 o_used = trie->trans[ stateidx ].check;
3088 U32 used = trie->trans[ stateidx ].check;
a3621e74
YO
3089 trie->trans[ stateidx ].check = 0;
3090
538e84ed
KW
3091 for ( charid = 0;
3092 used && charid < trie->uniquecharcount;
3093 charid++ )
3094 {
a3621e74
YO
3095 if ( flag || trie->trans[ stateidx + charid ].next ) {
3096 if ( trie->trans[ stateidx + charid ].next ) {
3097 if (o_used == 1) {
3098 for ( ; zp < pos ; zp++ ) {
3099 if ( ! trie->trans[ zp ].next ) {
3100 break;
3101 }
3102 }
538e84ed
KW
3103 trie->states[ state ].trans.base
3104 = zp
3105 + trie->uniquecharcount
3106 - charid ;
3107 trie->trans[ zp ].next
3108 = SAFE_TRIE_NODENUM( trie->trans[ stateidx
3109 + charid ].next );
a3621e74
YO
3110 trie->trans[ zp ].check = state;
3111 if ( ++zp > pos ) pos = zp;
3112 break;
3113 }
3114 used--;
3115 }
3116 if ( !flag ) {
3117 flag = 1;
538e84ed
KW
3118 trie->states[ state ].trans.base
3119 = pos + trie->uniquecharcount - charid ;
a3621e74 3120 }
538e84ed
KW
3121 trie->trans[ pos ].next
3122 = SAFE_TRIE_NODENUM(
3123 trie->trans[ stateidx + charid ].next );
a3621e74
YO
3124 trie->trans[ pos ].check = state;
3125 pos++;
3126 }
3127 }
3128 }
cc601c31 3129 trie->lasttrans = pos + 1;
c944940b
JH
3130 trie->states = (reg_trie_state *)
3131 PerlMemShared_realloc( trie->states, laststate
3132 * sizeof(reg_trie_state) );
a3621e74 3133 DEBUG_TRIE_COMPILE_MORE_r(
538e84ed
KW
3134 PerlIO_printf( Perl_debug_log,
3135 "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
3136 (int)depth * 2 + 2,"",
3137 (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount
3138 + 1 ),
3139 (IV)next_alloc,
3140 (IV)pos,
3141 ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
a3621e74
YO
3142 );
3143
3144 } /* end table compress */
3145 }
1e2e3d02 3146 DEBUG_TRIE_COMPILE_MORE_r(
538e84ed
KW
3147 PerlIO_printf(Perl_debug_log,
3148 "%*sStatecount:%"UVxf" Lasttrans:%"UVxf"\n",
1e2e3d02
YO
3149 (int)depth * 2 + 2, "",
3150 (UV)trie->statecount,
3151 (UV)trie->lasttrans)
3152 );
cc601c31 3153 /* resize the trans array to remove unused space */
c944940b
JH
3154 trie->trans = (reg_trie_trans *)
3155 PerlMemShared_realloc( trie->trans, trie->lasttrans
3156 * sizeof(reg_trie_trans) );
a3621e74 3157
538e84ed 3158 { /* Modify the program and insert the new TRIE node */
3dab1dad
YO
3159 U8 nodetype =(U8)(flags & 0xFF);
3160 char *str=NULL;
538e84ed 3161
07be1b83 3162#ifdef DEBUGGING
e62cc96a 3163 regnode *optimize = NULL;
7122b237
YO
3164#ifdef RE_TRACK_PATTERN_OFFSETS
3165
b57a0404
JH
3166 U32 mjd_offset = 0;
3167 U32 mjd_nodelen = 0;
7122b237
YO
3168#endif /* RE_TRACK_PATTERN_OFFSETS */
3169#endif /* DEBUGGING */
a3621e74 3170 /*
3dab1dad
YO
3171 This means we convert either the first branch or the first Exact,
3172 depending on whether the thing following (in 'last') is a branch
3173 or not and whther first is the startbranch (ie is it a sub part of
3174 the alternation or is it the whole thing.)
3b753521 3175 Assuming its a sub part we convert the EXACT otherwise we convert
3dab1dad 3176 the whole branch sequence, including the first.
a3621e74 3177 */
3dab1dad 3178 /* Find the node we are going to overwrite */
7f69552c 3179 if ( first != startbranch || OP( last ) == BRANCH ) {
07be1b83 3180 /* branch sub-chain */
3dab1dad 3181 NEXT_OFF( first ) = (U16)(last - first);
7122b237 3182#ifdef RE_TRACK_PATTERN_OFFSETS
07be1b83
YO
3183 DEBUG_r({
3184 mjd_offset= Node_Offset((convert));
3185 mjd_nodelen= Node_Length((convert));
3186 });
7122b237 3187#endif
7f69552c 3188 /* whole branch chain */
7122b237
YO
3189 }
3190#ifdef RE_TRACK_PATTERN_OFFSETS
3191 else {
7f69552c
YO
3192 DEBUG_r({
3193 const regnode *nop = NEXTOPER( convert );
3194 mjd_offset= Node_Offset((nop));
3195 mjd_nodelen= Node_Length((nop));
3196 });
07be1b83
YO
3197 }
3198 DEBUG_OPTIMISE_r(
538e84ed
KW
3199 PerlIO_printf(Perl_debug_log,
3200 "%*sMJD offset:%"UVuf" MJD length:%"UVuf"\n",
07be1b83 3201 (int)depth * 2 + 2, "",
786e8c11 3202 (UV)mjd_offset, (UV)mjd_nodelen)
07be1b83 3203 );
7122b237 3204#endif
538e84ed 3205 /* But first we check to see if there is a common prefix we can
3dab1dad
YO
3206 split out as an EXACT and put in front of the TRIE node. */
3207 trie->startstate= 1;
55eed653 3208 if ( trie->bitmap && !widecharmap && !trie->jump ) {
3dab1dad 3209 U32 state;
1e2e3d02 3210 for ( state = 1 ; state < trie->statecount-1 ; state++ ) {
a3621e74 3211 U32 ofs = 0;
8e11feef
RGS
3212 I32 idx = -1;
3213 U32 count = 0;
3214 const U32 base = trie->states[ state ].trans.base;
a3621e74 3215
3dab1dad 3216 if ( trie->states[state].wordnum )
8e11feef 3217 count = 1;
a3621e74 3218
8e11feef 3219 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
cc601c31
YO
3220 if ( ( base + ofs >= trie->uniquecharcount ) &&
3221 ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
a3621e74
YO
3222 trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
3223 {
3dab1dad 3224 if ( ++count > 1 ) {
2b8b4781 3225 SV **tmp = av_fetch( revcharmap, ofs, 0);
07be1b83 3226 const U8 *ch = (U8*)SvPV_nolen_const( *tmp );
8e11feef 3227 if ( state == 1 ) break;
3dab1dad
YO
3228 if ( count == 2 ) {
3229 Zero(trie->bitmap, ANYOF_BITMAP_SIZE, char);
3230 DEBUG_OPTIMISE_r(
8e11feef
RGS
3231 PerlIO_printf(Perl_debug_log,
3232 "%*sNew Start State=%"UVuf" Class: [",
3233 (int)depth * 2 + 2, "",
786e8c11 3234 (UV)state));
be8e71aa 3235 if (idx >= 0) {
2b8b4781 3236 SV ** const tmp = av_fetch( revcharmap, idx, 0);
be8e71aa 3237 const U8 * const ch = (U8*)SvPV_nolen_const( *tmp );
8e11feef 3238
3dab1dad 3239 TRIE_BITMAP_SET(trie,*ch);
8e11feef
RGS
3240 if ( folder )
3241 TRIE_BITMAP_SET(trie, folder[ *ch ]);
3dab1dad 3242 DEBUG_OPTIMISE_r(
f1f66076 3243 PerlIO_printf(Perl_debug_log, "%s", (char*)ch)
3dab1dad 3244 );
8e11feef
RGS
3245 }
3246 }
3247 TRIE_BITMAP_SET(trie,*ch);
3248 if ( folder )
3249 TRIE_BITMAP_SET(trie,folder[ *ch ]);
3250 DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"%s", ch));
3251 }
3252 idx = ofs;
3253 }
3dab1dad
YO
3254 }
3255 if ( count == 1 ) {
2b8b4781 3256 SV **tmp = av_fetch( revcharmap, idx, 0);
c490c714
YO
3257 STRLEN len;
3258 char *ch = SvPV( *tmp, len );
de734bd5
A
3259 DEBUG_OPTIMISE_r({
3260 SV *sv=sv_newmortal();
8e11feef
RGS
3261 PerlIO_printf( Perl_debug_log,
3262 "%*sPrefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
3263 (int)depth * 2 + 2, "",
538e84ed
KW
3264 (UV)state, (UV)idx,
3265 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6,
de734bd5
A
3266 PL_colors[0], PL_colors[1],
3267 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
538e84ed 3268 PERL_PV_ESCAPE_FIRSTCHAR
de734bd5
A
3269 )
3270 );
3271 });
3dab1dad
YO
3272 if ( state==1 ) {
3273 OP( convert ) = nodetype;
3274 str=STRING(convert);
3275 STR_LEN(convert)=0;
3276 }
c490c714
YO
3277 STR_LEN(convert) += len;
3278 while (len--)
de734bd5 3279 *str++ = *ch++;
8e11feef 3280 } else {
538e84ed 3281#ifdef DEBUGGING
8e11feef
RGS
3282 if (state>1)
3283 DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"]\n"));
f9049ba1 3284#endif
8e11feef
RGS
3285 break;
3286 }
3287 }
2e64971a 3288 trie->prefixlen = (state-1);
3dab1dad 3289 if (str) {
8e11feef 3290 regnode *n = convert+NODE_SZ_STR(convert);
07be1b83 3291 NEXT_OFF(convert) = NODE_SZ_STR(convert);
8e11feef 3292 trie->startstate = state;
07be1b83
YO
3293 trie->minlen -= (state - 1);
3294 trie->maxlen -= (state - 1);
33809eae
JH
3295#ifdef DEBUGGING
3296 /* At least the UNICOS C compiler choked on this
3297 * being argument to DEBUG_r(), so let's just have
3298 * it right here. */
3299 if (
3300#ifdef PERL_EXT_RE_BUILD
3301 1
3302#else
3303 DEBUG_r_TEST
3304#endif
3305 ) {
3306 regnode *fix = convert;
3307 U32 word = trie->wordcount;
3308 mjd_nodelen++;
3309 Set_Node_Offset_Length(convert, mjd_offset, state - 1);
3310 while( ++fix < n ) {
3311 Set_Node_Offset_Length(fix, 0, 0);
3312 }
3313 while (word--) {
3314 SV ** const tmp = av_fetch( trie_words, word, 0 );
3315 if (tmp) {
3316 if ( STR_LEN(convert) <= SvCUR(*tmp) )
3317 sv_chop(*tmp, SvPV_nolen(*tmp) + STR_LEN(convert));
3318 else
3319 sv_chop(*tmp, SvPV_nolen(*tmp) + SvCUR(*tmp));
3320 }
3321 }
3322 }
3323#endif
8e11feef
RGS
3324 if (trie->maxlen) {
3325 convert = n;
3326 } else {
3dab1dad 3327 NEXT_OFF(convert) = (U16)(tail - convert);
a5ca303d 3328 DEBUG_r(optimize= n);
3dab1dad
YO
3329 }
3330 }
3331 }
538e84ed
KW
3332 if (!jumper)
3333 jumper = last;
3dab1dad 3334 if ( trie->maxlen ) {
8e11feef
RGS
3335 NEXT_OFF( convert ) = (U16)(tail - convert);
3336 ARG_SET( convert, data_slot );
538e84ed
KW
3337 /* Store the offset to the first unabsorbed branch in
3338 jump[0], which is otherwise unused by the jump logic.
786e8c11 3339 We use this when dumping a trie and during optimisation. */
538e84ed 3340 if (trie->jump)
7f69552c 3341 trie->jump[0] = (U16)(nextbranch - convert);
538e84ed 3342
6c48061a
YO
3343 /* If the start state is not accepting (meaning there is no empty string/NOTHING)
3344 * and there is a bitmap
3345 * and the first "jump target" node we found leaves enough room
3346 * then convert the TRIE node into a TRIEC node, with the bitmap
3347 * embedded inline in the opcode - this is hypothetically faster.
3348 */
3349 if ( !trie->states[trie->startstate].wordnum
3350 && trie->bitmap
3351 && ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) )
786e8c11
YO
3352 {
3353 OP( convert ) = TRIEC;
3354 Copy(trie->bitmap, ((struct regnode_charclass *)convert)->bitmap, ANYOF_BITMAP_SIZE, char);
446bd890 3355 PerlMemShared_free(trie->bitmap);
786e8c11 3356 trie->bitmap= NULL;
538e84ed 3357 } else
786e8c11 3358 OP( convert ) = TRIE;
a3621e74 3359
3dab1dad
YO
3360 /* store the type in the flags */
3361 convert->flags = nodetype;
a5ca303d 3362 DEBUG_r({
538e84ed
KW
3363 optimize = convert
3364 + NODE_STEP_REGNODE
a5ca303d
YO
3365 + regarglen[ OP( convert ) ];
3366 });
538e84ed 3367 /* XXX We really should free up the resource in trie now,
a5ca303d 3368 as we won't use them - (which resources?) dmq */
3dab1dad 3369 }
a3621e74 3370 /* needed for dumping*/
e62cc96a 3371 DEBUG_r(if (optimize) {
07be1b83 3372 regnode *opt = convert;
bcdf7404 3373
e62cc96a 3374 while ( ++opt < optimize) {
07be1b83
YO
3375 Set_Node_Offset_Length(opt,0,0);
3376 }
538e84ed
KW
3377 /*
3378 Try to clean up some of the debris left after the
786e8c11 3379 optimisation.
a3621e74 3380 */
786e8c11 3381 while( optimize < jumper ) {
07be1b83 3382 mjd_nodelen += Node_Length((optimize));
a3621e74 3383 OP( optimize ) = OPTIMIZED;
07be1b83 3384 Set_Node_Offset_Length(optimize,0,0);
a3621e74
YO
3385 optimize++;
3386 }
07be1b83 3387 Set_Node_Offset_Length(convert,mjd_offset,mjd_nodelen);
a3621e74
YO
3388 });
3389 } /* end node insert */
2e64971a
DM
3390
3391 /* Finish populating the prev field of the wordinfo array. Walk back
3392 * from each accept state until we find another accept state, and if
3393 * so, point the first word's .prev field at the second word. If the
3394 * second already has a .prev field set, stop now. This will be the
3395 * case either if we've already processed that word's accept state,
3b753521
FN
3396 * or that state had multiple words, and the overspill words were
3397 * already linked up earlier.
2e64971a
DM
3398 */
3399 {
3400 U16 word;
3401 U32 state;
3402 U16 prev;
3403
3404 for (word=1; word <= trie->wordcount; word++) {
3405 prev = 0;
3406 if (trie->wordinfo[word].prev)
3407 continue;
3408 state = trie->wordinfo[word].accept;
3409 while (state) {
3410 state = prev_states[state];
3411 if (!state)
3412 break;
3413 prev = trie->states[state].wordnum;
3414 if (prev)
3415 break;
3416 }
3417 trie->wordinfo[word].prev = prev;
3418 }
3419 Safefree(prev_states);
3420 }
3421
3422
3423 /* and now dump out the compressed format */
3424 DEBUG_TRIE_COMPILE_r(dump_trie(trie, widecharmap, revcharmap, depth+1));
3425
55eed653 3426 RExC_rxi->data->data[ data_slot + 1 ] = (void*)widecharmap;
2b8b4781
NC
3427#ifdef DEBUGGING
3428 RExC_rxi->data->data[ data_slot + TRIE_WORDS_OFFSET ] = (void*)trie_words;
3429 RExC_rxi->data->data[ data_slot + 3 ] = (void*)revcharmap;
3430#else
03e70be4 3431 SvREFCNT_dec_NN(revcharmap);
07be1b83 3432#endif
538e84ed
KW
3433 return trie->jump
3434 ? MADE_JUMP_TRIE
3435 : trie->startstate>1
3436 ? MADE_EXACT_TRIE
786e8c11
YO
3437 : MADE_TRIE;
3438}
3439
615a2e7f
YO
3440STATIC regnode *
3441S_construct_ahocorasick_from_trie(pTHX_ RExC_state_t *pRExC_state, regnode *source, U32 depth)
786e8c11 3442{
b423522f
KW
3443/* The Trie is constructed and compressed now so we can build a fail array if
3444 * it's needed
786e8c11 3445
b423522f
KW
3446 This is basically the Aho-Corasick algorithm. Its from exercise 3.31 and
3447 3.32 in the
3448 "Red Dragon" -- Compilers, principles, techniques, and tools. Aho, Sethi,
3449 Ullman 1985/88
786e8c11
YO
3450 ISBN 0-201-10088-6
3451
b423522f
KW
3452 We find the fail state for each state in the trie, this state is the longest
3453 proper suffix of the current state's 'word' that is also a proper prefix of
3454 another word in our trie. State 1 represents the word '' and is thus the
3455 default fail state. This allows the DFA not to have to restart after its
3456 tried and failed a word at a given point, it simply continues as though it
3457 had been matching the other word in the first place.
786e8c11
YO
3458 Consider
3459 'abcdgu'=~/abcdefg|cdgu/
b423522f
KW
3460 When we get to 'd' we are still matching the first word, we would encounter
3461 'g' which would fail, which would bring us to the state representing 'd' in
3462 the second word where we would try 'g' and succeed, proceeding to match
3463 'cdgu'.
786e8c11
YO
3464 */
3465 /* add a fail transition */
3251b653
NC
3466 const U32 trie_offset = ARG(source);
3467 reg_trie_data *trie=(reg_trie_data *)RExC_rxi->data->data[trie_offset];
786e8c11
YO
3468 U32 *q;
3469 const U32 ucharcount = trie->uniquecharcount;
1e2e3d02 3470 const U32 numstates = trie->statecount;
786e8c11
YO
3471 const U32 ubound = trie->lasttrans + ucharcount;
3472 U32 q_read = 0;
3473 U32 q_write = 0;
3474 U32 charid;
3475 U32 base = trie->states[ 1 ].trans.base;
3476 U32 *fail;
3477 reg_ac_data *aho;
cf78de0b 3478 const U32 data_slot = add_data( pRExC_state, STR_WITH_LEN("T"));
615a2e7f 3479 regnode *stclass;
786e8c11 3480 GET_RE_DEBUG_FLAGS_DECL;
7918f24d 3481
615a2e7f 3482 PERL_ARGS_ASSERT_CONSTRUCT_AHOCORASICK_FROM_TRIE;
81611534 3483 PERL_UNUSED_CONTEXT;
786e8c11
YO
3484#ifndef DEBUGGING
3485 PERL_UNUSED_ARG(depth);
3486#endif
3487
615a2e7f
YO
3488 if ( OP(source) == TRIE ) {
3489 struct regnode_1 *op = (struct regnode_1 *)
3490 PerlMemShared_calloc(1, sizeof(struct regnode_1));
3491 StructCopy(source,op,struct regnode_1);
3492 stclass = (regnode *)op;
3493 } else {
3494 struct regnode_charclass *op = (struct regnode_charclass *)
3495 PerlMemShared_calloc(1, sizeof(struct regnode_charclass));
3496 StructCopy(source,op,struct regnode_charclass);
3497 stclass = (regnode *)op;
3498 }
2f306ab9 3499 OP(stclass)+=2; /* convert the TRIE type to its AHO-CORASICK equivalent */
786e8c11
YO
3500
3501 ARG_SET( stclass, data_slot );
c944940b 3502 aho = (reg_ac_data *) PerlMemShared_calloc( 1, sizeof(reg_ac_data) );
f8fc2ecf 3503 RExC_rxi->data->data[ data_slot ] = (void*)aho;
3251b653 3504 aho->trie=trie_offset;
446bd890
NC
3505 aho->states=(reg_trie_state *)PerlMemShared_malloc( numstates * sizeof(reg_trie_state) );
3506 Copy( trie->states, aho->states, numstates, reg_trie_state );
786e8c11 3507 Newxz( q, numstates, U32);
c944940b 3508 aho->fail = (U32 *) PerlMemShared_calloc( numstates, sizeof(U32) );
786e8c11
YO
3509 aho->refcount = 1;
3510 fail = aho->fail;
3511 /* initialize fail[0..1] to be 1 so that we always have
3512 a valid final fail state */
3513 fail[ 0 ] = fail[ 1 ] = 1;
3514
3515 for ( charid = 0; charid < ucharcount ; charid++ ) {
3516 const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 );
3517 if ( newstate ) {
3518 q[ q_write ] = newstate;
3519 /* set to point at the root */
3520 fail[ q[ q_write++ ] ]=1;
3521 }
3522 }
3523 while ( q_read < q_write) {
3524 const U32 cur = q[ q_read++ % numstates ];