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