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