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