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