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