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