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