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