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