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