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