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