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