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