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