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