Deprecate literal unescaped "{" in regexes.
[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 typedef struct RExC_state_t {
113     U32         flags;                  /* are we folding, multilining? */
114     char        *precomp;               /* uncompiled string. */
115     REGEXP      *rx_sv;                 /* The SV that is the regexp. */
116     regexp      *rx;                    /* perl core regexp structure */
117     regexp_internal     *rxi;           /* internal data for regexp object pprivate field */        
118     char        *start;                 /* Start of input for compile */
119     char        *end;                   /* End of input for compile */
120     char        *parse;                 /* Input-scan pointer. */
121     I32         whilem_seen;            /* number of WHILEM in this expr */
122     regnode     *emit_start;            /* Start of emitted-code area */
123     regnode     *emit_bound;            /* First regnode outside of the allocated space */
124     regnode     *emit;                  /* Code-emit pointer; &regdummy = don't = compiling */
125     I32         naughty;                /* How bad is this pattern? */
126     I32         sawback;                /* Did we see \1, ...? */
127     U32         seen;
128     I32         size;                   /* Code size. */
129     I32         npar;                   /* Capture buffer count, (OPEN). */
130     I32         cpar;                   /* Capture buffer count, (CLOSE). */
131     I32         nestroot;               /* root parens we are in - used by accept */
132     I32         extralen;
133     I32         seen_zerolen;
134     I32         seen_evals;
135     regnode     **open_parens;          /* pointers to open parens */
136     regnode     **close_parens;         /* pointers to close parens */
137     regnode     *opend;                 /* END node in program */
138     I32         utf8;           /* whether the pattern is utf8 or not */
139     I32         orig_utf8;      /* whether the pattern was originally in utf8 */
140                                 /* XXX use this for future optimisation of case
141                                  * where pattern must be upgraded to utf8. */
142     I32         uni_semantics;  /* If a d charset modifier should use unicode
143                                    rules, even if the pattern is not in
144                                    utf8 */
145     HV          *paren_names;           /* Paren names */
146     
147     regnode     **recurse;              /* Recurse regops */
148     I32         recurse_count;          /* Number of recurse regops */
149     I32         in_lookbehind;
150     I32         contains_locale;
151     I32         override_recoding;
152 #if ADD_TO_REGEXEC
153     char        *starttry;              /* -Dr: where regtry was called. */
154 #define RExC_starttry   (pRExC_state->starttry)
155 #endif
156 #ifdef DEBUGGING
157     const char  *lastparse;
158     I32         lastnum;
159     AV          *paren_name_list;       /* idx -> name */
160 #define RExC_lastparse  (pRExC_state->lastparse)
161 #define RExC_lastnum    (pRExC_state->lastnum)
162 #define RExC_paren_name_list    (pRExC_state->paren_name_list)
163 #endif
164 } RExC_state_t;
165
166 #define RExC_flags      (pRExC_state->flags)
167 #define RExC_precomp    (pRExC_state->precomp)
168 #define RExC_rx_sv      (pRExC_state->rx_sv)
169 #define RExC_rx         (pRExC_state->rx)
170 #define RExC_rxi        (pRExC_state->rxi)
171 #define RExC_start      (pRExC_state->start)
172 #define RExC_end        (pRExC_state->end)
173 #define RExC_parse      (pRExC_state->parse)
174 #define RExC_whilem_seen        (pRExC_state->whilem_seen)
175 #ifdef RE_TRACK_PATTERN_OFFSETS
176 #define RExC_offsets    (pRExC_state->rxi->u.offsets) /* I am not like the others */
177 #endif
178 #define RExC_emit       (pRExC_state->emit)
179 #define RExC_emit_start (pRExC_state->emit_start)
180 #define RExC_emit_bound (pRExC_state->emit_bound)
181 #define RExC_naughty    (pRExC_state->naughty)
182 #define RExC_sawback    (pRExC_state->sawback)
183 #define RExC_seen       (pRExC_state->seen)
184 #define RExC_size       (pRExC_state->size)
185 #define RExC_npar       (pRExC_state->npar)
186 #define RExC_nestroot   (pRExC_state->nestroot)
187 #define RExC_extralen   (pRExC_state->extralen)
188 #define RExC_seen_zerolen       (pRExC_state->seen_zerolen)
189 #define RExC_seen_evals (pRExC_state->seen_evals)
190 #define RExC_utf8       (pRExC_state->utf8)
191 #define RExC_uni_semantics      (pRExC_state->uni_semantics)
192 #define RExC_orig_utf8  (pRExC_state->orig_utf8)
193 #define RExC_open_parens        (pRExC_state->open_parens)
194 #define RExC_close_parens       (pRExC_state->close_parens)
195 #define RExC_opend      (pRExC_state->opend)
196 #define RExC_paren_names        (pRExC_state->paren_names)
197 #define RExC_recurse    (pRExC_state->recurse)
198 #define RExC_recurse_count      (pRExC_state->recurse_count)
199 #define RExC_in_lookbehind      (pRExC_state->in_lookbehind)
200 #define RExC_contains_locale    (pRExC_state->contains_locale)
201 #define RExC_override_recoding  (pRExC_state->override_recoding)
202
203
204 #define ISMULT1(c)      ((c) == '*' || (c) == '+' || (c) == '?')
205 #define ISMULT2(s)      ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
206         ((*s) == '{' && regcurly(s)))
207
208 #ifdef SPSTART
209 #undef SPSTART          /* dratted cpp namespace... */
210 #endif
211 /*
212  * Flags to be passed up and down.
213  */
214 #define WORST           0       /* Worst case. */
215 #define HASWIDTH        0x01    /* Known to match non-null strings. */
216
217 /* Simple enough to be STAR/PLUS operand, in an EXACT node must be a single
218  * character, and if utf8, must be invariant.  Note that this is not the same
219  * thing as REGNODE_SIMPLE */
220 #define SIMPLE          0x02
221 #define SPSTART         0x04    /* Starts with * or +. */
222 #define TRYAGAIN        0x08    /* Weeded out a declaration. */
223 #define POSTPONED       0x10    /* (?1),(?&name), (??{...}) or similar */
224
225 #define REG_NODE_NUM(x) ((x) ? (int)((x)-RExC_emit_start) : -1)
226
227 /* whether trie related optimizations are enabled */
228 #if PERL_ENABLE_EXTENDED_TRIE_OPTIMISATION
229 #define TRIE_STUDY_OPT
230 #define FULL_TRIE_STUDY
231 #define TRIE_STCLASS
232 #endif
233
234
235
236 #define PBYTE(u8str,paren) ((U8*)(u8str))[(paren) >> 3]
237 #define PBITVAL(paren) (1 << ((paren) & 7))
238 #define PAREN_TEST(u8str,paren) ( PBYTE(u8str,paren) & PBITVAL(paren))
239 #define PAREN_SET(u8str,paren) PBYTE(u8str,paren) |= PBITVAL(paren)
240 #define PAREN_UNSET(u8str,paren) PBYTE(u8str,paren) &= (~PBITVAL(paren))
241
242 /* If not already in utf8, do a longjmp back to the beginning */
243 #define UTF8_LONGJMP 42 /* Choose a value not likely to ever conflict */
244 #define REQUIRE_UTF8    STMT_START {                                       \
245                                      if (! UTF) JMPENV_JUMP(UTF8_LONGJMP); \
246                         } STMT_END
247
248 /* About scan_data_t.
249
250   During optimisation we recurse through the regexp program performing
251   various inplace (keyhole style) optimisations. In addition study_chunk
252   and scan_commit populate this data structure with information about
253   what strings MUST appear in the pattern. We look for the longest 
254   string that must appear at a fixed location, and we look for the
255   longest string that may appear at a floating location. So for instance
256   in the pattern:
257   
258     /FOO[xX]A.*B[xX]BAR/
259     
260   Both 'FOO' and 'A' are fixed strings. Both 'B' and 'BAR' are floating
261   strings (because they follow a .* construct). study_chunk will identify
262   both FOO and BAR as being the longest fixed and floating strings respectively.
263   
264   The strings can be composites, for instance
265   
266      /(f)(o)(o)/
267      
268   will result in a composite fixed substring 'foo'.
269   
270   For each string some basic information is maintained:
271   
272   - offset or min_offset
273     This is the position the string must appear at, or not before.
274     It also implicitly (when combined with minlenp) tells us how many
275     characters must match before the string we are searching for.
276     Likewise when combined with minlenp and the length of the string it
277     tells us how many characters must appear after the string we have 
278     found.
279   
280   - max_offset
281     Only used for floating strings. This is the rightmost point that
282     the string can appear at. If set to I32 max it indicates that the
283     string can occur infinitely far to the right.
284   
285   - minlenp
286     A pointer to the minimum length of the pattern that the string 
287     was found inside. This is important as in the case of positive 
288     lookahead or positive lookbehind we can have multiple patterns 
289     involved. Consider
290     
291     /(?=FOO).*F/
292     
293     The minimum length of the pattern overall is 3, the minimum length
294     of the lookahead part is 3, but the minimum length of the part that
295     will actually match is 1. So 'FOO's minimum length is 3, but the 
296     minimum length for the F is 1. This is important as the minimum length
297     is used to determine offsets in front of and behind the string being 
298     looked for.  Since strings can be composites this is the length of the
299     pattern at the time it was committed with a scan_commit. Note that
300     the length is calculated by study_chunk, so that the minimum lengths
301     are not known until the full pattern has been compiled, thus the 
302     pointer to the value.
303   
304   - lookbehind
305   
306     In the case of lookbehind the string being searched for can be
307     offset past the start point of the final matching string. 
308     If this value was just blithely removed from the min_offset it would
309     invalidate some of the calculations for how many chars must match
310     before or after (as they are derived from min_offset and minlen and
311     the length of the string being searched for). 
312     When the final pattern is compiled and the data is moved from the
313     scan_data_t structure into the regexp structure the information
314     about lookbehind is factored in, with the information that would 
315     have been lost precalculated in the end_shift field for the 
316     associated string.
317
318   The fields pos_min and pos_delta are used to store the minimum offset
319   and the delta to the maximum offset at the current point in the pattern.    
320
321 */
322
323 typedef struct scan_data_t {
324     /*I32 len_min;      unused */
325     /*I32 len_delta;    unused */
326     I32 pos_min;
327     I32 pos_delta;
328     SV *last_found;
329     I32 last_end;           /* min value, <0 unless valid. */
330     I32 last_start_min;
331     I32 last_start_max;
332     SV **longest;           /* Either &l_fixed, or &l_float. */
333     SV *longest_fixed;      /* longest fixed string found in pattern */
334     I32 offset_fixed;       /* offset where it starts */
335     I32 *minlen_fixed;      /* pointer to the minlen relevant to the string */
336     I32 lookbehind_fixed;   /* is the position of the string modfied by LB */
337     SV *longest_float;      /* longest floating string found in pattern */
338     I32 offset_float_min;   /* earliest point in string it can appear */
339     I32 offset_float_max;   /* latest point in string it can appear */
340     I32 *minlen_float;      /* pointer to the minlen relevant to the string */
341     I32 lookbehind_float;   /* is the position of the string modified by LB */
342     I32 flags;
343     I32 whilem_c;
344     I32 *last_closep;
345     struct regnode_charclass_class *start_class;
346 } scan_data_t;
347
348 /*
349  * Forward declarations for pregcomp()'s friends.
350  */
351
352 static const scan_data_t zero_scan_data =
353   { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ,0};
354
355 #define SF_BEFORE_EOL           (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
356 #define SF_BEFORE_SEOL          0x0001
357 #define SF_BEFORE_MEOL          0x0002
358 #define SF_FIX_BEFORE_EOL       (SF_FIX_BEFORE_SEOL|SF_FIX_BEFORE_MEOL)
359 #define SF_FL_BEFORE_EOL        (SF_FL_BEFORE_SEOL|SF_FL_BEFORE_MEOL)
360
361 #ifdef NO_UNARY_PLUS
362 #  define SF_FIX_SHIFT_EOL      (0+2)
363 #  define SF_FL_SHIFT_EOL               (0+4)
364 #else
365 #  define SF_FIX_SHIFT_EOL      (+2)
366 #  define SF_FL_SHIFT_EOL               (+4)
367 #endif
368
369 #define SF_FIX_BEFORE_SEOL      (SF_BEFORE_SEOL << SF_FIX_SHIFT_EOL)
370 #define SF_FIX_BEFORE_MEOL      (SF_BEFORE_MEOL << SF_FIX_SHIFT_EOL)
371
372 #define SF_FL_BEFORE_SEOL       (SF_BEFORE_SEOL << SF_FL_SHIFT_EOL)
373 #define SF_FL_BEFORE_MEOL       (SF_BEFORE_MEOL << SF_FL_SHIFT_EOL) /* 0x20 */
374 #define SF_IS_INF               0x0040
375 #define SF_HAS_PAR              0x0080
376 #define SF_IN_PAR               0x0100
377 #define SF_HAS_EVAL             0x0200
378 #define SCF_DO_SUBSTR           0x0400
379 #define SCF_DO_STCLASS_AND      0x0800
380 #define SCF_DO_STCLASS_OR       0x1000
381 #define SCF_DO_STCLASS          (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR)
382 #define SCF_WHILEM_VISITED_POS  0x2000
383
384 #define SCF_TRIE_RESTUDY        0x4000 /* Do restudy? */
385 #define SCF_SEEN_ACCEPT         0x8000 
386
387 #define UTF cBOOL(RExC_utf8)
388
389 /* The enums for all these are ordered so things work out correctly */
390 #define LOC (get_regex_charset(RExC_flags) == REGEX_LOCALE_CHARSET)
391 #define DEPENDS_SEMANTICS (get_regex_charset(RExC_flags) == REGEX_DEPENDS_CHARSET)
392 #define UNI_SEMANTICS (get_regex_charset(RExC_flags) == REGEX_UNICODE_CHARSET)
393 #define AT_LEAST_UNI_SEMANTICS (get_regex_charset(RExC_flags) >= REGEX_UNICODE_CHARSET)
394 #define ASCII_RESTRICTED (get_regex_charset(RExC_flags) == REGEX_ASCII_RESTRICTED_CHARSET)
395 #define MORE_ASCII_RESTRICTED (get_regex_charset(RExC_flags) == REGEX_ASCII_MORE_RESTRICTED_CHARSET)
396 #define AT_LEAST_ASCII_RESTRICTED (get_regex_charset(RExC_flags) >= REGEX_ASCII_RESTRICTED_CHARSET)
397
398 #define FOLD cBOOL(RExC_flags & RXf_PMf_FOLD)
399
400 #define OOB_UNICODE             12345678
401 #define OOB_NAMEDCLASS          -1
402
403 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
404 #define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
405
406
407 /* length of regex to show in messages that don't mark a position within */
408 #define RegexLengthToShowInErrorMessages 127
409
410 /*
411  * If MARKER[12] are adjusted, be sure to adjust the constants at the top
412  * of t/op/regmesg.t, the tests in t/op/re_tests, and those in
413  * op/pragma/warn/regcomp.
414  */
415 #define MARKER1 "<-- HERE"    /* marker as it appears in the description */
416 #define MARKER2 " <-- HERE "  /* marker as it appears within the regex */
417
418 #define REPORT_LOCATION " in regex; marked by " MARKER1 " in m/%.*s" MARKER2 "%s/"
419
420 /*
421  * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
422  * arg. Show regex, up to a maximum length. If it's too long, chop and add
423  * "...".
424  */
425 #define _FAIL(code) STMT_START {                                        \
426     const char *ellipses = "";                                          \
427     IV len = RExC_end - RExC_precomp;                                   \
428                                                                         \
429     if (!SIZE_ONLY)                                                     \
430         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv);                   \
431     if (len > RegexLengthToShowInErrorMessages) {                       \
432         /* chop 10 shorter than the max, to ensure meaning of "..." */  \
433         len = RegexLengthToShowInErrorMessages - 10;                    \
434         ellipses = "...";                                               \
435     }                                                                   \
436     code;                                                               \
437 } STMT_END
438
439 #define FAIL(msg) _FAIL(                            \
440     Perl_croak(aTHX_ "%s in regex m/%.*s%s/",       \
441             msg, (int)len, RExC_precomp, ellipses))
442
443 #define FAIL2(msg,arg) _FAIL(                       \
444     Perl_croak(aTHX_ msg " in regex m/%.*s%s/",     \
445             arg, (int)len, RExC_precomp, ellipses))
446
447 /*
448  * Simple_vFAIL -- like FAIL, but marks the current location in the scan
449  */
450 #define Simple_vFAIL(m) STMT_START {                                    \
451     const IV offset = RExC_parse - RExC_precomp;                        \
452     Perl_croak(aTHX_ "%s" REPORT_LOCATION,                              \
453             m, (int)offset, RExC_precomp, RExC_precomp + offset);       \
454 } STMT_END
455
456 /*
457  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL()
458  */
459 #define vFAIL(m) STMT_START {                           \
460     if (!SIZE_ONLY)                                     \
461         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv);   \
462     Simple_vFAIL(m);                                    \
463 } STMT_END
464
465 /*
466  * Like Simple_vFAIL(), but accepts two arguments.
467  */
468 #define Simple_vFAIL2(m,a1) STMT_START {                        \
469     const IV offset = RExC_parse - RExC_precomp;                        \
470     S_re_croak2(aTHX_ m, REPORT_LOCATION, a1,                   \
471             (int)offset, RExC_precomp, RExC_precomp + offset);  \
472 } STMT_END
473
474 /*
475  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL2().
476  */
477 #define vFAIL2(m,a1) STMT_START {                       \
478     if (!SIZE_ONLY)                                     \
479         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv);   \
480     Simple_vFAIL2(m, a1);                               \
481 } STMT_END
482
483
484 /*
485  * Like Simple_vFAIL(), but accepts three arguments.
486  */
487 #define Simple_vFAIL3(m, a1, a2) STMT_START {                   \
488     const IV offset = RExC_parse - RExC_precomp;                \
489     S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2,               \
490             (int)offset, RExC_precomp, RExC_precomp + offset);  \
491 } STMT_END
492
493 /*
494  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL3().
495  */
496 #define vFAIL3(m,a1,a2) STMT_START {                    \
497     if (!SIZE_ONLY)                                     \
498         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv);   \
499     Simple_vFAIL3(m, a1, a2);                           \
500 } STMT_END
501
502 /*
503  * Like Simple_vFAIL(), but accepts four arguments.
504  */
505 #define Simple_vFAIL4(m, a1, a2, a3) STMT_START {               \
506     const IV offset = RExC_parse - RExC_precomp;                \
507     S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3,           \
508             (int)offset, RExC_precomp, RExC_precomp + offset);  \
509 } STMT_END
510
511 #define ckWARNreg(loc,m) STMT_START {                                   \
512     const IV offset = loc - RExC_precomp;                               \
513     Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,      \
514             (int)offset, RExC_precomp, RExC_precomp + offset);          \
515 } STMT_END
516
517 #define ckWARNregdep(loc,m) STMT_START {                                \
518     const IV offset = loc - RExC_precomp;                               \
519     Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP),     \
520             m REPORT_LOCATION,                                          \
521             (int)offset, RExC_precomp, RExC_precomp + offset);          \
522 } STMT_END
523
524 #define ckWARN2regdep(loc,m, a1) STMT_START {                           \
525     const IV offset = loc - RExC_precomp;                               \
526     Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP),     \
527             m REPORT_LOCATION,                                          \
528             a1, (int)offset, RExC_precomp, RExC_precomp + offset);      \
529 } STMT_END
530
531 #define ckWARN2reg(loc, m, a1) STMT_START {                             \
532     const IV offset = loc - RExC_precomp;                               \
533     Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,      \
534             a1, (int)offset, RExC_precomp, RExC_precomp + offset);      \
535 } STMT_END
536
537 #define vWARN3(loc, m, a1, a2) STMT_START {                             \
538     const IV offset = loc - RExC_precomp;                               \
539     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
540             a1, a2, (int)offset, RExC_precomp, RExC_precomp + offset);  \
541 } STMT_END
542
543 #define ckWARN3reg(loc, m, a1, a2) STMT_START {                         \
544     const IV offset = loc - RExC_precomp;                               \
545     Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,      \
546             a1, a2, (int)offset, RExC_precomp, RExC_precomp + offset);  \
547 } STMT_END
548
549 #define vWARN4(loc, m, a1, a2, a3) STMT_START {                         \
550     const IV offset = loc - RExC_precomp;                               \
551     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
552             a1, a2, a3, (int)offset, RExC_precomp, RExC_precomp + offset); \
553 } STMT_END
554
555 #define ckWARN4reg(loc, m, a1, a2, a3) STMT_START {                     \
556     const IV offset = loc - RExC_precomp;                               \
557     Perl_ck_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 vWARN5(loc, m, a1, a2, a3, a4) STMT_START {                     \
562     const IV offset = loc - RExC_precomp;                               \
563     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
564             a1, a2, a3, a4, (int)offset, RExC_precomp, RExC_precomp + offset); \
565 } STMT_END
566
567
568 /* Allow for side effects in s */
569 #define REGC(c,s) STMT_START {                  \
570     if (!SIZE_ONLY) *(s) = (c); else (void)(s); \
571 } STMT_END
572
573 /* Macros for recording node offsets.   20001227 mjd@plover.com 
574  * Nodes are numbered 1, 2, 3, 4.  Node #n's position is recorded in
575  * element 2*n-1 of the array.  Element #2n holds the byte length node #n.
576  * Element 0 holds the number n.
577  * Position is 1 indexed.
578  */
579 #ifndef RE_TRACK_PATTERN_OFFSETS
580 #define Set_Node_Offset_To_R(node,byte)
581 #define Set_Node_Offset(node,byte)
582 #define Set_Cur_Node_Offset
583 #define Set_Node_Length_To_R(node,len)
584 #define Set_Node_Length(node,len)
585 #define Set_Node_Cur_Length(node)
586 #define Node_Offset(n) 
587 #define Node_Length(n) 
588 #define Set_Node_Offset_Length(node,offset,len)
589 #define ProgLen(ri) ri->u.proglen
590 #define SetProgLen(ri,x) ri->u.proglen = x
591 #else
592 #define ProgLen(ri) ri->u.offsets[0]
593 #define SetProgLen(ri,x) ri->u.offsets[0] = x
594 #define Set_Node_Offset_To_R(node,byte) STMT_START {                    \
595     if (! SIZE_ONLY) {                                                  \
596         MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n",         \
597                     __LINE__, (int)(node), (int)(byte)));               \
598         if((node) < 0) {                                                \
599             Perl_croak(aTHX_ "value of node is %d in Offset macro", (int)(node)); \
600         } else {                                                        \
601             RExC_offsets[2*(node)-1] = (byte);                          \
602         }                                                               \
603     }                                                                   \
604 } STMT_END
605
606 #define Set_Node_Offset(node,byte) \
607     Set_Node_Offset_To_R((node)-RExC_emit_start, (byte)-RExC_start)
608 #define Set_Cur_Node_Offset Set_Node_Offset(RExC_emit, RExC_parse)
609
610 #define Set_Node_Length_To_R(node,len) STMT_START {                     \
611     if (! SIZE_ONLY) {                                                  \
612         MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n",           \
613                 __LINE__, (int)(node), (int)(len)));                    \
614         if((node) < 0) {                                                \
615             Perl_croak(aTHX_ "value of node is %d in Length macro", (int)(node)); \
616         } else {                                                        \
617             RExC_offsets[2*(node)] = (len);                             \
618         }                                                               \
619     }                                                                   \
620 } STMT_END
621
622 #define Set_Node_Length(node,len) \
623     Set_Node_Length_To_R((node)-RExC_emit_start, len)
624 #define Set_Cur_Node_Length(len) Set_Node_Length(RExC_emit, len)
625 #define Set_Node_Cur_Length(node) \
626     Set_Node_Length(node, RExC_parse - parse_start)
627
628 /* Get offsets and lengths */
629 #define Node_Offset(n) (RExC_offsets[2*((n)-RExC_emit_start)-1])
630 #define Node_Length(n) (RExC_offsets[2*((n)-RExC_emit_start)])
631
632 #define Set_Node_Offset_Length(node,offset,len) STMT_START {    \
633     Set_Node_Offset_To_R((node)-RExC_emit_start, (offset));     \
634     Set_Node_Length_To_R((node)-RExC_emit_start, (len));        \
635 } STMT_END
636 #endif
637
638 #if PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS
639 #define EXPERIMENTAL_INPLACESCAN
640 #endif /*PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS*/
641
642 #define DEBUG_STUDYDATA(str,data,depth)                              \
643 DEBUG_OPTIMISE_MORE_r(if(data){                                      \
644     PerlIO_printf(Perl_debug_log,                                    \
645         "%*s" str "Pos:%"IVdf"/%"IVdf                                \
646         " Flags: 0x%"UVXf" Whilem_c: %"IVdf" Lcp: %"IVdf" %s",       \
647         (int)(depth)*2, "",                                          \
648         (IV)((data)->pos_min),                                       \
649         (IV)((data)->pos_delta),                                     \
650         (UV)((data)->flags),                                         \
651         (IV)((data)->whilem_c),                                      \
652         (IV)((data)->last_closep ? *((data)->last_closep) : -1),     \
653         is_inf ? "INF " : ""                                         \
654     );                                                               \
655     if ((data)->last_found)                                          \
656         PerlIO_printf(Perl_debug_log,                                \
657             "Last:'%s' %"IVdf":%"IVdf"/%"IVdf" %sFixed:'%s' @ %"IVdf \
658             " %sFloat: '%s' @ %"IVdf"/%"IVdf"",                      \
659             SvPVX_const((data)->last_found),                         \
660             (IV)((data)->last_end),                                  \
661             (IV)((data)->last_start_min),                            \
662             (IV)((data)->last_start_max),                            \
663             ((data)->longest &&                                      \
664              (data)->longest==&((data)->longest_fixed)) ? "*" : "",  \
665             SvPVX_const((data)->longest_fixed),                      \
666             (IV)((data)->offset_fixed),                              \
667             ((data)->longest &&                                      \
668              (data)->longest==&((data)->longest_float)) ? "*" : "",  \
669             SvPVX_const((data)->longest_float),                      \
670             (IV)((data)->offset_float_min),                          \
671             (IV)((data)->offset_float_max)                           \
672         );                                                           \
673     PerlIO_printf(Perl_debug_log,"\n");                              \
674 });
675
676 static void clear_re(pTHX_ void *r);
677
678 /* Mark that we cannot extend a found fixed substring at this point.
679    Update the longest found anchored substring and the longest found
680    floating substrings if needed. */
681
682 STATIC void
683 S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, I32 *minlenp, int is_inf)
684 {
685     const STRLEN l = CHR_SVLEN(data->last_found);
686     const STRLEN old_l = CHR_SVLEN(*data->longest);
687     GET_RE_DEBUG_FLAGS_DECL;
688
689     PERL_ARGS_ASSERT_SCAN_COMMIT;
690
691     if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
692         SvSetMagicSV(*data->longest, data->last_found);
693         if (*data->longest == data->longest_fixed) {
694             data->offset_fixed = l ? data->last_start_min : data->pos_min;
695             if (data->flags & SF_BEFORE_EOL)
696                 data->flags
697                     |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL);
698             else
699                 data->flags &= ~SF_FIX_BEFORE_EOL;
700             data->minlen_fixed=minlenp;
701             data->lookbehind_fixed=0;
702         }
703         else { /* *data->longest == data->longest_float */
704             data->offset_float_min = l ? data->last_start_min : data->pos_min;
705             data->offset_float_max = (l
706                                       ? data->last_start_max
707                                       : data->pos_min + data->pos_delta);
708             if (is_inf || (U32)data->offset_float_max > (U32)I32_MAX)
709                 data->offset_float_max = I32_MAX;
710             if (data->flags & SF_BEFORE_EOL)
711                 data->flags
712                     |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL);
713             else
714                 data->flags &= ~SF_FL_BEFORE_EOL;
715             data->minlen_float=minlenp;
716             data->lookbehind_float=0;
717         }
718     }
719     SvCUR_set(data->last_found, 0);
720     {
721         SV * const sv = data->last_found;
722         if (SvUTF8(sv) && SvMAGICAL(sv)) {
723             MAGIC * const mg = mg_find(sv, PERL_MAGIC_utf8);
724             if (mg)
725                 mg->mg_len = 0;
726         }
727     }
728     data->last_end = -1;
729     data->flags &= ~SF_BEFORE_EOL;
730     DEBUG_STUDYDATA("commit: ",data,0);
731 }
732
733 /* Can match anything (initialization) */
734 STATIC void
735 S_cl_anything(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
736 {
737     PERL_ARGS_ASSERT_CL_ANYTHING;
738
739     ANYOF_BITMAP_SETALL(cl);
740     cl->flags = ANYOF_CLASS|ANYOF_EOS|ANYOF_UNICODE_ALL
741                 |ANYOF_LOC_NONBITMAP_FOLD|ANYOF_NON_UTF8_LATIN1_ALL;
742
743     /* If any portion of the regex is to operate under locale rules,
744      * initialization includes it.  The reason this isn't done for all regexes
745      * is that the optimizer was written under the assumption that locale was
746      * all-or-nothing.  Given the complexity and lack of documentation in the
747      * optimizer, and that there are inadequate test cases for locale, so many
748      * parts of it may not work properly, it is safest to avoid locale unless
749      * necessary. */
750     if (RExC_contains_locale) {
751         ANYOF_CLASS_SETALL(cl);     /* /l uses class */
752         cl->flags |= ANYOF_LOCALE;
753     }
754     else {
755         ANYOF_CLASS_ZERO(cl);       /* Only /l uses class now */
756     }
757 }
758
759 /* Can match anything (initialization) */
760 STATIC int
761 S_cl_is_anything(const struct regnode_charclass_class *cl)
762 {
763     int value;
764
765     PERL_ARGS_ASSERT_CL_IS_ANYTHING;
766
767     for (value = 0; value <= ANYOF_MAX; value += 2)
768         if (ANYOF_CLASS_TEST(cl, value) && ANYOF_CLASS_TEST(cl, value + 1))
769             return 1;
770     if (!(cl->flags & ANYOF_UNICODE_ALL))
771         return 0;
772     if (!ANYOF_BITMAP_TESTALLSET((const void*)cl))
773         return 0;
774     return 1;
775 }
776
777 /* Can match anything (initialization) */
778 STATIC void
779 S_cl_init(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
780 {
781     PERL_ARGS_ASSERT_CL_INIT;
782
783     Zero(cl, 1, struct regnode_charclass_class);
784     cl->type = ANYOF;
785     cl_anything(pRExC_state, cl);
786     ARG_SET(cl, ANYOF_NONBITMAP_EMPTY);
787 }
788
789 /* These two functions currently do the exact same thing */
790 #define cl_init_zero            S_cl_init
791
792 /* 'AND' a given class with another one.  Can create false positives.  'cl'
793  * should not be inverted.  'and_with->flags & ANYOF_CLASS' should be 0 if
794  * 'and_with' is a regnode_charclass instead of a regnode_charclass_class. */
795 STATIC void
796 S_cl_and(struct regnode_charclass_class *cl,
797         const struct regnode_charclass_class *and_with)
798 {
799     PERL_ARGS_ASSERT_CL_AND;
800
801     assert(and_with->type == ANYOF);
802
803     /* I (khw) am not sure all these restrictions are necessary XXX */
804     if (!(ANYOF_CLASS_TEST_ANY_SET(and_with))
805         && !(ANYOF_CLASS_TEST_ANY_SET(cl))
806         && (and_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
807         && !(and_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
808         && !(cl->flags & ANYOF_LOC_NONBITMAP_FOLD)) {
809         int i;
810
811         if (and_with->flags & ANYOF_INVERT)
812             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
813                 cl->bitmap[i] &= ~and_with->bitmap[i];
814         else
815             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
816                 cl->bitmap[i] &= and_with->bitmap[i];
817     } /* XXXX: logic is complicated otherwise, leave it along for a moment. */
818
819     if (and_with->flags & ANYOF_INVERT) {
820
821         /* Here, the and'ed node is inverted.  Get the AND of the flags that
822          * aren't affected by the inversion.  Those that are affected are
823          * handled individually below */
824         U8 affected_flags = cl->flags & ~INVERSION_UNAFFECTED_FLAGS;
825         cl->flags &= (and_with->flags & INVERSION_UNAFFECTED_FLAGS);
826         cl->flags |= affected_flags;
827
828         /* We currently don't know how to deal with things that aren't in the
829          * bitmap, but we know that the intersection is no greater than what
830          * is already in cl, so let there be false positives that get sorted
831          * out after the synthetic start class succeeds, and the node is
832          * matched for real. */
833
834         /* The inversion of these two flags indicate that the resulting
835          * intersection doesn't have them */
836         if (and_with->flags & ANYOF_UNICODE_ALL) {
837             cl->flags &= ~ANYOF_UNICODE_ALL;
838         }
839         if (and_with->flags & ANYOF_NON_UTF8_LATIN1_ALL) {
840             cl->flags &= ~ANYOF_NON_UTF8_LATIN1_ALL;
841         }
842     }
843     else {   /* and'd node is not inverted */
844         U8 outside_bitmap_but_not_utf8; /* Temp variable */
845
846         if (! ANYOF_NONBITMAP(and_with)) {
847
848             /* Here 'and_with' doesn't match anything outside the bitmap
849              * (except possibly ANYOF_UNICODE_ALL), which means the
850              * intersection can't either, except for ANYOF_UNICODE_ALL, in
851              * which case we don't know what the intersection is, but it's no
852              * greater than what cl already has, so can just leave it alone,
853              * with possible false positives */
854             if (! (and_with->flags & ANYOF_UNICODE_ALL)) {
855                 ARG_SET(cl, ANYOF_NONBITMAP_EMPTY);
856                 cl->flags &= ~ANYOF_NONBITMAP_NON_UTF8;
857             }
858         }
859         else if (! ANYOF_NONBITMAP(cl)) {
860
861             /* Here, 'and_with' does match something outside the bitmap, and cl
862              * doesn't have a list of things to match outside the bitmap.  If
863              * cl can match all code points above 255, the intersection will
864              * be those above-255 code points that 'and_with' matches.  If cl
865              * can't match all Unicode code points, it means that it can't
866              * match anything outside the bitmap (since the 'if' that got us
867              * into this block tested for that), so we leave the bitmap empty.
868              */
869             if (cl->flags & ANYOF_UNICODE_ALL) {
870                 ARG_SET(cl, ARG(and_with));
871
872                 /* and_with's ARG may match things that don't require UTF8.
873                  * And now cl's will too, in spite of this being an 'and'.  See
874                  * the comments below about the kludge */
875                 cl->flags |= and_with->flags & ANYOF_NONBITMAP_NON_UTF8;
876             }
877         }
878         else {
879             /* Here, both 'and_with' and cl match something outside the
880              * bitmap.  Currently we do not do the intersection, so just match
881              * whatever cl had at the beginning.  */
882         }
883
884
885         /* Take the intersection of the two sets of flags.  However, the
886          * ANYOF_NONBITMAP_NON_UTF8 flag is treated as an 'or'.  This is a
887          * kludge around the fact that this flag is not treated like the others
888          * which are initialized in cl_anything().  The way the optimizer works
889          * is that the synthetic start class (SSC) is initialized to match
890          * anything, and then the first time a real node is encountered, its
891          * values are AND'd with the SSC's with the result being the values of
892          * the real node.  However, there are paths through the optimizer where
893          * the AND never gets called, so those initialized bits are set
894          * inappropriately, which is not usually a big deal, as they just cause
895          * false positives in the SSC, which will just mean a probably
896          * imperceptible slow down in execution.  However this bit has a
897          * higher false positive consequence in that it can cause utf8.pm,
898          * utf8_heavy.pl ... to be loaded when not necessary, which is a much
899          * bigger slowdown and also causes significant extra memory to be used.
900          * In order to prevent this, the code now takes a different tack.  The
901          * bit isn't set unless some part of the regular expression needs it,
902          * but once set it won't get cleared.  This means that these extra
903          * modules won't get loaded unless there was some path through the
904          * pattern that would have required them anyway, and  so any false
905          * positives that occur by not ANDing them out when they could be
906          * aren't as severe as they would be if we treated this bit like all
907          * the others */
908         outside_bitmap_but_not_utf8 = (cl->flags | and_with->flags)
909                                       & ANYOF_NONBITMAP_NON_UTF8;
910         cl->flags &= and_with->flags;
911         cl->flags |= outside_bitmap_but_not_utf8;
912     }
913 }
914
915 /* 'OR' a given class with another one.  Can create false positives.  'cl'
916  * should not be inverted.  'or_with->flags & ANYOF_CLASS' should be 0 if
917  * 'or_with' is a regnode_charclass instead of a regnode_charclass_class. */
918 STATIC void
919 S_cl_or(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, const struct regnode_charclass_class *or_with)
920 {
921     PERL_ARGS_ASSERT_CL_OR;
922
923     if (or_with->flags & ANYOF_INVERT) {
924
925         /* Here, the or'd node is to be inverted.  This means we take the
926          * complement of everything not in the bitmap, but currently we don't
927          * know what that is, so give up and match anything */
928         if (ANYOF_NONBITMAP(or_with)) {
929             cl_anything(pRExC_state, cl);
930         }
931         /* We do not use
932          * (B1 | CL1) | (!B2 & !CL2) = (B1 | !B2 & !CL2) | (CL1 | (!B2 & !CL2))
933          *   <= (B1 | !B2) | (CL1 | !CL2)
934          * which is wasteful if CL2 is small, but we ignore CL2:
935          *   (B1 | CL1) | (!B2 & !CL2) <= (B1 | CL1) | !B2 = (B1 | !B2) | CL1
936          * XXXX Can we handle case-fold?  Unclear:
937          *   (OK1(i) | OK1(i')) | !(OK1(i) | OK1(i')) =
938          *   (OK1(i) | OK1(i')) | (!OK1(i) & !OK1(i'))
939          */
940         else if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
941              && !(or_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
942              && !(cl->flags & ANYOF_LOC_NONBITMAP_FOLD) ) {
943             int i;
944
945             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
946                 cl->bitmap[i] |= ~or_with->bitmap[i];
947         } /* XXXX: logic is complicated otherwise */
948         else {
949             cl_anything(pRExC_state, cl);
950         }
951
952         /* And, we can just take the union of the flags that aren't affected
953          * by the inversion */
954         cl->flags |= or_with->flags & INVERSION_UNAFFECTED_FLAGS;
955
956         /* For the remaining flags:
957             ANYOF_UNICODE_ALL and inverted means to not match anything above
958                     255, which means that the union with cl should just be
959                     what cl has in it, so can ignore this flag
960             ANYOF_NON_UTF8_LATIN1_ALL and inverted means if not utf8 and ord
961                     is 127-255 to match them, but then invert that, so the
962                     union with cl should just be what cl has in it, so can
963                     ignore this flag
964          */
965     } else {    /* 'or_with' is not inverted */
966         /* (B1 | CL1) | (B2 | CL2) = (B1 | B2) | (CL1 | CL2)) */
967         if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
968              && (!(or_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
969                  || (cl->flags & ANYOF_LOC_NONBITMAP_FOLD)) ) {
970             int i;
971
972             /* OR char bitmap and class bitmap separately */
973             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
974                 cl->bitmap[i] |= or_with->bitmap[i];
975             if (ANYOF_CLASS_TEST_ANY_SET(or_with)) {
976                 for (i = 0; i < ANYOF_CLASSBITMAP_SIZE; i++)
977                     cl->classflags[i] |= or_with->classflags[i];
978                 cl->flags |= ANYOF_CLASS;
979             }
980         }
981         else { /* XXXX: logic is complicated, leave it along for a moment. */
982             cl_anything(pRExC_state, cl);
983         }
984
985         if (ANYOF_NONBITMAP(or_with)) {
986
987             /* Use the added node's outside-the-bit-map match if there isn't a
988              * conflict.  If there is a conflict (both nodes match something
989              * outside the bitmap, but what they match outside is not the same
990              * pointer, and hence not easily compared until XXX we extend
991              * inversion lists this far), give up and allow the start class to
992              * match everything outside the bitmap.  If that stuff is all above
993              * 255, can just set UNICODE_ALL, otherwise caould be anything. */
994             if (! ANYOF_NONBITMAP(cl)) {
995                 ARG_SET(cl, ARG(or_with));
996             }
997             else if (ARG(cl) != ARG(or_with)) {
998
999                 if ((or_with->flags & ANYOF_NONBITMAP_NON_UTF8)) {
1000                     cl_anything(pRExC_state, cl);
1001                 }
1002                 else {
1003                     cl->flags |= ANYOF_UNICODE_ALL;
1004                 }
1005             }
1006         }
1007
1008         /* Take the union */
1009         cl->flags |= or_with->flags;
1010     }
1011 }
1012
1013 #define TRIE_LIST_ITEM(state,idx) (trie->states[state].trans.list)[ idx ]
1014 #define TRIE_LIST_CUR(state)  ( TRIE_LIST_ITEM( state, 0 ).forid )
1015 #define TRIE_LIST_LEN(state) ( TRIE_LIST_ITEM( state, 0 ).newstate )
1016 #define TRIE_LIST_USED(idx)  ( trie->states[state].trans.list ? (TRIE_LIST_CUR( idx ) - 1) : 0 )
1017
1018
1019 #ifdef DEBUGGING
1020 /*
1021    dump_trie(trie,widecharmap,revcharmap)
1022    dump_trie_interim_list(trie,widecharmap,revcharmap,next_alloc)
1023    dump_trie_interim_table(trie,widecharmap,revcharmap,next_alloc)
1024
1025    These routines dump out a trie in a somewhat readable format.
1026    The _interim_ variants are used for debugging the interim
1027    tables that are used to generate the final compressed
1028    representation which is what dump_trie expects.
1029
1030    Part of the reason for their existence is to provide a form
1031    of documentation as to how the different representations function.
1032
1033 */
1034
1035 /*
1036   Dumps the final compressed table form of the trie to Perl_debug_log.
1037   Used for debugging make_trie().
1038 */
1039
1040 STATIC void
1041 S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap,
1042             AV *revcharmap, U32 depth)
1043 {
1044     U32 state;
1045     SV *sv=sv_newmortal();
1046     int colwidth= widecharmap ? 6 : 4;
1047     U16 word;
1048     GET_RE_DEBUG_FLAGS_DECL;
1049
1050     PERL_ARGS_ASSERT_DUMP_TRIE;
1051
1052     PerlIO_printf( Perl_debug_log, "%*sChar : %-6s%-6s%-4s ",
1053         (int)depth * 2 + 2,"",
1054         "Match","Base","Ofs" );
1055
1056     for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
1057         SV ** const tmp = av_fetch( revcharmap, state, 0);
1058         if ( tmp ) {
1059             PerlIO_printf( Perl_debug_log, "%*s", 
1060                 colwidth,
1061                 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
1062                             PL_colors[0], PL_colors[1],
1063                             (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
1064                             PERL_PV_ESCAPE_FIRSTCHAR 
1065                 ) 
1066             );
1067         }
1068     }
1069     PerlIO_printf( Perl_debug_log, "\n%*sState|-----------------------",
1070         (int)depth * 2 + 2,"");
1071
1072     for( state = 0 ; state < trie->uniquecharcount ; state++ )
1073         PerlIO_printf( Perl_debug_log, "%.*s", colwidth, "--------");
1074     PerlIO_printf( Perl_debug_log, "\n");
1075
1076     for( state = 1 ; state < trie->statecount ; state++ ) {
1077         const U32 base = trie->states[ state ].trans.base;
1078
1079         PerlIO_printf( Perl_debug_log, "%*s#%4"UVXf"|", (int)depth * 2 + 2,"", (UV)state);
1080
1081         if ( trie->states[ state ].wordnum ) {
1082             PerlIO_printf( Perl_debug_log, " W%4X", trie->states[ state ].wordnum );
1083         } else {
1084             PerlIO_printf( Perl_debug_log, "%6s", "" );
1085         }
1086
1087         PerlIO_printf( Perl_debug_log, " @%4"UVXf" ", (UV)base );
1088
1089         if ( base ) {
1090             U32 ofs = 0;
1091
1092             while( ( base + ofs  < trie->uniquecharcount ) ||
1093                    ( base + ofs - trie->uniquecharcount < trie->lasttrans
1094                      && trie->trans[ base + ofs - trie->uniquecharcount ].check != state))
1095                     ofs++;
1096
1097             PerlIO_printf( Perl_debug_log, "+%2"UVXf"[ ", (UV)ofs);
1098
1099             for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
1100                 if ( ( base + ofs >= trie->uniquecharcount ) &&
1101                      ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
1102                      trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
1103                 {
1104                    PerlIO_printf( Perl_debug_log, "%*"UVXf,
1105                     colwidth,
1106                     (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next );
1107                 } else {
1108                     PerlIO_printf( Perl_debug_log, "%*s",colwidth,"   ." );
1109                 }
1110             }
1111
1112             PerlIO_printf( Perl_debug_log, "]");
1113
1114         }
1115         PerlIO_printf( Perl_debug_log, "\n" );
1116     }
1117     PerlIO_printf(Perl_debug_log, "%*sword_info N:(prev,len)=", (int)depth*2, "");
1118     for (word=1; word <= trie->wordcount; word++) {
1119         PerlIO_printf(Perl_debug_log, " %d:(%d,%d)",
1120             (int)word, (int)(trie->wordinfo[word].prev),
1121             (int)(trie->wordinfo[word].len));
1122     }
1123     PerlIO_printf(Perl_debug_log, "\n" );
1124 }    
1125 /*
1126   Dumps a fully constructed but uncompressed trie in list form.
1127   List tries normally only are used for construction when the number of 
1128   possible chars (trie->uniquecharcount) is very high.
1129   Used for debugging make_trie().
1130 */
1131 STATIC void
1132 S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie,
1133                          HV *widecharmap, AV *revcharmap, U32 next_alloc,
1134                          U32 depth)
1135 {
1136     U32 state;
1137     SV *sv=sv_newmortal();
1138     int colwidth= widecharmap ? 6 : 4;
1139     GET_RE_DEBUG_FLAGS_DECL;
1140
1141     PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_LIST;
1142
1143     /* print out the table precompression.  */
1144     PerlIO_printf( Perl_debug_log, "%*sState :Word | Transition Data\n%*s%s",
1145         (int)depth * 2 + 2,"", (int)depth * 2 + 2,"",
1146         "------:-----+-----------------\n" );
1147     
1148     for( state=1 ; state < next_alloc ; state ++ ) {
1149         U16 charid;
1150     
1151         PerlIO_printf( Perl_debug_log, "%*s %4"UVXf" :",
1152             (int)depth * 2 + 2,"", (UV)state  );
1153         if ( ! trie->states[ state ].wordnum ) {
1154             PerlIO_printf( Perl_debug_log, "%5s| ","");
1155         } else {
1156             PerlIO_printf( Perl_debug_log, "W%4x| ",
1157                 trie->states[ state ].wordnum
1158             );
1159         }
1160         for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
1161             SV ** const tmp = av_fetch( revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0);
1162             if ( tmp ) {
1163                 PerlIO_printf( Perl_debug_log, "%*s:%3X=%4"UVXf" | ",
1164                     colwidth,
1165                     pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
1166                             PL_colors[0], PL_colors[1],
1167                             (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
1168                             PERL_PV_ESCAPE_FIRSTCHAR 
1169                     ) ,
1170                     TRIE_LIST_ITEM(state,charid).forid,
1171                     (UV)TRIE_LIST_ITEM(state,charid).newstate
1172                 );
1173                 if (!(charid % 10)) 
1174                     PerlIO_printf(Perl_debug_log, "\n%*s| ",
1175                         (int)((depth * 2) + 14), "");
1176             }
1177         }
1178         PerlIO_printf( Perl_debug_log, "\n");
1179     }
1180 }    
1181
1182 /*
1183   Dumps a fully constructed but uncompressed trie in table form.
1184   This is the normal DFA style state transition table, with a few 
1185   twists to facilitate compression later. 
1186   Used for debugging make_trie().
1187 */
1188 STATIC void
1189 S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie,
1190                           HV *widecharmap, AV *revcharmap, U32 next_alloc,
1191                           U32 depth)
1192 {
1193     U32 state;
1194     U16 charid;
1195     SV *sv=sv_newmortal();
1196     int colwidth= widecharmap ? 6 : 4;
1197     GET_RE_DEBUG_FLAGS_DECL;
1198
1199     PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_TABLE;
1200     
1201     /*
1202        print out the table precompression so that we can do a visual check
1203        that they are identical.
1204      */
1205     
1206     PerlIO_printf( Perl_debug_log, "%*sChar : ",(int)depth * 2 + 2,"" );
1207
1208     for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
1209         SV ** const tmp = av_fetch( revcharmap, charid, 0);
1210         if ( tmp ) {
1211             PerlIO_printf( Perl_debug_log, "%*s", 
1212                 colwidth,
1213                 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
1214                             PL_colors[0], PL_colors[1],
1215                             (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
1216                             PERL_PV_ESCAPE_FIRSTCHAR 
1217                 ) 
1218             );
1219         }
1220     }
1221
1222     PerlIO_printf( Perl_debug_log, "\n%*sState+-",(int)depth * 2 + 2,"" );
1223
1224     for( charid=0 ; charid < trie->uniquecharcount ; charid++ ) {
1225         PerlIO_printf( Perl_debug_log, "%.*s", colwidth,"--------");
1226     }
1227
1228     PerlIO_printf( Perl_debug_log, "\n" );
1229
1230     for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
1231
1232         PerlIO_printf( Perl_debug_log, "%*s%4"UVXf" : ", 
1233             (int)depth * 2 + 2,"",
1234             (UV)TRIE_NODENUM( state ) );
1235
1236         for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
1237             UV v=(UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next );
1238             if (v)
1239                 PerlIO_printf( Perl_debug_log, "%*"UVXf, colwidth, v );
1240             else
1241                 PerlIO_printf( Perl_debug_log, "%*s", colwidth, "." );
1242         }
1243         if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
1244             PerlIO_printf( Perl_debug_log, " (%4"UVXf")\n", (UV)trie->trans[ state ].check );
1245         } else {
1246             PerlIO_printf( Perl_debug_log, " (%4"UVXf") W%4X\n", (UV)trie->trans[ state ].check,
1247             trie->states[ TRIE_NODENUM( state ) ].wordnum );
1248         }
1249     }
1250 }
1251
1252 #endif
1253
1254
1255 /* make_trie(startbranch,first,last,tail,word_count,flags,depth)
1256   startbranch: the first branch in the whole branch sequence
1257   first      : start branch of sequence of branch-exact nodes.
1258                May be the same as startbranch
1259   last       : Thing following the last branch.
1260                May be the same as tail.
1261   tail       : item following the branch sequence
1262   count      : words in the sequence
1263   flags      : currently the OP() type we will be building one of /EXACT(|F|Fl)/
1264   depth      : indent depth
1265
1266 Inplace optimizes a sequence of 2 or more Branch-Exact nodes into a TRIE node.
1267
1268 A trie is an N'ary tree where the branches are determined by digital
1269 decomposition of the key. IE, at the root node you look up the 1st character and
1270 follow that branch repeat until you find the end of the branches. Nodes can be
1271 marked as "accepting" meaning they represent a complete word. Eg:
1272
1273   /he|she|his|hers/
1274
1275 would convert into the following structure. Numbers represent states, letters
1276 following numbers represent valid transitions on the letter from that state, if
1277 the number is in square brackets it represents an accepting state, otherwise it
1278 will be in parenthesis.
1279
1280       +-h->+-e->[3]-+-r->(8)-+-s->[9]
1281       |    |
1282       |   (2)
1283       |    |
1284      (1)   +-i->(6)-+-s->[7]
1285       |
1286       +-s->(3)-+-h->(4)-+-e->[5]
1287
1288       Accept Word Mapping: 3=>1 (he),5=>2 (she), 7=>3 (his), 9=>4 (hers)
1289
1290 This shows that when matching against the string 'hers' we will begin at state 1
1291 read 'h' and move to state 2, read 'e' and move to state 3 which is accepting,
1292 then read 'r' and go to state 8 followed by 's' which takes us to state 9 which
1293 is also accepting. Thus we know that we can match both 'he' and 'hers' with a
1294 single traverse. We store a mapping from accepting to state to which word was
1295 matched, and then when we have multiple possibilities we try to complete the
1296 rest of the regex in the order in which they occured in the alternation.
1297
1298 The only prior NFA like behaviour that would be changed by the TRIE support is
1299 the silent ignoring of duplicate alternations which are of the form:
1300
1301  / (DUPE|DUPE) X? (?{ ... }) Y /x
1302
1303 Thus EVAL blocks following a trie may be called a different number of times with
1304 and without the optimisation. With the optimisations dupes will be silently
1305 ignored. This inconsistent behaviour of EVAL type nodes is well established as
1306 the following demonstrates:
1307
1308  'words'=~/(word|word|word)(?{ print $1 })[xyz]/
1309
1310 which prints out 'word' three times, but
1311
1312  'words'=~/(word|word|word)(?{ print $1 })S/
1313
1314 which doesnt print it out at all. This is due to other optimisations kicking in.
1315
1316 Example of what happens on a structural level:
1317
1318 The regexp /(ac|ad|ab)+/ will produce the following debug output:
1319
1320    1: CURLYM[1] {1,32767}(18)
1321    5:   BRANCH(8)
1322    6:     EXACT <ac>(16)
1323    8:   BRANCH(11)
1324    9:     EXACT <ad>(16)
1325   11:   BRANCH(14)
1326   12:     EXACT <ab>(16)
1327   16:   SUCCEED(0)
1328   17:   NOTHING(18)
1329   18: END(0)
1330
1331 This would be optimizable with startbranch=5, first=5, last=16, tail=16
1332 and should turn into:
1333
1334    1: CURLYM[1] {1,32767}(18)
1335    5:   TRIE(16)
1336         [Words:3 Chars Stored:6 Unique Chars:4 States:5 NCP:1]
1337           <ac>
1338           <ad>
1339           <ab>
1340   16:   SUCCEED(0)
1341   17:   NOTHING(18)
1342   18: END(0)
1343
1344 Cases where tail != last would be like /(?foo|bar)baz/:
1345
1346    1: BRANCH(4)
1347    2:   EXACT <foo>(8)
1348    4: BRANCH(7)
1349    5:   EXACT <bar>(8)
1350    7: TAIL(8)
1351    8: EXACT <baz>(10)
1352   10: END(0)
1353
1354 which would be optimizable with startbranch=1, first=1, last=7, tail=8
1355 and would end up looking like:
1356
1357     1: TRIE(8)
1358       [Words:2 Chars Stored:6 Unique Chars:5 States:7 NCP:1]
1359         <foo>
1360         <bar>
1361    7: TAIL(8)
1362    8: EXACT <baz>(10)
1363   10: END(0)
1364
1365     d = uvuni_to_utf8_flags(d, uv, 0);
1366
1367 is the recommended Unicode-aware way of saying
1368
1369     *(d++) = uv;
1370 */
1371
1372 #define TRIE_STORE_REVCHAR(val)                                            \
1373     STMT_START {                                                           \
1374         if (UTF) {                                                         \
1375             SV *zlopp = newSV(7); /* XXX: optimize me */                   \
1376             unsigned char *flrbbbbb = (unsigned char *) SvPVX(zlopp);      \
1377             unsigned const char *const kapow = uvuni_to_utf8(flrbbbbb, val); \
1378             SvCUR_set(zlopp, kapow - flrbbbbb);                            \
1379             SvPOK_on(zlopp);                                               \
1380             SvUTF8_on(zlopp);                                              \
1381             av_push(revcharmap, zlopp);                                    \
1382         } else {                                                           \
1383             char ooooff = (char)val;                                           \
1384             av_push(revcharmap, newSVpvn(&ooooff, 1));                     \
1385         }                                                                  \
1386         } STMT_END
1387
1388 #define TRIE_READ_CHAR STMT_START {                                                     \
1389     wordlen++;                                                                          \
1390     if ( UTF ) {                                                                        \
1391         /* if it is UTF then it is either already folded, or does not need folding */   \
1392         uvc = utf8n_to_uvuni( (const U8*) uc, UTF8_MAXLEN, &len, uniflags);             \
1393     }                                                                                   \
1394     else if (folder == PL_fold_latin1) {                                                \
1395         /* if we use this folder we have to obey unicode rules on latin-1 data */       \
1396         if ( foldlen > 0 ) {                                                            \
1397            uvc = utf8n_to_uvuni( (const U8*) scan, UTF8_MAXLEN, &len, uniflags );       \
1398            foldlen -= len;                                                              \
1399            scan += len;                                                                 \
1400            len = 0;                                                                     \
1401         } else {                                                                        \
1402             len = 1;                                                                    \
1403             uvc = _to_fold_latin1( (U8) *uc, foldbuf, &foldlen, 1);                     \
1404             skiplen = UNISKIP(uvc);                                                     \
1405             foldlen -= skiplen;                                                         \
1406             scan = foldbuf + skiplen;                                                   \
1407         }                                                                               \
1408     } else {                                                                            \
1409         /* raw data, will be folded later if needed */                                  \
1410         uvc = (U32)*uc;                                                                 \
1411         len = 1;                                                                        \
1412     }                                                                                   \
1413 } STMT_END
1414
1415
1416
1417 #define TRIE_LIST_PUSH(state,fid,ns) STMT_START {               \
1418     if ( TRIE_LIST_CUR( state ) >=TRIE_LIST_LEN( state ) ) {    \
1419         U32 ging = TRIE_LIST_LEN( state ) *= 2;                 \
1420         Renew( trie->states[ state ].trans.list, ging, reg_trie_trans_le ); \
1421     }                                                           \
1422     TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).forid = fid;     \
1423     TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).newstate = ns;   \
1424     TRIE_LIST_CUR( state )++;                                   \
1425 } STMT_END
1426
1427 #define TRIE_LIST_NEW(state) STMT_START {                       \
1428     Newxz( trie->states[ state ].trans.list,               \
1429         4, reg_trie_trans_le );                                 \
1430      TRIE_LIST_CUR( state ) = 1;                                \
1431      TRIE_LIST_LEN( state ) = 4;                                \
1432 } STMT_END
1433
1434 #define TRIE_HANDLE_WORD(state) STMT_START {                    \
1435     U16 dupe= trie->states[ state ].wordnum;                    \
1436     regnode * const noper_next = regnext( noper );              \
1437                                                                 \
1438     DEBUG_r({                                                   \
1439         /* store the word for dumping */                        \
1440         SV* tmp;                                                \
1441         if (OP(noper) != NOTHING)                               \
1442             tmp = newSVpvn_utf8(STRING(noper), STR_LEN(noper), UTF);    \
1443         else                                                    \
1444             tmp = newSVpvn_utf8( "", 0, UTF );                  \
1445         av_push( trie_words, tmp );                             \
1446     });                                                         \
1447                                                                 \
1448     curword++;                                                  \
1449     trie->wordinfo[curword].prev   = 0;                         \
1450     trie->wordinfo[curword].len    = wordlen;                   \
1451     trie->wordinfo[curword].accept = state;                     \
1452                                                                 \
1453     if ( noper_next < tail ) {                                  \
1454         if (!trie->jump)                                        \
1455             trie->jump = (U16 *) PerlMemShared_calloc( word_count + 1, sizeof(U16) ); \
1456         trie->jump[curword] = (U16)(noper_next - convert);      \
1457         if (!jumper)                                            \
1458             jumper = noper_next;                                \
1459         if (!nextbranch)                                        \
1460             nextbranch= regnext(cur);                           \
1461     }                                                           \
1462                                                                 \
1463     if ( dupe ) {                                               \
1464         /* It's a dupe. Pre-insert into the wordinfo[].prev   */\
1465         /* chain, so that when the bits of chain are later    */\
1466         /* linked together, the dups appear in the chain      */\
1467         trie->wordinfo[curword].prev = trie->wordinfo[dupe].prev; \
1468         trie->wordinfo[dupe].prev = curword;                    \
1469     } else {                                                    \
1470         /* we haven't inserted this word yet.                */ \
1471         trie->states[ state ].wordnum = curword;                \
1472     }                                                           \
1473 } STMT_END
1474
1475
1476 #define TRIE_TRANS_STATE(state,base,ucharcount,charid,special)          \
1477      ( ( base + charid >=  ucharcount                                   \
1478          && base + charid < ubound                                      \
1479          && state == trie->trans[ base - ucharcount + charid ].check    \
1480          && trie->trans[ base - ucharcount + charid ].next )            \
1481            ? trie->trans[ base - ucharcount + charid ].next             \
1482            : ( state==1 ? special : 0 )                                 \
1483       )
1484
1485 #define MADE_TRIE       1
1486 #define MADE_JUMP_TRIE  2
1487 #define MADE_EXACT_TRIE 4
1488
1489 STATIC I32
1490 S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 word_count, U32 flags, U32 depth)
1491 {
1492     dVAR;
1493     /* first pass, loop through and scan words */
1494     reg_trie_data *trie;
1495     HV *widecharmap = NULL;
1496     AV *revcharmap = newAV();
1497     regnode *cur;
1498     const U32 uniflags = UTF8_ALLOW_DEFAULT;
1499     STRLEN len = 0;
1500     UV uvc = 0;
1501     U16 curword = 0;
1502     U32 next_alloc = 0;
1503     regnode *jumper = NULL;
1504     regnode *nextbranch = NULL;
1505     regnode *convert = NULL;
1506     U32 *prev_states; /* temp array mapping each state to previous one */
1507     /* we just use folder as a flag in utf8 */
1508     const U8 * folder = NULL;
1509
1510 #ifdef DEBUGGING
1511     const U32 data_slot = add_data( pRExC_state, 4, "tuuu" );
1512     AV *trie_words = NULL;
1513     /* along with revcharmap, this only used during construction but both are
1514      * useful during debugging so we store them in the struct when debugging.
1515      */
1516 #else
1517     const U32 data_slot = add_data( pRExC_state, 2, "tu" );
1518     STRLEN trie_charcount=0;
1519 #endif
1520     SV *re_trie_maxbuff;
1521     GET_RE_DEBUG_FLAGS_DECL;
1522
1523     PERL_ARGS_ASSERT_MAKE_TRIE;
1524 #ifndef DEBUGGING
1525     PERL_UNUSED_ARG(depth);
1526 #endif
1527
1528     switch (flags) {
1529         case EXACT: break;
1530         case EXACTFA:
1531         case EXACTFU_SS:
1532         case EXACTFU_TRICKYFOLD:
1533         case EXACTFU: folder = PL_fold_latin1; break;
1534         case EXACTF:  folder = PL_fold; break;
1535         case EXACTFL: folder = PL_fold_locale; break;
1536         default: Perl_croak( aTHX_ "panic! In trie construction, unknown node type %u %s", (unsigned) flags, PL_reg_name[flags] );
1537     }
1538
1539     trie = (reg_trie_data *) PerlMemShared_calloc( 1, sizeof(reg_trie_data) );
1540     trie->refcount = 1;
1541     trie->startstate = 1;
1542     trie->wordcount = word_count;
1543     RExC_rxi->data->data[ data_slot ] = (void*)trie;
1544     trie->charmap = (U16 *) PerlMemShared_calloc( 256, sizeof(U16) );
1545     if (flags == EXACT)
1546         trie->bitmap = (char *) PerlMemShared_calloc( ANYOF_BITMAP_SIZE, 1 );
1547     trie->wordinfo = (reg_trie_wordinfo *) PerlMemShared_calloc(
1548                        trie->wordcount+1, sizeof(reg_trie_wordinfo));
1549
1550     DEBUG_r({
1551         trie_words = newAV();
1552     });
1553
1554     re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
1555     if (!SvIOK(re_trie_maxbuff)) {
1556         sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
1557     }
1558     DEBUG_OPTIMISE_r({
1559                 PerlIO_printf( Perl_debug_log,
1560                   "%*smake_trie start==%d, first==%d, last==%d, tail==%d depth=%d\n",
1561                   (int)depth * 2 + 2, "", 
1562                   REG_NODE_NUM(startbranch),REG_NODE_NUM(first), 
1563                   REG_NODE_NUM(last), REG_NODE_NUM(tail),
1564                   (int)depth);
1565     });
1566    
1567    /* Find the node we are going to overwrite */
1568     if ( first == startbranch && OP( last ) != BRANCH ) {
1569         /* whole branch chain */
1570         convert = first;
1571     } else {
1572         /* branch sub-chain */
1573         convert = NEXTOPER( first );
1574     }
1575         
1576     /*  -- First loop and Setup --
1577
1578        We first traverse the branches and scan each word to determine if it
1579        contains widechars, and how many unique chars there are, this is
1580        important as we have to build a table with at least as many columns as we
1581        have unique chars.
1582
1583        We use an array of integers to represent the character codes 0..255
1584        (trie->charmap) and we use a an HV* to store Unicode characters. We use the
1585        native representation of the character value as the key and IV's for the
1586        coded index.
1587
1588        *TODO* If we keep track of how many times each character is used we can
1589        remap the columns so that the table compression later on is more
1590        efficient in terms of memory by ensuring the most common value is in the
1591        middle and the least common are on the outside.  IMO this would be better
1592        than a most to least common mapping as theres a decent chance the most
1593        common letter will share a node with the least common, meaning the node
1594        will not be compressible. With a middle is most common approach the worst
1595        case is when we have the least common nodes twice.
1596
1597      */
1598
1599     for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1600         regnode * const noper = NEXTOPER( cur );
1601         const U8 *uc = (U8*)STRING( noper );
1602         const U8 * const e  = uc + STR_LEN( noper );
1603         STRLEN foldlen = 0;
1604         U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1605         STRLEN skiplen = 0;
1606         const U8 *scan = (U8*)NULL;
1607         U32 wordlen      = 0;         /* required init */
1608         STRLEN chars = 0;
1609         bool set_bit = trie->bitmap ? 1 : 0; /*store the first char in the bitmap?*/
1610
1611         if (OP(noper) == NOTHING) {
1612             trie->minlen= 0;
1613             continue;
1614         }
1615         if ( set_bit ) { /* bitmap only alloced when !(UTF&&Folding) */
1616             TRIE_BITMAP_SET(trie,*uc); /* store the raw first byte
1617                                           regardless of encoding */
1618             if (OP( noper ) == EXACTFU_SS) {
1619                 /* false positives are ok, so just set this */
1620                 TRIE_BITMAP_SET(trie,0xDF);
1621             }
1622         }
1623         for ( ; uc < e ; uc += len ) {
1624             TRIE_CHARCOUNT(trie)++;
1625             TRIE_READ_CHAR;
1626             chars++;
1627             if ( uvc < 256 ) {
1628                 if ( folder ) {
1629                     U8 folded= folder[ (U8) uvc ];
1630                     if ( !trie->charmap[ folded ] ) {
1631                         trie->charmap[ folded ]=( ++trie->uniquecharcount );
1632                         TRIE_STORE_REVCHAR( folded );
1633                     }
1634                 }
1635                 if ( !trie->charmap[ uvc ] ) {
1636                     trie->charmap[ uvc ]=( ++trie->uniquecharcount );
1637                     TRIE_STORE_REVCHAR( uvc );
1638                 }
1639                 if ( set_bit ) {
1640                     /* store the codepoint in the bitmap, and its folded
1641                      * equivalent. */
1642                     TRIE_BITMAP_SET(trie, uvc);
1643
1644                     /* store the folded codepoint */
1645                     if ( folder ) TRIE_BITMAP_SET(trie, folder[(U8) uvc ]);
1646
1647                     if ( !UTF ) {
1648                         /* store first byte of utf8 representation of
1649                            variant codepoints */
1650                         if (! UNI_IS_INVARIANT(uvc)) {
1651                             TRIE_BITMAP_SET(trie, UTF8_TWO_BYTE_HI(uvc));
1652                         }
1653                     }
1654                     set_bit = 0; /* We've done our bit :-) */
1655                 }
1656             } else {
1657                 SV** svpp;
1658                 if ( !widecharmap )
1659                     widecharmap = newHV();
1660
1661                 svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 1 );
1662
1663                 if ( !svpp )
1664                     Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%"UVXf, uvc );
1665
1666                 if ( !SvTRUE( *svpp ) ) {
1667                     sv_setiv( *svpp, ++trie->uniquecharcount );
1668                     TRIE_STORE_REVCHAR(uvc);
1669                 }
1670             }
1671         }
1672         if( cur == first ) {
1673             trie->minlen = chars;
1674             trie->maxlen = chars;
1675         } else if (chars < trie->minlen) {
1676             trie->minlen = chars;
1677         } else if (chars > trie->maxlen) {
1678             trie->maxlen = chars;
1679         }
1680         if (OP( noper ) == EXACTFU_SS) {
1681             /* XXX: workaround - 'ss' could match "\x{DF}" so minlen could be 1 and not 2*/
1682             if (trie->minlen > 1)
1683                 trie->minlen= 1;
1684         }
1685         if (OP( noper ) == EXACTFU_TRICKYFOLD) {
1686             /* XXX: workround - things like "\x{1FBE}\x{0308}\x{0301}" can match "\x{0390}" 
1687              *                - We assume that any such sequence might match a 2 byte string */
1688             if (trie->minlen > 2 )
1689                 trie->minlen= 2;
1690         }
1691
1692     } /* end first pass */
1693     DEBUG_TRIE_COMPILE_r(
1694         PerlIO_printf( Perl_debug_log, "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
1695                 (int)depth * 2 + 2,"",
1696                 ( widecharmap ? "UTF8" : "NATIVE" ), (int)word_count,
1697                 (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount,
1698                 (int)trie->minlen, (int)trie->maxlen )
1699     );
1700
1701     /*
1702         We now know what we are dealing with in terms of unique chars and
1703         string sizes so we can calculate how much memory a naive
1704         representation using a flat table  will take. If it's over a reasonable
1705         limit (as specified by ${^RE_TRIE_MAXBUF}) we use a more memory
1706         conservative but potentially much slower representation using an array
1707         of lists.
1708
1709         At the end we convert both representations into the same compressed
1710         form that will be used in regexec.c for matching with. The latter
1711         is a form that cannot be used to construct with but has memory
1712         properties similar to the list form and access properties similar
1713         to the table form making it both suitable for fast searches and
1714         small enough that its feasable to store for the duration of a program.
1715
1716         See the comment in the code where the compressed table is produced
1717         inplace from the flat tabe representation for an explanation of how
1718         the compression works.
1719
1720     */
1721
1722
1723     Newx(prev_states, TRIE_CHARCOUNT(trie) + 2, U32);
1724     prev_states[1] = 0;
1725
1726     if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1) > SvIV(re_trie_maxbuff) ) {
1727         /*
1728             Second Pass -- Array Of Lists Representation
1729
1730             Each state will be represented by a list of charid:state records
1731             (reg_trie_trans_le) the first such element holds the CUR and LEN
1732             points of the allocated array. (See defines above).
1733
1734             We build the initial structure using the lists, and then convert
1735             it into the compressed table form which allows faster lookups
1736             (but cant be modified once converted).
1737         */
1738
1739         STRLEN transcount = 1;
1740
1741         DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log, 
1742             "%*sCompiling trie using list compiler\n",
1743             (int)depth * 2 + 2, ""));
1744
1745         trie->states = (reg_trie_state *)
1746             PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
1747                                   sizeof(reg_trie_state) );
1748         TRIE_LIST_NEW(1);
1749         next_alloc = 2;
1750
1751         for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1752
1753             regnode * const noper = NEXTOPER( cur );
1754             U8 *uc           = (U8*)STRING( noper );
1755             const U8 * const e = uc + STR_LEN( noper );
1756             U32 state        = 1;         /* required init */
1757             U16 charid       = 0;         /* sanity init */
1758             U8 *scan         = (U8*)NULL; /* sanity init */
1759             STRLEN foldlen   = 0;         /* required init */
1760             U32 wordlen      = 0;         /* required init */
1761             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1762             STRLEN skiplen   = 0;
1763
1764             if (OP(noper) != NOTHING) {
1765                 for ( ; uc < e ; uc += len ) {
1766
1767                     TRIE_READ_CHAR;
1768
1769                     if ( uvc < 256 ) {
1770                         charid = trie->charmap[ uvc ];
1771                     } else {
1772                         SV** const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
1773                         if ( !svpp ) {
1774                             charid = 0;
1775                         } else {
1776                             charid=(U16)SvIV( *svpp );
1777                         }
1778                     }
1779                     /* charid is now 0 if we dont know the char read, or nonzero if we do */
1780                     if ( charid ) {
1781
1782                         U16 check;
1783                         U32 newstate = 0;
1784
1785                         charid--;
1786                         if ( !trie->states[ state ].trans.list ) {
1787                             TRIE_LIST_NEW( state );
1788                         }
1789                         for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) {
1790                             if ( TRIE_LIST_ITEM( state, check ).forid == charid ) {
1791                                 newstate = TRIE_LIST_ITEM( state, check ).newstate;
1792                                 break;
1793                             }
1794                         }
1795                         if ( ! newstate ) {
1796                             newstate = next_alloc++;
1797                             prev_states[newstate] = state;
1798                             TRIE_LIST_PUSH( state, charid, newstate );
1799                             transcount++;
1800                         }
1801                         state = newstate;
1802                     } else {
1803                         Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1804                     }
1805                 }
1806             }
1807             TRIE_HANDLE_WORD(state);
1808
1809         } /* end second pass */
1810
1811         /* next alloc is the NEXT state to be allocated */
1812         trie->statecount = next_alloc; 
1813         trie->states = (reg_trie_state *)
1814             PerlMemShared_realloc( trie->states,
1815                                    next_alloc
1816                                    * sizeof(reg_trie_state) );
1817
1818         /* and now dump it out before we compress it */
1819         DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_list(trie, widecharmap,
1820                                                          revcharmap, next_alloc,
1821                                                          depth+1)
1822         );
1823
1824         trie->trans = (reg_trie_trans *)
1825             PerlMemShared_calloc( transcount, sizeof(reg_trie_trans) );
1826         {
1827             U32 state;
1828             U32 tp = 0;
1829             U32 zp = 0;
1830
1831
1832             for( state=1 ; state < next_alloc ; state ++ ) {
1833                 U32 base=0;
1834
1835                 /*
1836                 DEBUG_TRIE_COMPILE_MORE_r(
1837                     PerlIO_printf( Perl_debug_log, "tp: %d zp: %d ",tp,zp)
1838                 );
1839                 */
1840
1841                 if (trie->states[state].trans.list) {
1842                     U16 minid=TRIE_LIST_ITEM( state, 1).forid;
1843                     U16 maxid=minid;
1844                     U16 idx;
1845
1846                     for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1847                         const U16 forid = TRIE_LIST_ITEM( state, idx).forid;
1848                         if ( forid < minid ) {
1849                             minid=forid;
1850                         } else if ( forid > maxid ) {
1851                             maxid=forid;
1852                         }
1853                     }
1854                     if ( transcount < tp + maxid - minid + 1) {
1855                         transcount *= 2;
1856                         trie->trans = (reg_trie_trans *)
1857                             PerlMemShared_realloc( trie->trans,
1858                                                      transcount
1859                                                      * sizeof(reg_trie_trans) );
1860                         Zero( trie->trans + (transcount / 2), transcount / 2 , reg_trie_trans );
1861                     }
1862                     base = trie->uniquecharcount + tp - minid;
1863                     if ( maxid == minid ) {
1864                         U32 set = 0;
1865                         for ( ; zp < tp ; zp++ ) {
1866                             if ( ! trie->trans[ zp ].next ) {
1867                                 base = trie->uniquecharcount + zp - minid;
1868                                 trie->trans[ zp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1869                                 trie->trans[ zp ].check = state;
1870                                 set = 1;
1871                                 break;
1872                             }
1873                         }
1874                         if ( !set ) {
1875                             trie->trans[ tp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1876                             trie->trans[ tp ].check = state;
1877                             tp++;
1878                             zp = tp;
1879                         }
1880                     } else {
1881                         for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1882                             const U32 tid = base -  trie->uniquecharcount + TRIE_LIST_ITEM( state, idx ).forid;
1883                             trie->trans[ tid ].next = TRIE_LIST_ITEM( state, idx ).newstate;
1884                             trie->trans[ tid ].check = state;
1885                         }
1886                         tp += ( maxid - minid + 1 );
1887                     }
1888                     Safefree(trie->states[ state ].trans.list);
1889                 }
1890                 /*
1891                 DEBUG_TRIE_COMPILE_MORE_r(
1892                     PerlIO_printf( Perl_debug_log, " base: %d\n",base);
1893                 );
1894                 */
1895                 trie->states[ state ].trans.base=base;
1896             }
1897             trie->lasttrans = tp + 1;
1898         }
1899     } else {
1900         /*
1901            Second Pass -- Flat Table Representation.
1902
1903            we dont use the 0 slot of either trans[] or states[] so we add 1 to each.
1904            We know that we will need Charcount+1 trans at most to store the data
1905            (one row per char at worst case) So we preallocate both structures
1906            assuming worst case.
1907
1908            We then construct the trie using only the .next slots of the entry
1909            structs.
1910
1911            We use the .check field of the first entry of the node temporarily to
1912            make compression both faster and easier by keeping track of how many non
1913            zero fields are in the node.
1914
1915            Since trans are numbered from 1 any 0 pointer in the table is a FAIL
1916            transition.
1917
1918            There are two terms at use here: state as a TRIE_NODEIDX() which is a
1919            number representing the first entry of the node, and state as a
1920            TRIE_NODENUM() which is the trans number. state 1 is TRIE_NODEIDX(1) and
1921            TRIE_NODENUM(1), state 2 is TRIE_NODEIDX(2) and TRIE_NODENUM(3) if there
1922            are 2 entrys per node. eg:
1923
1924              A B       A B
1925           1. 2 4    1. 3 7
1926           2. 0 3    3. 0 5
1927           3. 0 0    5. 0 0
1928           4. 0 0    7. 0 0
1929
1930            The table is internally in the right hand, idx form. However as we also
1931            have to deal with the states array which is indexed by nodenum we have to
1932            use TRIE_NODENUM() to convert.
1933
1934         */
1935         DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log, 
1936             "%*sCompiling trie using table compiler\n",
1937             (int)depth * 2 + 2, ""));
1938
1939         trie->trans = (reg_trie_trans *)
1940             PerlMemShared_calloc( ( TRIE_CHARCOUNT(trie) + 1 )
1941                                   * trie->uniquecharcount + 1,
1942                                   sizeof(reg_trie_trans) );
1943         trie->states = (reg_trie_state *)
1944             PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
1945                                   sizeof(reg_trie_state) );
1946         next_alloc = trie->uniquecharcount + 1;
1947
1948
1949         for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1950
1951             regnode * const noper   = NEXTOPER( cur );
1952             const U8 *uc     = (U8*)STRING( noper );
1953             const U8 * const e = uc + STR_LEN( noper );
1954
1955             U32 state        = 1;         /* required init */
1956
1957             U16 charid       = 0;         /* sanity init */
1958             U32 accept_state = 0;         /* sanity init */
1959             U8 *scan         = (U8*)NULL; /* sanity init */
1960
1961             STRLEN foldlen   = 0;         /* required init */
1962             U32 wordlen      = 0;         /* required init */
1963             STRLEN skiplen   = 0;
1964             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1965
1966
1967             if ( OP(noper) != NOTHING ) {
1968                 for ( ; uc < e ; uc += len ) {
1969
1970                     TRIE_READ_CHAR;
1971
1972                     if ( uvc < 256 ) {
1973                         charid = trie->charmap[ uvc ];
1974                     } else {
1975                         SV* const * const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
1976                         charid = svpp ? (U16)SvIV(*svpp) : 0;
1977                     }
1978                     if ( charid ) {
1979                         charid--;
1980                         if ( !trie->trans[ state + charid ].next ) {
1981                             trie->trans[ state + charid ].next = next_alloc;
1982                             trie->trans[ state ].check++;
1983                             prev_states[TRIE_NODENUM(next_alloc)]
1984                                     = TRIE_NODENUM(state);
1985                             next_alloc += trie->uniquecharcount;
1986                         }
1987                         state = trie->trans[ state + charid ].next;
1988                     } else {
1989                         Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1990                     }
1991                     /* charid is now 0 if we dont know the char read, or nonzero if we do */
1992                 }
1993             }
1994             accept_state = TRIE_NODENUM( state );
1995             TRIE_HANDLE_WORD(accept_state);
1996
1997         } /* end second pass */
1998
1999         /* and now dump it out before we compress it */
2000         DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_table(trie, widecharmap,
2001                                                           revcharmap,
2002                                                           next_alloc, depth+1));
2003
2004         {
2005         /*
2006            * Inplace compress the table.*
2007
2008            For sparse data sets the table constructed by the trie algorithm will
2009            be mostly 0/FAIL transitions or to put it another way mostly empty.
2010            (Note that leaf nodes will not contain any transitions.)
2011
2012            This algorithm compresses the tables by eliminating most such
2013            transitions, at the cost of a modest bit of extra work during lookup:
2014
2015            - Each states[] entry contains a .base field which indicates the
2016            index in the state[] array wheres its transition data is stored.
2017
2018            - If .base is 0 there are no valid transitions from that node.
2019
2020            - If .base is nonzero then charid is added to it to find an entry in
2021            the trans array.
2022
2023            -If trans[states[state].base+charid].check!=state then the
2024            transition is taken to be a 0/Fail transition. Thus if there are fail
2025            transitions at the front of the node then the .base offset will point
2026            somewhere inside the previous nodes data (or maybe even into a node
2027            even earlier), but the .check field determines if the transition is
2028            valid.
2029
2030            XXX - wrong maybe?
2031            The following process inplace converts the table to the compressed
2032            table: We first do not compress the root node 1,and mark all its
2033            .check pointers as 1 and set its .base pointer as 1 as well. This
2034            allows us to do a DFA construction from the compressed table later,
2035            and ensures that any .base pointers we calculate later are greater
2036            than 0.
2037
2038            - We set 'pos' to indicate the first entry of the second node.
2039
2040            - We then iterate over the columns of the node, finding the first and
2041            last used entry at l and m. We then copy l..m into pos..(pos+m-l),
2042            and set the .check pointers accordingly, and advance pos
2043            appropriately and repreat for the next node. Note that when we copy
2044            the next pointers we have to convert them from the original
2045            NODEIDX form to NODENUM form as the former is not valid post
2046            compression.
2047
2048            - If a node has no transitions used we mark its base as 0 and do not
2049            advance the pos pointer.
2050
2051            - If a node only has one transition we use a second pointer into the
2052            structure to fill in allocated fail transitions from other states.
2053            This pointer is independent of the main pointer and scans forward
2054            looking for null transitions that are allocated to a state. When it
2055            finds one it writes the single transition into the "hole".  If the
2056            pointer doesnt find one the single transition is appended as normal.
2057
2058            - Once compressed we can Renew/realloc the structures to release the
2059            excess space.
2060
2061            See "Table-Compression Methods" in sec 3.9 of the Red Dragon,
2062            specifically Fig 3.47 and the associated pseudocode.
2063
2064            demq
2065         */
2066         const U32 laststate = TRIE_NODENUM( next_alloc );
2067         U32 state, charid;
2068         U32 pos = 0, zp=0;
2069         trie->statecount = laststate;
2070
2071         for ( state = 1 ; state < laststate ; state++ ) {
2072             U8 flag = 0;
2073             const U32 stateidx = TRIE_NODEIDX( state );
2074             const U32 o_used = trie->trans[ stateidx ].check;
2075             U32 used = trie->trans[ stateidx ].check;
2076             trie->trans[ stateidx ].check = 0;
2077
2078             for ( charid = 0 ; used && charid < trie->uniquecharcount ; charid++ ) {
2079                 if ( flag || trie->trans[ stateidx + charid ].next ) {
2080                     if ( trie->trans[ stateidx + charid ].next ) {
2081                         if (o_used == 1) {
2082                             for ( ; zp < pos ; zp++ ) {
2083                                 if ( ! trie->trans[ zp ].next ) {
2084                                     break;
2085                                 }
2086                             }
2087                             trie->states[ state ].trans.base = zp + trie->uniquecharcount - charid ;
2088                             trie->trans[ zp ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
2089                             trie->trans[ zp ].check = state;
2090                             if ( ++zp > pos ) pos = zp;
2091                             break;
2092                         }
2093                         used--;
2094                     }
2095                     if ( !flag ) {
2096                         flag = 1;
2097                         trie->states[ state ].trans.base = pos + trie->uniquecharcount - charid ;
2098                     }
2099                     trie->trans[ pos ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
2100                     trie->trans[ pos ].check = state;
2101                     pos++;
2102                 }
2103             }
2104         }
2105         trie->lasttrans = pos + 1;
2106         trie->states = (reg_trie_state *)
2107             PerlMemShared_realloc( trie->states, laststate
2108                                    * sizeof(reg_trie_state) );
2109         DEBUG_TRIE_COMPILE_MORE_r(
2110                 PerlIO_printf( Perl_debug_log,
2111                     "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
2112                     (int)depth * 2 + 2,"",
2113                     (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1 ),
2114                     (IV)next_alloc,
2115                     (IV)pos,
2116                     ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
2117             );
2118
2119         } /* end table compress */
2120     }
2121     DEBUG_TRIE_COMPILE_MORE_r(
2122             PerlIO_printf(Perl_debug_log, "%*sStatecount:%"UVxf" Lasttrans:%"UVxf"\n",
2123                 (int)depth * 2 + 2, "",
2124                 (UV)trie->statecount,
2125                 (UV)trie->lasttrans)
2126     );
2127     /* resize the trans array to remove unused space */
2128     trie->trans = (reg_trie_trans *)
2129         PerlMemShared_realloc( trie->trans, trie->lasttrans
2130                                * sizeof(reg_trie_trans) );
2131
2132     {   /* Modify the program and insert the new TRIE node */ 
2133         U8 nodetype =(U8)(flags & 0xFF);
2134         char *str=NULL;
2135         
2136 #ifdef DEBUGGING
2137         regnode *optimize = NULL;
2138 #ifdef RE_TRACK_PATTERN_OFFSETS
2139
2140         U32 mjd_offset = 0;
2141         U32 mjd_nodelen = 0;
2142 #endif /* RE_TRACK_PATTERN_OFFSETS */
2143 #endif /* DEBUGGING */
2144         /*
2145            This means we convert either the first branch or the first Exact,
2146            depending on whether the thing following (in 'last') is a branch
2147            or not and whther first is the startbranch (ie is it a sub part of
2148            the alternation or is it the whole thing.)
2149            Assuming its a sub part we convert the EXACT otherwise we convert
2150            the whole branch sequence, including the first.
2151          */
2152         /* Find the node we are going to overwrite */
2153         if ( first != startbranch || OP( last ) == BRANCH ) {
2154             /* branch sub-chain */
2155             NEXT_OFF( first ) = (U16)(last - first);
2156 #ifdef RE_TRACK_PATTERN_OFFSETS
2157             DEBUG_r({
2158                 mjd_offset= Node_Offset((convert));
2159                 mjd_nodelen= Node_Length((convert));
2160             });
2161 #endif
2162             /* whole branch chain */
2163         }
2164 #ifdef RE_TRACK_PATTERN_OFFSETS
2165         else {
2166             DEBUG_r({
2167                 const  regnode *nop = NEXTOPER( convert );
2168                 mjd_offset= Node_Offset((nop));
2169                 mjd_nodelen= Node_Length((nop));
2170             });
2171         }
2172         DEBUG_OPTIMISE_r(
2173             PerlIO_printf(Perl_debug_log, "%*sMJD offset:%"UVuf" MJD length:%"UVuf"\n",
2174                 (int)depth * 2 + 2, "",
2175                 (UV)mjd_offset, (UV)mjd_nodelen)
2176         );
2177 #endif
2178         /* But first we check to see if there is a common prefix we can 
2179            split out as an EXACT and put in front of the TRIE node.  */
2180         trie->startstate= 1;
2181         if ( trie->bitmap && !widecharmap && !trie->jump  ) {
2182             U32 state;
2183             for ( state = 1 ; state < trie->statecount-1 ; state++ ) {
2184                 U32 ofs = 0;
2185                 I32 idx = -1;
2186                 U32 count = 0;
2187                 const U32 base = trie->states[ state ].trans.base;
2188
2189                 if ( trie->states[state].wordnum )
2190                         count = 1;
2191
2192                 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
2193                     if ( ( base + ofs >= trie->uniquecharcount ) &&
2194                          ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
2195                          trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
2196                     {
2197                         if ( ++count > 1 ) {
2198                             SV **tmp = av_fetch( revcharmap, ofs, 0);
2199                             const U8 *ch = (U8*)SvPV_nolen_const( *tmp );
2200                             if ( state == 1 ) break;
2201                             if ( count == 2 ) {
2202                                 Zero(trie->bitmap, ANYOF_BITMAP_SIZE, char);
2203                                 DEBUG_OPTIMISE_r(
2204                                     PerlIO_printf(Perl_debug_log,
2205                                         "%*sNew Start State=%"UVuf" Class: [",
2206                                         (int)depth * 2 + 2, "",
2207                                         (UV)state));
2208                                 if (idx >= 0) {
2209                                     SV ** const tmp = av_fetch( revcharmap, idx, 0);
2210                                     const U8 * const ch = (U8*)SvPV_nolen_const( *tmp );
2211
2212                                     TRIE_BITMAP_SET(trie,*ch);
2213                                     if ( folder )
2214                                         TRIE_BITMAP_SET(trie, folder[ *ch ]);
2215                                     DEBUG_OPTIMISE_r(
2216                                         PerlIO_printf(Perl_debug_log, "%s", (char*)ch)
2217                                     );
2218                                 }
2219                             }
2220                             TRIE_BITMAP_SET(trie,*ch);
2221                             if ( folder )
2222                                 TRIE_BITMAP_SET(trie,folder[ *ch ]);
2223                             DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"%s", ch));
2224                         }
2225                         idx = ofs;
2226                     }
2227                 }
2228                 if ( count == 1 ) {
2229                     SV **tmp = av_fetch( revcharmap, idx, 0);
2230                     STRLEN len;
2231                     char *ch = SvPV( *tmp, len );
2232                     DEBUG_OPTIMISE_r({
2233                         SV *sv=sv_newmortal();
2234                         PerlIO_printf( Perl_debug_log,
2235                             "%*sPrefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
2236                             (int)depth * 2 + 2, "",
2237                             (UV)state, (UV)idx, 
2238                             pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6, 
2239                                 PL_colors[0], PL_colors[1],
2240                                 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
2241                                 PERL_PV_ESCAPE_FIRSTCHAR 
2242                             )
2243                         );
2244                     });
2245                     if ( state==1 ) {
2246                         OP( convert ) = nodetype;
2247                         str=STRING(convert);
2248                         STR_LEN(convert)=0;
2249                     }
2250                     STR_LEN(convert) += len;
2251                     while (len--)
2252                         *str++ = *ch++;
2253                 } else {
2254 #ifdef DEBUGGING            
2255                     if (state>1)
2256                         DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"]\n"));
2257 #endif
2258                     break;
2259                 }
2260             }
2261             trie->prefixlen = (state-1);
2262             if (str) {
2263                 regnode *n = convert+NODE_SZ_STR(convert);
2264                 NEXT_OFF(convert) = NODE_SZ_STR(convert);
2265                 trie->startstate = state;
2266                 trie->minlen -= (state - 1);
2267                 trie->maxlen -= (state - 1);
2268 #ifdef DEBUGGING
2269                /* At least the UNICOS C compiler choked on this
2270                 * being argument to DEBUG_r(), so let's just have
2271                 * it right here. */
2272                if (
2273 #ifdef PERL_EXT_RE_BUILD
2274                    1
2275 #else
2276                    DEBUG_r_TEST
2277 #endif
2278                    ) {
2279                    regnode *fix = convert;
2280                    U32 word = trie->wordcount;
2281                    mjd_nodelen++;
2282                    Set_Node_Offset_Length(convert, mjd_offset, state - 1);
2283                    while( ++fix < n ) {
2284                        Set_Node_Offset_Length(fix, 0, 0);
2285                    }
2286                    while (word--) {
2287                        SV ** const tmp = av_fetch( trie_words, word, 0 );
2288                        if (tmp) {
2289                            if ( STR_LEN(convert) <= SvCUR(*tmp) )
2290                                sv_chop(*tmp, SvPV_nolen(*tmp) + STR_LEN(convert));
2291                            else
2292                                sv_chop(*tmp, SvPV_nolen(*tmp) + SvCUR(*tmp));
2293                        }
2294                    }
2295                }
2296 #endif
2297                 if (trie->maxlen) {
2298                     convert = n;
2299                 } else {
2300                     NEXT_OFF(convert) = (U16)(tail - convert);
2301                     DEBUG_r(optimize= n);
2302                 }
2303             }
2304         }
2305         if (!jumper) 
2306             jumper = last; 
2307         if ( trie->maxlen ) {
2308             NEXT_OFF( convert ) = (U16)(tail - convert);
2309             ARG_SET( convert, data_slot );
2310             /* Store the offset to the first unabsorbed branch in 
2311                jump[0], which is otherwise unused by the jump logic. 
2312                We use this when dumping a trie and during optimisation. */
2313             if (trie->jump) 
2314                 trie->jump[0] = (U16)(nextbranch - convert);
2315             
2316             /* If the start state is not accepting (meaning there is no empty string/NOTHING)
2317              *   and there is a bitmap
2318              *   and the first "jump target" node we found leaves enough room
2319              * then convert the TRIE node into a TRIEC node, with the bitmap
2320              * embedded inline in the opcode - this is hypothetically faster.
2321              */
2322             if ( !trie->states[trie->startstate].wordnum
2323                  && trie->bitmap
2324                  && ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) )
2325             {
2326                 OP( convert ) = TRIEC;
2327                 Copy(trie->bitmap, ((struct regnode_charclass *)convert)->bitmap, ANYOF_BITMAP_SIZE, char);
2328                 PerlMemShared_free(trie->bitmap);
2329                 trie->bitmap= NULL;
2330             } else 
2331                 OP( convert ) = TRIE;
2332
2333             /* store the type in the flags */
2334             convert->flags = nodetype;
2335             DEBUG_r({
2336             optimize = convert 
2337                       + NODE_STEP_REGNODE 
2338                       + regarglen[ OP( convert ) ];
2339             });
2340             /* XXX We really should free up the resource in trie now, 
2341                    as we won't use them - (which resources?) dmq */
2342         }
2343         /* needed for dumping*/
2344         DEBUG_r(if (optimize) {
2345             regnode *opt = convert;
2346
2347             while ( ++opt < optimize) {
2348                 Set_Node_Offset_Length(opt,0,0);
2349             }
2350             /* 
2351                 Try to clean up some of the debris left after the 
2352                 optimisation.
2353              */
2354             while( optimize < jumper ) {
2355                 mjd_nodelen += Node_Length((optimize));
2356                 OP( optimize ) = OPTIMIZED;
2357                 Set_Node_Offset_Length(optimize,0,0);
2358                 optimize++;
2359             }
2360             Set_Node_Offset_Length(convert,mjd_offset,mjd_nodelen);
2361         });
2362     } /* end node insert */
2363
2364     /*  Finish populating the prev field of the wordinfo array.  Walk back
2365      *  from each accept state until we find another accept state, and if
2366      *  so, point the first word's .prev field at the second word. If the
2367      *  second already has a .prev field set, stop now. This will be the
2368      *  case either if we've already processed that word's accept state,
2369      *  or that state had multiple words, and the overspill words were
2370      *  already linked up earlier.
2371      */
2372     {
2373         U16 word;
2374         U32 state;
2375         U16 prev;
2376
2377         for (word=1; word <= trie->wordcount; word++) {
2378             prev = 0;
2379             if (trie->wordinfo[word].prev)
2380                 continue;
2381             state = trie->wordinfo[word].accept;
2382             while (state) {
2383                 state = prev_states[state];
2384                 if (!state)
2385                     break;
2386                 prev = trie->states[state].wordnum;
2387                 if (prev)
2388                     break;
2389             }
2390             trie->wordinfo[word].prev = prev;
2391         }
2392         Safefree(prev_states);
2393     }
2394
2395
2396     /* and now dump out the compressed format */
2397     DEBUG_TRIE_COMPILE_r(dump_trie(trie, widecharmap, revcharmap, depth+1));
2398
2399     RExC_rxi->data->data[ data_slot + 1 ] = (void*)widecharmap;
2400 #ifdef DEBUGGING
2401     RExC_rxi->data->data[ data_slot + TRIE_WORDS_OFFSET ] = (void*)trie_words;
2402     RExC_rxi->data->data[ data_slot + 3 ] = (void*)revcharmap;
2403 #else
2404     SvREFCNT_dec(revcharmap);
2405 #endif
2406     return trie->jump 
2407            ? MADE_JUMP_TRIE 
2408            : trie->startstate>1 
2409              ? MADE_EXACT_TRIE 
2410              : MADE_TRIE;
2411 }
2412
2413 STATIC void
2414 S_make_trie_failtable(pTHX_ RExC_state_t *pRExC_state, regnode *source,  regnode *stclass, U32 depth)
2415 {
2416 /* The Trie is constructed and compressed now so we can build a fail array if it's needed
2417
2418    This is basically the Aho-Corasick algorithm. Its from exercise 3.31 and 3.32 in the
2419    "Red Dragon" -- Compilers, principles, techniques, and tools. Aho, Sethi, Ullman 1985/88
2420    ISBN 0-201-10088-6
2421
2422    We find the fail state for each state in the trie, this state is the longest proper
2423    suffix of the current state's 'word' that is also a proper prefix of another word in our
2424    trie. State 1 represents the word '' and is thus the default fail state. This allows
2425    the DFA not to have to restart after its tried and failed a word at a given point, it
2426    simply continues as though it had been matching the other word in the first place.
2427    Consider
2428       'abcdgu'=~/abcdefg|cdgu/
2429    When we get to 'd' we are still matching the first word, we would encounter 'g' which would
2430    fail, which would bring us to the state representing 'd' in the second word where we would
2431    try 'g' and succeed, proceeding to match 'cdgu'.
2432  */
2433  /* add a fail transition */
2434     const U32 trie_offset = ARG(source);
2435     reg_trie_data *trie=(reg_trie_data *)RExC_rxi->data->data[trie_offset];
2436     U32 *q;
2437     const U32 ucharcount = trie->uniquecharcount;
2438     const U32 numstates = trie->statecount;
2439     const U32 ubound = trie->lasttrans + ucharcount;
2440     U32 q_read = 0;
2441     U32 q_write = 0;
2442     U32 charid;
2443     U32 base = trie->states[ 1 ].trans.base;
2444     U32 *fail;
2445     reg_ac_data *aho;
2446     const U32 data_slot = add_data( pRExC_state, 1, "T" );
2447     GET_RE_DEBUG_FLAGS_DECL;
2448
2449     PERL_ARGS_ASSERT_MAKE_TRIE_FAILTABLE;
2450 #ifndef DEBUGGING
2451     PERL_UNUSED_ARG(depth);
2452 #endif
2453
2454
2455     ARG_SET( stclass, data_slot );
2456     aho = (reg_ac_data *) PerlMemShared_calloc( 1, sizeof(reg_ac_data) );
2457     RExC_rxi->data->data[ data_slot ] = (void*)aho;
2458     aho->trie=trie_offset;
2459     aho->states=(reg_trie_state *)PerlMemShared_malloc( numstates * sizeof(reg_trie_state) );
2460     Copy( trie->states, aho->states, numstates, reg_trie_state );
2461     Newxz( q, numstates, U32);
2462     aho->fail = (U32 *) PerlMemShared_calloc( numstates, sizeof(U32) );
2463     aho->refcount = 1;
2464     fail = aho->fail;
2465     /* initialize fail[0..1] to be 1 so that we always have
2466        a valid final fail state */
2467     fail[ 0 ] = fail[ 1 ] = 1;
2468
2469     for ( charid = 0; charid < ucharcount ; charid++ ) {
2470         const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 );
2471         if ( newstate ) {
2472             q[ q_write ] = newstate;
2473             /* set to point at the root */
2474             fail[ q[ q_write++ ] ]=1;
2475         }
2476     }
2477     while ( q_read < q_write) {
2478         const U32 cur = q[ q_read++ % numstates ];
2479         base = trie->states[ cur ].trans.base;
2480
2481         for ( charid = 0 ; charid < ucharcount ; charid++ ) {
2482             const U32 ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 );
2483             if (ch_state) {
2484                 U32 fail_state = cur;
2485                 U32 fail_base;
2486                 do {
2487                     fail_state = fail[ fail_state ];
2488                     fail_base = aho->states[ fail_state ].trans.base;
2489                 } while ( !TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 ) );
2490
2491                 fail_state = TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 );
2492                 fail[ ch_state ] = fail_state;
2493                 if ( !aho->states[ ch_state ].wordnum && aho->states[ fail_state ].wordnum )
2494                 {
2495                         aho->states[ ch_state ].wordnum =  aho->states[ fail_state ].wordnum;
2496                 }
2497                 q[ q_write++ % numstates] = ch_state;
2498             }
2499         }
2500     }
2501     /* restore fail[0..1] to 0 so that we "fall out" of the AC loop
2502        when we fail in state 1, this allows us to use the
2503        charclass scan to find a valid start char. This is based on the principle
2504        that theres a good chance the string being searched contains lots of stuff
2505        that cant be a start char.
2506      */
2507     fail[ 0 ] = fail[ 1 ] = 0;
2508     DEBUG_TRIE_COMPILE_r({
2509         PerlIO_printf(Perl_debug_log,
2510                       "%*sStclass Failtable (%"UVuf" states): 0", 
2511                       (int)(depth * 2), "", (UV)numstates
2512         );
2513         for( q_read=1; q_read<numstates; q_read++ ) {
2514             PerlIO_printf(Perl_debug_log, ", %"UVuf, (UV)fail[q_read]);
2515         }
2516         PerlIO_printf(Perl_debug_log, "\n");
2517     });
2518     Safefree(q);
2519     /*RExC_seen |= REG_SEEN_TRIEDFA;*/
2520 }
2521
2522
2523 /*
2524  * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2.
2525  * These need to be revisited when a newer toolchain becomes available.
2526  */
2527 #if defined(__sparc64__) && defined(__GNUC__)
2528 #   if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
2529 #       undef  SPARC64_GCC_WORKAROUND
2530 #       define SPARC64_GCC_WORKAROUND 1
2531 #   endif
2532 #endif
2533
2534 #define DEBUG_PEEP(str,scan,depth) \
2535     DEBUG_OPTIMISE_r({if (scan){ \
2536        SV * const mysv=sv_newmortal(); \
2537        regnode *Next = regnext(scan); \
2538        regprop(RExC_rx, mysv, scan); \
2539        PerlIO_printf(Perl_debug_log, "%*s" str ">%3d: %s (%d)\n", \
2540        (int)depth*2, "", REG_NODE_NUM(scan), SvPV_nolen_const(mysv),\
2541        Next ? (REG_NODE_NUM(Next)) : 0 ); \
2542    }});
2543
2544
2545 /* The below joins as many adjacent EXACTish nodes as possible into a single
2546  * one, and looks for problematic sequences of characters whose folds vs.
2547  * non-folds have sufficiently different lengths, that the optimizer would be
2548  * fooled into rejecting legitimate matches of them, and the trie construction
2549  * code can't cope with them.  The joining is only done if:
2550  * 1) there is room in the current conglomerated node to entirely contain the
2551  *    next one.
2552  * 2) they are the exact same node type
2553  *
2554  * The adjacent nodes actually may be separated by NOTHING kind nodes, and
2555  * these get optimized out
2556  *
2557  * If there are problematic code sequences, *min_subtract is set to the delta
2558  * that the minimum size of the node can be less than its actual size.  And,
2559  * the node type of the result is changed to reflect that it contains these
2560  * sequences.
2561  *
2562  * And *has_exactf_sharp_s is set to indicate whether or not the node is EXACTF
2563  * and contains LATIN SMALL LETTER SHARP S
2564  *
2565  * This is as good a place as any to discuss the design of handling these
2566  * problematic sequences.  It's been wrong in Perl for a very long time.  There
2567  * are three code points in Unicode whose folded lengths differ so much from
2568  * the un-folded lengths that it causes problems for the optimizer and trie
2569  * construction.  Why only these are problematic, and not others where lengths
2570  * also differ is something I (khw) do not understand.  New versions of Unicode
2571  * might add more such code points.  Hopefully the logic in fold_grind.t that
2572  * figures out what to test (in part by verifying that each size-combination
2573  * gets tested) will catch any that do come along, so they can be added to the
2574  * special handling below.  The chances of new ones are actually rather small,
2575  * as most, if not all, of the world's scripts that have casefolding have
2576  * already been encoded by Unicode.  Also, a number of Unicode's decisions were
2577  * made to allow compatibility with pre-existing standards, and almost all of
2578  * those have already been dealt with.  These would otherwise be the most
2579  * likely candidates for generating further tricky sequences.  In other words,
2580  * Unicode by itself is unlikely to add new ones unless it is for compatibility
2581  * with pre-existing standards, and there aren't many of those left.
2582  *
2583  * The previous designs for dealing with these involved assigning a special
2584  * node for them.  This approach doesn't work, as evidenced by this example:
2585  *      "\xDFs" =~ /s\xDF/ui    # Used to fail before these patches
2586  * Both these fold to "sss", but if the pattern is parsed to create a node of
2587  * that would match just the \xDF, it won't be able to handle the case where a
2588  * successful match would have to cross the node's boundary.  The new approach
2589  * that hopefully generally solves the problem generates an EXACTFU_SS node
2590  * that is "sss".
2591  *
2592  * There are a number of components to the approach (a lot of work for just
2593  * three code points!):
2594  * 1)   This routine examines each EXACTFish node that could contain the
2595  *      problematic sequences.  It returns in *min_subtract how much to
2596  *      subtract from the the actual length of the string to get a real minimum
2597  *      for one that could match it.  This number is usually 0 except for the
2598  *      problematic sequences.  This delta is used by the caller to adjust the
2599  *      min length of the match, and the delta between min and max, so that the
2600  *      optimizer doesn't reject these possibilities based on size constraints.
2601  * 2)   These sequences are not currently correctly handled by the trie code
2602  *      either, so it changes the joined node type to ops that are not handled
2603  *      by trie's, those new ops being EXACTFU_SS and EXACTFU_TRICKYFOLD.
2604  * 3)   This is sufficient for the two Greek sequences (described below), but
2605  *      the one involving the Sharp s (\xDF) needs more.  The node type
2606  *      EXACTFU_SS is used for an EXACTFU node that contains at least one "ss"
2607  *      sequence in it.  For non-UTF-8 patterns and strings, this is the only
2608  *      case where there is a possible fold length change.  That means that a
2609  *      regular EXACTFU node without UTF-8 involvement doesn't have to concern
2610  *      itself with length changes, and so can be processed faster.  regexec.c
2611  *      takes advantage of this.  Generally, an EXACTFish node that is in UTF-8
2612  *      is pre-folded by regcomp.c.  This saves effort in regex matching.
2613  *      However, probably mostly for historical reasons, the pre-folding isn't
2614  *      done for non-UTF8 patterns (and it can't be for EXACTF and EXACTFL
2615  *      nodes, as what they fold to isn't known until runtime.)  The fold
2616  *      possibilities for the non-UTF8 patterns are quite simple, except for
2617  *      the sharp s.  All the ones that don't involve a UTF-8 target string
2618  *      are members of a fold-pair, and arrays are set up for all of them
2619  *      that quickly find the other member of the pair.  It might actually
2620  *      be faster to pre-fold these, but it isn't currently done, except for
2621  *      the sharp s.  Code elsewhere in this file makes sure that it gets
2622  *      folded to 'ss', even if the pattern isn't UTF-8.  This avoids the
2623  *      issues described in the next item.
2624  * 4)   A problem remains for the sharp s in EXACTF nodes.  Whether it matches
2625  *      'ss' or not is not knowable at compile time.  It will match iff the
2626  *      target string is in UTF-8, unlike the EXACTFU nodes, where it always
2627  *      matches; and the EXACTFL and EXACTFA nodes where it never does.  Thus
2628  *      it can't be folded to "ss" at compile time, unlike EXACTFU does as
2629  *      described in item 3).  An assumption that the optimizer part of
2630  *      regexec.c (probably unwittingly) makes is that a character in the
2631  *      pattern corresponds to at most a single character in the target string.
2632  *      (And I do mean character, and not byte here, unlike other parts of the
2633  *      documentation that have never been updated to account for multibyte
2634  *      Unicode.)  This assumption is wrong only in this case, as all other
2635  *      cases are either 1-1 folds when no UTF-8 is involved; or is true by
2636  *      virtue of having this file pre-fold UTF-8 patterns.   I'm
2637  *      reluctant to try to change this assumption, so instead the code punts.
2638  *      This routine examines EXACTF nodes for the sharp s, and returns a
2639  *      boolean indicating whether or not the node is an EXACTF node that
2640  *      contains a sharp s.  When it is true, the caller sets a flag that later
2641  *      causes the optimizer in this file to not set values for the floating
2642  *      and fixed string lengths, and thus avoids the optimizer code in
2643  *      regexec.c that makes the invalid assumption.  Thus, there is no
2644  *      optimization based on string lengths for EXACTF nodes that contain the
2645  *      sharp s.  This only happens for /id rules (which means the pattern
2646  *      isn't in UTF-8).
2647  */
2648
2649 #define JOIN_EXACT(scan,min_subtract,has_exactf_sharp_s, flags) \
2650     if (PL_regkind[OP(scan)] == EXACT) \
2651         join_exact(pRExC_state,(scan),(min_subtract),has_exactf_sharp_s, (flags),NULL,depth+1)
2652
2653 STATIC U32
2654 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) {
2655     /* Merge several consecutive EXACTish nodes into one. */
2656     regnode *n = regnext(scan);
2657     U32 stringok = 1;
2658     regnode *next = scan + NODE_SZ_STR(scan);
2659     U32 merged = 0;
2660     U32 stopnow = 0;
2661 #ifdef DEBUGGING
2662     regnode *stop = scan;
2663     GET_RE_DEBUG_FLAGS_DECL;
2664 #else
2665     PERL_UNUSED_ARG(depth);
2666 #endif
2667
2668     PERL_ARGS_ASSERT_JOIN_EXACT;
2669 #ifndef EXPERIMENTAL_INPLACESCAN
2670     PERL_UNUSED_ARG(flags);
2671     PERL_UNUSED_ARG(val);
2672 #endif
2673     DEBUG_PEEP("join",scan,depth);
2674
2675     /* Look through the subsequent nodes in the chain.  Skip NOTHING, merge
2676      * EXACT ones that are mergeable to the current one. */
2677     while (n
2678            && (PL_regkind[OP(n)] == NOTHING
2679                || (stringok && OP(n) == OP(scan)))
2680            && NEXT_OFF(n)
2681            && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX)
2682     {
2683         
2684         if (OP(n) == TAIL || n > next)
2685             stringok = 0;
2686         if (PL_regkind[OP(n)] == NOTHING) {
2687             DEBUG_PEEP("skip:",n,depth);
2688             NEXT_OFF(scan) += NEXT_OFF(n);
2689             next = n + NODE_STEP_REGNODE;
2690 #ifdef DEBUGGING
2691             if (stringok)
2692                 stop = n;
2693 #endif
2694             n = regnext(n);
2695         }
2696         else if (stringok) {
2697             const unsigned int oldl = STR_LEN(scan);
2698             regnode * const nnext = regnext(n);
2699
2700             if (oldl + STR_LEN(n) > U8_MAX)
2701                 break;
2702             
2703             DEBUG_PEEP("merg",n,depth);
2704             merged++;
2705
2706             NEXT_OFF(scan) += NEXT_OFF(n);
2707             STR_LEN(scan) += STR_LEN(n);
2708             next = n + NODE_SZ_STR(n);
2709             /* Now we can overwrite *n : */
2710             Move(STRING(n), STRING(scan) + oldl, STR_LEN(n), char);
2711 #ifdef DEBUGGING
2712             stop = next - 1;
2713 #endif
2714             n = nnext;
2715             if (stopnow) break;
2716         }
2717
2718 #ifdef EXPERIMENTAL_INPLACESCAN
2719         if (flags && !NEXT_OFF(n)) {
2720             DEBUG_PEEP("atch", val, depth);
2721             if (reg_off_by_arg[OP(n)]) {
2722                 ARG_SET(n, val - n);
2723             }
2724             else {
2725                 NEXT_OFF(n) = val - n;
2726             }
2727             stopnow = 1;
2728         }
2729 #endif
2730     }
2731
2732     *min_subtract = 0;
2733     *has_exactf_sharp_s = FALSE;
2734
2735     /* Here, all the adjacent mergeable EXACTish nodes have been merged.  We
2736      * can now analyze for sequences of problematic code points.  (Prior to
2737      * this final joining, sequences could have been split over boundaries, and
2738      * hence missed).  The sequences only happen in folding, hence for any
2739      * non-EXACT EXACTish node */
2740     if (OP(scan) != EXACT) {
2741         U8 *s;
2742         U8 * s0 = (U8*) STRING(scan);
2743         U8 * const s_end = s0 + STR_LEN(scan);
2744
2745         /* The below is perhaps overboard, but this allows us to save a test
2746          * each time through the loop at the expense of a mask.  This is
2747          * because on both EBCDIC and ASCII machines, 'S' and 's' differ by a
2748          * single bit.  On ASCII they are 32 apart; on EBCDIC, they are 64.
2749          * This uses an exclusive 'or' to find that bit and then inverts it to
2750          * form a mask, with just a single 0, in the bit position where 'S' and
2751          * 's' differ. */
2752         const U8 S_or_s_mask = (U8) ~ ('S' ^ 's');
2753         const U8 s_masked = 's' & S_or_s_mask;
2754
2755         /* One pass is made over the node's string looking for all the
2756          * possibilities.  to avoid some tests in the loop, there are two main
2757          * cases, for UTF-8 patterns (which can't have EXACTF nodes) and
2758          * non-UTF-8 */
2759         if (UTF) {
2760
2761             /* There are two problematic Greek code points in Unicode
2762              * casefolding
2763              *
2764              * U+0390 - GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
2765              * U+03B0 - GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
2766              *
2767              * which casefold to
2768              *
2769              * Unicode                      UTF-8
2770              *
2771              * U+03B9 U+0308 U+0301         0xCE 0xB9 0xCC 0x88 0xCC 0x81
2772              * U+03C5 U+0308 U+0301         0xCF 0x85 0xCC 0x88 0xCC 0x81
2773              *
2774              * This means that in case-insensitive matching (or "loose
2775              * matching", as Unicode calls it), an EXACTF of length six (the
2776              * UTF-8 encoded byte length of the above casefolded versions) can
2777              * match a target string of length two (the byte length of UTF-8
2778              * encoded U+0390 or U+03B0).  This would rather mess up the
2779              * minimum length computation.  (there are other code points that
2780              * also fold to these two sequences, but the delta is smaller)
2781              *
2782              * If these sequences are found, the minimum length is decreased by
2783              * four (six minus two).
2784              *
2785              * Similarly, 'ss' may match the single char and byte LATIN SMALL
2786              * LETTER SHARP S.  We decrease the min length by 1 for each
2787              * occurrence of 'ss' found */
2788
2789 #ifdef EBCDIC /* RD tunifold greek 0390 and 03B0 */
2790 #           define U390_first_byte 0xb4
2791             const U8 U390_tail[] = "\x68\xaf\x49\xaf\x42";
2792 #           define U3B0_first_byte 0xb5
2793             const U8 U3B0_tail[] = "\x46\xaf\x49\xaf\x42";
2794 #else
2795 #           define U390_first_byte 0xce
2796             const U8 U390_tail[] = "\xb9\xcc\x88\xcc\x81";
2797 #           define U3B0_first_byte 0xcf
2798             const U8 U3B0_tail[] = "\x85\xcc\x88\xcc\x81";
2799 #endif
2800             const U8 len = sizeof(U390_tail); /* (-1 for NUL; +1 for 1st byte;
2801                                                  yields a net of 0 */
2802             /* Examine the string for one of the problematic sequences */
2803             for (s = s0;
2804                  s < s_end - 1; /* Can stop 1 before the end, as minimum length
2805                                  * sequence we are looking for is 2 */
2806                  s += UTF8SKIP(s))
2807             {
2808
2809                 /* Look for the first byte in each problematic sequence */
2810                 switch (*s) {
2811                     /* We don't have to worry about other things that fold to
2812                      * 's' (such as the long s, U+017F), as all above-latin1
2813                      * code points have been pre-folded */
2814                     case 's':
2815                     case 'S':
2816
2817                         /* Current character is an 's' or 'S'.  If next one is
2818                          * as well, we have the dreaded sequence */
2819                         if (((*(s+1) & S_or_s_mask) == s_masked)
2820                             /* These two node types don't have special handling
2821                              * for 'ss' */
2822                             && OP(scan) != EXACTFL && OP(scan) != EXACTFA)
2823                         {
2824                             *min_subtract += 1;
2825                             OP(scan) = EXACTFU_SS;
2826                             s++;    /* No need to look at this character again */
2827                         }
2828                         break;
2829
2830                     case U390_first_byte:
2831                         if (s_end - s >= len
2832
2833                             /* The 1's are because are skipping comparing the
2834                              * first byte */
2835                             && memEQ(s + 1, U390_tail, len - 1))
2836                         {
2837                             goto greek_sequence;
2838                         }
2839                         break;
2840
2841                     case U3B0_first_byte:
2842                         if (! (s_end - s >= len
2843                                && memEQ(s + 1, U3B0_tail, len - 1)))
2844                         {
2845                             break;
2846                         }
2847                       greek_sequence:
2848                         *min_subtract += 4;
2849
2850                         /* This can't currently be handled by trie's, so change
2851                          * the node type to indicate this.  If EXACTFA and
2852                          * EXACTFL were ever to be handled by trie's, this
2853                          * would have to be changed.  If this node has already
2854                          * been changed to EXACTFU_SS in this loop, leave it as
2855                          * is.  (I (khw) think it doesn't matter in regexec.c
2856                          * for UTF patterns, but no need to change it */
2857                         if (OP(scan) == EXACTFU) {
2858                             OP(scan) = EXACTFU_TRICKYFOLD;
2859                         }
2860                         s += 6; /* We already know what this sequence is.  Skip
2861                                    the rest of it */
2862                         break;
2863                 }
2864             }
2865         }
2866         else if (OP(scan) != EXACTFL && OP(scan) != EXACTFA) {
2867
2868             /* Here, the pattern is not UTF-8.  We need to look only for the
2869              * 'ss' sequence, and in the EXACTF case, the sharp s, which can be
2870              * in the final position.  Otherwise we can stop looking 1 byte
2871              * earlier because have to find both the first and second 's' */
2872             const U8* upper = (OP(scan) == EXACTF) ? s_end : s_end -1;
2873
2874             for (s = s0; s < upper; s++) {
2875                 switch (*s) {
2876                     case 'S':
2877                     case 's':
2878                         if (s_end - s > 1
2879                             && ((*(s+1) & S_or_s_mask) == s_masked))
2880                         {
2881                             *min_subtract += 1;
2882
2883                             /* EXACTF nodes need to know that the minimum
2884                              * length changed so that a sharp s in the string
2885                              * can match this ss in the pattern, but they
2886                              * remain EXACTF nodes, as they are not trie'able,
2887                              * so don't have to invent a new node type to
2888                              * exclude them from the trie code */
2889                             if (OP(scan) != EXACTF) {
2890                                 OP(scan) = EXACTFU_SS;
2891                             }
2892                             s++;
2893                         }
2894                         break;
2895                     case LATIN_SMALL_LETTER_SHARP_S:
2896                         if (OP(scan) == EXACTF) {
2897                             *has_exactf_sharp_s = TRUE;
2898                         }
2899                         break;
2900                 }
2901             }
2902         }
2903     }
2904
2905 #ifdef DEBUGGING
2906     /* Allow dumping but overwriting the collection of skipped
2907      * ops and/or strings with fake optimized ops */
2908     n = scan + NODE_SZ_STR(scan);
2909     while (n <= stop) {
2910         OP(n) = OPTIMIZED;
2911         FLAGS(n) = 0;
2912         NEXT_OFF(n) = 0;
2913         n++;
2914     }
2915 #endif
2916     DEBUG_OPTIMISE_r(if (merged){DEBUG_PEEP("finl",scan,depth)});
2917     return stopnow;
2918 }
2919
2920 /* REx optimizer.  Converts nodes into quicker variants "in place".
2921    Finds fixed substrings.  */
2922
2923 /* Stops at toplevel WHILEM as well as at "last". At end *scanp is set
2924    to the position after last scanned or to NULL. */
2925
2926 #define INIT_AND_WITHP \
2927     assert(!and_withp); \
2928     Newx(and_withp,1,struct regnode_charclass_class); \
2929     SAVEFREEPV(and_withp)
2930
2931 /* this is a chain of data about sub patterns we are processing that
2932    need to be handled separately/specially in study_chunk. Its so
2933    we can simulate recursion without losing state.  */
2934 struct scan_frame;
2935 typedef struct scan_frame {
2936     regnode *last;  /* last node to process in this frame */
2937     regnode *next;  /* next node to process when last is reached */
2938     struct scan_frame *prev; /*previous frame*/
2939     I32 stop; /* what stopparen do we use */
2940 } scan_frame;
2941
2942
2943 #define SCAN_COMMIT(s, data, m) scan_commit(s, data, m, is_inf)
2944
2945 #define CASE_SYNST_FNC(nAmE)                                       \
2946 case nAmE:                                                         \
2947     if (flags & SCF_DO_STCLASS_AND) {                              \
2948             for (value = 0; value < 256; value++)                  \
2949                 if (!is_ ## nAmE ## _cp(value))                       \
2950                     ANYOF_BITMAP_CLEAR(data->start_class, value);  \
2951     }                                                              \
2952     else {                                                         \
2953             for (value = 0; value < 256; value++)                  \
2954                 if (is_ ## nAmE ## _cp(value))                        \
2955                     ANYOF_BITMAP_SET(data->start_class, value);    \
2956     }                                                              \
2957     break;                                                         \
2958 case N ## nAmE:                                                    \
2959     if (flags & SCF_DO_STCLASS_AND) {                              \
2960             for (value = 0; value < 256; value++)                   \
2961                 if (is_ ## nAmE ## _cp(value))                         \
2962                     ANYOF_BITMAP_CLEAR(data->start_class, value);   \
2963     }                                                               \
2964     else {                                                          \
2965             for (value = 0; value < 256; value++)                   \
2966                 if (!is_ ## nAmE ## _cp(value))                        \
2967                     ANYOF_BITMAP_SET(data->start_class, value);     \
2968     }                                                               \
2969     break
2970
2971
2972
2973 STATIC I32
2974 S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
2975                         I32 *minlenp, I32 *deltap,
2976                         regnode *last,
2977                         scan_data_t *data,
2978                         I32 stopparen,
2979                         U8* recursed,
2980                         struct regnode_charclass_class *and_withp,
2981                         U32 flags, U32 depth)
2982                         /* scanp: Start here (read-write). */
2983                         /* deltap: Write maxlen-minlen here. */
2984                         /* last: Stop before this one. */
2985                         /* data: string data about the pattern */
2986                         /* stopparen: treat close N as END */
2987                         /* recursed: which subroutines have we recursed into */
2988                         /* and_withp: Valid if flags & SCF_DO_STCLASS_OR */
2989 {
2990     dVAR;
2991     I32 min = 0, pars = 0, code;
2992     regnode *scan = *scanp, *next;
2993     I32 delta = 0;
2994     int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
2995     int is_inf_internal = 0;            /* The studied chunk is infinite */
2996     I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
2997     scan_data_t data_fake;
2998     SV *re_trie_maxbuff = NULL;
2999     regnode *first_non_open = scan;
3000     I32 stopmin = I32_MAX;
3001     scan_frame *frame = NULL;
3002     GET_RE_DEBUG_FLAGS_DECL;
3003
3004     PERL_ARGS_ASSERT_STUDY_CHUNK;
3005
3006 #ifdef DEBUGGING
3007     StructCopy(&zero_scan_data, &data_fake, scan_data_t);
3008 #endif
3009
3010     if ( depth == 0 ) {
3011         while (first_non_open && OP(first_non_open) == OPEN)
3012             first_non_open=regnext(first_non_open);
3013     }
3014
3015
3016   fake_study_recurse:
3017     while ( scan && OP(scan) != END && scan < last ){
3018         UV min_subtract = 0;    /* How much to subtract from the minimum node
3019                                    length to get a real minimum (because the
3020                                    folded version may be shorter) */
3021         bool has_exactf_sharp_s = FALSE;
3022         /* Peephole optimizer: */
3023         DEBUG_STUDYDATA("Peep:", data,depth);
3024         DEBUG_PEEP("Peep",scan,depth);
3025
3026         /* Its not clear to khw or hv why this is done here, and not in the
3027          * clauses that deal with EXACT nodes.  khw's guess is that it's
3028          * because of a previous design */
3029         JOIN_EXACT(scan,&min_subtract, &has_exactf_sharp_s, 0);
3030
3031         /* Follow the next-chain of the current node and optimize
3032            away all the NOTHINGs from it.  */
3033         if (OP(scan) != CURLYX) {
3034             const int max = (reg_off_by_arg[OP(scan)]
3035                        ? I32_MAX
3036                        /* I32 may be smaller than U16 on CRAYs! */
3037                        : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
3038             int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
3039             int noff;
3040             regnode *n = scan;
3041
3042             /* Skip NOTHING and LONGJMP. */
3043             while ((n = regnext(n))
3044                    && ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
3045                        || ((OP(n) == LONGJMP) && (noff = ARG(n))))
3046                    && off + noff < max)
3047                 off += noff;
3048             if (reg_off_by_arg[OP(scan)])
3049                 ARG(scan) = off;
3050             else
3051                 NEXT_OFF(scan) = off;
3052         }
3053
3054
3055
3056         /* The principal pseudo-switch.  Cannot be a switch, since we
3057            look into several different things.  */
3058         if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
3059                    || OP(scan) == IFTHEN) {
3060             next = regnext(scan);
3061             code = OP(scan);
3062             /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
3063
3064             if (OP(next) == code || code == IFTHEN) {
3065                 /* NOTE - There is similar code to this block below for handling
3066                    TRIE nodes on a re-study.  If you change stuff here check there
3067                    too. */
3068                 I32 max1 = 0, min1 = I32_MAX, num = 0;
3069                 struct regnode_charclass_class accum;
3070                 regnode * const startbranch=scan;
3071
3072                 if (flags & SCF_DO_SUBSTR)
3073                     SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot merge strings after this. */
3074                 if (flags & SCF_DO_STCLASS)
3075                     cl_init_zero(pRExC_state, &accum);
3076
3077                 while (OP(scan) == code) {
3078                     I32 deltanext, minnext, f = 0, fake;
3079                     struct regnode_charclass_class this_class;
3080
3081                     num++;
3082                     data_fake.flags = 0;
3083                     if (data) {
3084                         data_fake.whilem_c = data->whilem_c;
3085                         data_fake.last_closep = data->last_closep;
3086                     }
3087                     else
3088                         data_fake.last_closep = &fake;
3089
3090                     data_fake.pos_delta = delta;
3091                     next = regnext(scan);
3092                     scan = NEXTOPER(scan);
3093                     if (code != BRANCH)
3094                         scan = NEXTOPER(scan);
3095                     if (flags & SCF_DO_STCLASS) {
3096                         cl_init(pRExC_state, &this_class);
3097                         data_fake.start_class = &this_class;
3098                         f = SCF_DO_STCLASS_AND;
3099                     }
3100                     if (flags & SCF_WHILEM_VISITED_POS)
3101                         f |= SCF_WHILEM_VISITED_POS;
3102
3103                     /* we suppose the run is continuous, last=next...*/
3104                     minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
3105                                           next, &data_fake,
3106                                           stopparen, recursed, NULL, f,depth+1);
3107                     if (min1 > minnext)
3108                         min1 = minnext;
3109                     if (max1 < minnext + deltanext)
3110                         max1 = minnext + deltanext;
3111                     if (deltanext == I32_MAX)
3112                         is_inf = is_inf_internal = 1;
3113                     scan = next;
3114                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3115                         pars++;
3116                     if (data_fake.flags & SCF_SEEN_ACCEPT) {
3117                         if ( stopmin > minnext) 
3118                             stopmin = min + min1;
3119                         flags &= ~SCF_DO_SUBSTR;
3120                         if (data)
3121                             data->flags |= SCF_SEEN_ACCEPT;
3122                     }
3123                     if (data) {
3124                         if (data_fake.flags & SF_HAS_EVAL)
3125                             data->flags |= SF_HAS_EVAL;
3126                         data->whilem_c = data_fake.whilem_c;
3127                     }
3128                     if (flags & SCF_DO_STCLASS)
3129                         cl_or(pRExC_state, &accum, &this_class);
3130                 }
3131                 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
3132                     min1 = 0;
3133                 if (flags & SCF_DO_SUBSTR) {
3134                     data->pos_min += min1;
3135                     data->pos_delta += max1 - min1;
3136                     if (max1 != min1 || is_inf)
3137                         data->longest = &(data->longest_float);
3138                 }
3139                 min += min1;
3140                 delta += max1 - min1;
3141                 if (flags & SCF_DO_STCLASS_OR) {
3142                     cl_or(pRExC_state, data->start_class, &accum);
3143                     if (min1) {
3144                         cl_and(data->start_class, and_withp);
3145                         flags &= ~SCF_DO_STCLASS;
3146                     }
3147                 }
3148                 else if (flags & SCF_DO_STCLASS_AND) {
3149                     if (min1) {
3150                         cl_and(data->start_class, &accum);
3151                         flags &= ~SCF_DO_STCLASS;
3152                     }
3153                     else {
3154                         /* Switch to OR mode: cache the old value of
3155                          * data->start_class */
3156                         INIT_AND_WITHP;
3157                         StructCopy(data->start_class, and_withp,
3158                                    struct regnode_charclass_class);
3159                         flags &= ~SCF_DO_STCLASS_AND;
3160                         StructCopy(&accum, data->start_class,
3161                                    struct regnode_charclass_class);
3162                         flags |= SCF_DO_STCLASS_OR;
3163                         data->start_class->flags |= ANYOF_EOS;
3164                     }
3165                 }
3166
3167                 if (PERL_ENABLE_TRIE_OPTIMISATION && OP( startbranch ) == BRANCH ) {
3168                 /* demq.
3169
3170                    Assuming this was/is a branch we are dealing with: 'scan' now
3171                    points at the item that follows the branch sequence, whatever
3172                    it is. We now start at the beginning of the sequence and look
3173                    for subsequences of
3174
3175                    BRANCH->EXACT=>x1
3176                    BRANCH->EXACT=>x2
3177                    tail
3178
3179                    which would be constructed from a pattern like /A|LIST|OF|WORDS/
3180
3181                    If we can find such a subsequence we need to turn the first
3182                    element into a trie and then add the subsequent branch exact
3183                    strings to the trie.
3184
3185                    We have two cases
3186
3187                      1. patterns where the whole set of branches can be converted. 
3188
3189                      2. patterns where only a subset can be converted.
3190
3191                    In case 1 we can replace the whole set with a single regop
3192                    for the trie. In case 2 we need to keep the start and end
3193                    branches so
3194
3195                      'BRANCH EXACT; BRANCH EXACT; BRANCH X'
3196                      becomes BRANCH TRIE; BRANCH X;
3197
3198                   There is an additional case, that being where there is a 
3199                   common prefix, which gets split out into an EXACT like node
3200                   preceding the TRIE node.
3201
3202                   If x(1..n)==tail then we can do a simple trie, if not we make
3203                   a "jump" trie, such that when we match the appropriate word
3204                   we "jump" to the appropriate tail node. Essentially we turn
3205                   a nested if into a case structure of sorts.
3206
3207                 */
3208
3209                     int made=0;
3210                     if (!re_trie_maxbuff) {
3211                         re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
3212                         if (!SvIOK(re_trie_maxbuff))
3213                             sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
3214                     }
3215                     if ( SvIV(re_trie_maxbuff)>=0  ) {
3216                         regnode *cur;
3217                         regnode *first = (regnode *)NULL;
3218                         regnode *last = (regnode *)NULL;
3219                         regnode *tail = scan;
3220                         U8 trietype = 0;
3221                         U32 count=0;
3222
3223 #ifdef DEBUGGING
3224                         SV * const mysv = sv_newmortal();       /* for dumping */
3225 #endif
3226                         /* var tail is used because there may be a TAIL
3227                            regop in the way. Ie, the exacts will point to the
3228                            thing following the TAIL, but the last branch will
3229                            point at the TAIL. So we advance tail. If we
3230                            have nested (?:) we may have to move through several
3231                            tails.
3232                          */
3233
3234                         while ( OP( tail ) == TAIL ) {
3235                             /* this is the TAIL generated by (?:) */
3236                             tail = regnext( tail );
3237                         }
3238
3239                         
3240                         DEBUG_OPTIMISE_r({
3241                             regprop(RExC_rx, mysv, tail );
3242                             PerlIO_printf( Perl_debug_log, "%*s%s%s\n",
3243                                 (int)depth * 2 + 2, "", 
3244                                 "Looking for TRIE'able sequences. Tail node is: ", 
3245                                 SvPV_nolen_const( mysv )
3246                             );
3247                         });
3248                         
3249                         /*
3250
3251                             Step through the branches
3252                                 cur represents each branch,
3253                                 noper is the first thing to be matched as part of that branch
3254                                 noper_next is the regnext() of that node.
3255
3256                             We normally handle a case like this /FOO[xyz]|BAR[pqr]/
3257                             via a "jump trie" but we also support building with NOJUMPTRIE,
3258                             which restricts the trie logic to structures like /FOO|BAR/.
3259
3260                             If noper is a trieable nodetype then the branch is a possible optimization
3261                             target. If we are building under NOJUMPTRIE then we require that noper_next
3262                             is the same as scan (our current position in the regex program).
3263
3264                             Once we have two or more consecutive such branches we can create a
3265                             trie of the EXACT's contents and stitch it in place into the program.
3266
3267                             If the sequence represents all of the branches in the alternation we
3268                             replace the entire thing with a single TRIE node.
3269
3270                             Otherwise when it is a subsequence we need to stitch it in place and
3271                             replace only the relevant branches. This means the first branch has
3272                             to remain as it is used by the alternation logic, and its next pointer,
3273                             and needs to be repointed at the item on the branch chain following
3274                             the last branch we have optimized away.
3275
3276                             This could be either a BRANCH, in which case the subsequence is internal,
3277                             or it could be the item following the branch sequence in which case the
3278                             subsequence is at the end (which does not necessarily mean the first node
3279                             is the start of the alternation).
3280
3281                             TRIE_TYPE(X) is a define which maps the optype to a trietype.
3282
3283                                 optype          |  trietype
3284                                 ----------------+-----------
3285                                 NOTHING         | NOTHING
3286                                 EXACT           | EXACT
3287                                 EXACTFU         | EXACTFU
3288                                 EXACTFU_SS      | EXACTFU
3289                                 EXACTFU_TRICKYFOLD | EXACTFU
3290                                 EXACTFA         | 0
3291
3292
3293                         */
3294 #define TRIE_TYPE(X) ( ( NOTHING == (X) ) ? NOTHING :   \
3295                        ( EXACT == (X) )   ? EXACT :        \
3296                        ( EXACTFU == (X) || EXACTFU_SS == (X) || EXACTFU_TRICKYFOLD == (X) ) ? EXACTFU :        \
3297                        0 )
3298
3299                         /* dont use tail as the end marker for this traverse */
3300                         for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) {
3301                             regnode * const noper = NEXTOPER( cur );
3302                             U8 noper_type = OP( noper );
3303                             U8 noper_trietype = TRIE_TYPE( noper_type );
3304 #if defined(DEBUGGING) || defined(NOJUMPTRIE)
3305                             regnode * const noper_next = regnext( noper );
3306 #endif
3307
3308                             DEBUG_OPTIMISE_r({
3309                                 regprop(RExC_rx, mysv, cur);
3310                                 PerlIO_printf( Perl_debug_log, "%*s- %s (%d)",
3311                                    (int)depth * 2 + 2,"", SvPV_nolen_const( mysv ), REG_NODE_NUM(cur) );
3312
3313                                 regprop(RExC_rx, mysv, noper);
3314                                 PerlIO_printf( Perl_debug_log, " -> %s",
3315                                     SvPV_nolen_const(mysv));
3316
3317                                 if ( noper_next ) {
3318                                   regprop(RExC_rx, mysv, noper_next );
3319                                   PerlIO_printf( Perl_debug_log,"\t=> %s\t",
3320                                     SvPV_nolen_const(mysv));
3321                                 }
3322                                 PerlIO_printf( Perl_debug_log, "(First==%d,Last==%d,Cur==%d)\n",
3323                                    REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur) );
3324                             });
3325
3326                             /* Is noper a trieable nodetype that can be merged with the
3327                              * current trie (if there is one)? */
3328                             if ( noper_trietype
3329                                   &&
3330                                   (
3331                                         /* XXX: Currently we cannot allow a NOTHING node to be the first element
3332                                          * of a TRIEABLE sequence, Otherwise we will overwrite the regop following
3333                                          * the NOTHING with the TRIE regop later on. This is because a NOTHING node
3334                                          * is only one regnode wide, and a TRIE is two regnodes. An example of a
3335                                          * problematic pattern is: "x" =~ /\A(?>(?:(?:)A|B|C?x))\z/
3336                                          * At a later point of time we can somewhat workaround this by handling
3337                                          * NOTHING -> EXACT sequences as generated by /(?:)A|(?:)B/ type patterns,
3338                                          * as we can effectively ignore the NOTHING regop in that case.
3339                                          * This clause, which allows NOTHING to start a sequence is left commented
3340                                          * out as a reference.
3341                                          * - Yves
3342
3343                                            ( noper_trietype == NOTHING)
3344                                            || ( trietype == NOTHING )
3345                                         */
3346                                         ( noper_trietype == NOTHING && trietype )
3347                                         || ( trietype == noper_trietype )
3348                                   )
3349 #ifdef NOJUMPTRIE
3350                                   && noper_next == tail
3351 #endif
3352                                   && count < U16_MAX)
3353                             {
3354                                 /* Handle mergable triable node
3355                                  * Either we are the first node in a new trieable sequence,
3356                                  * in which case we do some bookkeeping, otherwise we update
3357                                  * the end pointer. */
3358                                 count++;
3359                                 if ( !first ) {
3360                                     first = cur;
3361                                     trietype = noper_trietype;
3362                                 } else {
3363                                     if ( trietype == NOTHING )
3364                                         trietype = noper_trietype;
3365                                     last = cur;
3366                                 }
3367                             } /* end handle mergable triable node */
3368                             else {
3369                                 /* handle unmergable node -
3370                                  * noper may either be a triable node which can not be tried
3371                                  * together with the current trie, or a non triable node */
3372                                 if ( last ) {
3373                                     /* If last is set and trietype is not NOTHING then we have found
3374                                      * at least two triable branch sequences in a row of a similar
3375                                      * trietype so we can turn them into a trie. If/when we
3376                                      * allow NOTHING to start a trie sequence this condition will be
3377                                      * required, and it isn't expensive so we leave it in for now. */
3378                                     if ( trietype != NOTHING )
3379                                         make_trie( pRExC_state,
3380                                                 startbranch, first, cur, tail, count,
3381                                                 trietype, depth+1 );
3382                                     last = NULL; /* note: we clear/update first, trietype etc below, so we dont do it here */
3383                                 }
3384                                 if ( noper_trietype
3385 #ifdef NOJUMPTRIE
3386                                      && noper_next == tail
3387 #endif
3388                                 ){
3389                                     /* noper is triable, so we can start a new trie sequence */
3390                                     count = 1;
3391                                     first = cur;
3392                                     trietype = noper_trietype;
3393                                 } else if (first) {
3394                                     /* if we already saw a first but the current node is not triable then we have
3395                                      * to reset the first information. */
3396                                     count = 0;
3397                                     first = NULL;
3398                                     trietype = 0;
3399                                 }
3400                             } /* end handle unmergable node */
3401                         } /* loop over branches */
3402                         DEBUG_OPTIMISE_r({
3403                             regprop(RExC_rx, mysv, cur);
3404                             PerlIO_printf( Perl_debug_log,
3405                               "%*s- %s (%d) <SCAN FINISHED>\n", (int)depth * 2 + 2,
3406                               "", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
3407
3408                         });
3409                         if ( last && trietype != NOTHING ) {
3410                             /* the last branch of the sequence was part of a trie,
3411                              * so we have to construct it here outside of the loop
3412                              */
3413                             made= make_trie( pRExC_state, startbranch, first, scan, tail, count, trietype, depth+1 );
3414 #ifdef TRIE_STUDY_OPT
3415                             if ( ((made == MADE_EXACT_TRIE && 
3416                                  startbranch == first) 
3417                                  || ( first_non_open == first )) && 
3418                                  depth==0 ) {
3419                                 flags |= SCF_TRIE_RESTUDY;
3420                                 if ( startbranch == first 
3421                                      && scan == tail ) 
3422                                 {
3423                                     RExC_seen &=~REG_TOP_LEVEL_BRANCHES;
3424                                 }
3425                             }
3426 #endif
3427                         } /* end if ( last) */
3428                     } /* TRIE_MAXBUF is non zero */
3429                     
3430                 } /* do trie */
3431                 
3432             }
3433             else if ( code == BRANCHJ ) {  /* single branch is optimized. */
3434                 scan = NEXTOPER(NEXTOPER(scan));
3435             } else                      /* single branch is optimized. */
3436                 scan = NEXTOPER(scan);
3437             continue;
3438         } else if (OP(scan) == SUSPEND || OP(scan) == GOSUB || OP(scan) == GOSTART) {
3439             scan_frame *newframe = NULL;
3440             I32 paren;
3441             regnode *start;
3442             regnode *end;
3443
3444             if (OP(scan) != SUSPEND) {
3445             /* set the pointer */
3446                 if (OP(scan) == GOSUB) {
3447                     paren = ARG(scan);
3448                     RExC_recurse[ARG2L(scan)] = scan;
3449                     start = RExC_open_parens[paren-1];
3450                     end   = RExC_close_parens[paren-1];
3451                 } else {
3452                     paren = 0;
3453                     start = RExC_rxi->program + 1;
3454                     end   = RExC_opend;
3455                 }
3456                 if (!recursed) {
3457                     Newxz(recursed, (((RExC_npar)>>3) +1), U8);
3458                     SAVEFREEPV(recursed);
3459                 }
3460                 if (!PAREN_TEST(recursed,paren+1)) {
3461                     PAREN_SET(recursed,paren+1);
3462                     Newx(newframe,1,scan_frame);
3463                 } else {
3464                     if (flags & SCF_DO_SUBSTR) {
3465                         SCAN_COMMIT(pRExC_state,data,minlenp);
3466                         data->longest = &(data->longest_float);
3467                     }
3468                     is_inf = is_inf_internal = 1;
3469                     if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3470                         cl_anything(pRExC_state, data->start_class);
3471                     flags &= ~SCF_DO_STCLASS;
3472                 }
3473             } else {
3474                 Newx(newframe,1,scan_frame);
3475                 paren = stopparen;
3476                 start = scan+2;
3477                 end = regnext(scan);
3478             }
3479             if (newframe) {
3480                 assert(start);
3481                 assert(end);
3482                 SAVEFREEPV(newframe);
3483                 newframe->next = regnext(scan);
3484                 newframe->last = last;
3485                 newframe->stop = stopparen;
3486                 newframe->prev = frame;
3487
3488                 frame = newframe;
3489                 scan =  start;
3490                 stopparen = paren;
3491                 last = end;
3492
3493                 continue;
3494             }
3495         }
3496         else if (OP(scan) == EXACT) {
3497             I32 l = STR_LEN(scan);
3498             UV uc;
3499             if (UTF) {
3500                 const U8 * const s = (U8*)STRING(scan);
3501                 uc = utf8_to_uvchr_buf(s, s + l, NULL);
3502                 l = utf8_length(s, s + l);
3503             } else {
3504                 uc = *((U8*)STRING(scan));
3505             }
3506             min += l;
3507             if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
3508                 /* The code below prefers earlier match for fixed
3509                    offset, later match for variable offset.  */
3510                 if (data->last_end == -1) { /* Update the start info. */
3511                     data->last_start_min = data->pos_min;
3512                     data->last_start_max = is_inf
3513                         ? I32_MAX : data->pos_min + data->pos_delta;
3514                 }
3515                 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
3516                 if (UTF)
3517                     SvUTF8_on(data->last_found);
3518                 {
3519                     SV * const sv = data->last_found;
3520                     MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
3521                         mg_find(sv, PERL_MAGIC_utf8) : NULL;
3522                     if (mg && mg->mg_len >= 0)
3523                         mg->mg_len += utf8_length((U8*)STRING(scan),
3524                                                   (U8*)STRING(scan)+STR_LEN(scan));
3525                 }
3526                 data->last_end = data->pos_min + l;
3527                 data->pos_min += l; /* As in the first entry. */
3528                 data->flags &= ~SF_BEFORE_EOL;
3529             }
3530             if (flags & SCF_DO_STCLASS_AND) {
3531                 /* Check whether it is compatible with what we know already! */
3532                 int compat = 1;
3533
3534
3535                 /* If compatible, we or it in below.  It is compatible if is
3536                  * in the bitmp and either 1) its bit or its fold is set, or 2)
3537                  * it's for a locale.  Even if there isn't unicode semantics
3538                  * here, at runtime there may be because of matching against a
3539                  * utf8 string, so accept a possible false positive for
3540                  * latin1-range folds */
3541                 if (uc >= 0x100 ||
3542                     (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
3543                     && !ANYOF_BITMAP_TEST(data->start_class, uc)
3544                     && (!(data->start_class->flags & ANYOF_LOC_NONBITMAP_FOLD)
3545                         || !ANYOF_BITMAP_TEST(data->start_class, PL_fold_latin1[uc])))
3546                     )
3547                 {
3548                     compat = 0;
3549                 }
3550                 ANYOF_CLASS_ZERO(data->start_class);
3551                 ANYOF_BITMAP_ZERO(data->start_class);
3552                 if (compat)
3553                     ANYOF_BITMAP_SET(data->start_class, uc);
3554                 else if (uc >= 0x100) {
3555                     int i;
3556
3557                     /* Some Unicode code points fold to the Latin1 range; as
3558                      * XXX temporary code, instead of figuring out if this is
3559                      * one, just assume it is and set all the start class bits
3560                      * that could be some such above 255 code point's fold
3561                      * which will generate fals positives.  As the code
3562                      * elsewhere that does compute the fold settles down, it
3563                      * can be extracted out and re-used here */
3564                     for (i = 0; i < 256; i++){
3565                         if (HAS_NONLATIN1_FOLD_CLOSURE(i)) {
3566                             ANYOF_BITMAP_SET(data->start_class, i);
3567                         }
3568                     }
3569                 }
3570                 data->start_class->flags &= ~ANYOF_EOS;
3571                 if (uc < 0x100)
3572                   data->start_class->flags &= ~ANYOF_UNICODE_ALL;
3573             }
3574             else if (flags & SCF_DO_STCLASS_OR) {
3575                 /* false positive possible if the class is case-folded */
3576                 if (uc < 0x100)
3577                     ANYOF_BITMAP_SET(data->start_class, uc);
3578                 else
3579                     data->start_class->flags |= ANYOF_UNICODE_ALL;
3580                 data->start_class->flags &= ~ANYOF_EOS;
3581                 cl_and(data->start_class, and_withp);
3582             }
3583             flags &= ~SCF_DO_STCLASS;
3584         }
3585         else if (PL_regkind[OP(scan)] == EXACT) { /* But OP != EXACT! */
3586             I32 l = STR_LEN(scan);
3587             UV uc = *((U8*)STRING(scan));
3588
3589             /* Search for fixed substrings supports EXACT only. */
3590             if (flags & SCF_DO_SUBSTR) {
3591                 assert(data);
3592                 SCAN_COMMIT(pRExC_state, data, minlenp);
3593             }
3594             if (UTF) {
3595                 const U8 * const s = (U8 *)STRING(scan);
3596                 uc = utf8_to_uvchr_buf(s, s + l, NULL);
3597                 l = utf8_length(s, s + l);
3598             }
3599             else if (has_exactf_sharp_s) {
3600                 RExC_seen |= REG_SEEN_EXACTF_SHARP_S;
3601             }
3602             min += l - min_subtract;
3603             if (min < 0) {
3604                 min = 0;
3605             }
3606             delta += min_subtract;
3607             if (flags & SCF_DO_SUBSTR) {
3608                 data->pos_min += l - min_subtract;
3609                 if (data->pos_min < 0) {
3610                     data->pos_min = 0;
3611                 }
3612                 data->pos_delta += min_subtract;
3613                 if (min_subtract) {
3614                     data->longest = &(data->longest_float);
3615                 }
3616             }
3617             if (flags & SCF_DO_STCLASS_AND) {
3618                 /* Check whether it is compatible with what we know already! */
3619                 int compat = 1;
3620                 if (uc >= 0x100 ||
3621                  (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
3622                   && !ANYOF_BITMAP_TEST(data->start_class, uc)
3623                   && !ANYOF_BITMAP_TEST(data->start_class, PL_fold_latin1[uc])))
3624                 {
3625                     compat = 0;
3626                 }
3627                 ANYOF_CLASS_ZERO(data->start_class);
3628                 ANYOF_BITMAP_ZERO(data->start_class);
3629                 if (compat) {
3630                     ANYOF_BITMAP_SET(data->start_class, uc);
3631                     data->start_class->flags &= ~ANYOF_EOS;
3632                     data->start_class->flags |= ANYOF_LOC_NONBITMAP_FOLD;
3633                     if (OP(scan) == EXACTFL) {
3634                         /* XXX This set is probably no longer necessary, and
3635                          * probably wrong as LOCALE now is on in the initial
3636                          * state */
3637                         data->start_class->flags |= ANYOF_LOCALE;
3638                     }
3639                     else {
3640
3641                         /* Also set the other member of the fold pair.  In case
3642                          * that unicode semantics is called for at runtime, use
3643                          * the full latin1 fold.  (Can't do this for locale,
3644                          * because not known until runtime) */
3645                         ANYOF_BITMAP_SET(data->start_class, PL_fold_latin1[uc]);
3646
3647                         /* All other (EXACTFL handled above) folds except under
3648                          * /iaa that include s, S, and sharp_s also may include
3649                          * the others */
3650                         if (OP(scan) != EXACTFA) {
3651                             if (uc == 's' || uc == 'S') {
3652                                 ANYOF_BITMAP_SET(data->start_class,
3653                                                  LATIN_SMALL_LETTER_SHARP_S);
3654                             }
3655                             else if (uc == LATIN_SMALL_LETTER_SHARP_S) {
3656                                 ANYOF_BITMAP_SET(data->start_class, 's');
3657                                 ANYOF_BITMAP_SET(data->start_class, 'S');
3658                             }
3659                         }
3660                     }
3661                 }
3662                 else if (uc >= 0x100) {
3663                     int i;
3664                     for (i = 0; i < 256; i++){
3665                         if (_HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)) {
3666                             ANYOF_BITMAP_SET(data->start_class, i);
3667                         }
3668                     }
3669                 }
3670             }
3671             else if (flags & SCF_DO_STCLASS_OR) {
3672                 if (data->start_class->flags & ANYOF_LOC_NONBITMAP_FOLD) {
3673                     /* false positive possible if the class is case-folded.
3674                        Assume that the locale settings are the same... */
3675                     if (uc < 0x100) {
3676                         ANYOF_BITMAP_SET(data->start_class, uc);
3677                         if (OP(scan) != EXACTFL) {
3678
3679                             /* And set the other member of the fold pair, but
3680                              * can't do that in locale because not known until
3681                              * run-time */
3682                             ANYOF_BITMAP_SET(data->start_class,
3683                                              PL_fold_latin1[uc]);
3684
3685                             /* All folds except under /iaa that include s, S,
3686                              * and sharp_s also may include the others */
3687                             if (OP(scan) != EXACTFA) {
3688                                 if (uc == 's' || uc == 'S') {
3689                                     ANYOF_BITMAP_SET(data->start_class,
3690                                                    LATIN_SMALL_LETTER_SHARP_S);
3691                                 }
3692                                 else if (uc == LATIN_SMALL_LETTER_SHARP_S) {
3693                                     ANYOF_BITMAP_SET(data->start_class, 's');
3694                                     ANYOF_BITMAP_SET(data->start_class, 'S');
3695                                 }
3696                             }
3697                         }
3698                     }
3699                     data->start_class->flags &= ~ANYOF_EOS;
3700                 }
3701                 cl_and(data->start_class, and_withp);
3702             }
3703             flags &= ~SCF_DO_STCLASS;
3704         }
3705         else if (REGNODE_VARIES(OP(scan))) {
3706             I32 mincount, maxcount, minnext, deltanext, fl = 0;
3707             I32 f = flags, pos_before = 0;
3708             regnode * const oscan = scan;
3709             struct regnode_charclass_class this_class;
3710             struct regnode_charclass_class *oclass = NULL;
3711             I32 next_is_eval = 0;
3712
3713             switch (PL_regkind[OP(scan)]) {
3714             case WHILEM:                /* End of (?:...)* . */
3715                 scan = NEXTOPER(scan);
3716                 goto finish;
3717             case PLUS:
3718                 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
3719                     next = NEXTOPER(scan);
3720                     if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
3721                         mincount = 1;
3722                         maxcount = REG_INFTY;
3723                         next = regnext(scan);
3724                         scan = NEXTOPER(scan);
3725                         goto do_curly;
3726                     }
3727                 }
3728                 if (flags & SCF_DO_SUBSTR)
3729                     data->pos_min++;
3730                 min++;
3731                 /* Fall through. */
3732             case STAR:
3733                 if (flags & SCF_DO_STCLASS) {
3734                     mincount = 0;
3735                     maxcount = REG_INFTY;
3736                     next = regnext(scan);
3737                     scan = NEXTOPER(scan);
3738                     goto do_curly;
3739                 }
3740                 is_inf = is_inf_internal = 1;
3741                 scan = regnext(scan);
3742                 if (flags & SCF_DO_SUBSTR) {
3743                     SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot extend fixed substrings */
3744                     data->longest = &(data->longest_float);
3745                 }
3746                 goto optimize_curly_tail;
3747             case CURLY:
3748                 if (stopparen>0 && (OP(scan)==CURLYN || OP(scan)==CURLYM)
3749                     && (scan->flags == stopparen))
3750                 {
3751                     mincount = 1;
3752                     maxcount = 1;
3753                 } else {
3754                     mincount = ARG1(scan);
3755                     maxcount = ARG2(scan);
3756                 }
3757                 next = regnext(scan);
3758                 if (OP(scan) == CURLYX) {
3759                     I32 lp = (data ? *(data->last_closep) : 0);
3760                     scan->flags = ((lp <= (I32)U8_MAX) ? (U8)lp : U8_MAX);
3761                 }
3762                 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3763                 next_is_eval = (OP(scan) == EVAL);
3764               do_curly:
3765                 if (flags & SCF_DO_SUBSTR) {
3766                     if (mincount == 0) SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot extend fixed substrings */
3767                     pos_before = data->pos_min;
3768                 }
3769                 if (data) {
3770                     fl = data->flags;
3771                     data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
3772                     if (is_inf)
3773                         data->flags |= SF_IS_INF;
3774                 }
3775                 if (flags & SCF_DO_STCLASS) {
3776                     cl_init(pRExC_state, &this_class);
3777                     oclass = data->start_class;
3778                     data->start_class = &this_class;
3779                     f |= SCF_DO_STCLASS_AND;
3780                     f &= ~SCF_DO_STCLASS_OR;
3781                 }
3782                 /* Exclude from super-linear cache processing any {n,m}
3783                    regops for which the combination of input pos and regex
3784                    pos is not enough information to determine if a match
3785                    will be possible.
3786
3787                    For example, in the regex /foo(bar\s*){4,8}baz/ with the
3788                    regex pos at the \s*, the prospects for a match depend not
3789                    only on the input position but also on how many (bar\s*)
3790                    repeats into the {4,8} we are. */
3791                if ((mincount > 1) || (maxcount > 1 && maxcount != REG_INFTY))
3792                     f &= ~SCF_WHILEM_VISITED_POS;
3793
3794                 /* This will finish on WHILEM, setting scan, or on NULL: */
3795                 minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext, 
3796                                       last, data, stopparen, recursed, NULL,
3797                                       (mincount == 0
3798                                         ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
3799
3800                 if (flags & SCF_DO_STCLASS)
3801                     data->start_class = oclass;
3802                 if (mincount == 0 || minnext == 0) {
3803                     if (flags & SCF_DO_STCLASS_OR) {
3804                         cl_or(pRExC_state, data->start_class, &this_class);
3805                     }
3806                     else if (flags & SCF_DO_STCLASS_AND) {
3807                         /* Switch to OR mode: cache the old value of
3808                          * data->start_class */
3809                         INIT_AND_WITHP;
3810                         StructCopy(data->start_class, and_withp,
3811                                    struct regnode_charclass_class);
3812                         flags &= ~SCF_DO_STCLASS_AND;
3813                         StructCopy(&this_class, data->start_class,
3814                                    struct regnode_charclass_class);
3815                         flags |= SCF_DO_STCLASS_OR;
3816                         data->start_class->flags |= ANYOF_EOS;
3817                     }
3818                 } else {                /* Non-zero len */
3819                     if (flags & SCF_DO_STCLASS_OR) {
3820                         cl_or(pRExC_state, data->start_class, &this_class);
3821                         cl_and(data->start_class, and_withp);
3822                     }
3823                     else if (flags & SCF_DO_STCLASS_AND)
3824                         cl_and(data->start_class, &this_class);
3825                     flags &= ~SCF_DO_STCLASS;
3826                 }
3827                 if (!scan)              /* It was not CURLYX, but CURLY. */
3828                     scan = next;
3829                 if ( /* ? quantifier ok, except for (?{ ... }) */
3830                     (next_is_eval || !(mincount == 0 && maxcount == 1))
3831                     && (minnext == 0) && (deltanext == 0)
3832                     && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
3833                     && maxcount <= REG_INFTY/3) /* Complement check for big count */
3834                 {
3835                     ckWARNreg(RExC_parse,
3836                               "Quantifier unexpected on zero-length expression");
3837                 }
3838
3839                 min += minnext * mincount;
3840                 is_inf_internal |= ((maxcount == REG_INFTY
3841                                      && (minnext + deltanext) > 0)
3842                                     || deltanext == I32_MAX);
3843                 is_inf |= is_inf_internal;
3844                 delta += (minnext + deltanext) * maxcount - minnext * mincount;
3845
3846                 /* Try powerful optimization CURLYX => CURLYN. */
3847                 if (  OP(oscan) == CURLYX && data
3848                       && data->flags & SF_IN_PAR
3849                       && !(data->flags & SF_HAS_EVAL)
3850                       && !deltanext && minnext == 1 ) {
3851                     /* Try to optimize to CURLYN.  */
3852                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
3853                     regnode * const nxt1 = nxt;
3854 #ifdef DEBUGGING
3855                     regnode *nxt2;
3856 #endif
3857
3858                     /* Skip open. */
3859                     nxt = regnext(nxt);
3860                     if (!REGNODE_SIMPLE(OP(nxt))
3861                         && !(PL_regkind[OP(nxt)] == EXACT
3862                              && STR_LEN(nxt) == 1))
3863                         goto nogo;
3864 #ifdef DEBUGGING
3865                     nxt2 = nxt;
3866 #endif
3867                     nxt = regnext(nxt);
3868                     if (OP(nxt) != CLOSE)
3869                         goto nogo;
3870                     if (RExC_open_parens) {
3871                         RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
3872                         RExC_close_parens[ARG(nxt1)-1]=nxt+2; /*close->while*/
3873                     }
3874                     /* Now we know that nxt2 is the only contents: */
3875                     oscan->flags = (U8)ARG(nxt);
3876                     OP(oscan) = CURLYN;
3877                     OP(nxt1) = NOTHING; /* was OPEN. */
3878
3879 #ifdef DEBUGGING
3880                     OP(nxt1 + 1) = OPTIMIZED; /* was count. */
3881                     NEXT_OFF(nxt1+ 1) = 0; /* just for consistency. */
3882                     NEXT_OFF(nxt2) = 0; /* just for consistency with CURLY. */
3883                     OP(nxt) = OPTIMIZED;        /* was CLOSE. */
3884                     OP(nxt + 1) = OPTIMIZED; /* was count. */
3885                     NEXT_OFF(nxt+ 1) = 0; /* just for consistency. */
3886 #endif
3887                 }
3888               nogo:
3889
3890                 /* Try optimization CURLYX => CURLYM. */
3891                 if (  OP(oscan) == CURLYX && data
3892                       && !(data->flags & SF_HAS_PAR)
3893                       && !(data->flags & SF_HAS_EVAL)
3894                       && !deltanext     /* atom is fixed width */
3895                       && minnext != 0   /* CURLYM can't handle zero width */
3896                 ) {
3897                     /* XXXX How to optimize if data == 0? */
3898                     /* Optimize to a simpler form.  */
3899                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
3900                     regnode *nxt2;
3901
3902                     OP(oscan) = CURLYM;
3903                     while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
3904                             && (OP(nxt2) != WHILEM))
3905                         nxt = nxt2;
3906                     OP(nxt2)  = SUCCEED; /* Whas WHILEM */
3907                     /* Need to optimize away parenths. */
3908                     if ((data->flags & SF_IN_PAR) && OP(nxt) == CLOSE) {
3909                         /* Set the parenth number.  */
3910                         regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
3911
3912                         oscan->flags = (U8)ARG(nxt);
3913                         if (RExC_open_parens) {
3914                             RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
3915                             RExC_close_parens[ARG(nxt1)-1]=nxt2+1; /*close->NOTHING*/
3916                         }
3917                         OP(nxt1) = OPTIMIZED;   /* was OPEN. */
3918                         OP(nxt) = OPTIMIZED;    /* was CLOSE. */
3919
3920 #ifdef DEBUGGING
3921                         OP(nxt1 + 1) = OPTIMIZED; /* was count. */
3922                         OP(nxt + 1) = OPTIMIZED; /* was count. */
3923                         NEXT_OFF(nxt1 + 1) = 0; /* just for consistency. */
3924                         NEXT_OFF(nxt + 1) = 0; /* just for consistency. */
3925 #endif
3926 #if 0
3927                         while ( nxt1 && (OP(nxt1) != WHILEM)) {
3928                             regnode *nnxt = regnext(nxt1);
3929                             if (nnxt == nxt) {
3930                                 if (reg_off_by_arg[OP(nxt1)])
3931                                     ARG_SET(nxt1, nxt2 - nxt1);
3932                                 else if (nxt2 - nxt1 < U16_MAX)
3933                                     NEXT_OFF(nxt1) = nxt2 - nxt1;
3934                                 else
3935                                     OP(nxt) = NOTHING;  /* Cannot beautify */
3936                             }
3937                             nxt1 = nnxt;
3938                         }
3939 #endif
3940                         /* Optimize again: */
3941                         study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt,
3942                                     NULL, stopparen, recursed, NULL, 0,depth+1);
3943                     }
3944                     else
3945                         oscan->flags = 0;
3946                 }
3947                 else if ((OP(oscan) == CURLYX)
3948                          && (flags & SCF_WHILEM_VISITED_POS)
3949                          /* See the comment on a similar expression above.
3950                             However, this time it's not a subexpression
3951                             we care about, but the expression itself. */
3952                          && (maxcount == REG_INFTY)
3953                          && data && ++data->whilem_c < 16) {
3954                     /* This stays as CURLYX, we can put the count/of pair. */
3955                     /* Find WHILEM (as in regexec.c) */
3956                     regnode *nxt = oscan + NEXT_OFF(oscan);
3957
3958                     if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
3959                         nxt += ARG(nxt);
3960                     PREVOPER(nxt)->flags = (U8)(data->whilem_c
3961                         | (RExC_whilem_seen << 4)); /* On WHILEM */
3962                 }
3963                 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
3964                     pars++;
3965                 if (flags & SCF_DO_SUBSTR) {
3966                     SV *last_str = NULL;
3967                     int counted = mincount != 0;
3968
3969                     if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
3970 #if defined(SPARC64_GCC_WORKAROUND)
3971                         I32 b = 0;
3972                         STRLEN l = 0;
3973                         const char *s = NULL;
3974                         I32 old = 0;
3975
3976                         if (pos_before >= data->last_start_min)
3977                             b = pos_before;
3978                         else
3979                             b = data->last_start_min;
3980
3981                         l = 0;
3982                         s = SvPV_const(data->last_found, l);
3983                         old = b - data->last_start_min;
3984
3985 #else
3986                         I32 b = pos_before >= data->last_start_min
3987                             ? pos_before : data->last_start_min;
3988                         STRLEN l;
3989                         const char * const s = SvPV_const(data->last_found, l);
3990                         I32 old = b - data->last_start_min;
3991 #endif
3992
3993                         if (UTF)
3994                             old = utf8_hop((U8*)s, old) - (U8*)s;
3995                         l -= old;
3996                         /* Get the added string: */
3997                         last_str = newSVpvn_utf8(s  + old, l, UTF);
3998                         if (deltanext == 0 && pos_before == b) {
3999                             /* What was added is a constant string */
4000                             if (mincount > 1) {
4001                                 SvGROW(last_str, (mincount * l) + 1);
4002                                 repeatcpy(SvPVX(last_str) + l,
4003                                           SvPVX_const(last_str), l, mincount - 1);
4004                                 SvCUR_set(last_str, SvCUR(last_str) * mincount);
4005                                 /* Add additional parts. */
4006                                 SvCUR_set(data->last_found,
4007                                           SvCUR(data->last_found) - l);
4008                                 sv_catsv(data->last_found, last_str);
4009                                 {
4010                                     SV * sv = data->last_found;
4011                                     MAGIC *mg =
4012                                         SvUTF8(sv) && SvMAGICAL(sv) ?
4013                                         mg_find(sv, PERL_MAGIC_utf8) : NULL;
4014                                     if (mg && mg->mg_len >= 0)
4015                                         mg->mg_len += CHR_SVLEN(last_str) - l;
4016                                 }
4017                                 data->last_end += l * (mincount - 1);
4018                             }
4019                         } else {
4020                             /* start offset must point into the last copy */
4021                             data->last_start_min += minnext * (mincount - 1);
4022                             data->last_start_max += is_inf ? I32_MAX
4023                                 : (maxcount - 1) * (minnext + data->pos_delta);
4024                         }
4025                     }
4026                     /* It is counted once already... */
4027                     data->pos_min += minnext * (mincount - counted);
4028                     data->pos_delta += - counted * deltanext +
4029                         (minnext + deltanext) * maxcount - minnext * mincount;
4030                     if (mincount != maxcount) {
4031                          /* Cannot extend fixed substrings found inside
4032                             the group.  */
4033                         SCAN_COMMIT(pRExC_state,data,minlenp);
4034                         if (mincount && last_str) {
4035                             SV * const sv = data->last_found;
4036                             MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
4037                                 mg_find(sv, PERL_MAGIC_utf8) : NULL;
4038
4039                             if (mg)
4040                                 mg->mg_len = -1;
4041                             sv_setsv(sv, last_str);
4042                             data->last_end = data->pos_min;
4043                             data->last_start_min =
4044                                 data->pos_min - CHR_SVLEN(last_str);
4045                             data->last_start_max = is_inf
4046                                 ? I32_MAX
4047                                 : data->pos_min + data->pos_delta
4048                                 - CHR_SVLEN(last_str);
4049                         }
4050                         data->longest = &(data->longest_float);
4051                     }
4052                     SvREFCNT_dec(last_str);
4053                 }
4054                 if (data && (fl & SF_HAS_EVAL))
4055                     data->flags |= SF_HAS_EVAL;
4056               optimize_curly_tail:
4057                 if (OP(oscan) != CURLYX) {
4058                     while (PL_regkind[OP(next = regnext(oscan))] == NOTHING
4059                            && NEXT_OFF(next))
4060                         NEXT_OFF(oscan) += NEXT_OFF(next);
4061                 }
4062                 continue;
4063             default:                    /* REF, ANYOFV, and CLUMP only? */
4064                 if (flags & SCF_DO_SUBSTR) {
4065                     SCAN_COMMIT(pRExC_state,data,minlenp);      /* Cannot expect anything... */
4066                     data->longest = &(data->longest_float);
4067                 }
4068                 is_inf = is_inf_internal = 1;
4069                 if (flags & SCF_DO_STCLASS_OR)
4070                     cl_anything(pRExC_state, data->start_class);
4071                 flags &= ~SCF_DO_STCLASS;
4072                 break;
4073             }
4074         }
4075         else if (OP(scan) == LNBREAK) {
4076             if (flags & SCF_DO_STCLASS) {
4077                 int value = 0;
4078                 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
4079                 if (flags & SCF_DO_STCLASS_AND) {
4080                     for (value = 0; value < 256; value++)
4081                         if (!is_VERTWS_cp(value))
4082                             ANYOF_BITMAP_CLEAR(data->start_class, value);
4083                 }
4084                 else {
4085                     for (value = 0; value < 256; value++)
4086                         if (is_VERTWS_cp(value))
4087                             ANYOF_BITMAP_SET(data->start_class, value);
4088                 }
4089                 if (flags & SCF_DO_STCLASS_OR)
4090                     cl_and(data->start_class, and_withp);
4091                 flags &= ~SCF_DO_STCLASS;
4092             }
4093             min += 1;
4094             delta += 1;
4095             if (flags & SCF_DO_SUBSTR) {
4096                 SCAN_COMMIT(pRExC_state,data,minlenp);  /* Cannot expect anything... */
4097                 data->pos_min += 1;
4098                 data->pos_delta += 1;
4099                 data->longest = &(data->longest_float);
4100             }
4101         }
4102         else if (REGNODE_SIMPLE(OP(scan))) {
4103             int value = 0;
4104
4105             if (flags & SCF_DO_SUBSTR) {
4106                 SCAN_COMMIT(pRExC_state,data,minlenp);
4107                 data->pos_min++;
4108             }
4109             min++;
4110             if (flags & SCF_DO_STCLASS) {
4111                 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
4112
4113                 /* Some of the logic below assumes that switching
4114                    locale on will only add false positives. */
4115                 switch (PL_regkind[OP(scan)]) {
4116                 case SANY:
4117                 default:
4118                   do_default:
4119                     /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
4120                     if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
4121                         cl_anything(pRExC_state, data->start_class);
4122                     break;
4123                 case REG_ANY:
4124                     if (OP(scan) == SANY)
4125                         goto do_default;
4126                     if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
4127                         value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
4128                                  || ANYOF_CLASS_TEST_ANY_SET(data->start_class));
4129                         cl_anything(pRExC_state, data->start_class);
4130                     }
4131                     if (flags & SCF_DO_STCLASS_AND || !value)
4132                         ANYOF_BITMAP_CLEAR(data->start_class,'\n');
4133                     break;
4134                 case ANYOF:
4135                     if (flags & SCF_DO_STCLASS_AND)
4136                         cl_and(data->start_class,
4137                                (struct regnode_charclass_class*)scan);
4138                     else
4139                         cl_or(pRExC_state, data->start_class,
4140                               (struct regnode_charclass_class*)scan);
4141                     break;
4142                 case ALNUM:
4143                     if (flags & SCF_DO_STCLASS_AND) {
4144                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
4145                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
4146                             if (OP(scan) == ALNUMU) {
4147                                 for (value = 0; value < 256; value++) {
4148                                     if (!isWORDCHAR_L1(value)) {
4149                                         ANYOF_BITMAP_CLEAR(data->start_class, value);
4150                                     }
4151                                 }
4152                             } else {
4153                                 for (value = 0; value < 256; value++) {
4154                                     if (!isALNUM(value)) {
4155                                         ANYOF_BITMAP_CLEAR(data->start_class, value);
4156                                     }
4157                                 }
4158                             }
4159                         }
4160                     }
4161                     else {
4162                         if (data->start_class->flags & ANYOF_LOCALE)
4163                             ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
4164
4165                         /* Even if under locale, set the bits for non-locale
4166                          * in case it isn't a true locale-node.  This will
4167                          * create false positives if it truly is locale */
4168                         if (OP(scan) == ALNUMU) {
4169                             for (value = 0; value < 256; value++) {
4170                                 if (isWORDCHAR_L1(value)) {
4171                                     ANYOF_BITMAP_SET(data->start_class, value);
4172                                 }
4173                             }
4174                         } else {
4175                             for (value = 0; value < 256; value++) {
4176                                 if (isALNUM(value)) {
4177                                     ANYOF_BITMAP_SET(data->start_class, value);
4178                                 }
4179                             }
4180                         }
4181                     }
4182                     break;
4183                 case NALNUM:
4184                     if (flags & SCF_DO_STCLASS_AND) {
4185                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
4186                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
4187                             if (OP(scan) == NALNUMU) {
4188                                 for (value = 0; value < 256; value++) {
4189                                     if (isWORDCHAR_L1(value)) {
4190                                         ANYOF_BITMAP_CLEAR(data->start_class, value);
4191                                     }
4192                                 }
4193                             } else {
4194                                 for (value = 0; value < 256; value++) {
4195                                     if (isALNUM(value)) {
4196                                         ANYOF_BITMAP_CLEAR(data->start_class, value);
4197                                     }
4198                                 }
4199                             }
4200                         }
4201                     }
4202                     else {
4203                         if (data->start_class->flags & ANYOF_LOCALE)
4204                             ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
4205
4206                         /* Even if under locale, set the bits for non-locale in
4207                          * case it isn't a true locale-node.  This will create
4208                          * false positives if it truly is locale */
4209                         if (OP(scan) == NALNUMU) {
4210                             for (value = 0; value < 256; value++) {
4211                                 if (! isWORDCHAR_L1(value)) {
4212                                     ANYOF_BITMAP_SET(data->start_class, value);
4213                                 }
4214                             }
4215                         } else {
4216                             for (value = 0; value < 256; value++) {
4217                                 if (! isALNUM(value)) {
4218                                     ANYOF_BITMAP_SET(data->start_class, value);
4219                                 }
4220                             }
4221                         }
4222                     }
4223                     break;
4224                 case SPACE:
4225                     if (flags & SCF_DO_STCLASS_AND) {
4226                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
4227                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
4228                             if (OP(scan) == SPACEU) {
4229                                 for (value = 0; value < 256; value++) {
4230                                     if (!isSPACE_L1(value)) {
4231                                         ANYOF_BITMAP_CLEAR(data->start_class, value);
4232                                     }
4233                                 }
4234                             } else {
4235                                 for (value = 0; value < 256; value++) {
4236                                     if (!isSPACE(value)) {
4237                                         ANYOF_BITMAP_CLEAR(data->start_class, value);
4238                                     }
4239                                 }
4240                             }
4241                         }
4242                     }
4243                     else {
4244                         if (data->start_class->flags & ANYOF_LOCALE) {
4245                             ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
4246                         }
4247                         if (OP(scan) == SPACEU) {
4248                             for (value = 0; value < 256; value++) {
4249                                 if (isSPACE_L1(value)) {
4250                                     ANYOF_BITMAP_SET(data->start_class, value);
4251                                 }
4252                             }
4253                         } else {
4254                             for (value = 0; value < 256; value++) {
4255                                 if (isSPACE(value)) {
4256                                     ANYOF_BITMAP_SET(data->start_class, value);
4257                                 }
4258                             }
4259                         }
4260                     }
4261                     break;
4262                 case NSPACE:
4263                     if (flags & SCF_DO_STCLASS_AND) {
4264                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
4265                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
4266                             if (OP(scan) == NSPACEU) {
4267                                 for (value = 0; value < 256; value++) {
4268                                     if (isSPACE_L1(value)) {
4269                                         ANYOF_BITMAP_CLEAR(data->start_class, value);
4270                                     }
4271                                 }
4272                             } else {
4273                                 for (value = 0; value < 256; value++) {
4274                                     if (isSPACE(value)) {
4275                                         ANYOF_BITMAP_CLEAR(data->start_class, value);
4276                                     }
4277                                 }
4278                             }
4279                         }
4280                     }
4281                     else {
4282                         if (data->start_class->flags & ANYOF_LOCALE)
4283                             ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
4284                         if (OP(scan) == NSPACEU) {
4285                             for (value = 0; value < 256; value++) {
4286                                 if (!isSPACE_L1(value)) {
4287                                     ANYOF_BITMAP_SET(data->start_class, value);
4288                                 }
4289                             }
4290                         }
4291                         else {
4292                             for (value = 0; value < 256; value++) {
4293                                 if (!isSPACE(value)) {
4294                                     ANYOF_BITMAP_SET(data->start_class, value);
4295                                 }
4296                             }
4297                         }
4298                     }
4299                     break;
4300                 case DIGIT:
4301                     if (flags & SCF_DO_STCLASS_AND) {
4302                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
4303                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
4304                             for (value = 0; value < 256; value++)
4305                                 if (!isDIGIT(value))
4306                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
4307                         }
4308                     }
4309                     else {
4310                         if (data->start_class->flags & ANYOF_LOCALE)
4311                             ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
4312                         for (value = 0; value < 256; value++)
4313                             if (isDIGIT(value))
4314                                 ANYOF_BITMAP_SET(data->start_class, value);
4315                     }
4316                     break;
4317                 case NDIGIT:
4318                     if (flags & SCF_DO_STCLASS_AND) {
4319                         if (!(data->start_class->flags & ANYOF_LOCALE))
4320                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
4321                         for (value = 0; value < 256; value++)
4322                             if (isDIGIT(value))
4323                                 ANYOF_BITMAP_CLEAR(data->start_class, value);
4324                     }
4325                     else {
4326                         if (data->start_class->flags & ANYOF_LOCALE)
4327                             ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
4328                         for (value = 0; value < 256; value++)
4329                             if (!isDIGIT(value))
4330                                 ANYOF_BITMAP_SET(data->start_class, value);
4331                     }
4332                     break;
4333                 CASE_SYNST_FNC(VERTWS);
4334                 CASE_SYNST_FNC(HORIZWS);
4335
4336                 }
4337                 if (flags & SCF_DO_STCLASS_OR)
4338                     cl_and(data->start_class, and_withp);
4339                 flags &= ~SCF_DO_STCLASS;
4340             }
4341         }
4342         else if (PL_regkind[OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
4343             data->flags |= (OP(scan) == MEOL
4344                             ? SF_BEFORE_MEOL
4345                             : SF_BEFORE_SEOL);
4346         }
4347         else if (  PL_regkind[OP(scan)] == BRANCHJ
4348                  /* Lookbehind, or need to calculate parens/evals/stclass: */
4349                    && (scan->flags || data || (flags & SCF_DO_STCLASS))
4350                    && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
4351             if ( !PERL_ENABLE_POSITIVE_ASSERTION_STUDY 
4352                 || OP(scan) == UNLESSM )
4353             {
4354                 /* Negative Lookahead/lookbehind
4355                    In this case we can't do fixed string optimisation.
4356                 */
4357
4358                 I32 deltanext, minnext, fake = 0;
4359                 regnode *nscan;
4360                 struct regnode_charclass_class intrnl;
4361                 int f = 0;
4362
4363                 data_fake.flags = 0;
4364                 if (data) {
4365                     data_fake.whilem_c = data->whilem_c;
4366                     data_fake.last_closep = data->last_closep;
4367                 }
4368                 else
4369                     data_fake.last_closep = &fake;
4370                 data_fake.pos_delta = delta;
4371                 if ( flags & SCF_DO_STCLASS && !scan->flags
4372                      && OP(scan) == IFMATCH ) { /* Lookahead */
4373                     cl_init(pRExC_state, &intrnl);
4374                     data_fake.start_class = &intrnl;
4375                     f |= SCF_DO_STCLASS_AND;
4376                 }
4377                 if (flags & SCF_WHILEM_VISITED_POS)
4378                     f |= SCF_WHILEM_VISITED_POS;
4379                 next = regnext(scan);
4380                 nscan = NEXTOPER(NEXTOPER(scan));
4381                 minnext = study_chunk(pRExC_state, &nscan, minlenp, &deltanext, 
4382                     last, &data_fake, stopparen, recursed, NULL, f, depth+1);
4383                 if (scan->flags) {
4384                     if (deltanext) {
4385                         FAIL("Variable length lookbehind not implemented");
4386                     }
4387                     else if (minnext > (I32)U8_MAX) {
4388                         FAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
4389                     }
4390                     scan->flags = (U8)minnext;
4391                 }
4392                 if (data) {
4393                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
4394                         pars++;
4395                     if (data_fake.flags & SF_HAS_EVAL)
4396                         data->flags |= SF_HAS_EVAL;
4397                     data->whilem_c = data_fake.whilem_c;
4398                 }
4399                 if (f & SCF_DO_STCLASS_AND) {
4400                     if (flags & SCF_DO_STCLASS_OR) {
4401                         /* OR before, AND after: ideally we would recurse with
4402                          * data_fake to get the AND applied by study of the
4403                          * remainder of the pattern, and then derecurse;
4404                          * *** HACK *** for now just treat as "no information".
4405                          * See [perl #56690].
4406                          */
4407                         cl_init(pRExC_state, data->start_class);
4408                     }  else {
4409                         /* AND before and after: combine and continue */
4410                         const int was = (data->start_class->flags & ANYOF_EOS);
4411
4412                         cl_and(data->start_class, &intrnl);
4413                         if (was)
4414                             data->start_class->flags |= ANYOF_EOS;
4415                     }
4416                 }
4417             }
4418 #if PERL_ENABLE_POSITIVE_ASSERTION_STUDY
4419             else {
4420                 /* Positive Lookahead/lookbehind
4421                    In this case we can do fixed string optimisation,
4422                    but we must be careful about it. Note in the case of
4423                    lookbehind the positions will be offset by the minimum
4424                    length of the pattern, something we won't know about
4425                    until after the recurse.
4426                 */
4427                 I32 deltanext, fake = 0;
4428                 regnode *nscan;
4429                 struct regnode_charclass_class intrnl;
4430                 int f = 0;
4431                 /* We use SAVEFREEPV so that when the full compile 
4432                     is finished perl will clean up the allocated 
4433                     minlens when it's all done. This way we don't
4434                     have to worry about freeing them when we know
4435                     they wont be used, which would be a pain.
4436                  */
4437                 I32 *minnextp;
4438                 Newx( minnextp, 1, I32 );
4439                 SAVEFREEPV(minnextp);
4440
4441                 if (data) {
4442                     StructCopy(data, &data_fake, scan_data_t);
4443                     if ((flags & SCF_DO_SUBSTR) && data->last_found) {
4444                         f |= SCF_DO_SUBSTR;
4445                         if (scan->flags) 
4446                             SCAN_COMMIT(pRExC_state, &data_fake,minlenp);
4447                         data_fake.last_found=newSVsv(data->last_found);
4448                     }
4449                 }
4450                 else
4451                     data_fake.last_closep = &fake;
4452                 data_fake.flags = 0;
4453                 data_fake.pos_delta = delta;
4454                 if (is_inf)
4455                     data_fake.flags |= SF_IS_INF;
4456                 if ( flags & SCF_DO_STCLASS && !scan->flags
4457                      && OP(scan) == IFMATCH ) { /* Lookahead */
4458                     cl_init(pRExC_state, &intrnl);
4459                     data_fake.start_class = &intrnl;
4460                     f |= SCF_DO_STCLASS_AND;
4461                 }
4462                 if (flags & SCF_WHILEM_VISITED_POS)
4463                     f |= SCF_WHILEM_VISITED_POS;
4464                 next = regnext(scan);
4465                 nscan = NEXTOPER(NEXTOPER(scan));
4466
4467                 *minnextp = study_chunk(pRExC_state, &nscan, minnextp, &deltanext, 
4468                     last, &data_fake, stopparen, recursed, NULL, f,depth+1);
4469                 if (scan->flags) {
4470                     if (deltanext) {
4471                         FAIL("Variable length lookbehind not implemented");
4472                     }
4473                     else if (*minnextp > (I32)U8_MAX) {
4474                         FAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
4475                     }
4476                     scan->flags = (U8)*minnextp;
4477                 }
4478
4479                 *minnextp += min;
4480
4481                 if (f & SCF_DO_STCLASS_AND) {
4482                     const int was = (data->start_class->flags & ANYOF_EOS);
4483
4484                     cl_and(data->start_class, &intrnl);
4485                     if (was)
4486                         data->start_class->flags |= ANYOF_EOS;
4487                 }
4488                 if (data) {
4489                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
4490                         pars++;
4491                     if (data_fake.flags & SF_HAS_EVAL)
4492                         data->flags |= SF_HAS_EVAL;
4493                     data->whilem_c = data_fake.whilem_c;
4494                     if ((flags & SCF_DO_SUBSTR) && data_fake.last_found) {
4495                         if (RExC_rx->minlen<*minnextp)
4496                             RExC_rx->minlen=*minnextp;
4497                         SCAN_COMMIT(pRExC_state, &data_fake, minnextp);
4498                         SvREFCNT_dec(data_fake.last_found);
4499                         
4500                         if ( data_fake.minlen_fixed != minlenp ) 
4501                         {
4502                             data->offset_fixed= data_fake.offset_fixed;
4503                             data->minlen_fixed= data_fake.minlen_fixed;
4504                             data->lookbehind_fixed+= scan->flags;
4505                         }
4506                         if ( data_fake.minlen_float != minlenp )
4507                         {
4508                             data->minlen_float= data_fake.minlen_float;
4509                             data->offset_float_min=data_fake.offset_float_min;
4510                             data->offset_float_max=data_fake.offset_float_max;
4511                             data->lookbehind_float+= scan->flags;
4512                         }
4513                     }
4514                 }
4515
4516
4517             }
4518 #endif
4519         }
4520         else if (OP(scan) == OPEN) {
4521             if (stopparen != (I32)ARG(scan))
4522                 pars++;
4523         }
4524         else if (OP(scan) == CLOSE) {
4525             if (stopparen == (I32)ARG(scan)) {
4526                 break;
4527             }
4528             if ((I32)ARG(scan) == is_par) {
4529                 next = regnext(scan);
4530
4531                 if ( next && (OP(next) != WHILEM) && next < last)
4532                     is_par = 0;         /* Disable optimization */
4533             }
4534             if (data)
4535                 *(data->last_closep) = ARG(scan);
4536         }
4537         else if (OP(scan) == EVAL) {
4538                 if (data)
4539                     data->flags |= SF_HAS_EVAL;
4540         }
4541         else if ( PL_regkind[OP(scan)] == ENDLIKE ) {
4542             if (flags & SCF_DO_SUBSTR) {
4543                 SCAN_COMMIT(pRExC_state,data,minlenp);
4544                 flags &= ~SCF_DO_SUBSTR;
4545             }
4546             if (data && OP(scan)==ACCEPT) {
4547                 data->flags |= SCF_SEEN_ACCEPT;
4548                 if (stopmin > min)
4549                     stopmin = min;
4550             }
4551         }
4552         else if (OP(scan) == LOGICAL && scan->flags == 2) /* Embedded follows */
4553         {
4554                 if (flags & SCF_DO_SUBSTR) {
4555                     SCAN_COMMIT(pRExC_state,data,minlenp);
4556                     data->longest = &(data->longest_float);
4557                 }
4558                 is_inf = is_inf_internal = 1;
4559                 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
4560                     cl_anything(pRExC_state, data->start_class);
4561                 flags &= ~SCF_DO_STCLASS;
4562         }
4563         else if (OP(scan) == GPOS) {
4564             if (!(RExC_rx->extflags & RXf_GPOS_FLOAT) &&
4565                 !(delta || is_inf || (data && data->pos_delta))) 
4566             {
4567                 if (!(RExC_rx->extflags & RXf_ANCH) && (flags & SCF_DO_SUBSTR))
4568                     RExC_rx->extflags |= RXf_ANCH_GPOS;
4569                 if (RExC_rx->gofs < (U32)min)
4570                     RExC_rx->gofs = min;
4571             } else {
4572                 RExC_rx->extflags |= RXf_GPOS_FLOAT;
4573                 RExC_rx->gofs = 0;
4574             }       
4575         }
4576 #ifdef TRIE_STUDY_OPT
4577 #ifdef FULL_TRIE_STUDY
4578         else if (PL_regkind[OP(scan)] == TRIE) {
4579             /* NOTE - There is similar code to this block above for handling
4580                BRANCH nodes on the initial study.  If you change stuff here
4581                check there too. */
4582             regnode *trie_node= scan;
4583             regnode *tail= regnext(scan);
4584             reg_trie_data *trie = (reg_trie_data*)RExC_rxi->data->data[ ARG(scan) ];
4585             I32 max1 = 0, min1 = I32_MAX;
4586             struct regnode_charclass_class accum;
4587
4588             if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
4589                 SCAN_COMMIT(pRExC_state, data,minlenp); /* Cannot merge strings after this. */
4590             if (flags & SCF_DO_STCLASS)
4591                 cl_init_zero(pRExC_state, &accum);
4592                 
4593             if (!trie->jump) {
4594                 min1= trie->minlen;
4595                 max1= trie->maxlen;
4596             } else {
4597                 const regnode *nextbranch= NULL;
4598                 U32 word;
4599                 
4600                 for ( word=1 ; word <= trie->wordcount ; word++) 
4601                 {
4602                     I32 deltanext=0, minnext=0, f = 0, fake;
4603                     struct regnode_charclass_class this_class;
4604                     
4605                     data_fake.flags = 0;
4606                     if (data) {
4607                         data_fake.whilem_c = data->whilem_c;
4608                         data_fake.last_closep = data->last_closep;
4609                     }
4610                     else
4611                         data_fake.last_closep = &fake;
4612                     data_fake.pos_delta = delta;
4613                     if (flags & SCF_DO_STCLASS) {
4614                         cl_init(pRExC_state, &this_class);
4615                         data_fake.start_class = &this_class;
4616                         f = SCF_DO_STCLASS_AND;
4617                     }
4618                     if (flags & SCF_WHILEM_VISITED_POS)
4619                         f |= SCF_WHILEM_VISITED_POS;
4620     
4621                     if (trie->jump[word]) {
4622                         if (!nextbranch)
4623                             nextbranch = trie_node + trie->jump[0];
4624                         scan= trie_node + trie->jump[word];
4625                         /* We go from the jump point to the branch that follows
4626                            it. Note this means we need the vestigal unused branches
4627                            even though they arent otherwise used.
4628                          */
4629                         minnext = study_chunk(pRExC_state, &scan, minlenp, 
4630                             &deltanext, (regnode *)nextbranch, &data_fake, 
4631                             stopparen, recursed, NULL, f,depth+1);
4632                     }
4633                     if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH)
4634                         nextbranch= regnext((regnode*)nextbranch);
4635                     
4636                     if (min1 > (I32)(minnext + trie->minlen))
4637                         min1 = minnext + trie->minlen;
4638                     if (max1 < (I32)(minnext + deltanext + trie->maxlen))
4639                         max1 = minnext + deltanext + trie->maxlen;
4640                     if (deltanext == I32_MAX)
4641                         is_inf = is_inf_internal = 1;
4642                     
4643                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
4644                         pars++;
4645                     if (data_fake.flags & SCF_SEEN_ACCEPT) {
4646                         if ( stopmin > min + min1) 
4647                             stopmin = min + min1;
4648                         flags &= ~SCF_DO_SUBSTR;
4649                         if (data)
4650                             data->flags |= SCF_SEEN_ACCEPT;
4651                     }
4652                     if (data) {
4653                         if (data_fake.flags & SF_HAS_EVAL)
4654                             data->flags |= SF_HAS_EVAL;
4655                         data->whilem_c = data_fake.whilem_c;
4656                     }
4657                     if (flags & SCF_DO_STCLASS)
4658                         cl_or(pRExC_state, &accum, &this_class);
4659                 }
4660             }
4661             if (flags & SCF_DO_SUBSTR) {
4662                 data->pos_min += min1;
4663                 data->pos_delta += max1 - min1;
4664                 if (max1 != min1 || is_inf)
4665                     data->longest = &(data->longest_float);
4666             }
4667             min += min1;
4668             delta += max1 - min1;
4669             if (flags & SCF_DO_STCLASS_OR) {
4670                 cl_or(pRExC_state, data->start_class, &accum);
4671                 if (min1) {
4672                     cl_and(data->start_class, and_withp);
4673                     flags &= ~SCF_DO_STCLASS;
4674                 }
4675             }
4676             else if (flags & SCF_DO_STCLASS_AND) {
4677                 if (min1) {
4678                     cl_and(data->start_class, &accum);
4679                     flags &= ~SCF_DO_STCLASS;
4680                 }
4681                 else {
4682                     /* Switch to OR mode: cache the old value of
4683                      * data->start_class */
4684                     INIT_AND_WITHP;
4685                     StructCopy(data->start_class, and_withp,
4686                                struct regnode_charclass_class);
4687                     flags &= ~SCF_DO_STCLASS_AND;
4688                     StructCopy(&accum, data->start_class,
4689                                struct regnode_charclass_class);
4690                     flags |= SCF_DO_STCLASS_OR;
4691                     data->start_class->flags |= ANYOF_EOS;
4692                 }
4693             }
4694             scan= tail;
4695             continue;
4696         }
4697 #else
4698         else if (PL_regkind[OP(scan)] == TRIE) {
4699             reg_trie_data *trie = (reg_trie_data*)RExC_rxi->data->data[ ARG(scan) ];
4700             U8*bang=NULL;
4701             
4702             min += trie->minlen;
4703             delta += (trie->maxlen - trie->minlen);
4704             flags &= ~SCF_DO_STCLASS; /* xxx */
4705             if (flags & SCF_DO_SUBSTR) {
4706                 SCAN_COMMIT(pRExC_state,data,minlenp);  /* Cannot expect anything... */
4707                 data->pos_min += trie->minlen;
4708                 data->pos_delta += (trie->maxlen - trie->minlen);
4709                 if (trie->maxlen != trie->minlen)
4710                     data->longest = &(data->longest_float);
4711             }
4712             if (trie->jump) /* no more substrings -- for now /grr*/
4713                 flags &= ~SCF_DO_SUBSTR; 
4714         }
4715 #endif /* old or new */
4716 #endif /* TRIE_STUDY_OPT */
4717
4718         /* Else: zero-length, ignore. */
4719         scan = regnext(scan);
4720     }
4721     if (frame) {
4722         last = frame->last;
4723         scan = frame->next;
4724         stopparen = frame->stop;
4725         frame = frame->prev;
4726         goto fake_study_recurse;
4727     }
4728
4729   finish:
4730     assert(!frame);
4731     DEBUG_STUDYDATA("pre-fin:",data,depth);
4732
4733     *scanp = scan;
4734     *deltap = is_inf_internal ? I32_MAX : delta;
4735     if (flags & SCF_DO_SUBSTR && is_inf)
4736         data->pos_delta = I32_MAX - data->pos_min;
4737     if (is_par > (I32)U8_MAX)
4738         is_par = 0;
4739     if (is_par && pars==1 && data) {
4740         data->flags |= SF_IN_PAR;
4741         data->flags &= ~SF_HAS_PAR;
4742     }
4743     else if (pars && data) {
4744         data->flags |= SF_HAS_PAR;
4745         data->flags &= ~SF_IN_PAR;
4746     }
4747     if (flags & SCF_DO_STCLASS_OR)
4748         cl_and(data->start_class, and_withp);
4749     if (flags & SCF_TRIE_RESTUDY)
4750         data->flags |=  SCF_TRIE_RESTUDY;
4751     
4752     DEBUG_STUDYDATA("post-fin:",data,depth);
4753     
4754     return min < stopmin ? min : stopmin;
4755 }
4756
4757 STATIC U32
4758 S_add_data(RExC_state_t *pRExC_state, U32 n, const char *s)
4759 {
4760     U32 count = RExC_rxi->data ? RExC_rxi->data->count : 0;
4761
4762     PERL_ARGS_ASSERT_ADD_DATA;
4763
4764     Renewc(RExC_rxi->data,
4765            sizeof(*RExC_rxi->data) + sizeof(void*) * (count + n - 1),
4766            char, struct reg_data);
4767     if(count)
4768         Renew(RExC_rxi->data->what, count + n, U8);
4769     else
4770         Newx(RExC_rxi->data->what, n, U8);
4771     RExC_rxi->data->count = count + n;
4772     Copy(s, RExC_rxi->data->what + count, n, U8);
4773     return count;
4774 }
4775
4776 /*XXX: todo make this not included in a non debugging perl */
4777 #ifndef PERL_IN_XSUB_RE
4778 void
4779 Perl_reginitcolors(pTHX)
4780 {
4781     dVAR;
4782     const char * const s = PerlEnv_getenv("PERL_RE_COLORS");
4783     if (s) {
4784         char *t = savepv(s);
4785         int i = 0;
4786         PL_colors[0] = t;
4787         while (++i < 6) {
4788             t = strchr(t, '\t');
4789             if (t) {
4790                 *t = '\0';
4791                 PL_colors[i] = ++t;
4792             }
4793             else
4794                 PL_colors[i] = t = (char *)"";
4795         }
4796     } else {
4797         int i = 0;
4798         while (i < 6)
4799             PL_colors[i++] = (char *)"";
4800     }
4801     PL_colorset = 1;
4802 }
4803 #endif
4804
4805
4806 #ifdef TRIE_STUDY_OPT
4807 #define CHECK_RESTUDY_GOTO                                  \
4808         if (                                                \
4809               (data.flags & SCF_TRIE_RESTUDY)               \
4810               && ! restudied++                              \
4811         )     goto reStudy
4812 #else
4813 #define CHECK_RESTUDY_GOTO
4814 #endif        
4815
4816 /*
4817  - pregcomp - compile a regular expression into internal code
4818  *
4819  * We can't allocate space until we know how big the compiled form will be,
4820  * but we can't compile it (and thus know how big it is) until we've got a
4821  * place to put the code.  So we cheat:  we compile it twice, once with code
4822  * generation turned off and size counting turned on, and once "for real".
4823  * This also means that we don't allocate space until we are sure that the
4824  * thing really will compile successfully, and we never have to move the
4825  * code and thus invalidate pointers into it.  (Note that it has to be in
4826  * one piece because free() must be able to free it all.) [NB: not true in perl]
4827  *
4828  * Beware that the optimization-preparation code in here knows about some
4829  * of the structure of the compiled regexp.  [I'll say.]
4830  */
4831
4832
4833
4834 #ifndef PERL_IN_XSUB_RE
4835 #define RE_ENGINE_PTR &PL_core_reg_engine
4836 #else
4837 extern const struct regexp_engine my_reg_engine;
4838 #define RE_ENGINE_PTR &my_reg_engine
4839 #endif
4840
4841 #ifndef PERL_IN_XSUB_RE 
4842 REGEXP *
4843 Perl_pregcomp(pTHX_ SV * const pattern, const U32 flags)
4844 {
4845     dVAR;
4846     HV * const table = GvHV(PL_hintgv);
4847
4848     PERL_ARGS_ASSERT_PREGCOMP;
4849
4850     /* Dispatch a request to compile a regexp to correct 
4851        regexp engine. */
4852     if (table) {
4853         SV **ptr= hv_fetchs(table, "regcomp", FALSE);
4854         GET_RE_DEBUG_FLAGS_DECL;
4855         if (ptr && SvIOK(*ptr) && SvIV(*ptr)) {
4856             const regexp_engine *eng=INT2PTR(regexp_engine*,SvIV(*ptr));
4857             DEBUG_COMPILE_r({
4858                 PerlIO_printf(Perl_debug_log, "Using engine %"UVxf"\n",
4859                     SvIV(*ptr));
4860             });            
4861             return CALLREGCOMP_ENG(eng, pattern, flags);
4862         } 
4863     }
4864     return Perl_re_compile(aTHX_ pattern, flags);
4865 }
4866 #endif
4867
4868 REGEXP *
4869 Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
4870 {
4871     dVAR;
4872     REGEXP *rx;
4873     struct regexp *r;
4874     register regexp_internal *ri;
4875     STRLEN plen;
4876     char* VOL exp;
4877     char* xend;
4878     regnode *scan;
4879     I32 flags;
4880     I32 minlen = 0;
4881     U32 pm_flags;
4882
4883     /* these are all flags - maybe they should be turned
4884      * into a single int with different bit masks */
4885     I32 sawlookahead = 0;
4886     I32 sawplus = 0;
4887     I32 sawopen = 0;
4888     bool used_setjump = FALSE;
4889     regex_charset initial_charset = get_regex_charset(orig_pm_flags);
4890
4891     U8 jump_ret = 0;
4892     dJMPENV;
4893     scan_data_t data;
4894     RExC_state_t RExC_state;
4895     RExC_state_t * const pRExC_state = &RExC_state;
4896 #ifdef TRIE_STUDY_OPT    
4897     int restudied;
4898     RExC_state_t copyRExC_state;
4899 #endif    
4900     GET_RE_DEBUG_FLAGS_DECL;
4901
4902     PERL_ARGS_ASSERT_RE_COMPILE;
4903
4904     DEBUG_r(if (!PL_colorset) reginitcolors());
4905
4906 #ifndef PERL_IN_XSUB_RE
4907     /* Initialize these here instead of as-needed, as is quick and avoids
4908      * having to test them each time otherwise */
4909     if (! PL_AboveLatin1) {
4910         PL_AboveLatin1 = _new_invlist_C_array(AboveLatin1_invlist);
4911         PL_ASCII = _new_invlist_C_array(ASCII_invlist);
4912         PL_Latin1 = _new_invlist_C_array(Latin1_invlist);
4913
4914         PL_L1PosixAlnum = _new_invlist_C_array(L1PosixAlnum_invlist);
4915         PL_PosixAlnum = _new_invlist_C_array(PosixAlnum_invlist);
4916
4917         PL_L1PosixAlpha = _new_invlist_C_array(L1PosixAlpha_invlist);
4918         PL_PosixAlpha = _new_invlist_C_array(PosixAlpha_invlist);
4919
4920         PL_PosixBlank = _new_invlist_C_array(PosixBlank_invlist);
4921         PL_XPosixBlank = _new_invlist_C_array(XPosixBlank_invlist);
4922
4923         PL_L1Cased = _new_invlist_C_array(L1Cased_invlist);
4924
4925         PL_PosixCntrl = _new_invlist_C_array(PosixCntrl_invlist);
4926         PL_XPosixCntrl = _new_invlist_C_array(XPosixCntrl_invlist);
4927
4928         PL_PosixDigit = _new_invlist_C_array(PosixDigit_invlist);
4929
4930         PL_L1PosixGraph = _new_invlist_C_array(L1PosixGraph_invlist);
4931         PL_PosixGraph = _new_invlist_C_array(PosixGraph_invlist);
4932
4933         PL_L1PosixAlnum = _new_invlist_C_array(L1PosixAlnum_invlist);
4934         PL_PosixAlnum = _new_invlist_C_array(PosixAlnum_invlist);
4935
4936         PL_L1PosixLower = _new_invlist_C_array(L1PosixLower_invlist);
4937         PL_PosixLower = _new_invlist_C_array(PosixLower_invlist);
4938
4939         PL_L1PosixPrint = _new_invlist_C_array(L1PosixPrint_invlist);
4940         PL_PosixPrint = _new_invlist_C_array(PosixPrint_invlist);
4941
4942         PL_L1PosixPunct = _new_invlist_C_array(L1PosixPunct_invlist);
4943         PL_PosixPunct = _new_invlist_C_array(PosixPunct_invlist);
4944
4945         PL_PerlSpace = _new_invlist_C_array(PerlSpace_invlist);
4946         PL_XPerlSpace = _new_invlist_C_array(XPerlSpace_invlist);
4947
4948         PL_PosixSpace = _new_invlist_C_array(PosixSpace_invlist);
4949         PL_XPosixSpace = _new_invlist_C_array(XPosixSpace_invlist);
4950
4951         PL_L1PosixUpper = _new_invlist_C_array(L1PosixUpper_invlist);
4952         PL_PosixUpper = _new_invlist_C_array(PosixUpper_invlist);
4953
4954         PL_VertSpace = _new_invlist_C_array(VertSpace_invlist);
4955
4956         PL_PosixWord = _new_invlist_C_array(PosixWord_invlist);
4957         PL_L1PosixWord = _new_invlist_C_array(L1PosixWord_invlist);
4958
4959         PL_PosixXDigit = _new_invlist_C_array(PosixXDigit_invlist);
4960         PL_XPosixXDigit = _new_invlist_C_array(XPosixXDigit_invlist);
4961     }
4962 #endif
4963
4964     exp = SvPV(pattern, plen);
4965
4966     if (plen == 0) { /* ignore the utf8ness if the pattern is 0 length */
4967         RExC_utf8 = RExC_orig_utf8 = 0;
4968     }
4969     else {
4970         RExC_utf8 = RExC_orig_utf8 = SvUTF8(pattern);
4971     }
4972     RExC_uni_semantics = 0;
4973     RExC_contains_locale = 0;
4974
4975     /****************** LONG JUMP TARGET HERE***********************/
4976     /* Longjmp back to here if have to switch in midstream to utf8 */
4977     if (! RExC_orig_utf8) {
4978         JMPENV_PUSH(jump_ret);
4979         used_setjump = TRUE;
4980     }
4981
4982     if (jump_ret == 0) {    /* First time through */
4983         xend = exp + plen;
4984
4985         DEBUG_COMPILE_r({
4986             SV *dsv= sv_newmortal();
4987             RE_PV_QUOTED_DECL(s, RExC_utf8,
4988                 dsv, exp, plen, 60);
4989             PerlIO_printf(Perl_debug_log, "%sCompiling REx%s %s\n",
4990                            PL_colors[4],PL_colors[5],s);
4991         });
4992     }
4993     else {  /* longjumped back */
4994         STRLEN len = plen;
4995
4996         /* If the cause for the longjmp was other than changing to utf8