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