No more ld2 and perlld under Cygwin
[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
1409                     /* store the folded codepoint */
1410                     if ( folder ) TRIE_BITMAP_SET(trie,folder[ uvc ]);
1411
1412                     if ( !UTF ) {
1413                         /* store first byte of utf8 representation of
1414                            codepoints in the 127 < uvc < 256 range */
1415                         if (127 < uvc && uvc < 192) {
1416                             TRIE_BITMAP_SET(trie,194);
1417                         } else if (191 < uvc ) {
1418                             TRIE_BITMAP_SET(trie,195);
1419                         /* && uvc < 256 -- we know uvc is < 256 already */
1420                         }
1421                     }
1422                     set_bit = 0; /* We've done our bit :-) */
1423                 }
1424             } else {
1425                 SV** svpp;
1426                 if ( !widecharmap )
1427                     widecharmap = newHV();
1428
1429                 svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 1 );
1430
1431                 if ( !svpp )
1432                     Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%"UVXf, uvc );
1433
1434                 if ( !SvTRUE( *svpp ) ) {
1435                     sv_setiv( *svpp, ++trie->uniquecharcount );
1436                     TRIE_STORE_REVCHAR;
1437                 }
1438             }
1439         }
1440         if( cur == first ) {
1441             trie->minlen=chars;
1442             trie->maxlen=chars;
1443         } else if (chars < trie->minlen) {
1444             trie->minlen=chars;
1445         } else if (chars > trie->maxlen) {
1446             trie->maxlen=chars;
1447         }
1448
1449     } /* end first pass */
1450     DEBUG_TRIE_COMPILE_r(
1451         PerlIO_printf( Perl_debug_log, "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
1452                 (int)depth * 2 + 2,"",
1453                 ( widecharmap ? "UTF8" : "NATIVE" ), (int)word_count,
1454                 (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount,
1455                 (int)trie->minlen, (int)trie->maxlen )
1456     );
1457     trie->wordlen = (U32 *) PerlMemShared_calloc( word_count, sizeof(U32) );
1458
1459     /*
1460         We now know what we are dealing with in terms of unique chars and
1461         string sizes so we can calculate how much memory a naive
1462         representation using a flat table  will take. If it's over a reasonable
1463         limit (as specified by ${^RE_TRIE_MAXBUF}) we use a more memory
1464         conservative but potentially much slower representation using an array
1465         of lists.
1466
1467         At the end we convert both representations into the same compressed
1468         form that will be used in regexec.c for matching with. The latter
1469         is a form that cannot be used to construct with but has memory
1470         properties similar to the list form and access properties similar
1471         to the table form making it both suitable for fast searches and
1472         small enough that its feasable to store for the duration of a program.
1473
1474         See the comment in the code where the compressed table is produced
1475         inplace from the flat tabe representation for an explanation of how
1476         the compression works.
1477
1478     */
1479
1480
1481     if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1) > SvIV(re_trie_maxbuff) ) {
1482         /*
1483             Second Pass -- Array Of Lists Representation
1484
1485             Each state will be represented by a list of charid:state records
1486             (reg_trie_trans_le) the first such element holds the CUR and LEN
1487             points of the allocated array. (See defines above).
1488
1489             We build the initial structure using the lists, and then convert
1490             it into the compressed table form which allows faster lookups
1491             (but cant be modified once converted).
1492         */
1493
1494         STRLEN transcount = 1;
1495
1496         DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log, 
1497             "%*sCompiling trie using list compiler\n",
1498             (int)depth * 2 + 2, ""));
1499         
1500         trie->states = (reg_trie_state *)
1501             PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
1502                                   sizeof(reg_trie_state) );
1503         TRIE_LIST_NEW(1);
1504         next_alloc = 2;
1505
1506         for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1507
1508             regnode * const noper = NEXTOPER( cur );
1509             U8 *uc           = (U8*)STRING( noper );
1510             const U8 * const e = uc + STR_LEN( noper );
1511             U32 state        = 1;         /* required init */
1512             U16 charid       = 0;         /* sanity init */
1513             U8 *scan         = (U8*)NULL; /* sanity init */
1514             STRLEN foldlen   = 0;         /* required init */
1515             U32 wordlen      = 0;         /* required init */
1516             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1517
1518             if (OP(noper) != NOTHING) {
1519                 for ( ; uc < e ; uc += len ) {
1520
1521                     TRIE_READ_CHAR;
1522
1523                     if ( uvc < 256 ) {
1524                         charid = trie->charmap[ uvc ];
1525                     } else {
1526                         SV** const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
1527                         if ( !svpp ) {
1528                             charid = 0;
1529                         } else {
1530                             charid=(U16)SvIV( *svpp );
1531                         }
1532                     }
1533                     /* charid is now 0 if we dont know the char read, or nonzero if we do */
1534                     if ( charid ) {
1535
1536                         U16 check;
1537                         U32 newstate = 0;
1538
1539                         charid--;
1540                         if ( !trie->states[ state ].trans.list ) {
1541                             TRIE_LIST_NEW( state );
1542                         }
1543                         for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) {
1544                             if ( TRIE_LIST_ITEM( state, check ).forid == charid ) {
1545                                 newstate = TRIE_LIST_ITEM( state, check ).newstate;
1546                                 break;
1547                             }
1548                         }
1549                         if ( ! newstate ) {
1550                             newstate = next_alloc++;
1551                             TRIE_LIST_PUSH( state, charid, newstate );
1552                             transcount++;
1553                         }
1554                         state = newstate;
1555                     } else {
1556                         Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1557                     }
1558                 }
1559             }
1560             TRIE_HANDLE_WORD(state);
1561
1562         } /* end second pass */
1563
1564         /* next alloc is the NEXT state to be allocated */
1565         trie->statecount = next_alloc; 
1566         trie->states = (reg_trie_state *)
1567             PerlMemShared_realloc( trie->states,
1568                                    next_alloc
1569                                    * sizeof(reg_trie_state) );
1570
1571         /* and now dump it out before we compress it */
1572         DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_list(trie, widecharmap,
1573                                                          revcharmap, next_alloc,
1574                                                          depth+1)
1575         );
1576
1577         trie->trans = (reg_trie_trans *)
1578             PerlMemShared_calloc( transcount, sizeof(reg_trie_trans) );
1579         {
1580             U32 state;
1581             U32 tp = 0;
1582             U32 zp = 0;
1583
1584
1585             for( state=1 ; state < next_alloc ; state ++ ) {
1586                 U32 base=0;
1587
1588                 /*
1589                 DEBUG_TRIE_COMPILE_MORE_r(
1590                     PerlIO_printf( Perl_debug_log, "tp: %d zp: %d ",tp,zp)
1591                 );
1592                 */
1593
1594                 if (trie->states[state].trans.list) {
1595                     U16 minid=TRIE_LIST_ITEM( state, 1).forid;
1596                     U16 maxid=minid;
1597                     U16 idx;
1598
1599                     for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1600                         const U16 forid = TRIE_LIST_ITEM( state, idx).forid;
1601                         if ( forid < minid ) {
1602                             minid=forid;
1603                         } else if ( forid > maxid ) {
1604                             maxid=forid;
1605                         }
1606                     }
1607                     if ( transcount < tp + maxid - minid + 1) {
1608                         transcount *= 2;
1609                         trie->trans = (reg_trie_trans *)
1610                             PerlMemShared_realloc( trie->trans,
1611                                                      transcount
1612                                                      * sizeof(reg_trie_trans) );
1613                         Zero( trie->trans + (transcount / 2), transcount / 2 , reg_trie_trans );
1614                     }
1615                     base = trie->uniquecharcount + tp - minid;
1616                     if ( maxid == minid ) {
1617                         U32 set = 0;
1618                         for ( ; zp < tp ; zp++ ) {
1619                             if ( ! trie->trans[ zp ].next ) {
1620                                 base = trie->uniquecharcount + zp - minid;
1621                                 trie->trans[ zp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1622                                 trie->trans[ zp ].check = state;
1623                                 set = 1;
1624                                 break;
1625                             }
1626                         }
1627                         if ( !set ) {
1628                             trie->trans[ tp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1629                             trie->trans[ tp ].check = state;
1630                             tp++;
1631                             zp = tp;
1632                         }
1633                     } else {
1634                         for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1635                             const U32 tid = base -  trie->uniquecharcount + TRIE_LIST_ITEM( state, idx ).forid;
1636                             trie->trans[ tid ].next = TRIE_LIST_ITEM( state, idx ).newstate;
1637                             trie->trans[ tid ].check = state;
1638                         }
1639                         tp += ( maxid - minid + 1 );
1640                     }
1641                     Safefree(trie->states[ state ].trans.list);
1642                 }
1643                 /*
1644                 DEBUG_TRIE_COMPILE_MORE_r(
1645                     PerlIO_printf( Perl_debug_log, " base: %d\n",base);
1646                 );
1647                 */
1648                 trie->states[ state ].trans.base=base;
1649             }
1650             trie->lasttrans = tp + 1;
1651         }
1652     } else {
1653         /*
1654            Second Pass -- Flat Table Representation.
1655
1656            we dont use the 0 slot of either trans[] or states[] so we add 1 to each.
1657            We know that we will need Charcount+1 trans at most to store the data
1658            (one row per char at worst case) So we preallocate both structures
1659            assuming worst case.
1660
1661            We then construct the trie using only the .next slots of the entry
1662            structs.
1663
1664            We use the .check field of the first entry of the node  temporarily to
1665            make compression both faster and easier by keeping track of how many non
1666            zero fields are in the node.
1667
1668            Since trans are numbered from 1 any 0 pointer in the table is a FAIL
1669            transition.
1670
1671            There are two terms at use here: state as a TRIE_NODEIDX() which is a
1672            number representing the first entry of the node, and state as a
1673            TRIE_NODENUM() which is the trans number. state 1 is TRIE_NODEIDX(1) and
1674            TRIE_NODENUM(1), state 2 is TRIE_NODEIDX(2) and TRIE_NODENUM(3) if there
1675            are 2 entrys per node. eg:
1676
1677              A B       A B
1678           1. 2 4    1. 3 7
1679           2. 0 3    3. 0 5
1680           3. 0 0    5. 0 0
1681           4. 0 0    7. 0 0
1682
1683            The table is internally in the right hand, idx form. However as we also
1684            have to deal with the states array which is indexed by nodenum we have to
1685            use TRIE_NODENUM() to convert.
1686
1687         */
1688         DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log, 
1689             "%*sCompiling trie using table compiler\n",
1690             (int)depth * 2 + 2, ""));
1691
1692         trie->trans = (reg_trie_trans *)
1693             PerlMemShared_calloc( ( TRIE_CHARCOUNT(trie) + 1 )
1694                                   * trie->uniquecharcount + 1,
1695                                   sizeof(reg_trie_trans) );
1696         trie->states = (reg_trie_state *)
1697             PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
1698                                   sizeof(reg_trie_state) );
1699         next_alloc = trie->uniquecharcount + 1;
1700
1701
1702         for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1703
1704             regnode * const noper   = NEXTOPER( cur );
1705             const U8 *uc     = (U8*)STRING( noper );
1706             const U8 * const e = uc + STR_LEN( noper );
1707
1708             U32 state        = 1;         /* required init */
1709
1710             U16 charid       = 0;         /* sanity init */
1711             U32 accept_state = 0;         /* sanity init */
1712             U8 *scan         = (U8*)NULL; /* sanity init */
1713
1714             STRLEN foldlen   = 0;         /* required init */
1715             U32 wordlen      = 0;         /* required init */
1716             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1717
1718             if ( OP(noper) != NOTHING ) {
1719                 for ( ; uc < e ; uc += len ) {
1720
1721                     TRIE_READ_CHAR;
1722
1723                     if ( uvc < 256 ) {
1724                         charid = trie->charmap[ uvc ];
1725                     } else {
1726                         SV* const * const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
1727                         charid = svpp ? (U16)SvIV(*svpp) : 0;
1728                     }
1729                     if ( charid ) {
1730                         charid--;
1731                         if ( !trie->trans[ state + charid ].next ) {
1732                             trie->trans[ state + charid ].next = next_alloc;
1733                             trie->trans[ state ].check++;
1734                             next_alloc += trie->uniquecharcount;
1735                         }
1736                         state = trie->trans[ state + charid ].next;
1737                     } else {
1738                         Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1739                     }
1740                     /* charid is now 0 if we dont know the char read, or nonzero if we do */
1741                 }
1742             }
1743             accept_state = TRIE_NODENUM( state );
1744             TRIE_HANDLE_WORD(accept_state);
1745
1746         } /* end second pass */
1747
1748         /* and now dump it out before we compress it */
1749         DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_table(trie, widecharmap,
1750                                                           revcharmap,
1751                                                           next_alloc, depth+1));
1752
1753         {
1754         /*
1755            * Inplace compress the table.*
1756
1757            For sparse data sets the table constructed by the trie algorithm will
1758            be mostly 0/FAIL transitions or to put it another way mostly empty.
1759            (Note that leaf nodes will not contain any transitions.)
1760
1761            This algorithm compresses the tables by eliminating most such
1762            transitions, at the cost of a modest bit of extra work during lookup:
1763
1764            - Each states[] entry contains a .base field which indicates the
1765            index in the state[] array wheres its transition data is stored.
1766
1767            - If .base is 0 there are no  valid transitions from that node.
1768
1769            - If .base is nonzero then charid is added to it to find an entry in
1770            the trans array.
1771
1772            -If trans[states[state].base+charid].check!=state then the
1773            transition is taken to be a 0/Fail transition. Thus if there are fail
1774            transitions at the front of the node then the .base offset will point
1775            somewhere inside the previous nodes data (or maybe even into a node
1776            even earlier), but the .check field determines if the transition is
1777            valid.
1778
1779            XXX - wrong maybe?
1780            The following process inplace converts the table to the compressed
1781            table: We first do not compress the root node 1,and mark its all its
1782            .check pointers as 1 and set its .base pointer as 1 as well. This
1783            allows to do a DFA construction from the compressed table later, and
1784            ensures that any .base pointers we calculate later are greater than
1785            0.
1786
1787            - We set 'pos' to indicate the first entry of the second node.
1788
1789            - We then iterate over the columns of the node, finding the first and
1790            last used entry at l and m. We then copy l..m into pos..(pos+m-l),
1791            and set the .check pointers accordingly, and advance pos
1792            appropriately and repreat for the next node. Note that when we copy
1793            the next pointers we have to convert them from the original
1794            NODEIDX form to NODENUM form as the former is not valid post
1795            compression.
1796
1797            - If a node has no transitions used we mark its base as 0 and do not
1798            advance the pos pointer.
1799
1800            - If a node only has one transition we use a second pointer into the
1801            structure to fill in allocated fail transitions from other states.
1802            This pointer is independent of the main pointer and scans forward
1803            looking for null transitions that are allocated to a state. When it
1804            finds one it writes the single transition into the "hole".  If the
1805            pointer doesnt find one the single transition is appended as normal.
1806
1807            - Once compressed we can Renew/realloc the structures to release the
1808            excess space.
1809
1810            See "Table-Compression Methods" in sec 3.9 of the Red Dragon,
1811            specifically Fig 3.47 and the associated pseudocode.
1812
1813            demq
1814         */
1815         const U32 laststate = TRIE_NODENUM( next_alloc );
1816         U32 state, charid;
1817         U32 pos = 0, zp=0;
1818         trie->statecount = laststate;
1819
1820         for ( state = 1 ; state < laststate ; state++ ) {
1821             U8 flag = 0;
1822             const U32 stateidx = TRIE_NODEIDX( state );
1823             const U32 o_used = trie->trans[ stateidx ].check;
1824             U32 used = trie->trans[ stateidx ].check;
1825             trie->trans[ stateidx ].check = 0;
1826
1827             for ( charid = 0 ; used && charid < trie->uniquecharcount ; charid++ ) {
1828                 if ( flag || trie->trans[ stateidx + charid ].next ) {
1829                     if ( trie->trans[ stateidx + charid ].next ) {
1830                         if (o_used == 1) {
1831                             for ( ; zp < pos ; zp++ ) {
1832                                 if ( ! trie->trans[ zp ].next ) {
1833                                     break;
1834                                 }
1835                             }
1836                             trie->states[ state ].trans.base = zp + trie->uniquecharcount - charid ;
1837                             trie->trans[ zp ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1838                             trie->trans[ zp ].check = state;
1839                             if ( ++zp > pos ) pos = zp;
1840                             break;
1841                         }
1842                         used--;
1843                     }
1844                     if ( !flag ) {
1845                         flag = 1;
1846                         trie->states[ state ].trans.base = pos + trie->uniquecharcount - charid ;
1847                     }
1848                     trie->trans[ pos ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1849                     trie->trans[ pos ].check = state;
1850                     pos++;
1851                 }
1852             }
1853         }
1854         trie->lasttrans = pos + 1;
1855         trie->states = (reg_trie_state *)
1856             PerlMemShared_realloc( trie->states, laststate
1857                                    * sizeof(reg_trie_state) );
1858         DEBUG_TRIE_COMPILE_MORE_r(
1859                 PerlIO_printf( Perl_debug_log,
1860                     "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
1861                     (int)depth * 2 + 2,"",
1862                     (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1 ),
1863                     (IV)next_alloc,
1864                     (IV)pos,
1865                     ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
1866             );
1867
1868         } /* end table compress */
1869     }
1870     DEBUG_TRIE_COMPILE_MORE_r(
1871             PerlIO_printf(Perl_debug_log, "%*sStatecount:%"UVxf" Lasttrans:%"UVxf"\n",
1872                 (int)depth * 2 + 2, "",
1873                 (UV)trie->statecount,
1874                 (UV)trie->lasttrans)
1875     );
1876     /* resize the trans array to remove unused space */
1877     trie->trans = (reg_trie_trans *)
1878         PerlMemShared_realloc( trie->trans, trie->lasttrans
1879                                * sizeof(reg_trie_trans) );
1880
1881     /* and now dump out the compressed format */
1882     DEBUG_TRIE_COMPILE_r(dump_trie(trie, widecharmap, revcharmap, depth+1));
1883
1884     {   /* Modify the program and insert the new TRIE node*/ 
1885         U8 nodetype =(U8)(flags & 0xFF);
1886         char *str=NULL;
1887         
1888 #ifdef DEBUGGING
1889         regnode *optimize = NULL;
1890 #ifdef RE_TRACK_PATTERN_OFFSETS
1891
1892         U32 mjd_offset = 0;
1893         U32 mjd_nodelen = 0;
1894 #endif /* RE_TRACK_PATTERN_OFFSETS */
1895 #endif /* DEBUGGING */
1896         /*
1897            This means we convert either the first branch or the first Exact,
1898            depending on whether the thing following (in 'last') is a branch
1899            or not and whther first is the startbranch (ie is it a sub part of
1900            the alternation or is it the whole thing.)
1901            Assuming its a sub part we conver the EXACT otherwise we convert
1902            the whole branch sequence, including the first.
1903          */
1904         /* Find the node we are going to overwrite */
1905         if ( first != startbranch || OP( last ) == BRANCH ) {
1906             /* branch sub-chain */
1907             NEXT_OFF( first ) = (U16)(last - first);
1908 #ifdef RE_TRACK_PATTERN_OFFSETS
1909             DEBUG_r({
1910                 mjd_offset= Node_Offset((convert));
1911                 mjd_nodelen= Node_Length((convert));
1912             });
1913 #endif
1914             /* whole branch chain */
1915         }
1916 #ifdef RE_TRACK_PATTERN_OFFSETS
1917         else {
1918             DEBUG_r({
1919                 const  regnode *nop = NEXTOPER( convert );
1920                 mjd_offset= Node_Offset((nop));
1921                 mjd_nodelen= Node_Length((nop));
1922             });
1923         }
1924         DEBUG_OPTIMISE_r(
1925             PerlIO_printf(Perl_debug_log, "%*sMJD offset:%"UVuf" MJD length:%"UVuf"\n",
1926                 (int)depth * 2 + 2, "",
1927                 (UV)mjd_offset, (UV)mjd_nodelen)
1928         );
1929 #endif
1930         /* But first we check to see if there is a common prefix we can 
1931            split out as an EXACT and put in front of the TRIE node.  */
1932         trie->startstate= 1;
1933         if ( trie->bitmap && !widecharmap && !trie->jump  ) {
1934             U32 state;
1935             for ( state = 1 ; state < trie->statecount-1 ; state++ ) {
1936                 U32 ofs = 0;
1937                 I32 idx = -1;
1938                 U32 count = 0;
1939                 const U32 base = trie->states[ state ].trans.base;
1940
1941                 if ( trie->states[state].wordnum )
1942                         count = 1;
1943
1944                 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
1945                     if ( ( base + ofs >= trie->uniquecharcount ) &&
1946                          ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
1947                          trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
1948                     {
1949                         if ( ++count > 1 ) {
1950                             SV **tmp = av_fetch( revcharmap, ofs, 0);
1951                             const U8 *ch = (U8*)SvPV_nolen_const( *tmp );
1952                             if ( state == 1 ) break;
1953                             if ( count == 2 ) {
1954                                 Zero(trie->bitmap, ANYOF_BITMAP_SIZE, char);
1955                                 DEBUG_OPTIMISE_r(
1956                                     PerlIO_printf(Perl_debug_log,
1957                                         "%*sNew Start State=%"UVuf" Class: [",
1958                                         (int)depth * 2 + 2, "",
1959                                         (UV)state));
1960                                 if (idx >= 0) {
1961                                     SV ** const tmp = av_fetch( revcharmap, idx, 0);
1962                                     const U8 * const ch = (U8*)SvPV_nolen_const( *tmp );
1963
1964                                     TRIE_BITMAP_SET(trie,*ch);
1965                                     if ( folder )
1966                                         TRIE_BITMAP_SET(trie, folder[ *ch ]);
1967                                     DEBUG_OPTIMISE_r(
1968                                         PerlIO_printf(Perl_debug_log, (char*)ch)
1969                                     );
1970                                 }
1971                             }
1972                             TRIE_BITMAP_SET(trie,*ch);
1973                             if ( folder )
1974                                 TRIE_BITMAP_SET(trie,folder[ *ch ]);
1975                             DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"%s", ch));
1976                         }
1977                         idx = ofs;
1978                     }
1979                 }
1980                 if ( count == 1 ) {
1981                     SV **tmp = av_fetch( revcharmap, idx, 0);
1982                     STRLEN len;
1983                     char *ch = SvPV( *tmp, len );
1984                     DEBUG_OPTIMISE_r({
1985                         SV *sv=sv_newmortal();
1986                         PerlIO_printf( Perl_debug_log,
1987                             "%*sPrefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
1988                             (int)depth * 2 + 2, "",
1989                             (UV)state, (UV)idx, 
1990                             pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6, 
1991                                 PL_colors[0], PL_colors[1],
1992                                 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
1993                                 PERL_PV_ESCAPE_FIRSTCHAR 
1994                             )
1995                         );
1996                     });
1997                     if ( state==1 ) {
1998                         OP( convert ) = nodetype;
1999                         str=STRING(convert);
2000                         STR_LEN(convert)=0;
2001                     }
2002                     STR_LEN(convert) += len;
2003                     while (len--)
2004                         *str++ = *ch++;
2005                 } else {
2006 #ifdef DEBUGGING            
2007                     if (state>1)
2008                         DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"]\n"));
2009 #endif
2010                     break;
2011                 }
2012             }
2013             if (str) {
2014                 regnode *n = convert+NODE_SZ_STR(convert);
2015                 NEXT_OFF(convert) = NODE_SZ_STR(convert);
2016                 trie->startstate = state;
2017                 trie->minlen -= (state - 1);
2018                 trie->maxlen -= (state - 1);
2019                 DEBUG_r({
2020                     regnode *fix = convert;
2021                     U32 word = trie->wordcount;
2022                     mjd_nodelen++;
2023                     Set_Node_Offset_Length(convert, mjd_offset, state - 1);
2024                     while( ++fix < n ) {
2025                         Set_Node_Offset_Length(fix, 0, 0);
2026                     }
2027                     while (word--) {
2028                         SV ** const tmp = av_fetch( trie_words, word, 0 );
2029                         if (tmp) {
2030                             if ( STR_LEN(convert) <= SvCUR(*tmp) )
2031                                 sv_chop(*tmp, SvPV_nolen(*tmp) + STR_LEN(convert));
2032                             else
2033                                 sv_chop(*tmp, SvPV_nolen(*tmp) + SvCUR(*tmp));
2034                         }
2035                     }    
2036                 });
2037                 if (trie->maxlen) {
2038                     convert = n;
2039                 } else {
2040                     NEXT_OFF(convert) = (U16)(tail - convert);
2041                     DEBUG_r(optimize= n);
2042                 }
2043             }
2044         }
2045         if (!jumper) 
2046             jumper = last; 
2047         if ( trie->maxlen ) {
2048             NEXT_OFF( convert ) = (U16)(tail - convert);
2049             ARG_SET( convert, data_slot );
2050             /* Store the offset to the first unabsorbed branch in 
2051                jump[0], which is otherwise unused by the jump logic. 
2052                We use this when dumping a trie and during optimisation. */
2053             if (trie->jump) 
2054                 trie->jump[0] = (U16)(nextbranch - convert);
2055             
2056             /* XXXX */
2057             if ( !trie->states[trie->startstate].wordnum && trie->bitmap && 
2058                  ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) )
2059             {
2060                 OP( convert ) = TRIEC;
2061                 Copy(trie->bitmap, ((struct regnode_charclass *)convert)->bitmap, ANYOF_BITMAP_SIZE, char);
2062                 PerlMemShared_free(trie->bitmap);
2063                 trie->bitmap= NULL;
2064             } else 
2065                 OP( convert ) = TRIE;
2066
2067             /* store the type in the flags */
2068             convert->flags = nodetype;
2069             DEBUG_r({
2070             optimize = convert 
2071                       + NODE_STEP_REGNODE 
2072                       + regarglen[ OP( convert ) ];
2073             });
2074             /* XXX We really should free up the resource in trie now, 
2075                    as we won't use them - (which resources?) dmq */
2076         }
2077         /* needed for dumping*/
2078         DEBUG_r(if (optimize) {
2079             regnode *opt = convert;
2080
2081             while ( ++opt < optimize) {
2082                 Set_Node_Offset_Length(opt,0,0);
2083             }
2084             /* 
2085                 Try to clean up some of the debris left after the 
2086                 optimisation.
2087              */
2088             while( optimize < jumper ) {
2089                 mjd_nodelen += Node_Length((optimize));
2090                 OP( optimize ) = OPTIMIZED;
2091                 Set_Node_Offset_Length(optimize,0,0);
2092                 optimize++;
2093             }
2094             Set_Node_Offset_Length(convert,mjd_offset,mjd_nodelen);
2095         });
2096     } /* end node insert */
2097     RExC_rxi->data->data[ data_slot + 1 ] = (void*)widecharmap;
2098 #ifdef DEBUGGING
2099     RExC_rxi->data->data[ data_slot + TRIE_WORDS_OFFSET ] = (void*)trie_words;
2100     RExC_rxi->data->data[ data_slot + 3 ] = (void*)revcharmap;
2101 #else
2102     SvREFCNT_dec(revcharmap);
2103 #endif
2104     return trie->jump 
2105            ? MADE_JUMP_TRIE 
2106            : trie->startstate>1 
2107              ? MADE_EXACT_TRIE 
2108              : MADE_TRIE;
2109 }
2110
2111 STATIC void
2112 S_make_trie_failtable(pTHX_ RExC_state_t *pRExC_state, regnode *source,  regnode *stclass, U32 depth)
2113 {
2114 /* The Trie is constructed and compressed now so we can build a fail array now if its needed
2115
2116    This is basically the Aho-Corasick algorithm. Its from exercise 3.31 and 3.32 in the
2117    "Red Dragon" -- Compilers, principles, techniques, and tools. Aho, Sethi, Ullman 1985/88
2118    ISBN 0-201-10088-6
2119
2120    We find the fail state for each state in the trie, this state is the longest proper
2121    suffix of the current states 'word' that is also a proper prefix of another word in our
2122    trie. State 1 represents the word '' and is the thus the default fail state. This allows
2123    the DFA not to have to restart after its tried and failed a word at a given point, it
2124    simply continues as though it had been matching the other word in the first place.
2125    Consider
2126       'abcdgu'=~/abcdefg|cdgu/
2127    When we get to 'd' we are still matching the first word, we would encounter 'g' which would
2128    fail, which would bring use to the state representing 'd' in the second word where we would
2129    try 'g' and succeed, prodceding to match 'cdgu'.
2130  */
2131  /* add a fail transition */
2132     const U32 trie_offset = ARG(source);
2133     reg_trie_data *trie=(reg_trie_data *)RExC_rxi->data->data[trie_offset];
2134     U32 *q;
2135     const U32 ucharcount = trie->uniquecharcount;
2136     const U32 numstates = trie->statecount;
2137     const U32 ubound = trie->lasttrans + ucharcount;
2138     U32 q_read = 0;
2139     U32 q_write = 0;
2140     U32 charid;
2141     U32 base = trie->states[ 1 ].trans.base;
2142     U32 *fail;
2143     reg_ac_data *aho;
2144     const U32 data_slot = add_data( pRExC_state, 1, "T" );
2145     GET_RE_DEBUG_FLAGS_DECL;
2146 #ifndef DEBUGGING
2147     PERL_UNUSED_ARG(depth);
2148 #endif
2149
2150
2151     ARG_SET( stclass, data_slot );
2152     aho = (reg_ac_data *) PerlMemShared_calloc( 1, sizeof(reg_ac_data) );
2153     RExC_rxi->data->data[ data_slot ] = (void*)aho;
2154     aho->trie=trie_offset;
2155     aho->states=(reg_trie_state *)PerlMemShared_malloc( numstates * sizeof(reg_trie_state) );
2156     Copy( trie->states, aho->states, numstates, reg_trie_state );
2157     Newxz( q, numstates, U32);
2158     aho->fail = (U32 *) PerlMemShared_calloc( numstates, sizeof(U32) );
2159     aho->refcount = 1;
2160     fail = aho->fail;
2161     /* initialize fail[0..1] to be 1 so that we always have
2162        a valid final fail state */
2163     fail[ 0 ] = fail[ 1 ] = 1;
2164
2165     for ( charid = 0; charid < ucharcount ; charid++ ) {
2166         const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 );
2167         if ( newstate ) {
2168             q[ q_write ] = newstate;
2169             /* set to point at the root */
2170             fail[ q[ q_write++ ] ]=1;
2171         }
2172     }
2173     while ( q_read < q_write) {
2174         const U32 cur = q[ q_read++ % numstates ];
2175         base = trie->states[ cur ].trans.base;
2176
2177         for ( charid = 0 ; charid < ucharcount ; charid++ ) {
2178             const U32 ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 );
2179             if (ch_state) {
2180                 U32 fail_state = cur;
2181                 U32 fail_base;
2182                 do {
2183                     fail_state = fail[ fail_state ];
2184                     fail_base = aho->states[ fail_state ].trans.base;
2185                 } while ( !TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 ) );
2186
2187                 fail_state = TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 );
2188                 fail[ ch_state ] = fail_state;
2189                 if ( !aho->states[ ch_state ].wordnum && aho->states[ fail_state ].wordnum )
2190                 {
2191                         aho->states[ ch_state ].wordnum =  aho->states[ fail_state ].wordnum;
2192                 }
2193                 q[ q_write++ % numstates] = ch_state;
2194             }
2195         }
2196     }
2197     /* restore fail[0..1] to 0 so that we "fall out" of the AC loop
2198        when we fail in state 1, this allows us to use the
2199        charclass scan to find a valid start char. This is based on the principle
2200        that theres a good chance the string being searched contains lots of stuff
2201        that cant be a start char.
2202      */
2203     fail[ 0 ] = fail[ 1 ] = 0;
2204     DEBUG_TRIE_COMPILE_r({
2205         PerlIO_printf(Perl_debug_log,
2206                       "%*sStclass Failtable (%"UVuf" states): 0", 
2207                       (int)(depth * 2), "", (UV)numstates
2208         );
2209         for( q_read=1; q_read<numstates; q_read++ ) {
2210             PerlIO_printf(Perl_debug_log, ", %"UVuf, (UV)fail[q_read]);
2211         }
2212         PerlIO_printf(Perl_debug_log, "\n");
2213     });
2214     Safefree(q);
2215     /*RExC_seen |= REG_SEEN_TRIEDFA;*/
2216 }
2217
2218
2219 /*
2220  * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2.
2221  * These need to be revisited when a newer toolchain becomes available.
2222  */
2223 #if defined(__sparc64__) && defined(__GNUC__)
2224 #   if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
2225 #       undef  SPARC64_GCC_WORKAROUND
2226 #       define SPARC64_GCC_WORKAROUND 1
2227 #   endif
2228 #endif
2229
2230 #define DEBUG_PEEP(str,scan,depth) \
2231     DEBUG_OPTIMISE_r({if (scan){ \
2232        SV * const mysv=sv_newmortal(); \
2233        regnode *Next = regnext(scan); \
2234        regprop(RExC_rx, mysv, scan); \
2235        PerlIO_printf(Perl_debug_log, "%*s" str ">%3d: %s (%d)\n", \
2236        (int)depth*2, "", REG_NODE_NUM(scan), SvPV_nolen_const(mysv),\
2237        Next ? (REG_NODE_NUM(Next)) : 0 ); \
2238    }});
2239
2240
2241
2242
2243
2244 #define JOIN_EXACT(scan,min,flags) \
2245     if (PL_regkind[OP(scan)] == EXACT) \
2246         join_exact(pRExC_state,(scan),(min),(flags),NULL,depth+1)
2247
2248 STATIC U32
2249 S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, I32 *min, U32 flags,regnode *val, U32 depth) {
2250     /* Merge several consecutive EXACTish nodes into one. */
2251     regnode *n = regnext(scan);
2252     U32 stringok = 1;
2253     regnode *next = scan + NODE_SZ_STR(scan);
2254     U32 merged = 0;
2255     U32 stopnow = 0;
2256 #ifdef DEBUGGING
2257     regnode *stop = scan;
2258     GET_RE_DEBUG_FLAGS_DECL;
2259 #else
2260     PERL_UNUSED_ARG(depth);
2261 #endif
2262 #ifndef EXPERIMENTAL_INPLACESCAN
2263     PERL_UNUSED_ARG(flags);
2264     PERL_UNUSED_ARG(val);
2265 #endif
2266     DEBUG_PEEP("join",scan,depth);
2267     
2268     /* Skip NOTHING, merge EXACT*. */
2269     while (n &&
2270            ( PL_regkind[OP(n)] == NOTHING ||
2271              (stringok && (OP(n) == OP(scan))))
2272            && NEXT_OFF(n)
2273            && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
2274         
2275         if (OP(n) == TAIL || n > next)
2276             stringok = 0;
2277         if (PL_regkind[OP(n)] == NOTHING) {
2278             DEBUG_PEEP("skip:",n,depth);
2279             NEXT_OFF(scan) += NEXT_OFF(n);
2280             next = n + NODE_STEP_REGNODE;
2281 #ifdef DEBUGGING
2282             if (stringok)
2283                 stop = n;
2284 #endif
2285             n = regnext(n);
2286         }
2287         else if (stringok) {
2288             const unsigned int oldl = STR_LEN(scan);
2289             regnode * const nnext = regnext(n);
2290             
2291             DEBUG_PEEP("merg",n,depth);
2292             
2293             merged++;
2294             if (oldl + STR_LEN(n) > U8_MAX)
2295                 break;
2296             NEXT_OFF(scan) += NEXT_OFF(n);
2297             STR_LEN(scan) += STR_LEN(n);
2298             next = n + NODE_SZ_STR(n);
2299             /* Now we can overwrite *n : */
2300             Move(STRING(n), STRING(scan) + oldl, STR_LEN(n), char);
2301 #ifdef DEBUGGING
2302             stop = next - 1;
2303 #endif
2304             n = nnext;
2305             if (stopnow) break;
2306         }
2307
2308 #ifdef EXPERIMENTAL_INPLACESCAN
2309         if (flags && !NEXT_OFF(n)) {
2310             DEBUG_PEEP("atch", val, depth);
2311             if (reg_off_by_arg[OP(n)]) {
2312                 ARG_SET(n, val - n);
2313             }
2314             else {
2315                 NEXT_OFF(n) = val - n;
2316             }
2317             stopnow = 1;
2318         }
2319 #endif
2320     }
2321     
2322     if (UTF && ( OP(scan) == EXACTF ) && ( STR_LEN(scan) >= 6 ) ) {
2323     /*
2324     Two problematic code points in Unicode casefolding of EXACT nodes:
2325     
2326     U+0390 - GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
2327     U+03B0 - GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
2328     
2329     which casefold to
2330     
2331     Unicode                      UTF-8
2332     
2333     U+03B9 U+0308 U+0301         0xCE 0xB9 0xCC 0x88 0xCC 0x81
2334     U+03C5 U+0308 U+0301         0xCF 0x85 0xCC 0x88 0xCC 0x81
2335     
2336     This means that in case-insensitive matching (or "loose matching",
2337     as Unicode calls it), an EXACTF of length six (the UTF-8 encoded byte
2338     length of the above casefolded versions) can match a target string
2339     of length two (the byte length of UTF-8 encoded U+0390 or U+03B0).
2340     This would rather mess up the minimum length computation.
2341     
2342     What we'll do is to look for the tail four bytes, and then peek
2343     at the preceding two bytes to see whether we need to decrease
2344     the minimum length by four (six minus two).
2345     
2346     Thanks to the design of UTF-8, there cannot be false matches:
2347     A sequence of valid UTF-8 bytes cannot be a subsequence of
2348     another valid sequence of UTF-8 bytes.
2349     
2350     */
2351          char * const s0 = STRING(scan), *s, *t;
2352          char * const s1 = s0 + STR_LEN(scan) - 1;
2353          char * const s2 = s1 - 4;
2354 #ifdef EBCDIC /* RD tunifold greek 0390 and 03B0 */
2355          const char t0[] = "\xaf\x49\xaf\x42";
2356 #else
2357          const char t0[] = "\xcc\x88\xcc\x81";
2358 #endif
2359          const char * const t1 = t0 + 3;
2360     
2361          for (s = s0 + 2;
2362               s < s2 && (t = ninstr(s, s1, t0, t1));
2363               s = t + 4) {
2364 #ifdef EBCDIC
2365               if (((U8)t[-1] == 0x68 && (U8)t[-2] == 0xB4) ||
2366                   ((U8)t[-1] == 0x46 && (U8)t[-2] == 0xB5))
2367 #else
2368               if (((U8)t[-1] == 0xB9 && (U8)t[-2] == 0xCE) ||
2369                   ((U8)t[-1] == 0x85 && (U8)t[-2] == 0xCF))
2370 #endif
2371                    *min -= 4;
2372          }
2373     }
2374     
2375 #ifdef DEBUGGING
2376     /* Allow dumping */
2377     n = scan + NODE_SZ_STR(scan);
2378     while (n <= stop) {
2379         if (PL_regkind[OP(n)] != NOTHING || OP(n) == NOTHING) {
2380             OP(n) = OPTIMIZED;
2381             NEXT_OFF(n) = 0;
2382         }
2383         n++;
2384     }
2385 #endif
2386     DEBUG_OPTIMISE_r(if (merged){DEBUG_PEEP("finl",scan,depth)});
2387     return stopnow;
2388 }
2389
2390 /* REx optimizer.  Converts nodes into quickier variants "in place".
2391    Finds fixed substrings.  */
2392
2393 /* Stops at toplevel WHILEM as well as at "last". At end *scanp is set
2394    to the position after last scanned or to NULL. */
2395
2396 #define INIT_AND_WITHP \
2397     assert(!and_withp); \
2398     Newx(and_withp,1,struct regnode_charclass_class); \
2399     SAVEFREEPV(and_withp)
2400
2401 /* this is a chain of data about sub patterns we are processing that
2402    need to be handled seperately/specially in study_chunk. Its so
2403    we can simulate recursion without losing state.  */
2404 struct scan_frame;
2405 typedef struct scan_frame {
2406     regnode *last;  /* last node to process in this frame */
2407     regnode *next;  /* next node to process when last is reached */
2408     struct scan_frame *prev; /*previous frame*/
2409     I32 stop; /* what stopparen do we use */
2410 } scan_frame;
2411
2412
2413 #define SCAN_COMMIT(s, data, m) scan_commit(s, data, m, is_inf)
2414
2415 #define CASE_SYNST_FNC(nAmE)                                       \
2416 case 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 case N ## nAmE:                                                    \
2429     if (flags & SCF_DO_STCLASS_AND) {                              \
2430             for (value = 0; value < 256; value++)                   \
2431                 if (is_ ## nAmE ## _cp(value))                         \
2432                     ANYOF_BITMAP_CLEAR(data->start_class, value);   \
2433     }                                                               \
2434     else {                                                          \
2435             for (value = 0; value < 256; value++)                   \
2436                 if (!is_ ## nAmE ## _cp(value))                        \
2437                     ANYOF_BITMAP_SET(data->start_class, value);     \
2438     }                                                               \
2439     break
2440
2441
2442
2443 STATIC I32
2444 S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
2445                         I32 *minlenp, I32 *deltap,
2446                         regnode *last,
2447                         scan_data_t *data,
2448                         I32 stopparen,
2449                         U8* recursed,
2450                         struct regnode_charclass_class *and_withp,
2451                         U32 flags, U32 depth)
2452                         /* scanp: Start here (read-write). */
2453                         /* deltap: Write maxlen-minlen here. */
2454                         /* last: Stop before this one. */
2455                         /* data: string data about the pattern */
2456                         /* stopparen: treat close N as END */
2457                         /* recursed: which subroutines have we recursed into */
2458                         /* and_withp: Valid if flags & SCF_DO_STCLASS_OR */
2459 {
2460     dVAR;
2461     I32 min = 0, pars = 0, code;
2462     regnode *scan = *scanp, *next;
2463     I32 delta = 0;
2464     int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
2465     int is_inf_internal = 0;            /* The studied chunk is infinite */
2466     I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
2467     scan_data_t data_fake;
2468     SV *re_trie_maxbuff = NULL;
2469     regnode *first_non_open = scan;
2470     I32 stopmin = I32_MAX;
2471     scan_frame *frame = NULL;
2472
2473     GET_RE_DEBUG_FLAGS_DECL;
2474
2475 #ifdef DEBUGGING
2476     StructCopy(&zero_scan_data, &data_fake, scan_data_t);
2477 #endif
2478
2479     if ( depth == 0 ) {
2480         while (first_non_open && OP(first_non_open) == OPEN)
2481             first_non_open=regnext(first_non_open);
2482     }
2483
2484
2485   fake_study_recurse:
2486     while ( scan && OP(scan) != END && scan < last ){
2487         /* Peephole optimizer: */
2488         DEBUG_STUDYDATA("Peep:", data,depth);
2489         DEBUG_PEEP("Peep",scan,depth);
2490         JOIN_EXACT(scan,&min,0);
2491
2492         /* Follow the next-chain of the current node and optimize
2493            away all the NOTHINGs from it.  */
2494         if (OP(scan) != CURLYX) {
2495             const int max = (reg_off_by_arg[OP(scan)]
2496                        ? I32_MAX
2497                        /* I32 may be smaller than U16 on CRAYs! */
2498                        : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
2499             int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
2500             int noff;
2501             regnode *n = scan;
2502         
2503             /* Skip NOTHING and LONGJMP. */
2504             while ((n = regnext(n))
2505                    && ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
2506                        || ((OP(n) == LONGJMP) && (noff = ARG(n))))
2507                    && off + noff < max)
2508                 off += noff;
2509             if (reg_off_by_arg[OP(scan)])
2510                 ARG(scan) = off;
2511             else
2512                 NEXT_OFF(scan) = off;
2513         }
2514
2515
2516
2517         /* The principal pseudo-switch.  Cannot be a switch, since we
2518            look into several different things.  */
2519         if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
2520                    || OP(scan) == IFTHEN) {
2521             next = regnext(scan);
2522             code = OP(scan);
2523             /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
2524         
2525             if (OP(next) == code || code == IFTHEN) {
2526                 /* NOTE - There is similar code to this block below for handling
2527                    TRIE nodes on a re-study.  If you change stuff here check there
2528                    too. */
2529                 I32 max1 = 0, min1 = I32_MAX, num = 0;
2530                 struct regnode_charclass_class accum;
2531                 regnode * const startbranch=scan;
2532                 
2533                 if (flags & SCF_DO_SUBSTR)
2534                     SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot merge strings after this. */
2535                 if (flags & SCF_DO_STCLASS)
2536                     cl_init_zero(pRExC_state, &accum);
2537
2538                 while (OP(scan) == code) {
2539                     I32 deltanext, minnext, f = 0, fake;
2540                     struct regnode_charclass_class this_class;
2541
2542                     num++;
2543                     data_fake.flags = 0;
2544                     if (data) {
2545                         data_fake.whilem_c = data->whilem_c;
2546                         data_fake.last_closep = data->last_closep;
2547                     }
2548                     else
2549                         data_fake.last_closep = &fake;
2550
2551                     data_fake.pos_delta = delta;
2552                     next = regnext(scan);
2553                     scan = NEXTOPER(scan);
2554                     if (code != BRANCH)
2555                         scan = NEXTOPER(scan);
2556                     if (flags & SCF_DO_STCLASS) {
2557                         cl_init(pRExC_state, &this_class);
2558                         data_fake.start_class = &this_class;
2559                         f = SCF_DO_STCLASS_AND;
2560                     }
2561                     if (flags & SCF_WHILEM_VISITED_POS)
2562                         f |= SCF_WHILEM_VISITED_POS;
2563
2564                     /* we suppose the run is continuous, last=next...*/
2565                     minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
2566                                           next, &data_fake,
2567                                           stopparen, recursed, NULL, f,depth+1);
2568                     if (min1 > minnext)
2569                         min1 = minnext;
2570                     if (max1 < minnext + deltanext)
2571                         max1 = minnext + deltanext;
2572                     if (deltanext == I32_MAX)
2573                         is_inf = is_inf_internal = 1;
2574                     scan = next;
2575                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
2576                         pars++;
2577                     if (data_fake.flags & SCF_SEEN_ACCEPT) {
2578                         if ( stopmin > minnext) 
2579                             stopmin = min + min1;
2580                         flags &= ~SCF_DO_SUBSTR;
2581                         if (data)
2582                             data->flags |= SCF_SEEN_ACCEPT;
2583                     }
2584                     if (data) {
2585                         if (data_fake.flags & SF_HAS_EVAL)
2586                             data->flags |= SF_HAS_EVAL;
2587                         data->whilem_c = data_fake.whilem_c;
2588                     }
2589                     if (flags & SCF_DO_STCLASS)
2590                         cl_or(pRExC_state, &accum, &this_class);
2591                 }
2592                 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
2593                     min1 = 0;
2594                 if (flags & SCF_DO_SUBSTR) {
2595                     data->pos_min += min1;
2596                     data->pos_delta += max1 - min1;
2597                     if (max1 != min1 || is_inf)
2598                         data->longest = &(data->longest_float);
2599                 }
2600                 min += min1;
2601                 delta += max1 - min1;
2602                 if (flags & SCF_DO_STCLASS_OR) {
2603                     cl_or(pRExC_state, data->start_class, &accum);
2604                     if (min1) {
2605                         cl_and(data->start_class, and_withp);
2606                         flags &= ~SCF_DO_STCLASS;
2607                     }
2608                 }
2609                 else if (flags & SCF_DO_STCLASS_AND) {
2610                     if (min1) {
2611                         cl_and(data->start_class, &accum);
2612                         flags &= ~SCF_DO_STCLASS;
2613                     }
2614                     else {
2615                         /* Switch to OR mode: cache the old value of
2616                          * data->start_class */
2617                         INIT_AND_WITHP;
2618                         StructCopy(data->start_class, and_withp,
2619                                    struct regnode_charclass_class);
2620                         flags &= ~SCF_DO_STCLASS_AND;
2621                         StructCopy(&accum, data->start_class,
2622                                    struct regnode_charclass_class);
2623                         flags |= SCF_DO_STCLASS_OR;
2624                         data->start_class->flags |= ANYOF_EOS;
2625                     }
2626                 }
2627
2628                 if (PERL_ENABLE_TRIE_OPTIMISATION && OP( startbranch ) == BRANCH ) {
2629                 /* demq.
2630
2631                    Assuming this was/is a branch we are dealing with: 'scan' now
2632                    points at the item that follows the branch sequence, whatever
2633                    it is. We now start at the beginning of the sequence and look
2634                    for subsequences of
2635
2636                    BRANCH->EXACT=>x1
2637                    BRANCH->EXACT=>x2
2638                    tail
2639
2640                    which would be constructed from a pattern like /A|LIST|OF|WORDS/
2641
2642                    If we can find such a subseqence we need to turn the first
2643                    element into a trie and then add the subsequent branch exact
2644                    strings to the trie.
2645
2646                    We have two cases
2647
2648                      1. patterns where the whole set of branch can be converted. 
2649
2650                      2. patterns where only a subset can be converted.
2651
2652                    In case 1 we can replace the whole set with a single regop
2653                    for the trie. In case 2 we need to keep the start and end
2654                    branchs so
2655
2656                      'BRANCH EXACT; BRANCH EXACT; BRANCH X'
2657                      becomes BRANCH TRIE; BRANCH X;
2658
2659                   There is an additional case, that being where there is a 
2660                   common prefix, which gets split out into an EXACT like node
2661                   preceding the TRIE node.
2662
2663                   If x(1..n)==tail then we can do a simple trie, if not we make
2664                   a "jump" trie, such that when we match the appropriate word
2665                   we "jump" to the appopriate tail node. Essentailly we turn
2666                   a nested if into a case structure of sorts.
2667
2668                 */
2669                 
2670                     int made=0;
2671                     if (!re_trie_maxbuff) {
2672                         re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
2673                         if (!SvIOK(re_trie_maxbuff))
2674                             sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
2675                     }
2676                     if ( SvIV(re_trie_maxbuff)>=0  ) {
2677                         regnode *cur;
2678                         regnode *first = (regnode *)NULL;
2679                         regnode *last = (regnode *)NULL;
2680                         regnode *tail = scan;
2681                         U8 optype = 0;
2682                         U32 count=0;
2683
2684 #ifdef DEBUGGING
2685                         SV * const mysv = sv_newmortal();       /* for dumping */
2686 #endif
2687                         /* var tail is used because there may be a TAIL
2688                            regop in the way. Ie, the exacts will point to the
2689                            thing following the TAIL, but the last branch will
2690                            point at the TAIL. So we advance tail. If we
2691                            have nested (?:) we may have to move through several
2692                            tails.
2693                          */
2694
2695                         while ( OP( tail ) == TAIL ) {
2696                             /* this is the TAIL generated by (?:) */
2697                             tail = regnext( tail );
2698                         }
2699
2700                         
2701                         DEBUG_OPTIMISE_r({
2702                             regprop(RExC_rx, mysv, tail );
2703                             PerlIO_printf( Perl_debug_log, "%*s%s%s\n",
2704                                 (int)depth * 2 + 2, "", 
2705                                 "Looking for TRIE'able sequences. Tail node is: ", 
2706                                 SvPV_nolen_const( mysv )
2707                             );
2708                         });
2709                         
2710                         /*
2711
2712                            step through the branches, cur represents each
2713                            branch, noper is the first thing to be matched
2714                            as part of that branch and noper_next is the
2715                            regnext() of that node. if noper is an EXACT
2716                            and noper_next is the same as scan (our current
2717                            position in the regex) then the EXACT branch is
2718                            a possible optimization target. Once we have
2719                            two or more consequetive such branches we can
2720                            create a trie of the EXACT's contents and stich
2721                            it in place. If the sequence represents all of
2722                            the branches we eliminate the whole thing and
2723                            replace it with a single TRIE. If it is a
2724                            subsequence then we need to stitch it in. This
2725                            means the first branch has to remain, and needs
2726                            to be repointed at the item on the branch chain
2727                            following the last branch optimized. This could
2728                            be either a BRANCH, in which case the
2729                            subsequence is internal, or it could be the
2730                            item following the branch sequence in which
2731                            case the subsequence is at the end.
2732
2733                         */
2734
2735                         /* dont use tail as the end marker for this traverse */
2736                         for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) {
2737                             regnode * const noper = NEXTOPER( cur );
2738 #if defined(DEBUGGING) || defined(NOJUMPTRIE)
2739                             regnode * const noper_next = regnext( noper );
2740 #endif
2741
2742                             DEBUG_OPTIMISE_r({
2743                                 regprop(RExC_rx, mysv, cur);
2744                                 PerlIO_printf( Perl_debug_log, "%*s- %s (%d)",
2745                                    (int)depth * 2 + 2,"", SvPV_nolen_const( mysv ), REG_NODE_NUM(cur) );
2746
2747                                 regprop(RExC_rx, mysv, noper);
2748                                 PerlIO_printf( Perl_debug_log, " -> %s",
2749                                     SvPV_nolen_const(mysv));
2750
2751                                 if ( noper_next ) {
2752                                   regprop(RExC_rx, mysv, noper_next );
2753                                   PerlIO_printf( Perl_debug_log,"\t=> %s\t",
2754                                     SvPV_nolen_const(mysv));
2755                                 }
2756                                 PerlIO_printf( Perl_debug_log, "(First==%d,Last==%d,Cur==%d)\n",
2757                                    REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur) );
2758                             });
2759                             if ( (((first && optype!=NOTHING) ? OP( noper ) == optype
2760                                          : PL_regkind[ OP( noper ) ] == EXACT )
2761                                   || OP(noper) == NOTHING )
2762 #ifdef NOJUMPTRIE
2763                                   && noper_next == tail
2764 #endif
2765                                   && count < U16_MAX)
2766                             {
2767                                 count++;
2768                                 if ( !first || optype == NOTHING ) {
2769                                     if (!first) first = cur;
2770                                     optype = OP( noper );
2771                                 } else {
2772                                     last = cur;
2773                                 }
2774                             } else {
2775                                 if ( last ) {
2776                                     make_trie( pRExC_state, 
2777                                             startbranch, first, cur, tail, count, 
2778                                             optype, depth+1 );
2779                                 }
2780                                 if ( PL_regkind[ OP( noper ) ] == EXACT
2781 #ifdef NOJUMPTRIE
2782                                      && noper_next == tail
2783 #endif
2784                                 ){
2785                                     count = 1;
2786                                     first = cur;
2787                                     optype = OP( noper );
2788                                 } else {
2789                                     count = 0;
2790                                     first = NULL;
2791                                     optype = 0;
2792                                 }
2793                                 last = NULL;
2794                             }
2795                         }
2796                         DEBUG_OPTIMISE_r({
2797                             regprop(RExC_rx, mysv, cur);
2798                             PerlIO_printf( Perl_debug_log,
2799                               "%*s- %s (%d) <SCAN FINISHED>\n", (int)depth * 2 + 2,
2800                               "", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
2801
2802                         });
2803                         if ( last ) {
2804                             made= make_trie( pRExC_state, startbranch, first, scan, tail, count, optype, depth+1 );
2805 #ifdef TRIE_STUDY_OPT   
2806                             if ( ((made == MADE_EXACT_TRIE && 
2807                                  startbranch == first) 
2808                                  || ( first_non_open == first )) && 
2809                                  depth==0 ) {
2810                                 flags |= SCF_TRIE_RESTUDY;
2811                                 if ( startbranch == first 
2812                                      && scan == tail ) 
2813                                 {
2814                                     RExC_seen &=~REG_TOP_LEVEL_BRANCHES;
2815                                 }
2816                             }
2817 #endif
2818                         }
2819                     }
2820                     
2821                 } /* do trie */
2822                 
2823             }
2824             else if ( code == BRANCHJ ) {  /* single branch is optimized. */
2825                 scan = NEXTOPER(NEXTOPER(scan));
2826             } else                      /* single branch is optimized. */
2827                 scan = NEXTOPER(scan);
2828             continue;
2829         } else if (OP(scan) == SUSPEND || OP(scan) == GOSUB || OP(scan) == GOSTART) {
2830             scan_frame *newframe = NULL;
2831             I32 paren;
2832             regnode *start;
2833             regnode *end;
2834
2835             if (OP(scan) != SUSPEND) {
2836             /* set the pointer */
2837                 if (OP(scan) == GOSUB) {
2838                     paren = ARG(scan);
2839                     RExC_recurse[ARG2L(scan)] = scan;
2840                     start = RExC_open_parens[paren-1];
2841                     end   = RExC_close_parens[paren-1];
2842                 } else {
2843                     paren = 0;
2844                     start = RExC_rxi->program + 1;
2845                     end   = RExC_opend;
2846                 }
2847                 if (!recursed) {
2848                     Newxz(recursed, (((RExC_npar)>>3) +1), U8);
2849                     SAVEFREEPV(recursed);
2850                 }
2851                 if (!PAREN_TEST(recursed,paren+1)) {
2852                     PAREN_SET(recursed,paren+1);
2853                     Newx(newframe,1,scan_frame);
2854                 } else {
2855                     if (flags & SCF_DO_SUBSTR) {
2856                         SCAN_COMMIT(pRExC_state,data,minlenp);
2857                         data->longest = &(data->longest_float);
2858                     }
2859                     is_inf = is_inf_internal = 1;
2860                     if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
2861                         cl_anything(pRExC_state, data->start_class);
2862                     flags &= ~SCF_DO_STCLASS;
2863                 }
2864             } else {
2865                 Newx(newframe,1,scan_frame);
2866                 paren = stopparen;
2867                 start = scan+2;
2868                 end = regnext(scan);
2869             }
2870             if (newframe) {
2871                 assert(start);
2872                 assert(end);
2873                 SAVEFREEPV(newframe);
2874                 newframe->next = regnext(scan);
2875                 newframe->last = last;
2876                 newframe->stop = stopparen;
2877                 newframe->prev = frame;
2878
2879                 frame = newframe;
2880                 scan =  start;
2881                 stopparen = paren;
2882                 last = end;
2883
2884                 continue;
2885             }
2886         }
2887         else if (OP(scan) == EXACT) {
2888             I32 l = STR_LEN(scan);
2889             UV uc;
2890             if (UTF) {
2891                 const U8 * const s = (U8*)STRING(scan);
2892                 l = utf8_length(s, s + l);
2893                 uc = utf8_to_uvchr(s, NULL);
2894             } else {
2895                 uc = *((U8*)STRING(scan));
2896             }
2897             min += l;
2898             if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
2899                 /* The code below prefers earlier match for fixed
2900                    offset, later match for variable offset.  */
2901                 if (data->last_end == -1) { /* Update the start info. */
2902                     data->last_start_min = data->pos_min;
2903                     data->last_start_max = is_inf
2904                         ? I32_MAX : data->pos_min + data->pos_delta;
2905                 }
2906                 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
2907                 if (UTF)
2908                     SvUTF8_on(data->last_found);
2909                 {
2910                     SV * const sv = data->last_found;
2911                     MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
2912                         mg_find(sv, PERL_MAGIC_utf8) : NULL;
2913                     if (mg && mg->mg_len >= 0)
2914                         mg->mg_len += utf8_length((U8*)STRING(scan),
2915                                                   (U8*)STRING(scan)+STR_LEN(scan));
2916                 }
2917                 data->last_end = data->pos_min + l;
2918                 data->pos_min += l; /* As in the first entry. */
2919                 data->flags &= ~SF_BEFORE_EOL;
2920             }
2921             if (flags & SCF_DO_STCLASS_AND) {
2922                 /* Check whether it is compatible with what we know already! */
2923                 int compat = 1;
2924
2925                 if (uc >= 0x100 ||
2926                     (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
2927                     && !ANYOF_BITMAP_TEST(data->start_class, uc)
2928                     && (!(data->start_class->flags & ANYOF_FOLD)
2929                         || !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
2930                     )
2931                     compat = 0;
2932                 ANYOF_CLASS_ZERO(data->start_class);
2933                 ANYOF_BITMAP_ZERO(data->start_class);
2934                 if (compat)
2935                     ANYOF_BITMAP_SET(data->start_class, uc);
2936                 data->start_class->flags &= ~ANYOF_EOS;
2937                 if (uc < 0x100)
2938                   data->start_class->flags &= ~ANYOF_UNICODE_ALL;
2939             }
2940             else if (flags & SCF_DO_STCLASS_OR) {
2941                 /* false positive possible if the class is case-folded */
2942                 if (uc < 0x100)
2943                     ANYOF_BITMAP_SET(data->start_class, uc);
2944                 else
2945                     data->start_class->flags |= ANYOF_UNICODE_ALL;
2946                 data->start_class->flags &= ~ANYOF_EOS;
2947                 cl_and(data->start_class, and_withp);
2948             }
2949             flags &= ~SCF_DO_STCLASS;
2950         }
2951         else if (PL_regkind[OP(scan)] == EXACT) { /* But OP != EXACT! */
2952             I32 l = STR_LEN(scan);
2953             UV uc = *((U8*)STRING(scan));
2954
2955             /* Search for fixed substrings supports EXACT only. */
2956             if (flags & SCF_DO_SUBSTR) {
2957                 assert(data);
2958                 SCAN_COMMIT(pRExC_state, data, minlenp);
2959             }
2960             if (UTF) {
2961                 const U8 * const s = (U8 *)STRING(scan);
2962                 l = utf8_length(s, s + l);
2963                 uc = utf8_to_uvchr(s, NULL);
2964             }
2965             min += l;
2966             if (flags & SCF_DO_SUBSTR)
2967                 data->pos_min += l;
2968             if (flags & SCF_DO_STCLASS_AND) {
2969                 /* Check whether it is compatible with what we know already! */
2970                 int compat = 1;
2971
2972                 if (uc >= 0x100 ||
2973                     (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
2974                     && !ANYOF_BITMAP_TEST(data->start_class, uc)
2975                      && !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
2976                     compat = 0;
2977                 ANYOF_CLASS_ZERO(data->start_class);
2978                 ANYOF_BITMAP_ZERO(data->start_class);
2979                 if (compat) {
2980                     ANYOF_BITMAP_SET(data->start_class, uc);
2981                     data->start_class->flags &= ~ANYOF_EOS;
2982                     data->start_class->flags |= ANYOF_FOLD;
2983                     if (OP(scan) == EXACTFL)
2984                         data->start_class->flags |= ANYOF_LOCALE;
2985                 }
2986             }
2987             else if (flags & SCF_DO_STCLASS_OR) {
2988                 if (data->start_class->flags & ANYOF_FOLD) {
2989                     /* false positive possible if the class is case-folded.
2990                        Assume that the locale settings are the same... */
2991                     if (uc < 0x100)
2992                         ANYOF_BITMAP_SET(data->start_class, uc);
2993                     data->start_class->flags &= ~ANYOF_EOS;
2994                 }
2995                 cl_and(data->start_class, and_withp);
2996             }
2997             flags &= ~SCF_DO_STCLASS;
2998         }
2999         else if (strchr((const char*)PL_varies,OP(scan))) {
3000             I32 mincount, maxcount, minnext, deltanext, fl = 0;
3001             I32 f = flags, pos_before = 0;
3002             regnode * const oscan = scan;
3003             struct regnode_charclass_class this_class;
3004             struct regnode_charclass_class *oclass = NULL;
3005             I32 next_is_eval = 0;
3006
3007             switch (PL_regkind[OP(scan)]) {
3008             case WHILEM:                /* End of (?:...)* . */
3009                 scan = NEXTOPER(scan);
3010                 goto finish;
3011             case PLUS:
3012                 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
3013                     next = NEXTOPER(scan);
3014                     if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
3015                         mincount = 1;
3016                         maxcount = REG_INFTY;
3017                         next = regnext(scan);
3018                         scan = NEXTOPER(scan);
3019                         goto do_curly;
3020                     }
3021                 }
3022                 if (flags & SCF_DO_SUBSTR)
3023                     data->pos_min++;
3024                 min++;
3025                 /* Fall through. */
3026             case STAR:
3027                 if (flags & SCF_DO_STCLASS) {
3028                     mincount = 0;
3029                     maxcount = REG_INFTY;
3030                     next = regnext(scan);
3031                     scan = NEXTOPER(scan);
3032                     goto do_curly;
3033                 }
3034                 is_inf = is_inf_internal = 1;
3035                 scan = regnext(scan);
3036                 if (flags & SCF_DO_SUBSTR) {
3037                     SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot extend fixed substrings */
3038                     data->longest = &(data->longest_float);
3039                 }
3040                 goto optimize_curly_tail;
3041             case CURLY:
3042                 if (stopparen>0 && (OP(scan)==CURLYN || OP(scan)==CURLYM)
3043                     && (scan->flags == stopparen))
3044                 {
3045                     mincount = 1;
3046                     maxcount = 1;
3047                 } else {
3048                     mincount = ARG1(scan);
3049                     maxcount = ARG2(scan);
3050                 }
3051                 next = regnext(scan);
3052                 if (OP(scan) == CURLYX) {
3053                     I32 lp = (data ? *(data->last_closep) : 0);
3054                     scan->flags = ((lp <= (I32)U8_MAX) ? (U8)lp : U8_MAX);
3055                 }
3056                 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3057                 next_is_eval = (OP(scan) == EVAL);
3058               do_curly:
3059                 if (flags & SCF_DO_SUBSTR) {
3060                     if (mincount == 0) SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot extend fixed substrings */
3061                     pos_before = data->pos_min;
3062                 }
3063                 if (data) {
3064                     fl = data->flags;
3065                     data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
3066                     if (is_inf)
3067                         data->flags |= SF_IS_INF;
3068                 }
3069                 if (flags & SCF_DO_STCLASS) {
3070                     cl_init(pRExC_state, &this_class);
3071                     oclass = data->start_class;
3072                     data->start_class = &this_class;
3073                     f |= SCF_DO_STCLASS_AND;
3074                     f &= ~SCF_DO_STCLASS_OR;
3075                 }
3076                 /* These are the cases when once a subexpression
3077                    fails at a particular position, it cannot succeed
3078                    even after backtracking at the enclosing scope.
3079                 
3080                    XXXX what if minimal match and we are at the
3081                         initial run of {n,m}? */
3082                 if ((mincount != maxcount - 1) && (maxcount != REG_INFTY))
3083                     f &= ~SCF_WHILEM_VISITED_POS;
3084
3085                 /* This will finish on WHILEM, setting scan, or on NULL: */
3086                 minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext, 
3087                                       last, data, stopparen, recursed, NULL,
3088                                       (mincount == 0
3089                                         ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
3090
3091                 if (flags & SCF_DO_STCLASS)
3092                     data->start_class = oclass;
3093                 if (mincount == 0 || minnext == 0) {
3094                     if (flags & SCF_DO_STCLASS_OR) {
3095                         cl_or(pRExC_state, data->start_class, &this_class);
3096                     }
3097                     else if (flags & SCF_DO_STCLASS_AND) {
3098                         /* Switch to OR mode: cache the old value of
3099                          * data->start_class */
3100                         INIT_AND_WITHP;
3101                         StructCopy(data->start_class, and_withp,
3102                                    struct regnode_charclass_class);
3103                         flags &= ~SCF_DO_STCLASS_AND;
3104                         StructCopy(&this_class, data->start_class,
3105                                    struct regnode_charclass_class);
3106                         flags |= SCF_DO_STCLASS_OR;
3107                         data->start_class->flags |= ANYOF_EOS;
3108                     }
3109                 } else {                /* Non-zero len */
3110                     if (flags & SCF_DO_STCLASS_OR) {
3111                         cl_or(pRExC_state, data->start_class, &this_class);
3112                         cl_and(data->start_class, and_withp);
3113                     }
3114                     else if (flags & SCF_DO_STCLASS_AND)
3115                         cl_and(data->start_class, &this_class);
3116                     flags &= ~SCF_DO_STCLASS;
3117                 }
3118                 if (!scan)              /* It was not CURLYX, but CURLY. */
3119                     scan = next;
3120                 if ( /* ? quantifier ok, except for (?{ ... }) */
3121                     (next_is_eval || !(mincount == 0 && maxcount == 1))
3122                     && (minnext == 0) && (deltanext == 0)
3123                     && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
3124                     && maxcount <= REG_INFTY/3 /* Complement check for big count */
3125                     && ckWARN(WARN_REGEXP))
3126                 {
3127                     vWARN(RExC_parse,
3128                           "Quantifier unexpected on zero-length expression");
3129                 }
3130
3131                 min += minnext * mincount;
3132                 is_inf_internal |= ((maxcount == REG_INFTY
3133                                      && (minnext + deltanext) > 0)
3134                                     || deltanext == I32_MAX);
3135                 is_inf |= is_inf_internal;
3136                 delta += (minnext + deltanext) * maxcount - minnext * mincount;
3137
3138                 /* Try powerful optimization CURLYX => CURLYN. */
3139                 if (  OP(oscan) == CURLYX && data
3140                       && data->flags & SF_IN_PAR
3141                       && !(data->flags & SF_HAS_EVAL)
3142                       && !deltanext && minnext == 1 ) {
3143                     /* Try to optimize to CURLYN.  */
3144                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
3145                     regnode * const nxt1 = nxt;
3146 #ifdef DEBUGGING
3147                     regnode *nxt2;
3148 #endif
3149
3150                     /* Skip open. */
3151                     nxt = regnext(nxt);
3152                     if (!strchr((const char*)PL_simple,OP(nxt))
3153                         && !(PL_regkind[OP(nxt)] == EXACT
3154                              && STR_LEN(nxt) == 1))
3155                         goto nogo;
3156 #ifdef DEBUGGING
3157                     nxt2 = nxt;
3158 #endif
3159                     nxt = regnext(nxt);
3160                     if (OP(nxt) != CLOSE)
3161                         goto nogo;
3162                     if (RExC_open_parens) {
3163                         RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
3164                         RExC_close_parens[ARG(nxt1)-1]=nxt+2; /*close->while*/
3165                     }
3166                     /* Now we know that nxt2 is the only contents: */
3167                     oscan->flags = (U8)ARG(nxt);
3168                     OP(oscan) = CURLYN;
3169                     OP(nxt1) = NOTHING; /* was OPEN. */
3170
3171 #ifdef DEBUGGING
3172                     OP(nxt1 + 1) = OPTIMIZED; /* was count. */
3173                     NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
3174                     NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */
3175                     OP(nxt) = OPTIMIZED;        /* was CLOSE. */
3176                     OP(nxt + 1) = OPTIMIZED; /* was count. */
3177                     NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
3178 #endif
3179                 }
3180               nogo:
3181
3182                 /* Try optimization CURLYX => CURLYM. */
3183                 if (  OP(oscan) == CURLYX && data
3184                       && !(data->flags & SF_HAS_PAR)
3185                       && !(data->flags & SF_HAS_EVAL)
3186                       && !deltanext     /* atom is fixed width */
3187                       && minnext != 0   /* CURLYM can't handle zero width */
3188                 ) {
3189                     /* XXXX How to optimize if data == 0? */
3190                     /* Optimize to a simpler form.  */
3191                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
3192                     regnode *nxt2;
3193
3194                     OP(oscan) = CURLYM;
3195                     while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
3196                             && (OP(nxt2) != WHILEM))
3197                         nxt = nxt2;
3198                     OP(nxt2)  = SUCCEED; /* Whas WHILEM */
3199                     /* Need to optimize away parenths. */
3200                     if (data->flags & SF_IN_PAR) {
3201                         /* Set the parenth number.  */
3202                         regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
3203
3204                         if (OP(nxt) != CLOSE)
3205                             FAIL("Panic opt close");
3206                         oscan->flags = (U8)ARG(nxt);
3207                         if (RExC_open_parens) {
3208                             RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
3209                             RExC_close_parens[ARG(nxt1)-1]=nxt2+1; /*close->NOTHING*/
3210                         }
3211                         OP(nxt1) = OPTIMIZED;   /* was OPEN. */
3212                         OP(nxt) = OPTIMIZED;    /* was CLOSE. */
3213
3214 #ifdef DEBUGGING
3215                         OP(nxt1 + 1) = OPTIMIZED; /* was count. */
3216                         OP(nxt + 1) = OPTIMIZED; /* was count. */
3217                         NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
3218                         NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
3219 #endif
3220 #if 0
3221                         while ( nxt1 && (OP(nxt1) != WHILEM)) {
3222                             regnode *nnxt = regnext(nxt1);
3223                         
3224                             if (nnxt == nxt) {
3225                                 if (reg_off_by_arg[OP(nxt1)])
3226                                     ARG_SET(nxt1, nxt2 - nxt1);
3227                                 else if (nxt2 - nxt1 < U16_MAX)
3228                                     NEXT_OFF(nxt1) = nxt2 - nxt1;
3229                                 else
3230                                     OP(nxt) = NOTHING;  /* Cannot beautify */
3231                             }
3232                             nxt1 = nnxt;
3233                         }
3234 #endif
3235                         /* Optimize again: */
3236                         study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt,
3237                                     NULL, stopparen, recursed, NULL, 0,depth+1);
3238                     }
3239                     else
3240                         oscan->flags = 0;
3241                 }
3242                 else if ((OP(oscan) == CURLYX)
3243                          && (flags & SCF_WHILEM_VISITED_POS)
3244                          /* See the comment on a similar expression above.
3245                             However, this time it not a subexpression
3246                             we care about, but the expression itself. */
3247                          && (maxcount == REG_INFTY)
3248                          && data && ++data->whilem_c < 16) {
3249                     /* This stays as CURLYX, we can put the count/of pair. */
3250                     /* Find WHILEM (as in regexec.c) */
3251                     regnode *nxt = oscan + NEXT_OFF(oscan);
3252
3253                     if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
3254                         nxt += ARG(nxt);
3255                     PREVOPER(nxt)->flags = (U8)(data->whilem_c
3256                         | (RExC_whilem_seen << 4)); /* On WHILEM */
3257                 }
3258                 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
3259                     pars++;
3260                 if (flags & SCF_DO_SUBSTR) {
3261                     SV *last_str = NULL;
3262                     int counted = mincount != 0;
3263
3264                     if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
3265 #if defined(SPARC64_GCC_WORKAROUND)
3266                         I32 b = 0;
3267                         STRLEN l = 0;
3268                         const char *s = NULL;
3269                         I32 old = 0;
3270
3271                         if (pos_before >= data->last_start_min)
3272                             b = pos_before;
3273                         else
3274                             b = data->last_start_min;
3275
3276                         l = 0;
3277                         s = SvPV_const(data->last_found, l);
3278                         old = b - data->last_start_min;
3279
3280 #else
3281                         I32 b = pos_before >= data->last_start_min
3282                             ? pos_before : data->last_start_min;
3283                         STRLEN l;
3284                         const char * const s = SvPV_const(data->last_found, l);
3285                         I32 old = b - data->last_start_min;
3286 #endif
3287
3288                         if (UTF)
3289                             old = utf8_hop((U8*)s, old) - (U8*)s;
3290                         
3291                         l -= old;
3292                         /* Get the added string: */
3293                         last_str = newSVpvn(s  + old, l);
3294                         if (UTF)
3295                             SvUTF8_on(last_str);
3296                         if (deltanext == 0 && pos_before == b) {
3297                             /* What was added is a constant string */
3298                             if (mincount > 1) {
3299                                 SvGROW(last_str, (mincount * l) + 1);
3300                                 repeatcpy(SvPVX(last_str) + l,
3301                                           SvPVX_const(last_str), l, mincount - 1);
3302                                 SvCUR_set(last_str, SvCUR(last_str) * mincount);
3303                                 /* Add additional parts. */
3304                                 SvCUR_set(data->last_found,
3305                                           SvCUR(data->last_found) - l);
3306                                 sv_catsv(data->last_found, last_str);
3307                                 {
3308                                     SV * sv = data->last_found;
3309                                     MAGIC *mg =
3310                                         SvUTF8(sv) && SvMAGICAL(sv) ?
3311                                         mg_find(sv, PERL_MAGIC_utf8) : NULL;
3312                                     if (mg && mg->mg_len >= 0)
3313                                         mg->mg_len += CHR_SVLEN(last_str) - l;
3314                                 }
3315                                 data->last_end += l * (mincount - 1);
3316                             }
3317                         } else {
3318                             /* start offset must point into the last copy */
3319                             data->last_start_min += minnext * (mincount - 1);
3320                             data->last_start_max += is_inf ? I32_MAX
3321                                 : (maxcount - 1) * (minnext + data->pos_delta);
3322                         }
3323                     }
3324                     /* It is counted once already... */
3325                     data->pos_min += minnext * (mincount - counted);
3326                     data->pos_delta += - counted * deltanext +
3327                         (minnext + deltanext) * maxcount - minnext * mincount;
3328                     if (mincount != maxcount) {
3329                          /* Cannot extend fixed substrings found inside
3330                             the group.  */
3331                         SCAN_COMMIT(pRExC_state,data,minlenp);
3332                         if (mincount && last_str) {
3333                             SV * const sv = data->last_found;
3334                             MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
3335                                 mg_find(sv, PERL_MAGIC_utf8) : NULL;
3336
3337                             if (mg)
3338                                 mg->mg_len = -1;
3339                             sv_setsv(sv, last_str);
3340                             data->last_end = data->pos_min;
3341                             data->last_start_min =
3342                                 data->pos_min - CHR_SVLEN(last_str);
3343                             data->last_start_max = is_inf
3344                                 ? I32_MAX
3345                                 : data->pos_min + data->pos_delta
3346                                 - CHR_SVLEN(last_str);
3347                         }
3348                         data->longest = &(data->longest_float);
3349                     }
3350                     SvREFCNT_dec(last_str);
3351                 }
3352                 if (data && (fl & SF_HAS_EVAL))
3353                     data->flags |= SF_HAS_EVAL;
3354               optimize_curly_tail:
3355                 if (OP(oscan) != CURLYX) {
3356                     while (PL_regkind[OP(next = regnext(oscan))] == NOTHING
3357                            && NEXT_OFF(next))
3358                         NEXT_OFF(oscan) += NEXT_OFF(next);
3359                 }
3360                 continue;
3361             default:                    /* REF and CLUMP only? */
3362                 if (flags & SCF_DO_SUBSTR) {
3363                     SCAN_COMMIT(pRExC_state,data,minlenp);      /* Cannot expect anything... */
3364                     data->longest = &(data->longest_float);
3365                 }
3366                 is_inf = is_inf_internal = 1;
3367                 if (flags & SCF_DO_STCLASS_OR)
3368                     cl_anything(pRExC_state, data->start_class);
3369                 flags &= ~SCF_DO_STCLASS;
3370                 break;
3371             }
3372         }
3373         else if (OP(scan) == LNBREAK) {
3374             if (flags & SCF_DO_STCLASS) {
3375                 int value = 0;
3376                 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
3377                 if (flags & SCF_DO_STCLASS_AND) {
3378                     for (value = 0; value < 256; value++)
3379                         if (!is_VERTWS_cp(value))
3380                             ANYOF_BITMAP_CLEAR(data->start_class, value);  
3381                 }                                                              
3382                 else {                                                         
3383                     for (value = 0; value < 256; value++)
3384                         if (is_VERTWS_cp(value))
3385                             ANYOF_BITMAP_SET(data->start_class, value);    
3386                 }                                                              
3387                 if (flags & SCF_DO_STCLASS_OR)
3388                     cl_and(data->start_class, and_withp);
3389                 flags &= ~SCF_DO_STCLASS;
3390             }
3391             min += 1;
3392             delta += 1;
3393             if (flags & SCF_DO_SUBSTR) {
3394                 SCAN_COMMIT(pRExC_state,data,minlenp);  /* Cannot expect anything... */
3395                 data->pos_min += 1;
3396                 data->pos_delta += 1;
3397                 data->longest = &(data->longest_float);
3398             }
3399             
3400         }
3401         else if (OP(scan) == FOLDCHAR) {
3402             int d = ARG(scan)==0xDF ? 1 : 2;
3403             flags &= ~SCF_DO_STCLASS;
3404             min += 1;
3405             delta += d;
3406             if (flags & SCF_DO_SUBSTR) {
3407                 SCAN_COMMIT(pRExC_state,data,minlenp);  /* Cannot expect anything... */
3408                 data->pos_min += 1;
3409                 data->pos_delta += d;
3410                 data->longest = &(data->longest_float);
3411             }
3412         }
3413         else if (strchr((const char*)PL_simple,OP(scan))) {
3414             int value = 0;
3415
3416             if (flags & SCF_DO_SUBSTR) {
3417                 SCAN_COMMIT(pRExC_state,data,minlenp);
3418                 data->pos_min++;
3419             }
3420             min++;
3421             if (flags & SCF_DO_STCLASS) {
3422                 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
3423
3424                 /* Some of the logic below assumes that switching
3425                    locale on will only add false positives. */
3426                 switch (PL_regkind[OP(scan)]) {
3427                 case SANY:
3428                 default:
3429                   do_default:
3430                     /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
3431                     if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3432                         cl_anything(pRExC_state, data->start_class);
3433                     break;
3434                 case REG_ANY:
3435                     if (OP(scan) == SANY)
3436                         goto do_default;
3437                     if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
3438                         value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
3439                                  || (data->start_class->flags & ANYOF_CLASS));
3440                         cl_anything(pRExC_state, data->start_class);
3441                     }
3442                     if (flags & SCF_DO_STCLASS_AND || !value)
3443                         ANYOF_BITMAP_CLEAR(data->start_class,'\n');
3444                     break;
3445                 case ANYOF:
3446                     if (flags & SCF_DO_STCLASS_AND)
3447                         cl_and(data->start_class,
3448                                (struct regnode_charclass_class*)scan);
3449                     else
3450                         cl_or(pRExC_state, data->start_class,
3451                               (struct regnode_charclass_class*)scan);
3452                     break;
3453                 case ALNUM:
3454                     if (flags & SCF_DO_STCLASS_AND) {
3455                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
3456                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
3457                             for (value = 0; value < 256; value++)
3458                                 if (!isALNUM(value))
3459                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3460                         }
3461                     }
3462                     else {
3463                         if (data->start_class->flags & ANYOF_LOCALE)
3464                             ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
3465                         else {
3466                             for (value = 0; value < 256; value++)
3467                                 if (isALNUM(value))
3468                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3469                         }
3470                     }
3471                     break;
3472                 case ALNUML:
3473                     if (flags & SCF_DO_STCLASS_AND) {
3474                         if (data->start_class->flags & ANYOF_LOCALE)
3475                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
3476                     }
3477                     else {
3478                         ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
3479                         data->start_class->flags |= ANYOF_LOCALE;
3480                     }
3481                     break;
3482                 case NALNUM:
3483                     if (flags & SCF_DO_STCLASS_AND) {
3484                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
3485                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
3486                             for (value = 0; value < 256; value++)
3487                                 if (isALNUM(value))
3488                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3489                         }
3490                     }
3491                     else {
3492                         if (data->start_class->flags & ANYOF_LOCALE)
3493                             ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
3494                         else {
3495                             for (value = 0; value < 256; value++)
3496                                 if (!isALNUM(value))
3497                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3498                         }
3499                     }
3500                     break;
3501                 case NALNUML:
3502                     if (flags & SCF_DO_STCLASS_AND) {
3503                         if (data->start_class->flags & ANYOF_LOCALE)
3504                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
3505                     }
3506                     else {
3507                         data->start_class->flags |= ANYOF_LOCALE;
3508                         ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
3509                     }
3510                     break;
3511                 case SPACE:
3512                     if (flags & SCF_DO_STCLASS_AND) {
3513                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
3514                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
3515                             for (value = 0; value < 256; value++)
3516                                 if (!isSPACE(value))
3517                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3518                         }
3519                     }
3520                     else {
3521                         if (data->start_class->flags & ANYOF_LOCALE)
3522                             ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
3523                         else {
3524                             for (value = 0; value < 256; value++)
3525                                 if (isSPACE(value))
3526                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3527                         }
3528                     }
3529                     break;
3530                 case SPACEL:
3531                     if (flags & SCF_DO_STCLASS_AND) {
3532                         if (data->start_class->flags & ANYOF_LOCALE)
3533                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
3534                     }
3535                     else {
3536                         data->start_class->flags |= ANYOF_LOCALE;
3537                         ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
3538                     }
3539                     break;
3540                 case NSPACE:
3541                     if (flags & SCF_DO_STCLASS_AND) {
3542                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
3543                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3544                             for (value = 0; value < 256; value++)
3545                                 if (isSPACE(value))
3546                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3547                         }
3548                     }
3549                     else {
3550                         if (data->start_class->flags & ANYOF_LOCALE)
3551                             ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3552                         else {
3553                             for (value = 0; value < 256; value++)
3554                                 if (!isSPACE(value))
3555                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3556                         }
3557                     }
3558                     break;
3559                 case NSPACEL:
3560                     if (flags & SCF_DO_STCLASS_AND) {
3561                         if (data->start_class->flags & ANYOF_LOCALE) {
3562                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3563                             for (value = 0; value < 256; value++)
3564                                 if (!isSPACE(value))
3565                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3566                         }
3567                     }
3568                     else {
3569                         data->start_class->flags |= ANYOF_LOCALE;
3570                         ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3571                     }
3572                     break;
3573                 case DIGIT:
3574                     if (flags & SCF_DO_STCLASS_AND) {
3575                         ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
3576                         for (value = 0; value < 256; value++)
3577                             if (!isDIGIT(value))
3578                                 ANYOF_BITMAP_CLEAR(data->start_class, value);
3579                     }
3580                     else {
3581                         if (data->start_class->flags & ANYOF_LOCALE)
3582                             ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
3583                         else {
3584                             for (value = 0; value < 256; value++)
3585                                 if (isDIGIT(value))
3586                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3587                         }
3588                     }
3589                     break;
3590                 case NDIGIT:
3591                     if (flags & SCF_DO_STCLASS_AND) {
3592                         ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
3593                         for (value = 0; value < 256; value++)
3594                             if (isDIGIT(value))
3595                                 ANYOF_BITMAP_CLEAR(data->start_class, value);
3596                     }
3597                     else {
3598                         if (data->start_class->flags & ANYOF_LOCALE)
3599                             ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
3600                         else {
3601                             for (value = 0; value < 256; value++)
3602                                 if (!isDIGIT(value))
3603                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3604                         }
3605                     }
3606                     break;
3607                 CASE_SYNST_FNC(VERTWS);
3608                 CASE_SYNST_FNC(HORIZWS);
3609                 
3610                 }
3611                 if (flags & SCF_DO_STCLASS_OR)
3612                     cl_and(data->start_class, and_withp);
3613                 flags &= ~SCF_DO_STCLASS;
3614             }
3615         }
3616         else if (PL_regkind[OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
3617             data->flags |= (OP(scan) == MEOL
3618                             ? SF_BEFORE_MEOL
3619                             : SF_BEFORE_SEOL);
3620         }
3621         else if (  PL_regkind[OP(scan)] == BRANCHJ
3622                  /* Lookbehind, or need to calculate parens/evals/stclass: */
3623                    && (scan->flags || data || (flags & SCF_DO_STCLASS))
3624                    && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
3625             if ( !PERL_ENABLE_POSITIVE_ASSERTION_STUDY 
3626                 || OP(scan) == UNLESSM )
3627             {
3628                 /* Negative Lookahead/lookbehind
3629                    In this case we can't do fixed string optimisation.
3630                 */
3631
3632                 I32 deltanext, minnext, fake = 0;
3633                 regnode *nscan;
3634                 struct regnode_charclass_class intrnl;
3635                 int f = 0;
3636
3637                 data_fake.flags = 0;
3638                 if (data) {
3639                     data_fake.whilem_c = data->whilem_c;
3640                     data_fake.last_closep = data->last_closep;
3641                 }
3642                 else
3643                     data_fake.last_closep = &fake;
3644                 data_fake.pos_delta = delta;
3645                 if ( flags & SCF_DO_STCLASS && !scan->flags
3646                      && OP(scan) == IFMATCH ) { /* Lookahead */
3647                     cl_init(pRExC_state, &intrnl);
3648                     data_fake.start_class = &intrnl;
3649                     f |= SCF_DO_STCLASS_AND;
3650                 }
3651                 if (flags & SCF_WHILEM_VISITED_POS)
3652                     f |= SCF_WHILEM_VISITED_POS;
3653                 next = regnext(scan);
3654                 nscan = NEXTOPER(NEXTOPER(scan));
3655                 minnext = study_chunk(pRExC_state, &nscan, minlenp, &deltanext, 
3656                     last, &data_fake, stopparen, recursed, NULL, f, depth+1);
3657                 if (scan->flags) {
3658                     if (deltanext) {
3659                         FAIL("Variable length lookbehind not implemented");
3660                     }
3661                     else if (minnext > (I32)U8_MAX) {
3662                         FAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
3663                     }
3664                     scan->flags = (U8)minnext;
3665                 }
3666                 if (data) {
3667                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3668                         pars++;
3669                     if (data_fake.flags & SF_HAS_EVAL)
3670                         data->flags |= SF_HAS_EVAL;
3671                     data->whilem_c = data_fake.whilem_c;
3672                 }
3673                 if (f & SCF_DO_STCLASS_AND) {
3674                     const int was = (data->start_class->flags & ANYOF_EOS);
3675
3676                     cl_and(data->start_class, &intrnl);
3677                     if (was)
3678                         data->start_class->flags |= ANYOF_EOS;
3679                 }
3680             }
3681 #if PERL_ENABLE_POSITIVE_ASSERTION_STUDY
3682             else {
3683                 /* Positive Lookahead/lookbehind
3684                    In this case we can do fixed string optimisation,
3685                    but we must be careful about it. Note in the case of
3686                    lookbehind the positions will be offset by the minimum
3687                    length of the pattern, something we won't know about
3688                    until after the recurse.
3689                 */
3690                 I32 deltanext, fake = 0;
3691                 regnode *nscan;
3692                 struct regnode_charclass_class intrnl;
3693                 int f = 0;
3694                 /* We use SAVEFREEPV so that when the full compile 
3695                     is finished perl will clean up the allocated 
3696                     minlens when its all done. This was we don't
3697                     have to worry about freeing them when we know
3698                     they wont be used, which would be a pain.
3699                  */
3700                 I32 *minnextp;
3701                 Newx( minnextp, 1, I32 );
3702                 SAVEFREEPV(minnextp);
3703
3704                 if (data) {
3705                     StructCopy(data, &data_fake, scan_data_t);
3706                     if ((flags & SCF_DO_SUBSTR) && data->last_found) {
3707                         f |= SCF_DO_SUBSTR;
3708                         if (scan->flags) 
3709                             SCAN_COMMIT(pRExC_state, &data_fake,minlenp);
3710                         data_fake.last_found=newSVsv(data->last_found);
3711                     }
3712                 }
3713                 else
3714                     data_fake.last_closep = &fake;
3715                 data_fake.flags = 0;
3716                 data_fake.pos_delta = delta;
3717                 if (is_inf)
3718                     data_fake.flags |= SF_IS_INF;
3719                 if ( flags & SCF_DO_STCLASS && !scan->flags
3720                      && OP(scan) == IFMATCH ) { /* Lookahead */
3721                     cl_init(pRExC_state, &intrnl);
3722                     data_fake.start_class = &intrnl;
3723                     f |= SCF_DO_STCLASS_AND;
3724                 }
3725                 if (flags & SCF_WHILEM_VISITED_POS)
3726                     f |= SCF_WHILEM_VISITED_POS;
3727                 next = regnext(scan);
3728                 nscan = NEXTOPER(NEXTOPER(scan));
3729
3730                 *minnextp = study_chunk(pRExC_state, &nscan, minnextp, &deltanext, 
3731                     last, &data_fake, stopparen, recursed, NULL, f,depth+1);
3732                 if (scan->flags) {
3733                     if (deltanext) {
3734                         FAIL("Variable length lookbehind not implemented");
3735                     }
3736                     else if (*minnextp > (I32)U8_MAX) {
3737                         FAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
3738                     }
3739                     scan->flags = (U8)*minnextp;
3740                 }
3741
3742                 *minnextp += min;
3743
3744                 if (f & SCF_DO_STCLASS_AND) {
3745                     const int was = (data->start_class->flags & ANYOF_EOS);
3746
3747                     cl_and(data->start_class, &intrnl);
3748                     if (was)
3749                         data->start_class->flags |= ANYOF_EOS;
3750                 }
3751                 if (data) {
3752                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3753                         pars++;
3754                     if (data_fake.flags & SF_HAS_EVAL)
3755                         data->flags |= SF_HAS_EVAL;
3756                     data->whilem_c = data_fake.whilem_c;
3757                     if ((flags & SCF_DO_SUBSTR) && data_fake.last_found) {
3758                         if (RExC_rx->minlen<*minnextp)
3759                             RExC_rx->minlen=*minnextp;
3760                         SCAN_COMMIT(pRExC_state, &data_fake, minnextp);
3761                         SvREFCNT_dec(data_fake.last_found);
3762                         
3763                         if ( data_fake.minlen_fixed != minlenp ) 
3764                         {
3765                             data->offset_fixed= data_fake.offset_fixed;
3766                             data->minlen_fixed= data_fake.minlen_fixed;
3767                             data->lookbehind_fixed+= scan->flags;
3768                         }
3769                         if ( data_fake.minlen_float != minlenp )
3770                         {
3771                             data->minlen_float= data_fake.minlen_float;
3772                             data->offset_float_min=data_fake.offset_float_min;
3773                             data->offset_float_max=data_fake.offset_float_max;
3774                             data->lookbehind_float+= scan->flags;
3775                         }
3776                     }
3777                 }
3778
3779
3780             }
3781 #endif
3782         }
3783         else if (OP(scan) == OPEN) {
3784             if (stopparen != (I32)ARG(scan))
3785                 pars++;
3786         }
3787         else if (OP(scan) == CLOSE) {
3788             if (stopparen == (I32)ARG(scan)) {
3789                 break;
3790             }
3791             if ((I32)ARG(scan) == is_par) {
3792                 next = regnext(scan);
3793
3794                 if ( next && (OP(next) != WHILEM) && next < last)
3795                     is_par = 0;         /* Disable optimization */
3796             }
3797             if (data)
3798                 *(data->last_closep) = ARG(scan);
3799         }
3800         else if (OP(scan) == EVAL) {
3801                 if (data)
3802                     data->flags |= SF_HAS_EVAL;
3803         }
3804         else if ( PL_regkind[OP(scan)] == ENDLIKE ) {
3805             if (flags & SCF_DO_SUBSTR) {
3806                 SCAN_COMMIT(pRExC_state,data,minlenp);
3807                 flags &= ~SCF_DO_SUBSTR;
3808             }
3809             if (data && OP(scan)==ACCEPT) {
3810                 data->flags |= SCF_SEEN_ACCEPT;
3811                 if (stopmin > min)
3812                     stopmin = min;
3813             }
3814         }
3815         else if (OP(scan) == LOGICAL && scan->flags == 2) /* Embedded follows */
3816         {
3817                 if (flags & SCF_DO_SUBSTR) {
3818                     SCAN_COMMIT(pRExC_state,data,minlenp);
3819                     data->longest = &(data->longest_float);
3820                 }
3821                 is_inf = is_inf_internal = 1;
3822                 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3823                     cl_anything(pRExC_state, data->start_class);
3824                 flags &= ~SCF_DO_STCLASS;
3825         }
3826         else if (OP(scan) == GPOS) {
3827             if (!(RExC_rx->extflags & RXf_GPOS_FLOAT) &&
3828                 !(delta || is_inf || (data && data->pos_delta))) 
3829             {