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