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