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