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