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