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