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