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