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