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