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