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