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