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