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