This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Further tweaks to make it easier to create regexp engine plug ins.
[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 = 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 =                                    \
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 = 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 = PerlMemShared_calloc( 256, sizeof(U16) );
1296     if (!(UTF && folder))
1297         trie->bitmap = 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 = 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 = PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
1453                                              sizeof(reg_trie_state) );
1454         TRIE_LIST_NEW(1);
1455         next_alloc = 2;
1456
1457         for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1458
1459             regnode * const noper = NEXTOPER( cur );
1460             U8 *uc           = (U8*)STRING( noper );
1461             const U8 * const e = uc + STR_LEN( noper );
1462             U32 state        = 1;         /* required init */
1463             U16 charid       = 0;         /* sanity init */
1464             U8 *scan         = (U8*)NULL; /* sanity init */
1465             STRLEN foldlen   = 0;         /* required init */
1466             U32 wordlen      = 0;         /* required init */
1467             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1468
1469             if (OP(noper) != NOTHING) {
1470                 for ( ; uc < e ; uc += len ) {
1471
1472                     TRIE_READ_CHAR;
1473
1474                     if ( uvc < 256 ) {
1475                         charid = trie->charmap[ uvc ];
1476                     } else {
1477                         SV** const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
1478                         if ( !svpp ) {
1479                             charid = 0;
1480                         } else {
1481                             charid=(U16)SvIV( *svpp );
1482                         }
1483                     }
1484                     /* charid is now 0 if we dont know the char read, or nonzero if we do */
1485                     if ( charid ) {
1486
1487                         U16 check;
1488                         U32 newstate = 0;
1489
1490                         charid--;
1491                         if ( !trie->states[ state ].trans.list ) {
1492                             TRIE_LIST_NEW( state );
1493                         }
1494                         for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) {
1495                             if ( TRIE_LIST_ITEM( state, check ).forid == charid ) {
1496                                 newstate = TRIE_LIST_ITEM( state, check ).newstate;
1497                                 break;
1498                             }
1499                         }
1500                         if ( ! newstate ) {
1501                             newstate = next_alloc++;
1502                             TRIE_LIST_PUSH( state, charid, newstate );
1503                             transcount++;
1504                         }
1505                         state = newstate;
1506                     } else {
1507                         Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1508                     }
1509                 }
1510             }
1511             TRIE_HANDLE_WORD(state);
1512
1513         } /* end second pass */
1514
1515         /* next alloc is the NEXT state to be allocated */
1516         trie->statecount = next_alloc; 
1517         trie->states = PerlMemShared_realloc( trie->states, next_alloc
1518                                               * sizeof(reg_trie_state) );
1519
1520         /* and now dump it out before we compress it */
1521         DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_list(trie, widecharmap,
1522                                                          revcharmap, next_alloc,
1523                                                          depth+1)
1524         );
1525
1526         trie->trans
1527             = PerlMemShared_calloc( transcount, sizeof(reg_trie_trans) );
1528         {
1529             U32 state;
1530             U32 tp = 0;
1531             U32 zp = 0;
1532
1533
1534             for( state=1 ; state < next_alloc ; state ++ ) {
1535                 U32 base=0;
1536
1537                 /*
1538                 DEBUG_TRIE_COMPILE_MORE_r(
1539                     PerlIO_printf( Perl_debug_log, "tp: %d zp: %d ",tp,zp)
1540                 );
1541                 */
1542
1543                 if (trie->states[state].trans.list) {
1544                     U16 minid=TRIE_LIST_ITEM( state, 1).forid;
1545                     U16 maxid=minid;
1546                     U16 idx;
1547
1548                     for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1549                         const U16 forid = TRIE_LIST_ITEM( state, idx).forid;
1550                         if ( forid < minid ) {
1551                             minid=forid;
1552                         } else if ( forid > maxid ) {
1553                             maxid=forid;
1554                         }
1555                     }
1556                     if ( transcount < tp + maxid - minid + 1) {
1557                         transcount *= 2;
1558                         trie->trans
1559                             = PerlMemShared_realloc( trie->trans,
1560                                                      transcount
1561                                                      * sizeof(reg_trie_trans) );
1562                         Zero( trie->trans + (transcount / 2), transcount / 2 , reg_trie_trans );
1563                     }
1564                     base = trie->uniquecharcount + tp - minid;
1565                     if ( maxid == minid ) {
1566                         U32 set = 0;
1567                         for ( ; zp < tp ; zp++ ) {
1568                             if ( ! trie->trans[ zp ].next ) {
1569                                 base = trie->uniquecharcount + zp - minid;
1570                                 trie->trans[ zp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1571                                 trie->trans[ zp ].check = state;
1572                                 set = 1;
1573                                 break;
1574                             }
1575                         }
1576                         if ( !set ) {
1577                             trie->trans[ tp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1578                             trie->trans[ tp ].check = state;
1579                             tp++;
1580                             zp = tp;
1581                         }
1582                     } else {
1583                         for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1584                             const U32 tid = base -  trie->uniquecharcount + TRIE_LIST_ITEM( state, idx ).forid;
1585                             trie->trans[ tid ].next = TRIE_LIST_ITEM( state, idx ).newstate;
1586                             trie->trans[ tid ].check = state;
1587                         }
1588                         tp += ( maxid - minid + 1 );
1589                     }
1590                     Safefree(trie->states[ state ].trans.list);
1591                 }
1592                 /*
1593                 DEBUG_TRIE_COMPILE_MORE_r(
1594                     PerlIO_printf( Perl_debug_log, " base: %d\n",base);
1595                 );
1596                 */
1597                 trie->states[ state ].trans.base=base;
1598             }
1599             trie->lasttrans = tp + 1;
1600         }
1601     } else {
1602         /*
1603            Second Pass -- Flat Table Representation.
1604
1605            we dont use the 0 slot of either trans[] or states[] so we add 1 to each.
1606            We know that we will need Charcount+1 trans at most to store the data
1607            (one row per char at worst case) So we preallocate both structures
1608            assuming worst case.
1609
1610            We then construct the trie using only the .next slots of the entry
1611            structs.
1612
1613            We use the .check field of the first entry of the node  temporarily to
1614            make compression both faster and easier by keeping track of how many non
1615            zero fields are in the node.
1616
1617            Since trans are numbered from 1 any 0 pointer in the table is a FAIL
1618            transition.
1619
1620            There are two terms at use here: state as a TRIE_NODEIDX() which is a
1621            number representing the first entry of the node, and state as a
1622            TRIE_NODENUM() which is the trans number. state 1 is TRIE_NODEIDX(1) and
1623            TRIE_NODENUM(1), state 2 is TRIE_NODEIDX(2) and TRIE_NODENUM(3) if there
1624            are 2 entrys per node. eg:
1625
1626              A B       A B
1627           1. 2 4    1. 3 7
1628           2. 0 3    3. 0 5
1629           3. 0 0    5. 0 0
1630           4. 0 0    7. 0 0
1631
1632            The table is internally in the right hand, idx form. However as we also
1633            have to deal with the states array which is indexed by nodenum we have to
1634            use TRIE_NODENUM() to convert.
1635
1636         */
1637         DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log, 
1638             "%*sCompiling trie using table compiler\n",
1639             (int)depth * 2 + 2, ""));
1640
1641         trie->trans = PerlMemShared_calloc( ( TRIE_CHARCOUNT(trie) + 1 )
1642                                             * trie->uniquecharcount + 1,
1643                                             sizeof(reg_trie_trans) );
1644         trie->states = PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
1645                                              sizeof(reg_trie_state) );
1646         next_alloc = trie->uniquecharcount + 1;
1647
1648
1649         for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1650
1651             regnode * const noper   = NEXTOPER( cur );
1652             const U8 *uc     = (U8*)STRING( noper );
1653             const U8 * const e = uc + STR_LEN( noper );
1654
1655             U32 state        = 1;         /* required init */
1656
1657             U16 charid       = 0;         /* sanity init */
1658             U32 accept_state = 0;         /* sanity init */
1659             U8 *scan         = (U8*)NULL; /* sanity init */
1660
1661             STRLEN foldlen   = 0;         /* required init */
1662             U32 wordlen      = 0;         /* required init */
1663             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1664
1665             if ( OP(noper) != NOTHING ) {
1666                 for ( ; uc < e ; uc += len ) {
1667
1668                     TRIE_READ_CHAR;
1669
1670                     if ( uvc < 256 ) {
1671                         charid = trie->charmap[ uvc ];
1672                     } else {
1673                         SV* const * const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
1674                         charid = svpp ? (U16)SvIV(*svpp) : 0;
1675                     }
1676                     if ( charid ) {
1677                         charid--;
1678                         if ( !trie->trans[ state + charid ].next ) {
1679                             trie->trans[ state + charid ].next = next_alloc;
1680                             trie->trans[ state ].check++;
1681                             next_alloc += trie->uniquecharcount;
1682                         }
1683                         state = trie->trans[ state + charid ].next;
1684                     } else {
1685                         Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1686                     }
1687                     /* charid is now 0 if we dont know the char read, or nonzero if we do */
1688                 }
1689             }
1690             accept_state = TRIE_NODENUM( state );
1691             TRIE_HANDLE_WORD(accept_state);
1692
1693         } /* end second pass */
1694
1695         /* and now dump it out before we compress it */
1696         DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_table(trie, widecharmap,
1697                                                           revcharmap,
1698                                                           next_alloc, depth+1));
1699
1700         {
1701         /*
1702            * Inplace compress the table.*
1703
1704            For sparse data sets the table constructed by the trie algorithm will
1705            be mostly 0/FAIL transitions or to put it another way mostly empty.
1706            (Note that leaf nodes will not contain any transitions.)
1707
1708            This algorithm compresses the tables by eliminating most such
1709            transitions, at the cost of a modest bit of extra work during lookup:
1710
1711            - Each states[] entry contains a .base field which indicates the
1712            index in the state[] array wheres its transition data is stored.
1713
1714            - If .base is 0 there are no  valid transitions from that node.
1715
1716            - If .base is nonzero then charid is added to it to find an entry in
1717            the trans array.
1718
1719            -If trans[states[state].base+charid].check!=state then the
1720            transition is taken to be a 0/Fail transition. Thus if there are fail
1721            transitions at the front of the node then the .base offset will point
1722            somewhere inside the previous nodes data (or maybe even into a node
1723            even earlier), but the .check field determines if the transition is
1724            valid.
1725
1726            XXX - wrong maybe?
1727            The following process inplace converts the table to the compressed
1728            table: We first do not compress the root node 1,and mark its all its
1729            .check pointers as 1 and set its .base pointer as 1 as well. This
1730            allows to do a DFA construction from the compressed table later, and
1731            ensures that any .base pointers we calculate later are greater than
1732            0.
1733
1734            - We set 'pos' to indicate the first entry of the second node.
1735
1736            - We then iterate over the columns of the node, finding the first and
1737            last used entry at l and m. We then copy l..m into pos..(pos+m-l),
1738            and set the .check pointers accordingly, and advance pos
1739            appropriately and repreat for the next node. Note that when we copy
1740            the next pointers we have to convert them from the original
1741            NODEIDX form to NODENUM form as the former is not valid post
1742            compression.
1743
1744            - If a node has no transitions used we mark its base as 0 and do not
1745            advance the pos pointer.
1746
1747            - If a node only has one transition we use a second pointer into the
1748            structure to fill in allocated fail transitions from other states.
1749            This pointer is independent of the main pointer and scans forward
1750            looking for null transitions that are allocated to a state. When it
1751            finds one it writes the single transition into the "hole".  If the
1752            pointer doesnt find one the single transition is appended as normal.
1753
1754            - Once compressed we can Renew/realloc the structures to release the
1755            excess space.
1756
1757            See "Table-Compression Methods" in sec 3.9 of the Red Dragon,
1758            specifically Fig 3.47 and the associated pseudocode.
1759
1760            demq
1761         */
1762         const U32 laststate = TRIE_NODENUM( next_alloc );
1763         U32 state, charid;
1764         U32 pos = 0, zp=0;
1765         trie->statecount = laststate;
1766
1767         for ( state = 1 ; state < laststate ; state++ ) {
1768             U8 flag = 0;
1769             const U32 stateidx = TRIE_NODEIDX( state );
1770             const U32 o_used = trie->trans[ stateidx ].check;
1771             U32 used = trie->trans[ stateidx ].check;
1772             trie->trans[ stateidx ].check = 0;
1773
1774             for ( charid = 0 ; used && charid < trie->uniquecharcount ; charid++ ) {
1775                 if ( flag || trie->trans[ stateidx + charid ].next ) {
1776                     if ( trie->trans[ stateidx + charid ].next ) {
1777                         if (o_used == 1) {
1778                             for ( ; zp < pos ; zp++ ) {
1779                                 if ( ! trie->trans[ zp ].next ) {
1780                                     break;
1781                                 }
1782                             }
1783                             trie->states[ state ].trans.base = zp + trie->uniquecharcount - charid ;
1784                             trie->trans[ zp ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1785                             trie->trans[ zp ].check = state;
1786                             if ( ++zp > pos ) pos = zp;
1787                             break;
1788                         }
1789                         used--;
1790                     }
1791                     if ( !flag ) {
1792                         flag = 1;
1793                         trie->states[ state ].trans.base = pos + trie->uniquecharcount - charid ;
1794                     }
1795                     trie->trans[ pos ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1796                     trie->trans[ pos ].check = state;
1797                     pos++;
1798                 }
1799             }
1800         }
1801         trie->lasttrans = pos + 1;
1802         trie->states = PerlMemShared_realloc( trie->states, laststate
1803                                               * sizeof(reg_trie_state) );
1804         DEBUG_TRIE_COMPILE_MORE_r(
1805                 PerlIO_printf( Perl_debug_log,
1806                     "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
1807                     (int)depth * 2 + 2,"",
1808                     (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1 ),
1809                     (IV)next_alloc,
1810                     (IV)pos,
1811                     ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
1812             );
1813
1814         } /* end table compress */
1815     }
1816     DEBUG_TRIE_COMPILE_MORE_r(
1817             PerlIO_printf(Perl_debug_log, "%*sStatecount:%"UVxf" Lasttrans:%"UVxf"\n",
1818                 (int)depth * 2 + 2, "",
1819                 (UV)trie->statecount,
1820                 (UV)trie->lasttrans)
1821     );
1822     /* resize the trans array to remove unused space */
1823     trie->trans = PerlMemShared_realloc( trie->trans, trie->lasttrans
1824                                          * sizeof(reg_trie_trans) );
1825
1826     /* and now dump out the compressed format */
1827     DEBUG_TRIE_COMPILE_r(dump_trie(trie, widecharmap, revcharmap, depth+1));
1828
1829     {   /* Modify the program and insert the new TRIE node*/ 
1830         U8 nodetype =(U8)(flags & 0xFF);
1831         char *str=NULL;
1832         
1833 #ifdef DEBUGGING
1834         regnode *optimize = NULL;
1835         U32 mjd_offset = 0;
1836         U32 mjd_nodelen = 0;
1837 #endif
1838         /*
1839            This means we convert either the first branch or the first Exact,
1840            depending on whether the thing following (in 'last') is a branch
1841            or not and whther first is the startbranch (ie is it a sub part of
1842            the alternation or is it the whole thing.)
1843            Assuming its a sub part we conver the EXACT otherwise we convert
1844            the whole branch sequence, including the first.
1845          */
1846         /* Find the node we are going to overwrite */
1847         if ( first != startbranch || OP( last ) == BRANCH ) {
1848             /* branch sub-chain */
1849             NEXT_OFF( first ) = (U16)(last - first);
1850             DEBUG_r({
1851                 mjd_offset= Node_Offset((convert));
1852                 mjd_nodelen= Node_Length((convert));
1853             });
1854             /* whole branch chain */
1855         } else {
1856             DEBUG_r({
1857                 const  regnode *nop = NEXTOPER( convert );
1858                 mjd_offset= Node_Offset((nop));
1859                 mjd_nodelen= Node_Length((nop));
1860             });
1861         }
1862         
1863         DEBUG_OPTIMISE_r(
1864             PerlIO_printf(Perl_debug_log, "%*sMJD offset:%"UVuf" MJD length:%"UVuf"\n",
1865                 (int)depth * 2 + 2, "",
1866                 (UV)mjd_offset, (UV)mjd_nodelen)
1867         );
1868
1869         /* But first we check to see if there is a common prefix we can 
1870            split out as an EXACT and put in front of the TRIE node.  */
1871         trie->startstate= 1;
1872         if ( trie->bitmap && !widecharmap && !trie->jump  ) {
1873             U32 state;
1874             for ( state = 1 ; state < trie->statecount-1 ; state++ ) {
1875                 U32 ofs = 0;
1876                 I32 idx = -1;
1877                 U32 count = 0;
1878                 const U32 base = trie->states[ state ].trans.base;
1879
1880                 if ( trie->states[state].wordnum )
1881                         count = 1;
1882
1883                 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
1884                     if ( ( base + ofs >= trie->uniquecharcount ) &&
1885                          ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
1886                          trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
1887                     {
1888                         if ( ++count > 1 ) {
1889                             SV **tmp = av_fetch( revcharmap, ofs, 0);
1890                             const U8 *ch = (U8*)SvPV_nolen_const( *tmp );
1891                             if ( state == 1 ) break;
1892                             if ( count == 2 ) {
1893                                 Zero(trie->bitmap, ANYOF_BITMAP_SIZE, char);
1894                                 DEBUG_OPTIMISE_r(
1895                                     PerlIO_printf(Perl_debug_log,
1896                                         "%*sNew Start State=%"UVuf" Class: [",
1897                                         (int)depth * 2 + 2, "",
1898                                         (UV)state));
1899                                 if (idx >= 0) {
1900                                     SV ** const tmp = av_fetch( revcharmap, idx, 0);
1901                                     const U8 * const ch = (U8*)SvPV_nolen_const( *tmp );
1902
1903                                     TRIE_BITMAP_SET(trie,*ch);
1904                                     if ( folder )
1905                                         TRIE_BITMAP_SET(trie, folder[ *ch ]);
1906                                     DEBUG_OPTIMISE_r(
1907                                         PerlIO_printf(Perl_debug_log, (char*)ch)
1908                                     );
1909                                 }
1910                             }
1911                             TRIE_BITMAP_SET(trie,*ch);
1912                             if ( folder )
1913                                 TRIE_BITMAP_SET(trie,folder[ *ch ]);
1914                             DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"%s", ch));
1915                         }
1916                         idx = ofs;
1917                     }
1918                 }
1919                 if ( count == 1 ) {
1920                     SV **tmp = av_fetch( revcharmap, idx, 0);
1921                     char *ch = SvPV_nolen( *tmp );
1922                     DEBUG_OPTIMISE_r({
1923                         SV *sv=sv_newmortal();
1924                         PerlIO_printf( Perl_debug_log,
1925                             "%*sPrefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
1926                             (int)depth * 2 + 2, "",
1927                             (UV)state, (UV)idx, 
1928                             pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6, 
1929                                 PL_colors[0], PL_colors[1],
1930                                 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
1931                                 PERL_PV_ESCAPE_FIRSTCHAR 
1932                             )
1933                         );
1934                     });
1935                     if ( state==1 ) {
1936                         OP( convert ) = nodetype;
1937                         str=STRING(convert);
1938                         STR_LEN(convert)=0;
1939                     }
1940                     while (*ch) {
1941                         *str++ = *ch++;
1942                         STR_LEN(convert)++;
1943                     }
1944                     
1945                 } else {
1946 #ifdef DEBUGGING            
1947                     if (state>1)
1948                         DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"]\n"));
1949 #endif
1950                     break;
1951                 }
1952             }
1953             if (str) {
1954                 regnode *n = convert+NODE_SZ_STR(convert);
1955                 NEXT_OFF(convert) = NODE_SZ_STR(convert);
1956                 trie->startstate = state;
1957                 trie->minlen -= (state - 1);
1958                 trie->maxlen -= (state - 1);
1959                 DEBUG_r({
1960                     regnode *fix = convert;
1961                     U32 word = trie->wordcount;
1962                     mjd_nodelen++;
1963                     Set_Node_Offset_Length(convert, mjd_offset, state - 1);
1964                     while( ++fix < n ) {
1965                         Set_Node_Offset_Length(fix, 0, 0);
1966                     }
1967                     while (word--) {
1968                         SV ** const tmp = av_fetch( trie_words, word, 0 );
1969                         if (tmp) {
1970                             if ( STR_LEN(convert) <= SvCUR(*tmp) )
1971                                 sv_chop(*tmp, SvPV_nolen(*tmp) + STR_LEN(convert));
1972                             else
1973                                 sv_chop(*tmp, SvPV_nolen(*tmp) + SvCUR(*tmp));
1974                         }
1975                     }    
1976                 });
1977                 if (trie->maxlen) {
1978                     convert = n;
1979                 } else {
1980                     NEXT_OFF(convert) = (U16)(tail - convert);
1981                     DEBUG_r(optimize= n);
1982                 }
1983             }
1984         }
1985         if (!jumper) 
1986             jumper = last; 
1987         if ( trie->maxlen ) {
1988             NEXT_OFF( convert ) = (U16)(tail - convert);
1989             ARG_SET( convert, data_slot );
1990             /* Store the offset to the first unabsorbed branch in 
1991                jump[0], which is otherwise unused by the jump logic. 
1992                We use this when dumping a trie and during optimisation. */
1993             if (trie->jump) 
1994                 trie->jump[0] = (U16)(nextbranch - convert);
1995             
1996             /* XXXX */
1997             if ( !trie->states[trie->startstate].wordnum && trie->bitmap && 
1998                  ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) )
1999             {
2000                 OP( convert ) = TRIEC;
2001                 Copy(trie->bitmap, ((struct regnode_charclass *)convert)->bitmap, ANYOF_BITMAP_SIZE, char);
2002                 PerlMemShared_free(trie->bitmap);
2003                 trie->bitmap= NULL;
2004             } else 
2005                 OP( convert ) = TRIE;
2006
2007             /* store the type in the flags */
2008             convert->flags = nodetype;
2009             DEBUG_r({
2010             optimize = convert 
2011                       + NODE_STEP_REGNODE 
2012                       + regarglen[ OP( convert ) ];
2013             });
2014             /* XXX We really should free up the resource in trie now, 
2015                    as we won't use them - (which resources?) dmq */
2016         }
2017         /* needed for dumping*/
2018         DEBUG_r(if (optimize) {
2019             regnode *opt = convert;
2020             while ( ++opt < optimize) {
2021                 Set_Node_Offset_Length(opt,0,0);
2022             }
2023             /* 
2024                 Try to clean up some of the debris left after the 
2025                 optimisation.
2026              */
2027             while( optimize < jumper ) {
2028                 mjd_nodelen += Node_Length((optimize));
2029                 OP( optimize ) = OPTIMIZED;
2030                 Set_Node_Offset_Length(optimize,0,0);
2031                 optimize++;
2032             }
2033             Set_Node_Offset_Length(convert,mjd_offset,mjd_nodelen);
2034         });
2035     } /* end node insert */
2036     RExC_rxi->data->data[ data_slot + 1 ] = (void*)widecharmap;
2037 #ifdef DEBUGGING
2038     RExC_rxi->data->data[ data_slot + TRIE_WORDS_OFFSET ] = (void*)trie_words;
2039     RExC_rxi->data->data[ data_slot + 3 ] = (void*)revcharmap;
2040 #else
2041     SvREFCNT_dec(revcharmap);
2042 #endif
2043     return trie->jump 
2044            ? MADE_JUMP_TRIE 
2045            : trie->startstate>1 
2046              ? MADE_EXACT_TRIE 
2047              : MADE_TRIE;
2048 }
2049
2050 STATIC void
2051 S_make_trie_failtable(pTHX_ RExC_state_t *pRExC_state, regnode *source,  regnode *stclass, U32 depth)
2052 {
2053 /* The Trie is constructed and compressed now so we can build a fail array now if its needed
2054
2055    This is basically the Aho-Corasick algorithm. Its from exercise 3.31 and 3.32 in the
2056    "Red Dragon" -- Compilers, principles, techniques, and tools. Aho, Sethi, Ullman 1985/88
2057    ISBN 0-201-10088-6
2058
2059    We find the fail state for each state in the trie, this state is the longest proper
2060    suffix of the current states 'word' that is also a proper prefix of another word in our
2061    trie. State 1 represents the word '' and is the thus the default fail state. This allows
2062    the DFA not to have to restart after its tried and failed a word at a given point, it
2063    simply continues as though it had been matching the other word in the first place.
2064    Consider
2065       'abcdgu'=~/abcdefg|cdgu/
2066    When we get to 'd' we are still matching the first word, we would encounter 'g' which would
2067    fail, which would bring use to the state representing 'd' in the second word where we would
2068    try 'g' and succeed, prodceding to match 'cdgu'.
2069  */
2070  /* add a fail transition */
2071     const U32 trie_offset = ARG(source);
2072     reg_trie_data *trie=(reg_trie_data *)RExC_rxi->data->data[trie_offset];
2073     U32 *q;
2074     const U32 ucharcount = trie->uniquecharcount;
2075     const U32 numstates = trie->statecount;
2076     const U32 ubound = trie->lasttrans + ucharcount;
2077     U32 q_read = 0;
2078     U32 q_write = 0;
2079     U32 charid;
2080     U32 base = trie->states[ 1 ].trans.base;
2081     U32 *fail;
2082     reg_ac_data *aho;
2083     const U32 data_slot = add_data( pRExC_state, 1, "T" );
2084     GET_RE_DEBUG_FLAGS_DECL;
2085 #ifndef DEBUGGING
2086     PERL_UNUSED_ARG(depth);
2087 #endif
2088
2089
2090     ARG_SET( stclass, data_slot );
2091     aho = PerlMemShared_calloc( 1, sizeof(reg_ac_data) );
2092     RExC_rxi->data->data[ data_slot ] = (void*)aho;
2093     aho->trie=trie_offset;
2094     aho->states=(reg_trie_state *)PerlMemShared_malloc( numstates * sizeof(reg_trie_state) );
2095     Copy( trie->states, aho->states, numstates, reg_trie_state );
2096     Newxz( q, numstates, U32);
2097     aho->fail = PerlMemShared_calloc( numstates, sizeof(U32) );
2098     aho->refcount = 1;
2099     fail = aho->fail;
2100     /* initialize fail[0..1] to be 1 so that we always have
2101        a valid final fail state */
2102     fail[ 0 ] = fail[ 1 ] = 1;
2103
2104     for ( charid = 0; charid < ucharcount ; charid++ ) {
2105         const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 );
2106         if ( newstate ) {
2107             q[ q_write ] = newstate;
2108             /* set to point at the root */
2109             fail[ q[ q_write++ ] ]=1;
2110         }
2111     }
2112     while ( q_read < q_write) {
2113         const U32 cur = q[ q_read++ % numstates ];
2114         base = trie->states[ cur ].trans.base;
2115
2116         for ( charid = 0 ; charid < ucharcount ; charid++ ) {
2117             const U32 ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 );
2118             if (ch_state) {
2119                 U32 fail_state = cur;
2120                 U32 fail_base;
2121                 do {
2122                     fail_state = fail[ fail_state ];
2123                     fail_base = aho->states[ fail_state ].trans.base;
2124                 } while ( !TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 ) );
2125
2126                 fail_state = TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 );
2127                 fail[ ch_state ] = fail_state;
2128                 if ( !aho->states[ ch_state ].wordnum && aho->states[ fail_state ].wordnum )
2129                 {
2130                         aho->states[ ch_state ].wordnum =  aho->states[ fail_state ].wordnum;
2131                 }
2132                 q[ q_write++ % numstates] = ch_state;
2133             }
2134         }
2135     }
2136     /* restore fail[0..1] to 0 so that we "fall out" of the AC loop
2137        when we fail in state 1, this allows us to use the
2138        charclass scan to find a valid start char. This is based on the principle
2139        that theres a good chance the string being searched contains lots of stuff
2140        that cant be a start char.
2141      */
2142     fail[ 0 ] = fail[ 1 ] = 0;
2143     DEBUG_TRIE_COMPILE_r({
2144         PerlIO_printf(Perl_debug_log,
2145                       "%*sStclass Failtable (%"UVuf" states): 0", 
2146                       (int)(depth * 2), "", (UV)numstates
2147         );
2148         for( q_read=1; q_read<numstates; q_read++ ) {
2149             PerlIO_printf(Perl_debug_log, ", %"UVuf, (UV)fail[q_read]);
2150         }
2151         PerlIO_printf(Perl_debug_log, "\n");
2152     });
2153     Safefree(q);
2154     /*RExC_seen |= REG_SEEN_TRIEDFA;*/
2155 }
2156
2157
2158 /*
2159  * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2.
2160  * These need to be revisited when a newer toolchain becomes available.
2161  */
2162 #if defined(__sparc64__) && defined(__GNUC__)
2163 #   if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
2164 #       undef  SPARC64_GCC_WORKAROUND
2165 #       define SPARC64_GCC_WORKAROUND 1
2166 #   endif
2167 #endif
2168
2169 #define DEBUG_PEEP(str,scan,depth) \
2170     DEBUG_OPTIMISE_r({if (scan){ \
2171        SV * const mysv=sv_newmortal(); \
2172        regnode *Next = regnext(scan); \
2173        regprop(RExC_rx, mysv, scan); \
2174        PerlIO_printf(Perl_debug_log, "%*s" str ">%3d: %s (%d)\n", \
2175        (int)depth*2, "", REG_NODE_NUM(scan), SvPV_nolen_const(mysv),\
2176        Next ? (REG_NODE_NUM(Next)) : 0 ); \
2177    }});
2178
2179
2180
2181
2182
2183 #define JOIN_EXACT(scan,min,flags) \
2184     if (PL_regkind[OP(scan)] == EXACT) \
2185         join_exact(pRExC_state,(scan),(min),(flags),NULL,depth+1)
2186
2187 STATIC U32
2188 S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, I32 *min, U32 flags,regnode *val, U32 depth) {
2189     /* Merge several consecutive EXACTish nodes into one. */
2190     regnode *n = regnext(scan);
2191     U32 stringok = 1;
2192     regnode *next = scan + NODE_SZ_STR(scan);
2193     U32 merged = 0;
2194     U32 stopnow = 0;
2195 #ifdef DEBUGGING
2196     regnode *stop = scan;
2197     GET_RE_DEBUG_FLAGS_DECL;
2198 #else
2199     PERL_UNUSED_ARG(depth);
2200 #endif
2201 #ifndef EXPERIMENTAL_INPLACESCAN
2202     PERL_UNUSED_ARG(flags);
2203     PERL_UNUSED_ARG(val);
2204 #endif
2205     DEBUG_PEEP("join",scan,depth);
2206     
2207     /* Skip NOTHING, merge EXACT*. */
2208     while (n &&
2209            ( PL_regkind[OP(n)] == NOTHING ||
2210              (stringok && (OP(n) == OP(scan))))
2211            && NEXT_OFF(n)
2212            && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
2213         
2214         if (OP(n) == TAIL || n > next)
2215             stringok = 0;
2216         if (PL_regkind[OP(n)] == NOTHING) {
2217             DEBUG_PEEP("skip:",n,depth);
2218             NEXT_OFF(scan) += NEXT_OFF(n);
2219             next = n + NODE_STEP_REGNODE;
2220 #ifdef DEBUGGING
2221             if (stringok)
2222                 stop = n;
2223 #endif
2224             n = regnext(n);
2225         }
2226         else if (stringok) {
2227             const unsigned int oldl = STR_LEN(scan);
2228             regnode * const nnext = regnext(n);
2229             
2230             DEBUG_PEEP("merg",n,depth);
2231             
2232             merged++;
2233             if (oldl + STR_LEN(n) > U8_MAX)
2234                 break;
2235             NEXT_OFF(scan) += NEXT_OFF(n);
2236             STR_LEN(scan) += STR_LEN(n);
2237             next = n + NODE_SZ_STR(n);
2238             /* Now we can overwrite *n : */
2239             Move(STRING(n), STRING(scan) + oldl, STR_LEN(n), char);
2240 #ifdef DEBUGGING
2241             stop = next - 1;
2242 #endif
2243             n = nnext;
2244             if (stopnow) break;
2245         }
2246
2247 #ifdef EXPERIMENTAL_INPLACESCAN
2248         if (flags && !NEXT_OFF(n)) {
2249             DEBUG_PEEP("atch", val, depth);
2250             if (reg_off_by_arg[OP(n)]) {
2251                 ARG_SET(n, val - n);
2252             }
2253             else {
2254                 NEXT_OFF(n) = val - n;
2255             }
2256             stopnow = 1;
2257         }
2258 #endif
2259     }
2260     
2261     if (UTF && ( OP(scan) == EXACTF ) && ( STR_LEN(scan) >= 6 ) ) {
2262     /*
2263     Two problematic code points in Unicode casefolding of EXACT nodes:
2264     
2265     U+0390 - GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
2266     U+03B0 - GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
2267     
2268     which casefold to
2269     
2270     Unicode                      UTF-8
2271     
2272     U+03B9 U+0308 U+0301         0xCE 0xB9 0xCC 0x88 0xCC 0x81
2273     U+03C5 U+0308 U+0301         0xCF 0x85 0xCC 0x88 0xCC 0x81
2274     
2275     This means that in case-insensitive matching (or "loose matching",
2276     as Unicode calls it), an EXACTF of length six (the UTF-8 encoded byte
2277     length of the above casefolded versions) can match a target string
2278     of length two (the byte length of UTF-8 encoded U+0390 or U+03B0).
2279     This would rather mess up the minimum length computation.
2280     
2281     What we'll do is to look for the tail four bytes, and then peek
2282     at the preceding two bytes to see whether we need to decrease
2283     the minimum length by four (six minus two).
2284     
2285     Thanks to the design of UTF-8, there cannot be false matches:
2286     A sequence of valid UTF-8 bytes cannot be a subsequence of
2287     another valid sequence of UTF-8 bytes.
2288     
2289     */
2290          char * const s0 = STRING(scan), *s, *t;
2291          char * const s1 = s0 + STR_LEN(scan) - 1;
2292          char * const s2 = s1 - 4;
2293 #ifdef EBCDIC /* RD tunifold greek 0390 and 03B0 */
2294          const char t0[] = "\xaf\x49\xaf\x42";
2295 #else
2296          const char t0[] = "\xcc\x88\xcc\x81";
2297 #endif
2298          const char * const t1 = t0 + 3;
2299     
2300          for (s = s0 + 2;
2301               s < s2 && (t = ninstr(s, s1, t0, t1));
2302               s = t + 4) {
2303 #ifdef EBCDIC
2304               if (((U8)t[-1] == 0x68 && (U8)t[-2] == 0xB4) ||
2305                   ((U8)t[-1] == 0x46 && (U8)t[-2] == 0xB5))
2306 #else
2307               if (((U8)t[-1] == 0xB9 && (U8)t[-2] == 0xCE) ||
2308                   ((U8)t[-1] == 0x85 && (U8)t[-2] == 0xCF))
2309 #endif
2310                    *min -= 4;
2311          }
2312     }
2313     
2314 #ifdef DEBUGGING
2315     /* Allow dumping */
2316     n = scan + NODE_SZ_STR(scan);
2317     while (n <= stop) {
2318         if (PL_regkind[OP(n)] != NOTHING || OP(n) == NOTHING) {
2319             OP(n) = OPTIMIZED;
2320             NEXT_OFF(n) = 0;
2321         }
2322         n++;
2323     }
2324 #endif
2325     DEBUG_OPTIMISE_r(if (merged){DEBUG_PEEP("finl",scan,depth)});
2326     return stopnow;
2327 }
2328
2329 /* REx optimizer.  Converts nodes into quickier variants "in place".
2330    Finds fixed substrings.  */
2331
2332 /* Stops at toplevel WHILEM as well as at "last". At end *scanp is set
2333    to the position after last scanned or to NULL. */
2334
2335 #define INIT_AND_WITHP \
2336     assert(!and_withp); \
2337     Newx(and_withp,1,struct regnode_charclass_class); \
2338     SAVEFREEPV(and_withp)
2339
2340 /* this is a chain of data about sub patterns we are processing that
2341    need to be handled seperately/specially in study_chunk. Its so
2342    we can simulate recursion without losing state.  */
2343 struct scan_frame;
2344 typedef struct scan_frame {
2345     regnode *last;  /* last node to process in this frame */
2346     regnode *next;  /* next node to process when last is reached */
2347     struct scan_frame *prev; /*previous frame*/
2348     I32 stop; /* what stopparen do we use */
2349 } scan_frame;
2350
2351
2352 #define SCAN_COMMIT(s, data, m) scan_commit(s, data, m, is_inf)
2353
2354 STATIC I32
2355 S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
2356                         I32 *minlenp, I32 *deltap,
2357                         regnode *last,
2358                         scan_data_t *data,
2359                         I32 stopparen,
2360                         U8* recursed,
2361                         struct regnode_charclass_class *and_withp,
2362                         U32 flags, U32 depth)
2363                         /* scanp: Start here (read-write). */
2364                         /* deltap: Write maxlen-minlen here. */
2365                         /* last: Stop before this one. */
2366                         /* data: string data about the pattern */
2367                         /* stopparen: treat close N as END */
2368                         /* recursed: which subroutines have we recursed into */
2369                         /* and_withp: Valid if flags & SCF_DO_STCLASS_OR */
2370 {
2371     dVAR;
2372     I32 min = 0, pars = 0, code;
2373     regnode *scan = *scanp, *next;
2374     I32 delta = 0;
2375     int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
2376     int is_inf_internal = 0;            /* The studied chunk is infinite */
2377     I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
2378     scan_data_t data_fake;
2379     SV *re_trie_maxbuff = NULL;
2380     regnode *first_non_open = scan;
2381     I32 stopmin = I32_MAX;
2382     scan_frame *frame = NULL;
2383
2384     GET_RE_DEBUG_FLAGS_DECL;
2385
2386 #ifdef DEBUGGING
2387     StructCopy(&zero_scan_data, &data_fake, scan_data_t);
2388 #endif
2389
2390     if ( depth == 0 ) {
2391         while (first_non_open && OP(first_non_open) == OPEN)
2392             first_non_open=regnext(first_non_open);
2393     }
2394
2395
2396   fake_study_recurse:
2397     while ( scan && OP(scan) != END && scan < last ){
2398         /* Peephole optimizer: */
2399         DEBUG_STUDYDATA("Peep:", data,depth);
2400         DEBUG_PEEP("Peep",scan,depth);
2401         JOIN_EXACT(scan,&min,0);
2402
2403         /* Follow the next-chain of the current node and optimize
2404            away all the NOTHINGs from it.  */
2405         if (OP(scan) != CURLYX) {
2406             const int max = (reg_off_by_arg[OP(scan)]
2407                        ? I32_MAX
2408                        /* I32 may be smaller than U16 on CRAYs! */
2409                        : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
2410             int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
2411             int noff;
2412             regnode *n = scan;
2413         
2414             /* Skip NOTHING and LONGJMP. */
2415             while ((n = regnext(n))
2416                    && ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
2417                        || ((OP(n) == LONGJMP) && (noff = ARG(n))))
2418                    && off + noff < max)
2419                 off += noff;
2420             if (reg_off_by_arg[OP(scan)])
2421                 ARG(scan) = off;
2422             else
2423                 NEXT_OFF(scan) = off;
2424         }
2425
2426
2427
2428         /* The principal pseudo-switch.  Cannot be a switch, since we
2429            look into several different things.  */
2430         if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
2431                    || OP(scan) == IFTHEN) {
2432             next = regnext(scan);
2433             code = OP(scan);
2434             /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
2435         
2436             if (OP(next) == code || code == IFTHEN) {
2437                 /* NOTE - There is similar code to this block below for handling
2438                    TRIE nodes on a re-study.  If you change stuff here check there
2439                    too. */
2440                 I32 max1 = 0, min1 = I32_MAX, num = 0;
2441                 struct regnode_charclass_class accum;
2442                 regnode * const startbranch=scan;
2443                 
2444                 if (flags & SCF_DO_SUBSTR)
2445                     SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot merge strings after this. */
2446                 if (flags & SCF_DO_STCLASS)
2447                     cl_init_zero(pRExC_state, &accum);
2448
2449                 while (OP(scan) == code) {
2450                     I32 deltanext, minnext, f = 0, fake;
2451                     struct regnode_charclass_class this_class;
2452
2453                     num++;
2454                     data_fake.flags = 0;
2455                     if (data) {
2456                         data_fake.whilem_c = data->whilem_c;
2457                         data_fake.last_closep = data->last_closep;
2458                     }
2459                     else
2460                         data_fake.last_closep = &fake;
2461
2462                     data_fake.pos_delta = delta;
2463                     next = regnext(scan);
2464                     scan = NEXTOPER(scan);
2465                     if (code != BRANCH)
2466                         scan = NEXTOPER(scan);
2467                     if (flags & SCF_DO_STCLASS) {
2468                         cl_init(pRExC_state, &this_class);
2469                         data_fake.start_class = &this_class;
2470                         f = SCF_DO_STCLASS_AND;
2471                     }
2472                     if (flags & SCF_WHILEM_VISITED_POS)
2473                         f |= SCF_WHILEM_VISITED_POS;
2474
2475                     /* we suppose the run is continuous, last=next...*/
2476                     minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
2477                                           next, &data_fake,
2478                                           stopparen, recursed, NULL, f,depth+1);
2479                     if (min1 > minnext)
2480                         min1 = minnext;
2481                     if (max1 < minnext + deltanext)
2482                         max1 = minnext + deltanext;
2483                     if (deltanext == I32_MAX)
2484                         is_inf = is_inf_internal = 1;
2485                     scan = next;
2486                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
2487                         pars++;
2488                     if (data_fake.flags & SCF_SEEN_ACCEPT) {
2489                         if ( stopmin > minnext) 
2490                             stopmin = min + min1;
2491                         flags &= ~SCF_DO_SUBSTR;
2492                         if (data)
2493                             data->flags |= SCF_SEEN_ACCEPT;
2494                     }
2495                     if (data) {
2496                         if (data_fake.flags & SF_HAS_EVAL)
2497                             data->flags |= SF_HAS_EVAL;
2498                         data->whilem_c = data_fake.whilem_c;
2499                     }
2500                     if (flags & SCF_DO_STCLASS)
2501                         cl_or(pRExC_state, &accum, &this_class);
2502                 }
2503                 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
2504                     min1 = 0;
2505                 if (flags & SCF_DO_SUBSTR) {
2506                     data->pos_min += min1;
2507                     data->pos_delta += max1 - min1;
2508                     if (max1 != min1 || is_inf)
2509                         data->longest = &(data->longest_float);
2510                 }
2511                 min += min1;
2512                 delta += max1 - min1;
2513                 if (flags & SCF_DO_STCLASS_OR) {
2514                     cl_or(pRExC_state, data->start_class, &accum);
2515                     if (min1) {
2516                         cl_and(data->start_class, and_withp);
2517                         flags &= ~SCF_DO_STCLASS;
2518                     }
2519                 }
2520                 else if (flags & SCF_DO_STCLASS_AND) {
2521                     if (min1) {
2522                         cl_and(data->start_class, &accum);
2523                         flags &= ~SCF_DO_STCLASS;
2524                     }
2525                     else {
2526                         /* Switch to OR mode: cache the old value of
2527                          * data->start_class */
2528                         INIT_AND_WITHP;
2529                         StructCopy(data->start_class, and_withp,
2530                                    struct regnode_charclass_class);
2531                         flags &= ~SCF_DO_STCLASS_AND;
2532                         StructCopy(&accum, data->start_class,
2533                                    struct regnode_charclass_class);
2534                         flags |= SCF_DO_STCLASS_OR;
2535                         data->start_class->flags |= ANYOF_EOS;
2536                     }
2537                 }
2538
2539                 if (PERL_ENABLE_TRIE_OPTIMISATION && OP( startbranch ) == BRANCH ) {
2540                 /* demq.
2541
2542                    Assuming this was/is a branch we are dealing with: 'scan' now
2543                    points at the item that follows the branch sequence, whatever
2544                    it is. We now start at the beginning of the sequence and look
2545                    for subsequences of
2546
2547                    BRANCH->EXACT=>x1
2548                    BRANCH->EXACT=>x2
2549                    tail
2550
2551                    which would be constructed from a pattern like /A|LIST|OF|WORDS/
2552
2553                    If we can find such a subseqence we need to turn the first
2554                    element into a trie and then add the subsequent branch exact
2555                    strings to the trie.
2556
2557                    We have two cases
2558
2559                      1. patterns where the whole set of branch can be converted. 
2560
2561                      2. patterns where only a subset can be converted.
2562
2563                    In case 1 we can replace the whole set with a single regop
2564                    for the trie. In case 2 we need to keep the start and end
2565                    branchs so
2566
2567                      'BRANCH EXACT; BRANCH EXACT; BRANCH X'
2568                      becomes BRANCH TRIE; BRANCH X;
2569
2570                   There is an additional case, that being where there is a 
2571                   common prefix, which gets split out into an EXACT like node
2572                   preceding the TRIE node.
2573
2574                   If x(1..n)==tail then we can do a simple trie, if not we make
2575                   a "jump" trie, such that when we match the appropriate word
2576                   we "jump" to the appopriate tail node. Essentailly we turn
2577                   a nested if into a case structure of sorts.
2578
2579                 */
2580                 
2581                     int made=0;
2582                     if (!re_trie_maxbuff) {
2583                         re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
2584                         if (!SvIOK(re_trie_maxbuff))
2585                             sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
2586                     }
2587                     if ( SvIV(re_trie_maxbuff)>=0  ) {
2588                         regnode *cur;
2589                         regnode *first = (regnode *)NULL;
2590                         regnode *last = (regnode *)NULL;
2591                         regnode *tail = scan;
2592                         U8 optype = 0;
2593                         U32 count=0;
2594
2595 #ifdef DEBUGGING
2596                         SV * const mysv = sv_newmortal();       /* for dumping */
2597 #endif
2598                         /* var tail is used because there may be a TAIL
2599                            regop in the way. Ie, the exacts will point to the
2600                            thing following the TAIL, but the last branch will
2601                            point at the TAIL. So we advance tail. If we
2602                            have nested (?:) we may have to move through several
2603                            tails.
2604                          */
2605
2606                         while ( OP( tail ) == TAIL ) {
2607                             /* this is the TAIL generated by (?:) */
2608                             tail = regnext( tail );
2609                         }
2610
2611                         
2612                         DEBUG_OPTIMISE_r({
2613                             regprop(RExC_rx, mysv, tail );
2614                             PerlIO_printf( Perl_debug_log, "%*s%s%s\n",
2615                                 (int)depth * 2 + 2, "", 
2616                                 "Looking for TRIE'able sequences. Tail node is: ", 
2617                                 SvPV_nolen_const( mysv )
2618                             );
2619                         });
2620                         
2621                         /*
2622
2623                            step through the branches, cur represents each
2624                            branch, noper is the first thing to be matched
2625                            as part of that branch and noper_next is the
2626                            regnext() of that node. if noper is an EXACT
2627                            and noper_next is the same as scan (our current
2628                            position in the regex) then the EXACT branch is
2629                            a possible optimization target. Once we have
2630                            two or more consequetive such branches we can
2631                            create a trie of the EXACT's contents and stich
2632                            it in place. If the sequence represents all of
2633                            the branches we eliminate the whole thing and
2634                            replace it with a single TRIE. If it is a
2635                            subsequence then we need to stitch it in. This
2636                            means the first branch has to remain, and needs
2637                            to be repointed at the item on the branch chain
2638                            following the last branch optimized. This could
2639                            be either a BRANCH, in which case the
2640                            subsequence is internal, or it could be the
2641                            item following the branch sequence in which
2642                            case the subsequence is at the end.
2643
2644                         */
2645
2646                         /* dont use tail as the end marker for this traverse */
2647                         for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) {
2648                             regnode * const noper = NEXTOPER( cur );
2649 #if defined(DEBUGGING) || defined(NOJUMPTRIE)
2650                             regnode * const noper_next = regnext( noper );
2651 #endif
2652
2653                             DEBUG_OPTIMISE_r({
2654                                 regprop(RExC_rx, mysv, cur);
2655                                 PerlIO_printf( Perl_debug_log, "%*s- %s (%d)",
2656                                    (int)depth * 2 + 2,"", SvPV_nolen_const( mysv ), REG_NODE_NUM(cur) );
2657
2658                                 regprop(RExC_rx, mysv, noper);
2659                                 PerlIO_printf( Perl_debug_log, " -> %s",
2660                                     SvPV_nolen_const(mysv));
2661
2662                                 if ( noper_next ) {
2663                                   regprop(RExC_rx, mysv, noper_next );
2664                                   PerlIO_printf( Perl_debug_log,"\t=> %s\t",
2665                                     SvPV_nolen_const(mysv));
2666                                 }
2667                                 PerlIO_printf( Perl_debug_log, "(First==%d,Last==%d,Cur==%d)\n",
2668                                    REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur) );
2669                             });
2670                             if ( (((first && optype!=NOTHING) ? OP( noper ) == optype
2671                                          : PL_regkind[ OP( noper ) ] == EXACT )
2672                                   || OP(noper) == NOTHING )
2673 #ifdef NOJUMPTRIE
2674                                   && noper_next == tail
2675 #endif
2676                                   && count < U16_MAX)
2677                             {
2678                                 count++;
2679                                 if ( !first || optype == NOTHING ) {
2680                                     if (!first) first = cur;
2681                                     optype = OP( noper );
2682                                 } else {
2683                                     last = cur;
2684                                 }
2685                             } else {
2686                                 if ( last ) {
2687                                     make_trie( pRExC_state, 
2688                                             startbranch, first, cur, tail, count, 
2689                                             optype, depth+1 );
2690                                 }
2691                                 if ( PL_regkind[ OP( noper ) ] == EXACT
2692 #ifdef NOJUMPTRIE
2693                                      && noper_next == tail
2694 #endif
2695                                 ){
2696                                     count = 1;
2697                                     first = cur;
2698                                     optype = OP( noper );
2699                                 } else {
2700                                     count = 0;
2701                                     first = NULL;
2702                                     optype = 0;
2703                                 }
2704                                 last = NULL;
2705                             }
2706                         }
2707                         DEBUG_OPTIMISE_r({
2708                             regprop(RExC_rx, mysv, cur);
2709                             PerlIO_printf( Perl_debug_log,
2710                               "%*s- %s (%d) <SCAN FINISHED>\n", (int)depth * 2 + 2,
2711                               "", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
2712
2713                         });
2714                         if ( last ) {
2715                             made= make_trie( pRExC_state, startbranch, first, scan, tail, count, optype, depth+1 );
2716 #ifdef TRIE_STUDY_OPT   
2717                             if ( ((made == MADE_EXACT_TRIE && 
2718                                  startbranch == first) 
2719                                  || ( first_non_open == first )) && 
2720                                  depth==0 ) {
2721                                 flags |= SCF_TRIE_RESTUDY;
2722                                 if ( startbranch == first 
2723                                      && scan == tail ) 
2724                                 {
2725                                     RExC_seen &=~REG_TOP_LEVEL_BRANCHES;
2726                                 }
2727                             }
2728 #endif
2729                         }
2730                     }
2731                     
2732                 } /* do trie */
2733                 
2734             }
2735             else if ( code == BRANCHJ ) {  /* single branch is optimized. */
2736                 scan = NEXTOPER(NEXTOPER(scan));
2737             } else                      /* single branch is optimized. */
2738                 scan = NEXTOPER(scan);
2739             continue;
2740         } else if (OP(scan) == SUSPEND || OP(scan) == GOSUB || OP(scan) == GOSTART) {
2741             scan_frame *newframe = NULL;
2742             I32 paren;
2743             regnode *start;
2744             regnode *end;
2745
2746             if (OP(scan) != SUSPEND) {
2747             /* set the pointer */
2748                 if (OP(scan) == GOSUB) {
2749                     paren = ARG(scan);
2750                     RExC_recurse[ARG2L(scan)] = scan;
2751                     start = RExC_open_parens[paren-1];
2752                     end   = RExC_close_parens[paren-1];
2753                 } else {
2754                     paren = 0;
2755                     start = RExC_rxi->program + 1;
2756                     end   = RExC_opend;
2757                 }
2758                 if (!recursed) {
2759                     Newxz(recursed, (((RExC_npar)>>3) +1), U8);
2760                     SAVEFREEPV(recursed);
2761                 }
2762                 if (!PAREN_TEST(recursed,paren+1)) {
2763                     PAREN_SET(recursed,paren+1);
2764                     Newx(newframe,1,scan_frame);
2765                 } else {
2766                     if (flags & SCF_DO_SUBSTR) {
2767                         SCAN_COMMIT(pRExC_state,data,minlenp);
2768                         data->longest = &(data->longest_float);
2769                     }
2770                     is_inf = is_inf_internal = 1;
2771                     if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
2772                         cl_anything(pRExC_state, data->start_class);
2773                     flags &= ~SCF_DO_STCLASS;
2774                 }
2775             } else {
2776                 Newx(newframe,1,scan_frame);
2777                 paren = stopparen;
2778                 start = scan+2;
2779                 end = regnext(scan);
2780             }
2781             if (newframe) {
2782                 assert(start);
2783                 assert(end);
2784                 SAVEFREEPV(newframe);
2785                 newframe->next = regnext(scan);
2786                 newframe->last = last;
2787                 newframe->stop = stopparen;
2788                 newframe->prev = frame;
2789
2790                 frame = newframe;
2791                 scan =  start;
2792                 stopparen = paren;
2793                 last = end;
2794
2795                 continue;
2796             }
2797         }
2798         else if (OP(scan) == EXACT) {
2799             I32 l = STR_LEN(scan);
2800             UV uc;
2801             if (UTF) {
2802                 const U8 * const s = (U8*)STRING(scan);
2803                 l = utf8_length(s, s + l);
2804                 uc = utf8_to_uvchr(s, NULL);
2805             } else {
2806                 uc = *((U8*)STRING(scan));
2807             }
2808             min += l;
2809             if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
2810                 /* The code below prefers earlier match for fixed
2811                    offset, later match for variable offset.  */
2812                 if (data->last_end == -1) { /* Update the start info. */
2813                     data->last_start_min = data->pos_min;
2814                     data->last_start_max = is_inf
2815                         ? I32_MAX : data->pos_min + data->pos_delta;
2816                 }
2817                 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
2818                 if (UTF)
2819                     SvUTF8_on(data->last_found);
2820                 {
2821                     SV * const sv = data->last_found;
2822                     MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
2823                         mg_find(sv, PERL_MAGIC_utf8) : NULL;
2824                     if (mg && mg->mg_len >= 0)
2825                         mg->mg_len += utf8_length((U8*)STRING(scan),
2826                                                   (U8*)STRING(scan)+STR_LEN(scan));
2827                 }
2828                 data->last_end = data->pos_min + l;
2829                 data->pos_min += l; /* As in the first entry. */
2830                 data->flags &= ~SF_BEFORE_EOL;
2831             }
2832             if (flags & SCF_DO_STCLASS_AND) {
2833                 /* Check whether it is compatible with what we know already! */
2834                 int compat = 1;
2835
2836                 if (uc >= 0x100 ||
2837                     (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
2838                     && !ANYOF_BITMAP_TEST(data->start_class, uc)
2839                     && (!(data->start_class->flags & ANYOF_FOLD)
2840                         || !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
2841                     )
2842                     compat = 0;
2843                 ANYOF_CLASS_ZERO(data->start_class);
2844                 ANYOF_BITMAP_ZERO(data->start_class);
2845                 if (compat)
2846                     ANYOF_BITMAP_SET(data->start_class, uc);
2847                 data->start_class->flags &= ~ANYOF_EOS;
2848                 if (uc < 0x100)
2849                   data->start_class->flags &= ~ANYOF_UNICODE_ALL;
2850             }
2851             else if (flags & SCF_DO_STCLASS_OR) {
2852                 /* false positive possible if the class is case-folded */
2853                 if (uc < 0x100)
2854                     ANYOF_BITMAP_SET(data->start_class, uc);
2855                 else
2856                     data->start_class->flags |= ANYOF_UNICODE_ALL;
2857                 data->start_class->flags &= ~ANYOF_EOS;
2858                 cl_and(data->start_class, and_withp);
2859             }
2860             flags &= ~SCF_DO_STCLASS;
2861         }
2862         else if (PL_regkind[OP(scan)] == EXACT) { /* But OP != EXACT! */
2863             I32 l = STR_LEN(scan);
2864             UV uc = *((U8*)STRING(scan));
2865
2866             /* Search for fixed substrings supports EXACT only. */
2867             if (flags & SCF_DO_SUBSTR) {
2868                 assert(data);
2869                 SCAN_COMMIT(pRExC_state, data, minlenp);
2870             }
2871             if (UTF) {
2872                 const U8 * const s = (U8 *)STRING(scan);
2873                 l = utf8_length(s, s + l);
2874                 uc = utf8_to_uvchr(s, NULL);
2875             }
2876             min += l;
2877             if (flags & SCF_DO_SUBSTR)
2878                 data->pos_min += l;
2879             if (flags & SCF_DO_STCLASS_AND) {
2880                 /* Check whether it is compatible with what we know already! */
2881                 int compat = 1;
2882
2883                 if (uc >= 0x100 ||
2884                     (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
2885                     && !ANYOF_BITMAP_TEST(data->start_class, uc)
2886                      && !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
2887                     compat = 0;
2888                 ANYOF_CLASS_ZERO(data->start_class);
2889                 ANYOF_BITMAP_ZERO(data->start_class);
2890                 if (compat) {
2891                     ANYOF_BITMAP_SET(data->start_class, uc);
2892                     data->start_class->flags &= ~ANYOF_EOS;
2893                     data->start_class->flags |= ANYOF_FOLD;
2894                     if (OP(scan) == EXACTFL)
2895                         data->start_class->flags |= ANYOF_LOCALE;
2896                 }
2897             }
2898             else if (flags & SCF_DO_STCLASS_OR) {
2899                 if (data->start_class->flags & ANYOF_FOLD) {
2900                     /* false positive possible if the class is case-folded.
2901                        Assume that the locale settings are the same... */
2902                     if (uc < 0x100)
2903                         ANYOF_BITMAP_SET(data->start_class, uc);
2904                     data->start_class->flags &= ~ANYOF_EOS;
2905                 }
2906                 cl_and(data->start_class, and_withp);
2907             }
2908             flags &= ~SCF_DO_STCLASS;
2909         }
2910         else if (strchr((const char*)PL_varies,OP(scan))) {
2911             I32 mincount, maxcount, minnext, deltanext, fl = 0;
2912             I32 f = flags, pos_before = 0;
2913             regnode * const oscan = scan;
2914             struct regnode_charclass_class this_class;
2915             struct regnode_charclass_class *oclass = NULL;
2916             I32 next_is_eval = 0;
2917
2918             switch (PL_regkind[OP(scan)]) {
2919             case WHILEM:                /* End of (?:...)* . */
2920                 scan = NEXTOPER(scan);
2921                 goto finish;
2922             case PLUS:
2923                 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
2924                     next = NEXTOPER(scan);
2925                     if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
2926                         mincount = 1;
2927                         maxcount = REG_INFTY;
2928                         next = regnext(scan);
2929                         scan = NEXTOPER(scan);
2930                         goto do_curly;
2931                     }
2932                 }
2933                 if (flags & SCF_DO_SUBSTR)
2934                     data->pos_min++;
2935                 min++;
2936                 /* Fall through. */
2937             case STAR:
2938                 if (flags & SCF_DO_STCLASS) {
2939                     mincount = 0;
2940                     maxcount = REG_INFTY;
2941                     next = regnext(scan);
2942                     scan = NEXTOPER(scan);
2943                     goto do_curly;
2944                 }
2945                 is_inf = is_inf_internal = 1;
2946                 scan = regnext(scan);
2947                 if (flags & SCF_DO_SUBSTR) {
2948                     SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot extend fixed substrings */
2949                     data->longest = &(data->longest_float);
2950                 }
2951                 goto optimize_curly_tail;
2952             case CURLY:
2953                 if (stopparen>0 && (OP(scan)==CURLYN || OP(scan)==CURLYM)
2954                     && (scan->flags == stopparen))
2955                 {
2956                     mincount = 1;
2957                     maxcount = 1;
2958                 } else {
2959                     mincount = ARG1(scan);
2960                     maxcount = ARG2(scan);
2961                 }
2962                 next = regnext(scan);
2963                 if (OP(scan) == CURLYX) {
2964                     I32 lp = (data ? *(data->last_closep) : 0);
2965                     scan->flags = ((lp <= (I32)U8_MAX) ? (U8)lp : U8_MAX);
2966                 }
2967                 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
2968                 next_is_eval = (OP(scan) == EVAL);
2969               do_curly:
2970                 if (flags & SCF_DO_SUBSTR) {
2971                     if (mincount == 0) SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot extend fixed substrings */
2972                     pos_before = data->pos_min;
2973                 }
2974                 if (data) {
2975                     fl = data->flags;
2976                     data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
2977                     if (is_inf)
2978                         data->flags |= SF_IS_INF;
2979                 }
2980                 if (flags & SCF_DO_STCLASS) {
2981                     cl_init(pRExC_state, &this_class);
2982                     oclass = data->start_class;
2983                     data->start_class = &this_class;
2984                     f |= SCF_DO_STCLASS_AND;
2985                     f &= ~SCF_DO_STCLASS_OR;
2986                 }
2987                 /* These are the cases when once a subexpression
2988                    fails at a particular position, it cannot succeed
2989                    even after backtracking at the enclosing scope.
2990                 
2991                    XXXX what if minimal match and we are at the
2992                         initial run of {n,m}? */
2993                 if ((mincount != maxcount - 1) && (maxcount != REG_INFTY))
2994                     f &= ~SCF_WHILEM_VISITED_POS;
2995
2996                 /* This will finish on WHILEM, setting scan, or on NULL: */
2997                 minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext, 
2998                                       last, data, stopparen, recursed, NULL,
2999                                       (mincount == 0
3000                                         ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
3001
3002                 if (flags & SCF_DO_STCLASS)
3003                     data->start_class = oclass;
3004                 if (mincount == 0 || minnext == 0) {
3005                     if (flags & SCF_DO_STCLASS_OR) {
3006                         cl_or(pRExC_state, data->start_class, &this_class);
3007                     }
3008                     else if (flags & SCF_DO_STCLASS_AND) {
3009                         /* Switch to OR mode: cache the old value of
3010                          * data->start_class */
3011                         INIT_AND_WITHP;
3012                         StructCopy(data->start_class, and_withp,
3013                                    struct regnode_charclass_class);
3014                         flags &= ~SCF_DO_STCLASS_AND;
3015                         StructCopy(&this_class, data->start_class,
3016                                    struct regnode_charclass_class);
3017                         flags |= SCF_DO_STCLASS_OR;
3018                         data->start_class->flags |= ANYOF_EOS;
3019                     }
3020                 } else {                /* Non-zero len */
3021                     if (flags & SCF_DO_STCLASS_OR) {
3022                         cl_or(pRExC_state, data->start_class, &this_class);
3023                         cl_and(data->start_class, and_withp);
3024                     }
3025                     else if (flags & SCF_DO_STCLASS_AND)
3026                         cl_and(data->start_class, &this_class);
3027                     flags &= ~SCF_DO_STCLASS;
3028                 }
3029                 if (!scan)              /* It was not CURLYX, but CURLY. */
3030                     scan = next;
3031                 if ( /* ? quantifier ok, except for (?{ ... }) */
3032                     (next_is_eval || !(mincount == 0 && maxcount == 1))
3033                     && (minnext == 0) && (deltanext == 0)
3034                     && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
3035                     && maxcount <= REG_INFTY/3 /* Complement check for big count */
3036                     && ckWARN(WARN_REGEXP))
3037                 {
3038                     vWARN(RExC_parse,
3039                           "Quantifier unexpected on zero-length expression");
3040                 }
3041
3042                 min += minnext * mincount;
3043                 is_inf_internal |= ((maxcount == REG_INFTY
3044                                      && (minnext + deltanext) > 0)
3045                                     || deltanext == I32_MAX);
3046                 is_inf |= is_inf_internal;
3047                 delta += (minnext + deltanext) * maxcount - minnext * mincount;
3048
3049                 /* Try powerful optimization CURLYX => CURLYN. */
3050                 if (  OP(oscan) == CURLYX && data
3051                       && data->flags & SF_IN_PAR
3052                       && !(data->flags & SF_HAS_EVAL)
3053                       && !deltanext && minnext == 1 ) {
3054                     /* Try to optimize to CURLYN.  */
3055                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
3056                     regnode * const nxt1 = nxt;
3057 #ifdef DEBUGGING
3058                     regnode *nxt2;
3059 #endif
3060
3061                     /* Skip open. */
3062                     nxt = regnext(nxt);
3063                     if (!strchr((const char*)PL_simple,OP(nxt))
3064                         && !(PL_regkind[OP(nxt)] == EXACT
3065                              && STR_LEN(nxt) == 1))
3066                         goto nogo;
3067 #ifdef DEBUGGING
3068                     nxt2 = nxt;
3069 #endif
3070                     nxt = regnext(nxt);
3071                     if (OP(nxt) != CLOSE)
3072                         goto nogo;
3073                     if (RExC_open_parens) {
3074                         RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
3075                         RExC_close_parens[ARG(nxt1)-1]=nxt+2; /*close->while*/
3076                     }
3077                     /* Now we know that nxt2 is the only contents: */
3078                     oscan->flags = (U8)ARG(nxt);
3079                     OP(oscan) = CURLYN;
3080                     OP(nxt1) = NOTHING; /* was OPEN. */
3081
3082 #ifdef DEBUGGING
3083                     OP(nxt1 + 1) = OPTIMIZED; /* was count. */
3084                     NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
3085                     NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */
3086                     OP(nxt) = OPTIMIZED;        /* was CLOSE. */
3087                     OP(nxt + 1) = OPTIMIZED; /* was count. */
3088                     NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
3089 #endif
3090                 }
3091               nogo:
3092
3093                 /* Try optimization CURLYX => CURLYM. */
3094                 if (  OP(oscan) == CURLYX && data
3095                       && !(data->flags & SF_HAS_PAR)
3096                       && !(data->flags & SF_HAS_EVAL)
3097                       && !deltanext     /* atom is fixed width */
3098                       && minnext != 0   /* CURLYM can't handle zero width */
3099                 ) {
3100                     /* XXXX How to optimize if data == 0? */
3101                     /* Optimize to a simpler form.  */
3102                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
3103                     regnode *nxt2;
3104
3105                     OP(oscan) = CURLYM;
3106                     while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
3107                             && (OP(nxt2) != WHILEM))
3108                         nxt = nxt2;
3109                     OP(nxt2)  = SUCCEED; /* Whas WHILEM */
3110                     /* Need to optimize away parenths. */
3111                     if (data->flags & SF_IN_PAR) {
3112                         /* Set the parenth number.  */
3113                         regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
3114
3115                         if (OP(nxt) != CLOSE)
3116                             FAIL("Panic opt close");
3117                         oscan->flags = (U8)ARG(nxt);
3118                         if (RExC_open_parens) {
3119                             RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
3120                             RExC_close_parens[ARG(nxt1)-1]=nxt2+1; /*close->NOTHING*/
3121                         }
3122                         OP(nxt1) = OPTIMIZED;   /* was OPEN. */
3123                         OP(nxt) = OPTIMIZED;    /* was CLOSE. */
3124
3125 #ifdef DEBUGGING
3126                         OP(nxt1 + 1) = OPTIMIZED; /* was count. */
3127                         OP(nxt + 1) = OPTIMIZED; /* was count. */
3128                         NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
3129                         NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
3130 #endif
3131 #if 0
3132                         while ( nxt1 && (OP(nxt1) != WHILEM)) {
3133                             regnode *nnxt = regnext(nxt1);
3134                         
3135                             if (nnxt == nxt) {
3136                                 if (reg_off_by_arg[OP(nxt1)])
3137                                     ARG_SET(nxt1, nxt2 - nxt1);
3138                                 else if (nxt2 - nxt1 < U16_MAX)
3139                                     NEXT_OFF(nxt1) = nxt2 - nxt1;
3140                                 else
3141                                     OP(nxt) = NOTHING;  /* Cannot beautify */
3142                             }
3143                             nxt1 = nnxt;
3144                         }
3145 #endif
3146                         /* Optimize again: */
3147                         study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt,
3148                                     NULL, stopparen, recursed, NULL, 0,depth+1);
3149                     }
3150                     else
3151                         oscan->flags = 0;
3152                 }
3153                 else if ((OP(oscan) == CURLYX)
3154                          && (flags & SCF_WHILEM_VISITED_POS)
3155                          /* See the comment on a similar expression above.
3156                             However, this time it not a subexpression
3157                             we care about, but the expression itself. */
3158                          && (maxcount == REG_INFTY)
3159                          && data && ++data->whilem_c < 16) {
3160                     /* This stays as CURLYX, we can put the count/of pair. */
3161                     /* Find WHILEM (as in regexec.c) */
3162                     regnode *nxt = oscan + NEXT_OFF(oscan);
3163
3164                     if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
3165                         nxt += ARG(nxt);
3166                     PREVOPER(nxt)->flags = (U8)(data->whilem_c
3167                         | (RExC_whilem_seen << 4)); /* On WHILEM */
3168                 }
3169                 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
3170                     pars++;
3171                 if (flags & SCF_DO_SUBSTR) {
3172                     SV *last_str = NULL;
3173                     int counted = mincount != 0;
3174
3175                     if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
3176 #if defined(SPARC64_GCC_WORKAROUND)
3177                         I32 b = 0;
3178                         STRLEN l = 0;
3179                         const char *s = NULL;
3180                         I32 old = 0;
3181
3182                         if (pos_before >= data->last_start_min)
3183                             b = pos_before;
3184                         else
3185                             b = data->last_start_min;
3186
3187                         l = 0;
3188                         s = SvPV_const(data->last_found, l);
3189                         old = b - data->last_start_min;
3190
3191 #else
3192                         I32 b = pos_before >= data->last_start_min
3193                             ? pos_before : data->last_start_min;
3194                         STRLEN l;
3195                         const char * const s = SvPV_const(data->last_found, l);
3196                         I32 old = b - data->last_start_min;
3197 #endif
3198
3199                         if (UTF)
3200                             old = utf8_hop((U8*)s, old) - (U8*)s;
3201                         
3202                         l -= old;
3203                         /* Get the added string: */
3204                         last_str = newSVpvn(s  + old, l);
3205                         if (UTF)
3206                             SvUTF8_on(last_str);
3207                         if (deltanext == 0 && pos_before == b) {
3208                             /* What was added is a constant string */
3209                             if (mincount > 1) {
3210                                 SvGROW(last_str, (mincount * l) + 1);
3211                                 repeatcpy(SvPVX(last_str) + l,
3212                                           SvPVX_const(last_str), l, mincount - 1);
3213                                 SvCUR_set(last_str, SvCUR(last_str) * mincount);
3214                                 /* Add additional parts. */
3215                                 SvCUR_set(data->last_found,
3216                                           SvCUR(data->last_found) - l);
3217                                 sv_catsv(data->last_found, last_str);
3218                                 {
3219                                     SV * sv = data->last_found;
3220                                     MAGIC *mg =
3221                                         SvUTF8(sv) && SvMAGICAL(sv) ?
3222                                         mg_find(sv, PERL_MAGIC_utf8) : NULL;
3223                                     if (mg && mg->mg_len >= 0)
3224                                         mg->mg_len += CHR_SVLEN(last_str);
3225                                 }
3226                                 data->last_end += l * (mincount - 1);
3227                             }
3228                         } else {
3229                             /* start offset must point into the last copy */
3230                             data->last_start_min += minnext * (mincount - 1);
3231                             data->last_start_max += is_inf ? I32_MAX
3232                                 : (maxcount - 1) * (minnext + data->pos_delta);
3233                         }
3234                     }
3235                     /* It is counted once already... */
3236                     data->pos_min += minnext * (mincount - counted);
3237                     data->pos_delta += - counted * deltanext +
3238                         (minnext + deltanext) * maxcount - minnext * mincount;
3239                     if (mincount != maxcount) {
3240                          /* Cannot extend fixed substrings found inside
3241                             the group.  */
3242                         SCAN_COMMIT(pRExC_state,data,minlenp);
3243                         if (mincount && last_str) {
3244                             SV * const sv = data->last_found;
3245                             MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
3246                                 mg_find(sv, PERL_MAGIC_utf8) : NULL;
3247
3248                             if (mg)
3249                                 mg->mg_len = -1;
3250                             sv_setsv(sv, last_str);
3251                             data->last_end = data->pos_min;
3252                             data->last_start_min =
3253                                 data->pos_min - CHR_SVLEN(last_str);
3254                             data->last_start_max = is_inf
3255                                 ? I32_MAX
3256                                 : data->pos_min + data->pos_delta
3257                                 - CHR_SVLEN(last_str);
3258                         }
3259                         data->longest = &(data->longest_float);
3260                     }
3261                     SvREFCNT_dec(last_str);
3262                 }
3263                 if (data && (fl & SF_HAS_EVAL))
3264                     data->flags |= SF_HAS_EVAL;
3265               optimize_curly_tail:
3266                 if (OP(oscan) != CURLYX) {
3267                     while (PL_regkind[OP(next = regnext(oscan))] == NOTHING
3268                            && NEXT_OFF(next))
3269                         NEXT_OFF(oscan) += NEXT_OFF(next);
3270                 }
3271                 continue;
3272             default:                    /* REF and CLUMP only? */
3273                 if (flags & SCF_DO_SUBSTR) {
3274                     SCAN_COMMIT(pRExC_state,data,minlenp);      /* Cannot expect anything... */
3275                     data->longest = &(data->longest_float);
3276                 }
3277                 is_inf = is_inf_internal = 1;
3278                 if (flags & SCF_DO_STCLASS_OR)
3279                     cl_anything(pRExC_state, data->start_class);
3280                 flags &= ~SCF_DO_STCLASS;
3281                 break;
3282             }
3283         }
3284         else if (strchr((const char*)PL_simple,OP(scan))) {
3285             int value = 0;
3286
3287             if (flags & SCF_DO_SUBSTR) {
3288                 SCAN_COMMIT(pRExC_state,data,minlenp);
3289                 data->pos_min++;
3290             }
3291             min++;
3292             if (flags & SCF_DO_STCLASS) {
3293                 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
3294
3295                 /* Some of the logic below assumes that switching
3296                    locale on will only add false positives. */
3297                 switch (PL_regkind[OP(scan)]) {
3298                 case SANY:
3299                 default:
3300                   do_default:
3301                     /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
3302                     if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3303                         cl_anything(pRExC_state, data->start_class);
3304                     break;
3305                 case REG_ANY:
3306                     if (OP(scan) == SANY)
3307                         goto do_default;
3308                     if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
3309                         value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
3310                                  || (data->start_class->flags & ANYOF_CLASS));
3311                         cl_anything(pRExC_state, data->start_class);
3312                     }
3313                     if (flags & SCF_DO_STCLASS_AND || !value)
3314                         ANYOF_BITMAP_CLEAR(data->start_class,'\n');
3315                     break;
3316                 case ANYOF:
3317                     if (flags & SCF_DO_STCLASS_AND)
3318                         cl_and(data->start_class,
3319                                (struct regnode_charclass_class*)scan);
3320                     else
3321                         cl_or(pRExC_state, data->start_class,
3322                               (struct regnode_charclass_class*)scan);
3323                     break;
3324                 case ALNUM:
3325                     if (flags & SCF_DO_STCLASS_AND) {
3326                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
3327                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
3328                             for (value = 0; value < 256; value++)
3329                                 if (!isALNUM(value))
3330                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3331                         }
3332                     }
3333                     else {
3334                         if (data->start_class->flags & ANYOF_LOCALE)
3335                             ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
3336                         else {
3337                             for (value = 0; value < 256; value++)
3338                                 if (isALNUM(value))
3339                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3340                         }
3341                     }
3342                     break;
3343                 case ALNUML:
3344                     if (flags & SCF_DO_STCLASS_AND) {
3345                         if (data->start_class->flags & ANYOF_LOCALE)
3346                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
3347                     }
3348                     else {
3349                         ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
3350                         data->start_class->flags |= ANYOF_LOCALE;
3351                     }
3352                     break;
3353                 case NALNUM:
3354                     if (flags & SCF_DO_STCLASS_AND) {
3355                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
3356                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
3357                             for (value = 0; value < 256; value++)
3358                                 if (isALNUM(value))
3359                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3360                         }
3361                     }
3362                     else {
3363                         if (data->start_class->flags & ANYOF_LOCALE)
3364                             ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
3365                         else {
3366                             for (value = 0; value < 256; value++)
3367                                 if (!isALNUM(value))
3368                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3369                         }
3370                     }
3371                     break;
3372                 case NALNUML:
3373                     if (flags & SCF_DO_STCLASS_AND) {
3374                         if (data->start_class->flags & ANYOF_LOCALE)
3375                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
3376                     }
3377                     else {
3378                         data->start_class->flags |= ANYOF_LOCALE;
3379                         ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
3380                     }
3381                     break;
3382                 case SPACE:
3383                     if (flags & SCF_DO_STCLASS_AND) {
3384                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
3385                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
3386                             for (value = 0; value < 256; value++)
3387                                 if (!isSPACE(value))
3388                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3389                         }
3390                     }
3391                     else {
3392                         if (data->start_class->flags & ANYOF_LOCALE)
3393                             ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
3394                         else {
3395                             for (value = 0; value < 256; value++)
3396                                 if (isSPACE(value))
3397                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3398                         }
3399                     }
3400                     break;
3401                 case SPACEL:
3402                     if (flags & SCF_DO_STCLASS_AND) {
3403                         if (data->start_class->flags & ANYOF_LOCALE)
3404                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
3405                     }
3406                     else {
3407                         data->start_class->flags |= ANYOF_LOCALE;
3408                         ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
3409                     }
3410                     break;
3411                 case NSPACE:
3412                     if (flags & SCF_DO_STCLASS_AND) {
3413                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
3414                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3415                             for (value = 0; value < 256; value++)
3416                                 if (isSPACE(value))
3417                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3418                         }
3419                     }
3420                     else {
3421                         if (data->start_class->flags & ANYOF_LOCALE)
3422                             ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3423                         else {
3424                             for (value = 0; value < 256; value++)
3425                                 if (!isSPACE(value))
3426                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3427                         }
3428                     }
3429                     break;
3430                 case NSPACEL:
3431                     if (flags & SCF_DO_STCLASS_AND) {
3432                         if (data->start_class->flags & ANYOF_LOCALE) {
3433                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3434                             for (value = 0; value < 256; value++)
3435                                 if (!isSPACE(value))
3436                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3437                         }
3438                     }
3439                     else {
3440                         data->start_class->flags |= ANYOF_LOCALE;
3441                         ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3442                     }
3443                     break;
3444                 case DIGIT:
3445                     if (flags & SCF_DO_STCLASS_AND) {
3446                         ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
3447                         for (value = 0; value < 256; value++)
3448                             if (!isDIGIT(value))
3449                                 ANYOF_BITMAP_CLEAR(data->start_class, value);
3450                     }
3451                     else {
3452                         if (data->start_class->flags & ANYOF_LOCALE)
3453                             ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
3454                         else {
3455                             for (value = 0; value < 256; value++)
3456                                 if (isDIGIT(value))
3457                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3458                         }
3459                     }
3460                     break;
3461                 case NDIGIT:
3462                     if (flags & SCF_DO_STCLASS_AND) {
3463                         ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
3464                         for (value = 0; value < 256; value++)
3465                             if (isDIGIT(value))
3466                                 ANYOF_BITMAP_CLEAR(data->start_class, value);
3467                     }
3468                     else {
3469                         if (data->start_class->flags & ANYOF_LOCALE)
3470                             ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
3471                         else {
3472                             for (value = 0; value < 256; value++)
3473                                 if (!isDIGIT(value))
3474                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3475                         }
3476                     }
3477                     break;
3478                 }
3479                 if (flags & SCF_DO_STCLASS_OR)
3480                     cl_and(data->start_class, and_withp);
3481                 flags &= ~SCF_DO_STCLASS;
3482             }
3483         }
3484         else if (PL_regkind[OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
3485             data->flags |= (OP(scan) == MEOL
3486                             ? SF_BEFORE_MEOL
3487                             : SF_BEFORE_SEOL);
3488         }
3489         else if (  PL_regkind[OP(scan)] == BRANCHJ
3490                  /* Lookbehind, or need to calculate parens/evals/stclass: */
3491                    && (scan->flags || data || (flags & SCF_DO_STCLASS))
3492                    && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
3493             if ( !PERL_ENABLE_POSITIVE_ASSERTION_STUDY 
3494                 || OP(scan) == UNLESSM )
3495             {
3496                 /* Negative Lookahead/lookbehind
3497                    In this case we can't do fixed string optimisation.
3498                 */
3499
3500                 I32 deltanext, minnext, fake = 0;
3501                 regnode *nscan;
3502                 struct regnode_charclass_class intrnl;
3503                 int f = 0;
3504
3505                 data_fake.flags = 0;
3506                 if (data) {
3507                     data_fake.whilem_c = data->whilem_c;
3508                     data_fake.last_closep = data->last_closep;
3509                 }
3510                 else
3511                     data_fake.last_closep = &fake;
3512                 data_fake.pos_delta = delta;
3513                 if ( flags & SCF_DO_STCLASS && !scan->flags
3514                      && OP(scan) == IFMATCH ) { /* Lookahead */
3515                     cl_init(pRExC_state, &intrnl);
3516                     data_fake.start_class = &intrnl;
3517                     f |= SCF_DO_STCLASS_AND;
3518                 }
3519                 if (flags & SCF_WHILEM_VISITED_POS)
3520                     f |= SCF_WHILEM_VISITED_POS;
3521                 next = regnext(scan);
3522                 nscan = NEXTOPER(NEXTOPER(scan));
3523                 minnext = study_chunk(pRExC_state, &nscan, minlenp, &deltanext, 
3524                     last, &data_fake, stopparen, recursed, NULL, f, depth+1);
3525                 if (scan->flags) {
3526                     if (deltanext) {
3527                         FAIL("Variable length lookbehind not implemented");
3528                     }
3529                     else if (minnext > (I32)U8_MAX) {
3530                         FAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
3531                     }
3532                     scan->flags = (U8)minnext;
3533                 }
3534                 if (data) {
3535                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3536                         pars++;
3537                     if (data_fake.flags & SF_HAS_EVAL)
3538                         data->flags |= SF_HAS_EVAL;
3539                     data->whilem_c = data_fake.whilem_c;
3540                 }
3541                 if (f & SCF_DO_STCLASS_AND) {
3542                     const int was = (data->start_class->flags & ANYOF_EOS);
3543
3544                     cl_and(data->start_class, &intrnl);
3545                     if (was)
3546                         data->start_class->flags |= ANYOF_EOS;
3547                 }
3548             }
3549 #if PERL_ENABLE_POSITIVE_ASSERTION_STUDY
3550             else {
3551                 /* Positive Lookahead/lookbehind
3552                    In this case we can do fixed string optimisation,
3553                    but we must be careful about it. Note in the case of
3554                    lookbehind the positions will be offset by the minimum
3555                    length of the pattern, something we won't know about
3556                    until after the recurse.
3557                 */
3558                 I32 deltanext, fake = 0;
3559                 regnode *nscan;
3560                 struct regnode_charclass_class intrnl;
3561                 int f = 0;
3562                 /* We use SAVEFREEPV so that when the full compile 
3563                     is finished perl will clean up the allocated 
3564                     minlens when its all done. This was we don't
3565                     have to worry about freeing them when we know
3566                     they wont be used, which would be a pain.
3567                  */
3568                 I32 *minnextp;
3569                 Newx( minnextp, 1, I32 );
3570                 SAVEFREEPV(minnextp);
3571
3572                 if (data) {
3573                     StructCopy(data, &data_fake, scan_data_t);
3574                     if ((flags & SCF_DO_SUBSTR) && data->last_found) {
3575                         f |= SCF_DO_SUBSTR;
3576                         if (scan->flags) 
3577                             SCAN_COMMIT(pRExC_state, &data_fake,minlenp);
3578                         data_fake.last_found=newSVsv(data->last_found);
3579                     }
3580                 }
3581                 else
3582                     data_fake.last_closep = &fake;
3583                 data_fake.flags = 0;
3584                 data_fake.pos_delta = delta;
3585                 if (is_inf)
3586                     data_fake.flags |= SF_IS_INF;
3587                 if ( flags & SCF_DO_STCLASS && !scan->flags
3588                      && OP(scan) == IFMATCH ) { /* Lookahead */
3589                     cl_init(pRExC_state, &intrnl);
3590                     data_fake.start_class = &intrnl;
3591                     f |= SCF_DO_STCLASS_AND;
3592                 }
3593                 if (flags & SCF_WHILEM_VISITED_POS)
3594                     f |= SCF_WHILEM_VISITED_POS;
3595                 next = regnext(scan);
3596                 nscan = NEXTOPER(NEXTOPER(scan));
3597
3598                 *minnextp = study_chunk(pRExC_state, &nscan, minnextp, &deltanext, 
3599                     last, &data_fake, stopparen, recursed, NULL, f,depth+1);
3600                 if (scan->flags) {
3601                     if (deltanext) {
3602                         FAIL("Variable length lookbehind not implemented");
3603                     }
3604                     else if (*minnextp > (I32)U8_MAX) {
3605                         FAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
3606                     }
3607                     scan->flags = (U8)*minnextp;
3608                 }
3609
3610                 *minnextp += min;
3611
3612                 if (f & SCF_DO_STCLASS_AND) {
3613                     const int was = (data->start_class->flags & ANYOF_EOS);
3614
3615                     cl_and(data->start_class, &intrnl);
3616                     if (was)
3617                         data->start_class->flags |= ANYOF_EOS;
3618                 }
3619                 if (data) {
3620                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3621                         pars++;
3622                     if (data_fake.flags & SF_HAS_EVAL)
3623                         data->flags |= SF_HAS_EVAL;
3624                     data->whilem_c = data_fake.whilem_c;
3625                     if ((flags & SCF_DO_SUBSTR) && data_fake.last_found) {
3626                         if (RExC_rx->minlen<*minnextp)
3627                             RExC_rx->minlen=*minnextp;
3628                         SCAN_COMMIT(pRExC_state, &data_fake, minnextp);
3629                         SvREFCNT_dec(data_fake.last_found);
3630                         
3631                         if ( data_fake.minlen_fixed != minlenp ) 
3632                         {
3633                             data->offset_fixed= data_fake.offset_fixed;
3634                             data->minlen_fixed= data_fake.minlen_fixed;
3635                             data->lookbehind_fixed+= scan->flags;
3636                         }
3637                         if ( data_fake.minlen_float != minlenp )
3638                         {
3639                             data->minlen_float= data_fake.minlen_float;
3640                             data->offset_float_min=data_fake.offset_float_min;
3641                             data->offset_float_max=data_fake.offset_float_max;
3642                             data->lookbehind_float+= scan->flags;
3643                         }
3644                     }
3645                 }
3646
3647
3648             }
3649 #endif
3650         }
3651         else if (OP(scan) == OPEN) {
3652             if (stopparen != (I32)ARG(scan))
3653                 pars++;
3654         }
3655         else if (OP(scan) == CLOSE) {
3656             if (stopparen == (I32)ARG(scan)) {
3657                 break;
3658             }
3659             if ((I32)ARG(scan) == is_par) {
3660                 next = regnext(scan);
3661
3662                 if ( next && (OP(next) != WHILEM) && next < last)
3663                     is_par = 0;         /* Disable optimization */
3664             }
3665             if (data)
3666                 *(data->last_closep) = ARG(scan);
3667         }
3668         else if (OP(scan) == EVAL) {
3669                 if (data)
3670                     data->flags |= SF_HAS_EVAL;
3671         }
3672         else if ( PL_regkind[OP(scan)] == ENDLIKE ) {
3673             if (flags & SCF_DO_SUBSTR) {
3674                 SCAN_COMMIT(pRExC_state,data,minlenp);
3675                 flags &= ~SCF_DO_SUBSTR;
3676             }
3677             if (data && OP(scan)==ACCEPT) {
3678                 data->flags |= SCF_SEEN_ACCEPT;
3679                 if (stopmin > min)
3680                     stopmin = min;
3681             }
3682         }
3683         else if (OP(scan) == LOGICAL && scan->flags == 2) /* Embedded follows */
3684         {
3685                 if (flags & SCF_DO_SUBSTR) {
3686                     SCAN_COMMIT(pRExC_state,data,minlenp);
3687                     data->longest = &(data->longest_float);
3688                 }
3689                 is_inf = is_inf_internal = 1;
3690                 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3691                     cl_anything(pRExC_state, data->start_class);
3692                 flags &= ~SCF_DO_STCLASS;
3693         }
3694         else if (OP(scan) == GPOS) {
3695             if (!(RExC_rx->extflags & RXf_GPOS_FLOAT) &&
3696                 !(delta || is_inf || (data && data->pos_delta))) 
3697             {
3698                 if (!(RExC_rx->extflags & RXf_ANCH) && (flags & SCF_DO_SUBSTR))
3699                     RExC_rx->extflags |= RXf_ANCH_GPOS;
3700                 if (RExC_rx->gofs < (U32)min)
3701                     RExC_rx->gofs = min;
3702             } else {
3703                 RExC_rx->extflags |= RXf_GPOS_FLOAT;
3704                 RExC_rx->gofs = 0;
3705             }       
3706         }
3707 #ifdef TRIE_STUDY_OPT
3708 #ifdef FULL_TRIE_STUDY
3709         else if (PL_regkind[OP(scan)] == TRIE) {
3710             /* NOTE - There is similar code to this block above for handling
3711                BRANCH nodes on the initial study.  If you change stuff here
3712                check there too. */
3713             regnode *trie_node= scan;
3714             regnode *tail= regnext(scan);
3715             reg_trie_data *trie = (reg_trie_data*)RExC_rxi->data->data[ ARG(scan) ];
3716             I32 max1 = 0, min1 = I32_MAX;
3717             struct regnode_charclass_class accum;
3718
3719             if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
3720                 SCAN_COMMIT(pRExC_state, data,minlenp); /* Cannot merge strings after this. */
3721             if (flags & SCF_DO_STCLASS)
3722                 cl_init_zero(pRExC_state, &accum);
3723                 
3724             if (!trie->jump) {
3725                 min1= trie->minlen;
3726                 max1= trie->maxlen;
3727             } else {
3728                 const regnode *nextbranch= NULL;
3729                 U32 word;
3730                 
3731                 for ( word=1 ; word <= trie->wordcount ; word++) 
3732                 {
3733                     I32 deltanext=0, minnext=0, f = 0, fake;
3734                     struct regnode_charclass_class this_class;
3735                     
3736                     data_fake.flags = 0;
3737                     if (data) {
3738                         data_fake.whilem_c = data->whilem_c;
3739                         data_fake.last_closep = data->last_closep;
3740                     }
3741                     else
3742                         data_fake.last_closep = &fake;
3743                     data_fake.pos_delta = delta;
3744                     if (flags & SCF_DO_STCLASS) {
3745                         cl_init(pRExC_state, &this_class);
3746                         data_fake.start_class = &this_class;
3747                         f = SCF_DO_STCLASS_AND;
3748                     }
3749                     if (flags & SCF_WHILEM_VISITED_POS)
3750                         f |= SCF_WHILEM_VISITED_POS;
3751     
3752                     if (trie->jump[word]) {
3753                         if (!nextbranch)
3754                             nextbranch = trie_node + trie->jump[0];
3755                         scan= trie_node + trie->jump[word];
3756                         /* We go from the jump point to the branch that follows
3757                            it. Note this means we need the vestigal unused branches
3758                            even though they arent otherwise used.
3759                          */
3760                         minnext = study_chunk(pRExC_state, &scan, minlenp, 
3761                             &deltanext, (regnode *)nextbranch, &data_fake, 
3762                             stopparen, recursed, NULL, f,depth+1);
3763                     }
3764                     if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH)
3765                         nextbranch= regnext((regnode*)nextbranch);
3766                     
3767                     if (min1 > (I32)(minnext + trie->minlen))
3768                         min1 = minnext + trie->minlen;
3769                     if (max1 < (I32)(minnext + deltanext + trie->maxlen))
3770                         max1 = minnext + deltanext + trie->maxlen;
3771                     if (deltanext == I32_MAX)
3772                         is_inf = is_inf_internal = 1;
3773                     
3774                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3775                         pars++;
3776                     if (data_fake.flags & SCF_SEEN_ACCEPT) {
3777                         if ( stopmin > min + min1) 
3778                             stopmin = min + min1;
3779                         flags &= ~SCF_DO_SUBSTR;
3780                         if (data)
3781                             data->flags |= SCF_SEEN_ACCEPT;
3782                     }
3783                     if (data) {
3784                         if (data_fake.flags & SF_HAS_EVAL)
3785                             data->flags |= SF_HAS_EVAL;
3786                         data->whilem_c = data_fake.whilem_c;
3787                     }
3788                     if (flags & SCF_DO_STCLASS)
3789                         cl_or(pRExC_state, &accum, &this_class);
3790                 }
3791             }
3792             if (flags & SCF_DO_SUBSTR) {
3793                 data->pos_min += min1;
3794                 data->pos_delta += max1 - min1;
3795                 if (max1 != min1 || is_inf)
3796                     data->longest = &(data->longest_float);
3797             }
3798             min += min1;
3799             delta += max1 - min1;
3800             if (flags & SCF_DO_STCLASS_OR) {
3801                 cl_or(pRExC_state, data->start_class, &accum);
3802                 if (min1) {
3803                     cl_and(data->start_class, and_withp);
3804                     flags &= ~SCF_DO_STCLASS;
3805                 }
3806             }
3807             else if (flags & SCF_DO_STCLASS_AND) {
3808                 if (min1) {
3809                     cl_and(data->start_class, &accum);
3810                     flags &= ~SCF_DO_STCLASS;
3811                 }
3812                 else {
3813                     /* Switch to OR mode: cache the old value of
3814                      * data->start_class */
3815                     INIT_AND_WITHP;
3816                     StructCopy(data->start_class, and_withp,
3817                                struct regnode_charclass_class);
3818                     flags &= ~SCF_DO_STCLASS_AND;