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