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