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