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