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