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