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