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