This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
c26677a91a63c6d9c8cf7e8ba22e59535aeee519
[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((const void*)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, 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, 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, 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 #ifdef EBCDIC /* RD tunifold greek 0390 and 03B0 */
2009          const char t0[] = "\xaf\x49\xaf\x42";
2010 #else
2011          const char t0[] = "\xcc\x88\xcc\x81";
2012 #endif
2013          const char * const t1 = t0 + 3;
2014     
2015          for (s = s0 + 2;
2016               s < s2 && (t = ninstr(s, s1, t0, t1));
2017               s = t + 4) {
2018 #ifdef EBCDIC
2019               if (((U8)t[-1] == 0x68 && (U8)t[-2] == 0xB4) ||
2020                   ((U8)t[-1] == 0x46 && (U8)t[-2] == 0xB5))
2021 #else
2022               if (((U8)t[-1] == 0xB9 && (U8)t[-2] == 0xCE) ||
2023                   ((U8)t[-1] == 0x85 && (U8)t[-2] == 0xCF))
2024 #endif
2025                    *min -= 4;
2026          }
2027     }
2028     
2029 #ifdef DEBUGGING
2030     /* Allow dumping */
2031     n = scan + NODE_SZ_STR(scan);
2032     while (n <= stop) {
2033         if (PL_regkind[OP(n)] != NOTHING || OP(n) == NOTHING) {
2034             OP(n) = OPTIMIZED;
2035             NEXT_OFF(n) = 0;
2036         }
2037         n++;
2038     }
2039 #endif
2040     DEBUG_OPTIMISE_r(if (merged){DEBUG_PEEP("finl",scan,depth)});
2041     return stopnow;
2042 }
2043
2044 /* REx optimizer.  Converts nodes into quickier variants "in place".
2045    Finds fixed substrings.  */
2046
2047 /* Stops at toplevel WHILEM as well as at "last". At end *scanp is set
2048    to the position after last scanned or to NULL. */
2049
2050
2051
2052 STATIC I32
2053 S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
2054                         regnode *last, scan_data_t *data, U32 flags, U32 depth)
2055                         /* scanp: Start here (read-write). */
2056                         /* deltap: Write maxlen-minlen here. */
2057                         /* last: Stop before this one. */
2058 {
2059     dVAR;
2060     I32 min = 0, pars = 0, code;
2061     regnode *scan = *scanp, *next;
2062     I32 delta = 0;
2063     int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
2064     int is_inf_internal = 0;            /* The studied chunk is infinite */
2065     I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
2066     scan_data_t data_fake;
2067     struct regnode_charclass_class and_with; /* Valid if flags & SCF_DO_STCLASS_OR */
2068     SV *re_trie_maxbuff = NULL;
2069
2070     GET_RE_DEBUG_FLAGS_DECL;
2071 #ifdef DEBUGGING
2072     StructCopy(&zero_scan_data, &data_fake, scan_data_t);    
2073 #endif
2074
2075     while (scan && OP(scan) != END && scan < last) {
2076         /* Peephole optimizer: */
2077         DEBUG_PEEP("Peep",scan,depth);
2078
2079         JOIN_EXACT(scan,&min,0);
2080
2081         /* Follow the next-chain of the current node and optimize
2082            away all the NOTHINGs from it.  */
2083         if (OP(scan) != CURLYX) {
2084             const int max = (reg_off_by_arg[OP(scan)]
2085                        ? I32_MAX
2086                        /* I32 may be smaller than U16 on CRAYs! */
2087                        : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
2088             int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
2089             int noff;
2090             regnode *n = scan;
2091         
2092             /* Skip NOTHING and LONGJMP. */
2093             while ((n = regnext(n))
2094                    && ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
2095                        || ((OP(n) == LONGJMP) && (noff = ARG(n))))
2096                    && off + noff < max)
2097                 off += noff;
2098             if (reg_off_by_arg[OP(scan)])
2099                 ARG(scan) = off;
2100             else
2101                 NEXT_OFF(scan) = off;
2102         }
2103
2104
2105
2106         /* The principal pseudo-switch.  Cannot be a switch, since we
2107            look into several different things.  */
2108         if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
2109                    || OP(scan) == IFTHEN || OP(scan) == SUSPEND) {
2110             next = regnext(scan);
2111             code = OP(scan);
2112             /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
2113         
2114             if (OP(next) == code || code == IFTHEN || code == SUSPEND) {
2115                 I32 max1 = 0, min1 = I32_MAX, num = 0;
2116                 struct regnode_charclass_class accum;
2117                 regnode * const startbranch=scan;
2118                 
2119                 if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
2120                     scan_commit(pRExC_state, data); /* Cannot merge strings after this. */
2121                 if (flags & SCF_DO_STCLASS)
2122                     cl_init_zero(pRExC_state, &accum);
2123
2124                 while (OP(scan) == code) {
2125                     I32 deltanext, minnext, f = 0, fake;
2126                     struct regnode_charclass_class this_class;
2127
2128                     num++;
2129                     data_fake.flags = 0;
2130                     if (data) {         
2131                         data_fake.whilem_c = data->whilem_c;
2132                         data_fake.last_closep = data->last_closep;
2133                     }
2134                     else
2135                         data_fake.last_closep = &fake;
2136                     next = regnext(scan);
2137                     scan = NEXTOPER(scan);
2138                     if (code != BRANCH)
2139                         scan = NEXTOPER(scan);
2140                     if (flags & SCF_DO_STCLASS) {
2141                         cl_init(pRExC_state, &this_class);
2142                         data_fake.start_class = &this_class;
2143                         f = SCF_DO_STCLASS_AND;
2144                     }           
2145                     if (flags & SCF_WHILEM_VISITED_POS)
2146                         f |= SCF_WHILEM_VISITED_POS;
2147
2148                     /* we suppose the run is continuous, last=next...*/
2149                     minnext = study_chunk(pRExC_state, &scan, &deltanext,
2150                                           next, &data_fake, f,depth+1);
2151                     if (min1 > minnext)
2152                         min1 = minnext;
2153                     if (max1 < minnext + deltanext)
2154                         max1 = minnext + deltanext;
2155                     if (deltanext == I32_MAX)
2156                         is_inf = is_inf_internal = 1;
2157                     scan = next;
2158                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
2159                         pars++;
2160                     if (data) {
2161                         if (data_fake.flags & SF_HAS_EVAL)
2162                             data->flags |= SF_HAS_EVAL;
2163                         data->whilem_c = data_fake.whilem_c;
2164                     }
2165                     if (flags & SCF_DO_STCLASS)
2166                         cl_or(pRExC_state, &accum, &this_class);
2167                     if (code == SUSPEND)
2168                         break;
2169                 }
2170                 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
2171                     min1 = 0;
2172                 if (flags & SCF_DO_SUBSTR) {
2173                     data->pos_min += min1;
2174                     data->pos_delta += max1 - min1;
2175                     if (max1 != min1 || is_inf)
2176                         data->longest = &(data->longest_float);
2177                 }
2178                 min += min1;
2179                 delta += max1 - min1;
2180                 if (flags & SCF_DO_STCLASS_OR) {
2181                     cl_or(pRExC_state, data->start_class, &accum);
2182                     if (min1) {
2183                         cl_and(data->start_class, &and_with);
2184                         flags &= ~SCF_DO_STCLASS;
2185                     }
2186                 }
2187                 else if (flags & SCF_DO_STCLASS_AND) {
2188                     if (min1) {
2189                         cl_and(data->start_class, &accum);
2190                         flags &= ~SCF_DO_STCLASS;
2191                     }
2192                     else {
2193                         /* Switch to OR mode: cache the old value of
2194                          * data->start_class */
2195                         StructCopy(data->start_class, &and_with,
2196                                    struct regnode_charclass_class);
2197                         flags &= ~SCF_DO_STCLASS_AND;
2198                         StructCopy(&accum, data->start_class,
2199                                    struct regnode_charclass_class);
2200                         flags |= SCF_DO_STCLASS_OR;
2201                         data->start_class->flags |= ANYOF_EOS;
2202                     }
2203                 }
2204
2205                 /* demq.
2206
2207                    Assuming this was/is a branch we are dealing with: 'scan' now
2208                    points at the item that follows the branch sequence, whatever
2209                    it is. We now start at the beginning of the sequence and look
2210                    for subsequences of
2211
2212                    BRANCH->EXACT=>X
2213                    BRANCH->EXACT=>X
2214
2215                    which would be constructed from a pattern like /A|LIST|OF|WORDS/
2216
2217                    If we can find such a subseqence we need to turn the first
2218                    element into a trie and then add the subsequent branch exact
2219                    strings to the trie.
2220
2221                    We have two cases
2222
2223                      1. patterns where the whole set of branch can be converted to a trie,
2224
2225                      2. patterns where only a subset of the alternations can be
2226                      converted to a trie.
2227
2228                    In case 1 we can replace the whole set with a single regop
2229                    for the trie. In case 2 we need to keep the start and end
2230                    branchs so
2231
2232                      'BRANCH EXACT; BRANCH EXACT; BRANCH X'
2233                      becomes BRANCH TRIE; BRANCH X;
2234
2235                    Hypthetically when we know the regex isnt anchored we can
2236                    turn a case 1 into a DFA and let it rip... Every time it finds a match
2237                    it would just call its tail, no WHILEM/CURLY needed.
2238
2239                 */
2240                 if (PERL_ENABLE_TRIE_OPTIMISATION) {
2241                     int made=0;
2242                     if (!re_trie_maxbuff) {
2243                         re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
2244                         if (!SvIOK(re_trie_maxbuff))
2245                             sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
2246                     }
2247                     if ( SvIV(re_trie_maxbuff)>=0 && OP( startbranch )==BRANCH ) {
2248                         regnode *cur;
2249                         regnode *first = (regnode *)NULL;
2250                         regnode *last = (regnode *)NULL;
2251                         regnode *tail = scan;
2252                         U8 optype = 0;
2253                         U32 count=0;
2254
2255 #ifdef DEBUGGING
2256                         SV * const mysv = sv_newmortal();       /* for dumping */
2257 #endif
2258                         /* var tail is used because there may be a TAIL
2259                            regop in the way. Ie, the exacts will point to the
2260                            thing following the TAIL, but the last branch will
2261                            point at the TAIL. So we advance tail. If we
2262                            have nested (?:) we may have to move through several
2263                            tails.
2264                          */
2265
2266                         while ( OP( tail ) == TAIL ) {
2267                             /* this is the TAIL generated by (?:) */
2268                             tail = regnext( tail );
2269                         }
2270
2271                         
2272                         DEBUG_OPTIMISE_r({
2273                             regprop(RExC_rx, mysv, tail );
2274                             PerlIO_printf( Perl_debug_log, "%*s%s%s\n",
2275                                 (int)depth * 2 + 2, "", 
2276                                 "Looking for TRIE'able sequences. Tail node is: ", 
2277                                 SvPV_nolen_const( mysv )
2278                             );
2279                         });
2280                         
2281                         /*
2282
2283                            step through the branches, cur represents each
2284                            branch, noper is the first thing to be matched
2285                            as part of that branch and noper_next is the
2286                            regnext() of that node. if noper is an EXACT
2287                            and noper_next is the same as scan (our current
2288                            position in the regex) then the EXACT branch is
2289                            a possible optimization target. Once we have
2290                            two or more consequetive such branches we can
2291                            create a trie of the EXACT's contents and stich
2292                            it in place. If the sequence represents all of
2293                            the branches we eliminate the whole thing and
2294                            replace it with a single TRIE. If it is a
2295                            subsequence then we need to stitch it in. This
2296                            means the first branch has to remain, and needs
2297                            to be repointed at the item on the branch chain
2298                            following the last branch optimized. This could
2299                            be either a BRANCH, in which case the
2300                            subsequence is internal, or it could be the
2301                            item following the branch sequence in which
2302                            case the subsequence is at the end.
2303
2304                         */
2305
2306                         /* dont use tail as the end marker for this traverse */
2307                         for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) {
2308                             regnode * const noper = NEXTOPER( cur );
2309                             regnode * const noper_next = regnext( noper );
2310
2311                             DEBUG_OPTIMISE_r({
2312                                 regprop(RExC_rx, mysv, cur);
2313                                 PerlIO_printf( Perl_debug_log, "%*s- %s (%d)",
2314                                    (int)depth * 2 + 2,"", SvPV_nolen_const( mysv ), REG_NODE_NUM(cur) );
2315
2316                                 regprop(RExC_rx, mysv, noper);
2317                                 PerlIO_printf( Perl_debug_log, " -> %s",
2318                                     SvPV_nolen_const(mysv));
2319
2320                                 if ( noper_next ) {
2321                                   regprop(RExC_rx, mysv, noper_next );
2322                                   PerlIO_printf( Perl_debug_log,"\t=> %s\t",
2323                                     SvPV_nolen_const(mysv));
2324                                 }
2325                                 PerlIO_printf( Perl_debug_log, "(First==%d,Last==%d,Cur==%d)\n",
2326                                    REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur) );
2327                             });
2328                             if ( (((first && optype!=NOTHING) ? OP( noper ) == optype
2329                                          : PL_regkind[ OP( noper ) ] == EXACT )
2330                                   || OP(noper) == NOTHING )
2331                                   && noper_next == tail && count<U16_MAX)
2332                             {
2333                                 count++;
2334                                 if ( !first || optype == NOTHING ) {
2335                                     if (!first) first = cur;
2336                                     optype = OP( noper );
2337                                 } else {
2338                                     last = cur;
2339                                 }
2340                             } else {
2341                                 if ( last ) {
2342                                     made+=make_trie( pRExC_state, startbranch, first, cur, tail, optype, depth+1 );
2343                                 }
2344                                 if ( PL_regkind[ OP( noper ) ] == EXACT
2345                                      && noper_next == tail )
2346                                 {
2347                                     count = 1;
2348                                     first = cur;
2349                                     optype = OP( noper );
2350                                 } else {
2351                                     count = 0;
2352                                     first = NULL;
2353                                     optype = 0;
2354                                 }
2355                                 last = NULL;
2356                             }
2357                         }
2358                         DEBUG_OPTIMISE_r({
2359                             regprop(RExC_rx, mysv, cur);
2360                             PerlIO_printf( Perl_debug_log,
2361                               "%*s- %s (%d) <SCAN FINISHED>\n", (int)depth * 2 + 2,
2362                               "", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
2363
2364                         });
2365                         if ( last ) {
2366                             made+= make_trie( pRExC_state, startbranch, first, scan, tail, optype, depth+1 );
2367 #ifdef TRIE_STUDY_OPT   
2368                             if ( made && startbranch == first ) {
2369                                 if ( OP(first)!=TRIE )
2370                                     flags |= SCF_EXACT_TRIE;
2371                                 else {
2372                                     regnode *chk=*scanp;
2373                                     while ( OP( chk ) == OPEN ) 
2374                                         chk = regnext( chk );
2375                                     if (chk==first) 
2376                                         flags |= SCF_EXACT_TRIE;
2377                                 }
2378                             }                   
2379 #endif
2380                         }
2381                     }
2382                     
2383                 } /* do trie */
2384             }
2385             else if ( code == BRANCHJ ) {  /* single branch is optimized. */
2386                 scan = NEXTOPER(NEXTOPER(scan));
2387             } else                      /* single branch is optimized. */
2388                 scan = NEXTOPER(scan);
2389             continue;
2390         }
2391         else if (OP(scan) == EXACT) {
2392             I32 l = STR_LEN(scan);
2393             UV uc;
2394             if (UTF) {
2395                 const U8 * const s = (U8*)STRING(scan);
2396                 l = utf8_length(s, s + l);
2397                 uc = utf8_to_uvchr(s, NULL);
2398             } else {
2399                 uc = *((U8*)STRING(scan));
2400             }
2401             min += l;
2402             if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
2403                 /* The code below prefers earlier match for fixed
2404                    offset, later match for variable offset.  */
2405                 if (data->last_end == -1) { /* Update the start info. */
2406                     data->last_start_min = data->pos_min;
2407                     data->last_start_max = is_inf
2408                         ? I32_MAX : data->pos_min + data->pos_delta;
2409                 }
2410                 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
2411                 if (UTF)
2412                     SvUTF8_on(data->last_found);
2413                 {
2414                     SV * const sv = data->last_found;
2415                     MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
2416                         mg_find(sv, PERL_MAGIC_utf8) : NULL;
2417                     if (mg && mg->mg_len >= 0)
2418                         mg->mg_len += utf8_length((U8*)STRING(scan),
2419                                                   (U8*)STRING(scan)+STR_LEN(scan));
2420                 }
2421                 data->last_end = data->pos_min + l;
2422                 data->pos_min += l; /* As in the first entry. */
2423                 data->flags &= ~SF_BEFORE_EOL;
2424             }
2425             if (flags & SCF_DO_STCLASS_AND) {
2426                 /* Check whether it is compatible with what we know already! */
2427                 int compat = 1;
2428
2429                 if (uc >= 0x100 ||
2430                     (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
2431                     && !ANYOF_BITMAP_TEST(data->start_class, uc)
2432                     && (!(data->start_class->flags & ANYOF_FOLD)
2433                         || !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
2434                     )
2435                     compat = 0;
2436                 ANYOF_CLASS_ZERO(data->start_class);
2437                 ANYOF_BITMAP_ZERO(data->start_class);
2438                 if (compat)
2439                     ANYOF_BITMAP_SET(data->start_class, uc);
2440                 data->start_class->flags &= ~ANYOF_EOS;
2441                 if (uc < 0x100)
2442                   data->start_class->flags &= ~ANYOF_UNICODE_ALL;
2443             }
2444             else if (flags & SCF_DO_STCLASS_OR) {
2445                 /* false positive possible if the class is case-folded */
2446                 if (uc < 0x100)
2447                     ANYOF_BITMAP_SET(data->start_class, uc);
2448                 else
2449                     data->start_class->flags |= ANYOF_UNICODE_ALL;
2450                 data->start_class->flags &= ~ANYOF_EOS;
2451                 cl_and(data->start_class, &and_with);
2452             }
2453             flags &= ~SCF_DO_STCLASS;
2454         }
2455         else if (PL_regkind[OP(scan)] == EXACT) { /* But OP != EXACT! */
2456             I32 l = STR_LEN(scan);
2457             UV uc = *((U8*)STRING(scan));
2458
2459             /* Search for fixed substrings supports EXACT only. */
2460             if (flags & SCF_DO_SUBSTR) {
2461                 assert(data);
2462                 scan_commit(pRExC_state, data);
2463             }
2464             if (UTF) {
2465                 const U8 * const s = (U8 *)STRING(scan);
2466                 l = utf8_length(s, s + l);
2467                 uc = utf8_to_uvchr(s, NULL);
2468             }
2469             min += l;
2470             if (flags & SCF_DO_SUBSTR)
2471                 data->pos_min += l;
2472             if (flags & SCF_DO_STCLASS_AND) {
2473                 /* Check whether it is compatible with what we know already! */
2474                 int compat = 1;
2475
2476                 if (uc >= 0x100 ||
2477                     (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
2478                     && !ANYOF_BITMAP_TEST(data->start_class, uc)
2479                      && !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
2480                     compat = 0;
2481                 ANYOF_CLASS_ZERO(data->start_class);
2482                 ANYOF_BITMAP_ZERO(data->start_class);
2483                 if (compat) {
2484                     ANYOF_BITMAP_SET(data->start_class, uc);
2485                     data->start_class->flags &= ~ANYOF_EOS;
2486                     data->start_class->flags |= ANYOF_FOLD;
2487                     if (OP(scan) == EXACTFL)
2488                         data->start_class->flags |= ANYOF_LOCALE;
2489                 }
2490             }
2491             else if (flags & SCF_DO_STCLASS_OR) {
2492                 if (data->start_class->flags & ANYOF_FOLD) {
2493                     /* false positive possible if the class is case-folded.
2494                        Assume that the locale settings are the same... */
2495                     if (uc < 0x100)
2496                         ANYOF_BITMAP_SET(data->start_class, uc);
2497                     data->start_class->flags &= ~ANYOF_EOS;
2498                 }
2499                 cl_and(data->start_class, &and_with);
2500             }
2501             flags &= ~SCF_DO_STCLASS;
2502         }
2503 #ifdef TRIE_STUDY_OPT   
2504         else if (OP(scan) == TRIE) {
2505             reg_trie_data *trie = (reg_trie_data*)RExC_rx->data->data[ ARG(scan) ];
2506             min += trie->minlen;
2507             delta += (trie->maxlen - trie->minlen);
2508             flags &= ~SCF_DO_STCLASS; /* xxx */
2509             if (flags & SCF_DO_SUBSTR) {
2510                 scan_commit(pRExC_state,data);  /* Cannot expect anything... */
2511                 data->pos_min += trie->minlen;
2512                 data->pos_delta += (trie->maxlen - trie->minlen);
2513                 if (trie->maxlen != trie->minlen)
2514                     data->longest = &(data->longest_float);
2515             }
2516         }
2517 #endif  
2518         else if (strchr((const char*)PL_varies,OP(scan))) {
2519             I32 mincount, maxcount, minnext, deltanext, fl = 0;
2520             I32 f = flags, pos_before = 0;
2521             regnode * const oscan = scan;
2522             struct regnode_charclass_class this_class;
2523             struct regnode_charclass_class *oclass = NULL;
2524             I32 next_is_eval = 0;
2525
2526             switch (PL_regkind[OP(scan)]) {
2527             case WHILEM:                /* End of (?:...)* . */
2528                 scan = NEXTOPER(scan);
2529                 goto finish;
2530             case PLUS:
2531                 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
2532                     next = NEXTOPER(scan);
2533                     if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
2534                         mincount = 1;
2535                         maxcount = REG_INFTY;
2536                         next = regnext(scan);
2537                         scan = NEXTOPER(scan);
2538                         goto do_curly;
2539                     }
2540                 }
2541                 if (flags & SCF_DO_SUBSTR)
2542                     data->pos_min++;
2543                 min++;
2544                 /* Fall through. */
2545             case STAR:
2546                 if (flags & SCF_DO_STCLASS) {
2547                     mincount = 0;
2548                     maxcount = REG_INFTY;
2549                     next = regnext(scan);
2550                     scan = NEXTOPER(scan);
2551                     goto do_curly;
2552                 }
2553                 is_inf = is_inf_internal = 1;
2554                 scan = regnext(scan);
2555                 if (flags & SCF_DO_SUBSTR) {
2556                     scan_commit(pRExC_state, data); /* Cannot extend fixed substrings */
2557                     data->longest = &(data->longest_float);
2558                 }
2559                 goto optimize_curly_tail;
2560             case CURLY:
2561                 mincount = ARG1(scan);
2562                 maxcount = ARG2(scan);
2563                 next = regnext(scan);
2564                 if (OP(scan) == CURLYX) {
2565                     I32 lp = (data ? *(data->last_closep) : 0);
2566                     scan->flags = ((lp <= U8_MAX) ? (U8)lp : U8_MAX);
2567                 }
2568                 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
2569                 next_is_eval = (OP(scan) == EVAL);
2570               do_curly:
2571                 if (flags & SCF_DO_SUBSTR) {
2572                     if (mincount == 0) scan_commit(pRExC_state,data); /* Cannot extend fixed substrings */
2573                     pos_before = data->pos_min;
2574                 }
2575                 if (data) {
2576                     fl = data->flags;
2577                     data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
2578                     if (is_inf)
2579                         data->flags |= SF_IS_INF;
2580                 }
2581                 if (flags & SCF_DO_STCLASS) {
2582                     cl_init(pRExC_state, &this_class);
2583                     oclass = data->start_class;
2584                     data->start_class = &this_class;
2585                     f |= SCF_DO_STCLASS_AND;
2586                     f &= ~SCF_DO_STCLASS_OR;
2587                 }
2588                 /* These are the cases when once a subexpression
2589                    fails at a particular position, it cannot succeed
2590                    even after backtracking at the enclosing scope.
2591                 
2592                    XXXX what if minimal match and we are at the
2593                         initial run of {n,m}? */
2594                 if ((mincount != maxcount - 1) && (maxcount != REG_INFTY))
2595                     f &= ~SCF_WHILEM_VISITED_POS;
2596
2597                 /* This will finish on WHILEM, setting scan, or on NULL: */
2598                 minnext = study_chunk(pRExC_state, &scan, &deltanext, last, data,
2599                                       (mincount == 0
2600                                         ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
2601
2602                 if (flags & SCF_DO_STCLASS)
2603                     data->start_class = oclass;
2604                 if (mincount == 0 || minnext == 0) {
2605                     if (flags & SCF_DO_STCLASS_OR) {
2606                         cl_or(pRExC_state, data->start_class, &this_class);
2607                     }
2608                     else if (flags & SCF_DO_STCLASS_AND) {
2609                         /* Switch to OR mode: cache the old value of
2610                          * data->start_class */
2611                         StructCopy(data->start_class, &and_with,
2612                                    struct regnode_charclass_class);
2613                         flags &= ~SCF_DO_STCLASS_AND;
2614                         StructCopy(&this_class, data->start_class,
2615                                    struct regnode_charclass_class);
2616                         flags |= SCF_DO_STCLASS_OR;
2617                         data->start_class->flags |= ANYOF_EOS;
2618                     }
2619                 } else {                /* Non-zero len */
2620                     if (flags & SCF_DO_STCLASS_OR) {
2621                         cl_or(pRExC_state, data->start_class, &this_class);
2622                         cl_and(data->start_class, &and_with);
2623                     }
2624                     else if (flags & SCF_DO_STCLASS_AND)
2625                         cl_and(data->start_class, &this_class);
2626                     flags &= ~SCF_DO_STCLASS;
2627                 }
2628                 if (!scan)              /* It was not CURLYX, but CURLY. */
2629                     scan = next;
2630                 if ( /* ? quantifier ok, except for (?{ ... }) */
2631                     (next_is_eval || !(mincount == 0 && maxcount == 1))
2632                     && (minnext == 0) && (deltanext == 0)
2633                     && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
2634                     && maxcount <= REG_INFTY/3 /* Complement check for big count */
2635                     && ckWARN(WARN_REGEXP))
2636                 {
2637                     vWARN(RExC_parse,
2638                           "Quantifier unexpected on zero-length expression");
2639                 }
2640
2641                 min += minnext * mincount;
2642                 is_inf_internal |= ((maxcount == REG_INFTY
2643                                      && (minnext + deltanext) > 0)
2644                                     || deltanext == I32_MAX);
2645                 is_inf |= is_inf_internal;
2646                 delta += (minnext + deltanext) * maxcount - minnext * mincount;
2647
2648                 /* Try powerful optimization CURLYX => CURLYN. */
2649                 if (  OP(oscan) == CURLYX && data
2650                       && data->flags & SF_IN_PAR
2651                       && !(data->flags & SF_HAS_EVAL)
2652                       && !deltanext && minnext == 1 ) {
2653                     /* Try to optimize to CURLYN.  */
2654                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
2655                     regnode * const nxt1 = nxt;
2656 #ifdef DEBUGGING
2657                     regnode *nxt2;
2658 #endif
2659
2660                     /* Skip open. */
2661                     nxt = regnext(nxt);
2662                     if (!strchr((const char*)PL_simple,OP(nxt))
2663                         && !(PL_regkind[OP(nxt)] == EXACT
2664                              && STR_LEN(nxt) == 1))
2665                         goto nogo;
2666 #ifdef DEBUGGING
2667                     nxt2 = nxt;
2668 #endif
2669                     nxt = regnext(nxt);
2670                     if (OP(nxt) != CLOSE)
2671                         goto nogo;
2672                     /* Now we know that nxt2 is the only contents: */
2673                     oscan->flags = (U8)ARG(nxt);
2674                     OP(oscan) = CURLYN;
2675                     OP(nxt1) = NOTHING; /* was OPEN. */
2676 #ifdef DEBUGGING
2677                     OP(nxt1 + 1) = OPTIMIZED; /* was count. */
2678                     NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
2679                     NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */
2680                     OP(nxt) = OPTIMIZED;        /* was CLOSE. */
2681                     OP(nxt + 1) = OPTIMIZED; /* was count. */
2682                     NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
2683 #endif
2684                 }
2685               nogo:
2686
2687                 /* Try optimization CURLYX => CURLYM. */
2688                 if (  OP(oscan) == CURLYX && data
2689                       && !(data->flags & SF_HAS_PAR)
2690                       && !(data->flags & SF_HAS_EVAL)
2691                       && !deltanext     /* atom is fixed width */
2692                       && minnext != 0   /* CURLYM can't handle zero width */
2693                 ) {
2694                     /* XXXX How to optimize if data == 0? */
2695                     /* Optimize to a simpler form.  */
2696                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
2697                     regnode *nxt2;
2698
2699                     OP(oscan) = CURLYM;
2700                     while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
2701                             && (OP(nxt2) != WHILEM))
2702                         nxt = nxt2;
2703                     OP(nxt2)  = SUCCEED; /* Whas WHILEM */
2704                     /* Need to optimize away parenths. */
2705                     if (data->flags & SF_IN_PAR) {
2706                         /* Set the parenth number.  */
2707                         regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
2708
2709                         if (OP(nxt) != CLOSE)
2710                             FAIL("Panic opt close");
2711                         oscan->flags = (U8)ARG(nxt);
2712                         OP(nxt1) = OPTIMIZED;   /* was OPEN. */
2713                         OP(nxt) = OPTIMIZED;    /* was CLOSE. */
2714 #ifdef DEBUGGING
2715                         OP(nxt1 + 1) = OPTIMIZED; /* was count. */
2716                         OP(nxt + 1) = OPTIMIZED; /* was count. */
2717                         NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
2718                         NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
2719 #endif
2720 #if 0
2721                         while ( nxt1 && (OP(nxt1) != WHILEM)) {
2722                             regnode *nnxt = regnext(nxt1);
2723                         
2724                             if (nnxt == nxt) {
2725                                 if (reg_off_by_arg[OP(nxt1)])
2726                                     ARG_SET(nxt1, nxt2 - nxt1);
2727                                 else if (nxt2 - nxt1 < U16_MAX)
2728                                     NEXT_OFF(nxt1) = nxt2 - nxt1;
2729                                 else
2730                                     OP(nxt) = NOTHING;  /* Cannot beautify */
2731                             }
2732                             nxt1 = nnxt;
2733                         }
2734 #endif
2735                         /* Optimize again: */
2736                         study_chunk(pRExC_state, &nxt1, &deltanext, nxt,
2737                                     NULL, 0,depth+1);
2738                     }
2739                     else
2740                         oscan->flags = 0;
2741                 }
2742                 else if ((OP(oscan) == CURLYX)
2743                          && (flags & SCF_WHILEM_VISITED_POS)
2744                          /* See the comment on a similar expression above.
2745                             However, this time it not a subexpression
2746                             we care about, but the expression itself. */
2747                          && (maxcount == REG_INFTY)
2748                          && data && ++data->whilem_c < 16) {
2749                     /* This stays as CURLYX, we can put the count/of pair. */
2750                     /* Find WHILEM (as in regexec.c) */
2751                     regnode *nxt = oscan + NEXT_OFF(oscan);
2752
2753                     if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
2754                         nxt += ARG(nxt);
2755                     PREVOPER(nxt)->flags = (U8)(data->whilem_c
2756                         | (RExC_whilem_seen << 4)); /* On WHILEM */
2757                 }
2758                 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
2759                     pars++;
2760                 if (flags & SCF_DO_SUBSTR) {
2761                     SV *last_str = NULL;
2762                     int counted = mincount != 0;
2763
2764                     if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
2765 #if defined(SPARC64_GCC_WORKAROUND)
2766                         I32 b = 0;
2767                         STRLEN l = 0;
2768                         const char *s = NULL;
2769                         I32 old = 0;
2770
2771                         if (pos_before >= data->last_start_min)
2772                             b = pos_before;
2773                         else
2774                             b = data->last_start_min;
2775
2776                         l = 0;
2777                         s = SvPV_const(data->last_found, l);
2778                         old = b - data->last_start_min;
2779
2780 #else
2781                         I32 b = pos_before >= data->last_start_min
2782                             ? pos_before : data->last_start_min;
2783                         STRLEN l;
2784                         const char * const s = SvPV_const(data->last_found, l);
2785                         I32 old = b - data->last_start_min;
2786 #endif
2787
2788                         if (UTF)
2789                             old = utf8_hop((U8*)s, old) - (U8*)s;
2790                         
2791                         l -= old;
2792                         /* Get the added string: */
2793                         last_str = newSVpvn(s  + old, l);
2794                         if (UTF)
2795                             SvUTF8_on(last_str);
2796                         if (deltanext == 0 && pos_before == b) {
2797                             /* What was added is a constant string */
2798                             if (mincount > 1) {
2799                                 SvGROW(last_str, (mincount * l) + 1);
2800                                 repeatcpy(SvPVX(last_str) + l,
2801                                           SvPVX_const(last_str), l, mincount - 1);
2802                                 SvCUR_set(last_str, SvCUR(last_str) * mincount);
2803                                 /* Add additional parts. */
2804                                 SvCUR_set(data->last_found,
2805                                           SvCUR(data->last_found) - l);
2806                                 sv_catsv(data->last_found, last_str);
2807                                 {
2808                                     SV * sv = data->last_found;
2809                                     MAGIC *mg =
2810                                         SvUTF8(sv) && SvMAGICAL(sv) ?
2811                                         mg_find(sv, PERL_MAGIC_utf8) : NULL;
2812                                     if (mg && mg->mg_len >= 0)
2813                                         mg->mg_len += CHR_SVLEN(last_str);
2814                                 }
2815                                 data->last_end += l * (mincount - 1);
2816                             }
2817                         } else {
2818                             /* start offset must point into the last copy */
2819                             data->last_start_min += minnext * (mincount - 1);
2820                             data->last_start_max += is_inf ? I32_MAX
2821                                 : (maxcount - 1) * (minnext + data->pos_delta);
2822                         }
2823                     }
2824                     /* It is counted once already... */
2825                     data->pos_min += minnext * (mincount - counted);
2826                     data->pos_delta += - counted * deltanext +
2827                         (minnext + deltanext) * maxcount - minnext * mincount;
2828                     if (mincount != maxcount) {
2829                          /* Cannot extend fixed substrings found inside
2830                             the group.  */
2831                         scan_commit(pRExC_state,data);
2832                         if (mincount && last_str) {
2833                             SV * const sv = data->last_found;
2834                             MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
2835                                 mg_find(sv, PERL_MAGIC_utf8) : NULL;
2836
2837                             if (mg)
2838                                 mg->mg_len = -1;
2839                             sv_setsv(sv, last_str);
2840                             data->last_end = data->pos_min;
2841                             data->last_start_min =
2842                                 data->pos_min - CHR_SVLEN(last_str);
2843                             data->last_start_max = is_inf
2844                                 ? I32_MAX
2845                                 : data->pos_min + data->pos_delta
2846                                 - CHR_SVLEN(last_str);
2847                         }
2848                         data->longest = &(data->longest_float);
2849                     }
2850                     SvREFCNT_dec(last_str);
2851                 }
2852                 if (data && (fl & SF_HAS_EVAL))
2853                     data->flags |= SF_HAS_EVAL;
2854               optimize_curly_tail:
2855                 if (OP(oscan) != CURLYX) {
2856                     while (PL_regkind[OP(next = regnext(oscan))] == NOTHING
2857                            && NEXT_OFF(next))
2858                         NEXT_OFF(oscan) += NEXT_OFF(next);
2859                 }
2860                 continue;
2861             default:                    /* REF and CLUMP only? */
2862                 if (flags & SCF_DO_SUBSTR) {
2863                     scan_commit(pRExC_state,data);      /* Cannot expect anything... */
2864                     data->longest = &(data->longest_float);
2865                 }
2866                 is_inf = is_inf_internal = 1;
2867                 if (flags & SCF_DO_STCLASS_OR)
2868                     cl_anything(pRExC_state, data->start_class);
2869                 flags &= ~SCF_DO_STCLASS;
2870                 break;
2871             }
2872         }
2873         else if (strchr((const char*)PL_simple,OP(scan))) {
2874             int value = 0;
2875
2876             if (flags & SCF_DO_SUBSTR) {
2877                 scan_commit(pRExC_state,data);
2878                 data->pos_min++;
2879             }
2880             min++;
2881             if (flags & SCF_DO_STCLASS) {
2882                 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
2883
2884                 /* Some of the logic below assumes that switching
2885                    locale on will only add false positives. */
2886                 switch (PL_regkind[OP(scan)]) {
2887                 case SANY:
2888                 default:
2889                   do_default:
2890                     /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
2891                     if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
2892                         cl_anything(pRExC_state, data->start_class);
2893                     break;
2894                 case REG_ANY:
2895                     if (OP(scan) == SANY)
2896                         goto do_default;
2897                     if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
2898                         value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
2899                                  || (data->start_class->flags & ANYOF_CLASS));
2900                         cl_anything(pRExC_state, data->start_class);
2901                     }
2902                     if (flags & SCF_DO_STCLASS_AND || !value)
2903                         ANYOF_BITMAP_CLEAR(data->start_class,'\n');
2904                     break;
2905                 case ANYOF:
2906                     if (flags & SCF_DO_STCLASS_AND)
2907                         cl_and(data->start_class,
2908                                (struct regnode_charclass_class*)scan);
2909                     else
2910                         cl_or(pRExC_state, data->start_class,
2911                               (struct regnode_charclass_class*)scan);
2912                     break;
2913                 case ALNUM:
2914                     if (flags & SCF_DO_STCLASS_AND) {
2915                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
2916                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
2917                             for (value = 0; value < 256; value++)
2918                                 if (!isALNUM(value))
2919                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
2920                         }
2921                     }
2922                     else {
2923                         if (data->start_class->flags & ANYOF_LOCALE)
2924                             ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
2925                         else {
2926                             for (value = 0; value < 256; value++)
2927                                 if (isALNUM(value))
2928                                     ANYOF_BITMAP_SET(data->start_class, value);                 
2929                         }
2930                     }
2931                     break;
2932                 case ALNUML:
2933                     if (flags & SCF_DO_STCLASS_AND) {
2934                         if (data->start_class->flags & ANYOF_LOCALE)
2935                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
2936                     }
2937                     else {
2938                         ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
2939                         data->start_class->flags |= ANYOF_LOCALE;
2940                     }
2941                     break;
2942                 case NALNUM:
2943                     if (flags & SCF_DO_STCLASS_AND) {
2944                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
2945                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
2946                             for (value = 0; value < 256; value++)
2947                                 if (isALNUM(value))
2948                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
2949                         }
2950                     }
2951                     else {
2952                         if (data->start_class->flags & ANYOF_LOCALE)
2953                             ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
2954                         else {
2955                             for (value = 0; value < 256; value++)
2956                                 if (!isALNUM(value))
2957                                     ANYOF_BITMAP_SET(data->start_class, value);                 
2958                         }
2959                     }
2960                     break;
2961                 case NALNUML:
2962                     if (flags & SCF_DO_STCLASS_AND) {
2963                         if (data->start_class->flags & ANYOF_LOCALE)
2964                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
2965                     }
2966                     else {
2967                         data->start_class->flags |= ANYOF_LOCALE;
2968                         ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
2969                     }
2970                     break;
2971                 case SPACE:
2972                     if (flags & SCF_DO_STCLASS_AND) {
2973                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
2974                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
2975                             for (value = 0; value < 256; value++)
2976                                 if (!isSPACE(value))
2977                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
2978                         }
2979                     }
2980                     else {
2981                         if (data->start_class->flags & ANYOF_LOCALE)
2982                             ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
2983                         else {
2984                             for (value = 0; value < 256; value++)
2985                                 if (isSPACE(value))
2986                                     ANYOF_BITMAP_SET(data->start_class, value);                 
2987                         }
2988                     }
2989                     break;
2990                 case SPACEL:
2991                     if (flags & SCF_DO_STCLASS_AND) {
2992                         if (data->start_class->flags & ANYOF_LOCALE)
2993                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
2994                     }
2995                     else {
2996                         data->start_class->flags |= ANYOF_LOCALE;
2997                         ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
2998                     }
2999                     break;
3000                 case NSPACE:
3001                     if (flags & SCF_DO_STCLASS_AND) {
3002                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
3003                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3004                             for (value = 0; value < 256; value++)
3005                                 if (isSPACE(value))
3006                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3007                         }
3008                     }
3009                     else {
3010                         if (data->start_class->flags & ANYOF_LOCALE)
3011                             ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3012                         else {
3013                             for (value = 0; value < 256; value++)
3014                                 if (!isSPACE(value))
3015                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3016                         }
3017                     }
3018                     break;
3019                 case NSPACEL:
3020                     if (flags & SCF_DO_STCLASS_AND) {
3021                         if (data->start_class->flags & ANYOF_LOCALE) {
3022                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3023                             for (value = 0; value < 256; value++)
3024                                 if (!isSPACE(value))
3025                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3026                         }
3027                     }
3028                     else {
3029                         data->start_class->flags |= ANYOF_LOCALE;
3030                         ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3031                     }
3032                     break;
3033                 case DIGIT:
3034                     if (flags & SCF_DO_STCLASS_AND) {
3035                         ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
3036                         for (value = 0; value < 256; value++)
3037                             if (!isDIGIT(value))
3038                                 ANYOF_BITMAP_CLEAR(data->start_class, value);
3039                     }
3040                     else {
3041                         if (data->start_class->flags & ANYOF_LOCALE)
3042                             ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
3043                         else {
3044                             for (value = 0; value < 256; value++)
3045                                 if (isDIGIT(value))
3046                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3047                         }
3048                     }
3049                     break;
3050                 case NDIGIT:
3051                     if (flags & SCF_DO_STCLASS_AND) {
3052                         ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
3053                         for (value = 0; value < 256; value++)
3054                             if (isDIGIT(value))
3055                                 ANYOF_BITMAP_CLEAR(data->start_class, value);
3056                     }
3057                     else {
3058                         if (data->start_class->flags & ANYOF_LOCALE)
3059                             ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
3060                         else {
3061                             for (value = 0; value < 256; value++)
3062                                 if (!isDIGIT(value))
3063                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3064                         }
3065                     }
3066                     break;
3067                 }
3068                 if (flags & SCF_DO_STCLASS_OR)
3069                     cl_and(data->start_class, &and_with);
3070                 flags &= ~SCF_DO_STCLASS;
3071             }
3072         }
3073         else if (PL_regkind[OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
3074             data->flags |= (OP(scan) == MEOL
3075                             ? SF_BEFORE_MEOL
3076                             : SF_BEFORE_SEOL);
3077         }
3078         else if (  PL_regkind[OP(scan)] == BRANCHJ
3079                  /* Lookbehind, or need to calculate parens/evals/stclass: */
3080                    && (scan->flags || data || (flags & SCF_DO_STCLASS))
3081                    && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
3082             /* Lookahead/lookbehind */
3083             I32 deltanext, minnext, fake = 0;
3084             regnode *nscan;
3085             struct regnode_charclass_class intrnl;
3086             int f = 0;
3087
3088             data_fake.flags = 0;
3089             if (data) {         
3090                 data_fake.whilem_c = data->whilem_c;
3091                 data_fake.last_closep = data->last_closep;
3092             }
3093             else
3094                 data_fake.last_closep = &fake;
3095             if ( flags & SCF_DO_STCLASS && !scan->flags
3096                  && OP(scan) == IFMATCH ) { /* Lookahead */
3097                 cl_init(pRExC_state, &intrnl);
3098                 data_fake.start_class = &intrnl;
3099                 f |= SCF_DO_STCLASS_AND;
3100             }
3101             if (flags & SCF_WHILEM_VISITED_POS)
3102                 f |= SCF_WHILEM_VISITED_POS;
3103             next = regnext(scan);
3104             nscan = NEXTOPER(NEXTOPER(scan));
3105             minnext = study_chunk(pRExC_state, &nscan, &deltanext, last, &data_fake, f,depth+1);
3106             if (scan->flags) {
3107                 if (deltanext) {
3108                     vFAIL("Variable length lookbehind not implemented");
3109                 }
3110                 else if (minnext > U8_MAX) {
3111                     vFAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
3112                 }
3113                 scan->flags = (U8)minnext;
3114             }
3115             if (data) {
3116                 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3117                     pars++;
3118                 if (data_fake.flags & SF_HAS_EVAL)
3119                     data->flags |= SF_HAS_EVAL;
3120                 data->whilem_c = data_fake.whilem_c;
3121             }
3122             if (f & SCF_DO_STCLASS_AND) {
3123                 const int was = (data->start_class->flags & ANYOF_EOS);
3124
3125                 cl_and(data->start_class, &intrnl);
3126                 if (was)
3127                     data->start_class->flags |= ANYOF_EOS;
3128             }
3129         }
3130         else if (OP(scan) == OPEN) {
3131             pars++;
3132         }
3133         else if (OP(scan) == CLOSE) {
3134             if ((I32)ARG(scan) == is_par) {
3135                 next = regnext(scan);
3136
3137                 if ( next && (OP(next) != WHILEM) && next < last)
3138                     is_par = 0;         /* Disable optimization */
3139             }
3140             if (data)
3141                 *(data->last_closep) = ARG(scan);
3142         }
3143         else if (OP(scan) == EVAL) {
3144                 if (data)
3145                     data->flags |= SF_HAS_EVAL;
3146         }
3147         else if (OP(scan) == LOGICAL && scan->flags == 2) { /* Embedded follows */
3148                 if (flags & SCF_DO_SUBSTR) {
3149                     scan_commit(pRExC_state,data);
3150                     data->longest = &(data->longest_float);
3151                 }
3152                 is_inf = is_inf_internal = 1;
3153                 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3154                     cl_anything(pRExC_state, data->start_class);
3155                 flags &= ~SCF_DO_STCLASS;
3156         }
3157         /* Else: zero-length, ignore. */
3158         scan = regnext(scan);
3159     }
3160
3161   finish:
3162     *scanp = scan;
3163     *deltap = is_inf_internal ? I32_MAX : delta;
3164     if (flags & SCF_DO_SUBSTR && is_inf)
3165         data->pos_delta = I32_MAX - data->pos_min;
3166     if (is_par > U8_MAX)
3167         is_par = 0;
3168     if (is_par && pars==1 && data) {
3169         data->flags |= SF_IN_PAR;
3170         data->flags &= ~SF_HAS_PAR;
3171     }
3172     else if (pars && data) {
3173         data->flags |= SF_HAS_PAR;
3174         data->flags &= ~SF_IN_PAR;
3175     }
3176     if (flags & SCF_DO_STCLASS_OR)
3177         cl_and(data->start_class, &and_with);
3178     if (flags & SCF_EXACT_TRIE) 
3179         data->flags |=  SCF_EXACT_TRIE;
3180     return min;
3181 }
3182
3183 STATIC I32
3184 S_add_data(RExC_state_t *pRExC_state, I32 n, const char *s)
3185 {
3186     if (RExC_rx->data) {
3187         Renewc(RExC_rx->data,
3188                sizeof(*RExC_rx->data) + sizeof(void*) * (RExC_rx->data->count + n - 1),
3189                char, struct reg_data);
3190         Renew(RExC_rx->data->what, RExC_rx->data->count + n, U8);
3191         RExC_rx->data->count += n;
3192     }
3193     else {
3194         Newxc(RExC_rx->data, sizeof(*RExC_rx->data) + sizeof(void*) * (n - 1),
3195              char, struct reg_data);
3196         Newx(RExC_rx->data->what, n, U8);
3197         RExC_rx->data->count = n;
3198     }
3199     Copy(s, RExC_rx->data->what + RExC_rx->data->count - n, n, U8);
3200     return RExC_rx->data->count - n;
3201 }
3202
3203 #ifndef PERL_IN_XSUB_RE
3204 void
3205 Perl_reginitcolors(pTHX)
3206 {
3207     dVAR;
3208     const char * const s = PerlEnv_getenv("PERL_RE_COLORS");
3209     if (s) {
3210         char *t = savepv(s);
3211         int i = 0;
3212         PL_colors[0] = t;
3213         while (++i < 6) {
3214             t = strchr(t, '\t');
3215             if (t) {
3216                 *t = '\0';
3217                 PL_colors[i] = ++t;
3218             }
3219             else
3220                 PL_colors[i] = t = (char *)"";
3221         }
3222     } else {
3223         int i = 0;
3224         while (i < 6)
3225             PL_colors[i++] = (char *)"";
3226     }
3227     PL_colorset = 1;
3228 }
3229 #endif
3230
3231
3232 /*
3233  - pregcomp - compile a regular expression into internal code
3234  *
3235  * We can't allocate space until we know how big the compiled form will be,
3236  * but we can't compile it (and thus know how big it is) until we've got a
3237  * place to put the code.  So we cheat:  we compile it twice, once with code
3238  * generation turned off and size counting turned on, and once "for real".
3239  * This also means that we don't allocate space until we are sure that the
3240  * thing really will compile successfully, and we never have to move the
3241  * code and thus invalidate pointers into it.  (Note that it has to be in
3242  * one piece because free() must be able to free it all.) [NB: not true in perl]
3243  *
3244  * Beware that the optimization-preparation code in here knows about some
3245  * of the structure of the compiled regexp.  [I'll say.]
3246  */
3247 regexp *
3248 Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
3249 {
3250     dVAR;
3251     register regexp *r;
3252     regnode *scan;
3253     regnode *first;
3254     I32 flags;
3255     I32 minlen = 0;
3256     I32 sawplus = 0;
3257     I32 sawopen = 0;
3258     scan_data_t data;
3259     RExC_state_t RExC_state;
3260     RExC_state_t * const pRExC_state = &RExC_state;
3261 #ifdef TRIE_STUDY_OPT    
3262     int restudied= 0;
3263     RExC_state_t copyRExC_state;
3264 #endif    
3265
3266     GET_RE_DEBUG_FLAGS_DECL;
3267
3268     if (exp == NULL)
3269         FAIL("NULL regexp argument");
3270
3271     RExC_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
3272
3273     RExC_precomp = exp;
3274     DEBUG_r(if (!PL_colorset) reginitcolors());
3275     DEBUG_COMPILE_r({
3276         SV *dsv= sv_newmortal();
3277         RE_PV_QUOTED_DECL(s, RExC_utf8,
3278             dsv, RExC_precomp, (xend - exp), 60);
3279         PerlIO_printf(Perl_debug_log, "%sCompiling REx%s %s\n",
3280                        PL_colors[4],PL_colors[5],s);
3281     });
3282     RExC_flags = pm->op_pmflags;
3283     RExC_sawback = 0;
3284
3285     RExC_seen = 0;
3286     RExC_seen_zerolen = *exp == '^' ? -1 : 0;
3287     RExC_seen_evals = 0;
3288     RExC_extralen = 0;
3289
3290     /* First pass: determine size, legality. */
3291     RExC_parse = exp;
3292     RExC_start = exp;
3293     RExC_end = xend;
3294     RExC_naughty = 0;
3295     RExC_npar = 1;
3296     RExC_size = 0L;
3297     RExC_emit = &PL_regdummy;
3298     RExC_whilem_seen = 0;
3299 #if 0 /* REGC() is (currently) a NOP at the first pass.
3300        * Clever compilers notice this and complain. --jhi */
3301     REGC((U8)REG_MAGIC, (char*)RExC_emit);
3302 #endif
3303     DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "Starting first pass (sizing)\n"));
3304     if (reg(pRExC_state, 0, &flags,1) == NULL) {
3305         RExC_precomp = NULL;
3306         return(NULL);
3307     }
3308     DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "Required "));
3309     DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" nodes ", (IV)RExC_size));
3310     DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "\nStarting second pass (creation)\n"));
3311     DEBUG_PARSE_r({
3312         RExC_lastnum=0; 
3313         RExC_lastparse=NULL; 
3314     });
3315
3316     
3317     /* Small enough for pointer-storage convention?
3318        If extralen==0, this means that we will not need long jumps. */
3319     if (RExC_size >= 0x10000L && RExC_extralen)
3320         RExC_size += RExC_extralen;
3321     else
3322         RExC_extralen = 0;
3323     if (RExC_whilem_seen > 15)
3324         RExC_whilem_seen = 15;
3325
3326     /* Allocate space and initialize. */
3327     Newxc(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode),
3328          char, regexp);
3329     if (r == NULL)
3330         FAIL("Regexp out of space");
3331
3332 #ifdef DEBUGGING
3333     /* avoid reading uninitialized memory in DEBUGGING code in study_chunk() */
3334     Zero(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode), char);
3335 #endif
3336     r->refcnt = 1;
3337     r->prelen = xend - exp;
3338     r->precomp = savepvn(RExC_precomp, r->prelen);
3339     r->subbeg = NULL;
3340 #ifdef PERL_OLD_COPY_ON_WRITE
3341     r->saved_copy = NULL;
3342 #endif
3343     r->reganch = pm->op_pmflags & PMf_COMPILETIME;
3344     r->nparens = RExC_npar - 1; /* set early to validate backrefs */
3345     r->lastparen = 0;                   /* mg.c reads this.  */
3346
3347     r->substrs = 0;                     /* Useful during FAIL. */
3348     r->startp = 0;                      /* Useful during FAIL. */
3349     r->endp = 0;                        /* Useful during FAIL. */
3350
3351     Newxz(r->offsets, 2*RExC_size+1, U32); /* MJD 20001228 */
3352     if (r->offsets) {
3353         r->offsets[0] = RExC_size;
3354     }
3355     DEBUG_OFFSETS_r(PerlIO_printf(Perl_debug_log,
3356                           "%s %"UVuf" bytes for offset annotations.\n",
3357                           r->offsets ? "Got" : "Couldn't get",
3358                           (UV)((2*RExC_size+1) * sizeof(U32))));
3359
3360     RExC_rx = r;
3361
3362     /* Second pass: emit code. */
3363     RExC_flags = pm->op_pmflags;        /* don't let top level (?i) bleed */
3364     RExC_parse = exp;
3365     RExC_end = xend;
3366     RExC_naughty = 0;
3367     RExC_npar = 1;
3368     RExC_emit_start = r->program;
3369     RExC_emit = r->program;
3370     /* Store the count of eval-groups for security checks: */
3371     RExC_emit->next_off = (U16)((RExC_seen_evals > U16_MAX) ? U16_MAX : RExC_seen_evals);
3372     REGC((U8)REG_MAGIC, (char*) RExC_emit++);
3373     r->data = 0;
3374     if (reg(pRExC_state, 0, &flags,1) == NULL)
3375         return(NULL);
3376     /* XXXX To minimize changes to RE engine we always allocate
3377        3-units-long substrs field. */
3378     Newx(r->substrs, 1, struct reg_substr_data);
3379
3380 reStudy:
3381     Zero(r->substrs, 1, struct reg_substr_data);
3382     StructCopy(&zero_scan_data, &data, scan_data_t);
3383
3384 #ifdef TRIE_STUDY_OPT
3385     if ( restudied ) {
3386         DEBUG_OPTIMISE_r(PerlIO_printf(Perl_debug_log,"Restudying\n"));
3387         RExC_state=copyRExC_state;
3388         if (data.longest_fixed)
3389             SvREFCNT_dec(data.longest_fixed);
3390         if (data.longest_float)
3391             SvREFCNT_dec(data.longest_float);
3392         if (data.last_found)
3393             SvREFCNT_dec(data.last_found);
3394     } else {
3395         copyRExC_state=RExC_state;
3396     }
3397 #endif    
3398     /* Dig out information for optimizations. */
3399     r->reganch = pm->op_pmflags & PMf_COMPILETIME; /* Again? */
3400     pm->op_pmflags = RExC_flags;
3401     if (UTF)
3402         r->reganch |= ROPT_UTF8;        /* Unicode in it? */
3403     r->regstclass = NULL;
3404     if (RExC_naughty >= 10)     /* Probably an expensive pattern. */
3405         r->reganch |= ROPT_NAUGHTY;
3406     scan = r->program + 1;              /* First BRANCH. */
3407
3408     /* XXXX Should not we check for something else?  Usually it is OPEN1... */
3409     if (OP(scan) != BRANCH) {   /* Only one top-level choice. */
3410         I32 fake;
3411         STRLEN longest_float_length, longest_fixed_length;
3412         struct regnode_charclass_class ch_class; /* pointed to by data */
3413         int stclass_flag;
3414         I32 last_close = 0; /* pointed to by data */
3415
3416         first = scan;
3417         /* Skip introductions and multiplicators >= 1. */
3418         while ((OP(first) == OPEN && (sawopen = 1)) ||
3419                /* An OR of *one* alternative - should not happen now. */
3420             (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
3421             /* for now we can't handle lookbehind IFMATCH*/
3422             (OP(first) == IFMATCH && !first->flags) || 
3423             (OP(first) == PLUS) ||
3424             (OP(first) == MINMOD) ||
3425                /* An {n,m} with n>0 */
3426             (PL_regkind[OP(first)] == CURLY && ARG1(first) > 0) ) 
3427         {
3428                 DEBUG_PEEP("first:",first,0);
3429                 if (OP(first) == PLUS)
3430                     sawplus = 1;
3431                 else
3432                     first += regarglen[OP(first)];
3433                 if (OP(first) == IFMATCH) {
3434                     first = NEXTOPER(first);
3435                     first += EXTRA_STEP_2ARGS;
3436                 } else  /* XXX possible optimisation for /(?=)/  */
3437                     first = NEXTOPER(first);
3438         }
3439
3440         /* Starting-point info. */
3441       again:
3442         /* Ignore EXACT as we deal with it later. */
3443         if (PL_regkind[OP(first)] == EXACT) {
3444             if (OP(first) == EXACT)
3445                 NOOP;   /* Empty, get anchored substr later. */
3446             else if ((OP(first) == EXACTF || OP(first) == EXACTFL))
3447                 r->regstclass = first;
3448         }
3449 #ifdef TRIE_STCLASS     
3450         else if (OP(first) == TRIE &&
3451                 ((reg_trie_data *)r->data->data[ ARG(first) ])->minlen>0) 
3452         {
3453             /* this can happen only on restudy */
3454             struct regnode_1 *trie_op;
3455             Newxz(trie_op,1,struct regnode_1);
3456             StructCopy(first,trie_op,struct regnode_1);
3457             make_trie_failtable(pRExC_state, (regnode *)first, (regnode *)trie_op, 0);
3458             r->regstclass = (regnode *)trie_op;
3459         }
3460 #endif  
3461         else if (strchr((const char*)PL_simple,OP(first)))
3462             r->regstclass = first;
3463         else if (PL_regkind[OP(first)] == BOUND ||
3464                  PL_regkind[OP(first)] == NBOUND)
3465             r->regstclass = first;
3466         else if (PL_regkind[OP(first)] == BOL) {
3467             r->reganch |= (OP(first) == MBOL
3468                            ? ROPT_ANCH_MBOL
3469                            : (OP(first) == SBOL
3470                               ? ROPT_ANCH_SBOL
3471                               : ROPT_ANCH_BOL));
3472             first = NEXTOPER(first);
3473             goto again;
3474         }
3475         else if (OP(first) == GPOS) {
3476             r->reganch |= ROPT_ANCH_GPOS;
3477             first = NEXTOPER(first);
3478             goto again;
3479         }
3480         else if (!sawopen && (OP(first) == STAR &&
3481             PL_regkind[OP(NEXTOPER(first))] == REG_ANY) &&
3482             !(r->reganch & ROPT_ANCH) )
3483         {
3484             /* turn .* into ^.* with an implied $*=1 */
3485             const int type =
3486                 (OP(NEXTOPER(first)) == REG_ANY)
3487                     ? ROPT_ANCH_MBOL
3488                     : ROPT_ANCH_SBOL;
3489             r->reganch |= type | ROPT_IMPLICIT;
3490             first = NEXTOPER(first);
3491             goto again;
3492         }
3493         if (sawplus && (!sawopen || !RExC_sawback)
3494             && !(RExC_seen & REG_SEEN_EVAL)) /* May examine pos and $& */
3495             /* x+ must match at the 1st pos of run of x's */
3496             r->reganch |= ROPT_SKIP;
3497
3498         /* Scan is after the zeroth branch, first is atomic matcher. */
3499 #ifdef TRIE_STUDY_OPT
3500         DEBUG_COMPILE_r(
3501             if (!restudied)
3502                 PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
3503                               (IV)(first - scan + 1))
3504         );
3505 #else
3506         DEBUG_COMPILE_r(
3507             PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
3508                 (IV)(first - scan + 1))
3509         );
3510 #endif
3511
3512
3513         /*
3514         * If there's something expensive in the r.e., find the
3515         * longest literal string that must appear and make it the
3516         * regmust.  Resolve ties in favor of later strings, since
3517         * the regstart check works with the beginning of the r.e.
3518         * and avoiding duplication strengthens checking.  Not a
3519         * strong reason, but sufficient in the absence of others.
3520         * [Now we resolve ties in favor of the earlier string if
3521         * it happens that c_offset_min has been invalidated, since the
3522         * earlier string may buy us something the later one won't.]
3523         */
3524         minlen = 0;
3525
3526         data.longest_fixed = newSVpvs("");
3527         data.longest_float = newSVpvs("");
3528         data.last_found = newSVpvs("");
3529         data.longest = &(data.longest_fixed);
3530         first = scan;
3531         if (!r->regstclass) {
3532             cl_init(pRExC_state, &ch_class);
3533             data.start_class = &ch_class;
3534             stclass_flag = SCF_DO_STCLASS_AND;
3535         } else                          /* XXXX Check for BOUND? */
3536             stclass_flag = 0;
3537         data.last_closep = &last_close;
3538
3539         minlen = study_chunk(pRExC_state, &first, &fake, scan + RExC_size, /* Up to end */
3540                              &data, SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag,0);
3541
3542 #ifdef TRIE_STUDY_OPT           
3543         if ( (data.flags & SCF_EXACT_TRIE) && ! restudied++ ) {
3544             goto reStudy;
3545         }
3546 #endif  
3547         
3548         if ( RExC_npar == 1 && data.longest == &(data.longest_fixed)
3549              && data.last_start_min == 0 && data.last_end > 0
3550              && !RExC_seen_zerolen
3551              && (!(RExC_seen & REG_SEEN_GPOS) || (r->reganch & ROPT_ANCH_GPOS)))
3552             r->reganch |= ROPT_CHECK_ALL;
3553         scan_commit(pRExC_state, &data);
3554         SvREFCNT_dec(data.last_found);
3555
3556         longest_float_length = CHR_SVLEN(data.longest_float);
3557         if (longest_float_length
3558             || (data.flags & SF_FL_BEFORE_EOL
3559                 && (!(data.flags & SF_FL_BEFORE_MEOL)
3560                     || (RExC_flags & PMf_MULTILINE)))) {
3561             int t;
3562
3563             if (SvCUR(data.longest_fixed)                       /* ok to leave SvCUR */
3564                 && data.offset_fixed == data.offset_float_min
3565                 && SvCUR(data.longest_fixed) == SvCUR(data.longest_float))
3566                     goto remove_float;          /* As in (a)+. */
3567
3568             if (SvUTF8(data.longest_float)) {
3569                 r->float_utf8 = data.longest_float;
3570                 r->float_substr = NULL;
3571             } else {
3572                 r->float_substr = data.longest_float;
3573                 r->float_utf8 = NULL;
3574             }
3575             r->float_min_offset = data.offset_float_min;
3576             r->float_max_offset = data.offset_float_max;
3577             t = (data.flags & SF_FL_BEFORE_EOL /* Can't have SEOL and MULTI */
3578                        && (!(data.flags & SF_FL_BEFORE_MEOL)
3579                            || (RExC_flags & PMf_MULTILINE)));
3580             fbm_compile(data.longest_float, t ? FBMcf_TAIL : 0);
3581         }
3582         else {
3583           remove_float:
3584             r->float_substr = r->float_utf8 = NULL;
3585             SvREFCNT_dec(data.longest_float);
3586             longest_float_length = 0;
3587         }
3588
3589         longest_fixed_length = CHR_SVLEN(data.longest_fixed);
3590         if (longest_fixed_length
3591             || (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
3592                 && (!(data.flags & SF_FIX_BEFORE_MEOL)
3593                     || (RExC_flags & PMf_MULTILINE)))) {
3594             int t;
3595
3596             if (SvUTF8(data.longest_fixed)) {
3597                 r->anchored_utf8 = data.longest_fixed;
3598                 r->anchored_substr = NULL;
3599             } else {
3600                 r->anchored_substr = data.longest_fixed;
3601                 r->anchored_utf8 = NULL;
3602             }
3603             r->anchored_offset = data.offset_fixed;
3604             t = (data.flags & SF_FIX_BEFORE_EOL /* Can't have SEOL and MULTI */
3605                  && (!(data.flags & SF_FIX_BEFORE_MEOL)
3606                      || (RExC_flags & PMf_MULTILINE)));
3607             fbm_compile(data.longest_fixed, t ? FBMcf_TAIL : 0);
3608         }
3609         else {
3610             r->anchored_substr = r->anchored_utf8 = NULL;
3611             SvREFCNT_dec(data.longest_fixed);
3612             longest_fixed_length = 0;
3613         }
3614         if (r->regstclass
3615             && (OP(r->regstclass) == REG_ANY || OP(r->regstclass) == SANY))
3616             r->regstclass = NULL;
3617         if ((!(r->anchored_substr || r->anchored_utf8) || r->anchored_offset)
3618             && stclass_flag
3619             && !(data.start_class->flags & ANYOF_EOS)
3620             && !cl_is_anything(data.start_class))
3621         {
3622             const I32 n = add_data(pRExC_state, 1, "f");
3623
3624             Newx(RExC_rx->data->data[n], 1,
3625                 struct regnode_charclass_class);
3626             StructCopy(data.start_class,
3627                        (struct regnode_charclass_class*)RExC_rx->data->data[n],
3628                        struct regnode_charclass_class);
3629             r->regstclass = (regnode*)RExC_rx->data->data[n];
3630             r->reganch &= ~ROPT_SKIP;   /* Used in find_byclass(). */
3631             DEBUG_COMPILE_r({ SV *sv = sv_newmortal();
3632                       regprop(r, sv, (regnode*)data.start_class);
3633                       PerlIO_printf(Perl_debug_log,
3634                                     "synthetic stclass \"%s\".\n",
3635                                     SvPVX_const(sv));});
3636         }
3637
3638         /* A temporary algorithm prefers floated substr to fixed one to dig more info. */
3639         if (longest_fixed_length > longest_float_length) {
3640             r->check_substr = r->anchored_substr;
3641             r->check_utf8 = r->anchored_utf8;
3642             r->check_offset_min = r->check_offset_max = r->anchored_offset;
3643             if (r->reganch & ROPT_ANCH_SINGLE)
3644                 r->reganch |= ROPT_NOSCAN;
3645         }
3646         else {
3647             r->check_substr = r->float_substr;
3648             r->check_utf8 = r->float_utf8;
3649             r->check_offset_min = data.offset_float_min;
3650             r->check_offset_max = data.offset_float_max;
3651         }
3652         /* XXXX Currently intuiting is not compatible with ANCH_GPOS.
3653            This should be changed ASAP!  */
3654         if ((r->check_substr || r->check_utf8) && !(r->reganch & ROPT_ANCH_GPOS)) {
3655             r->reganch |= RE_USE_INTUIT;
3656             if (SvTAIL(r->check_substr ? r->check_substr : r->check_utf8))
3657                 r->reganch |= RE_INTUIT_TAIL;
3658         }
3659     }
3660     else {
3661         /* Several toplevels. Best we can is to set minlen. */
3662         I32 fake;
3663         struct regnode_charclass_class ch_class;
3664         I32 last_close = 0;
3665         
3666         DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "\n"));
3667
3668         scan = r->program + 1;
3669         cl_init(pRExC_state, &ch_class);
3670         data.start_class = &ch_class;
3671         data.last_closep = &last_close;
3672
3673         minlen = study_chunk(pRExC_state, &scan, &fake, scan + RExC_size,
3674             &data, SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS,0);
3675
3676 #ifdef TRIE_STUDY_OPT
3677         if ( (data.flags & SCF_EXACT_TRIE) && ! restudied++ ) {
3678             goto reStudy;
3679         }
3680 #endif
3681
3682         r->check_substr = r->check_utf8 = r->anchored_substr = r->anchored_utf8
3683                 = r->float_substr = r->float_utf8 = NULL;
3684         if (!(data.start_class->flags & ANYOF_EOS)
3685             && !cl_is_anything(data.start_class))
3686         {
3687             const I32 n = add_data(pRExC_state, 1, "f");
3688
3689             Newx(RExC_rx->data->data[n], 1,
3690                 struct regnode_charclass_class);
3691             StructCopy(data.start_class,
3692                        (struct regnode_charclass_class*)RExC_rx->data->data[n],
3693                        struct regnode_charclass_class);
3694             r->regstclass = (regnode*)RExC_rx->data->data[n];
3695             r->reganch &= ~ROPT_SKIP;   /* Used in find_byclass(). */
3696             DEBUG_COMPILE_r({ SV* sv = sv_newmortal();
3697                       regprop(r, sv, (regnode*)data.start_class);
3698                       PerlIO_printf(Perl_debug_log,
3699                                     "synthetic stclass \"%s\".\n",
3700                                     SvPVX_const(sv));});
3701         }
3702     }
3703
3704     r->minlen = minlen;
3705     if (RExC_seen & REG_SEEN_GPOS)
3706         r->reganch |= ROPT_GPOS_SEEN;
3707     if (RExC_seen & REG_SEEN_LOOKBEHIND)
3708         r->reganch |= ROPT_LOOKBEHIND_SEEN;
3709     if (RExC_seen & REG_SEEN_EVAL)
3710         r->reganch |= ROPT_EVAL_SEEN;
3711     if (RExC_seen & REG_SEEN_CANY)
3712         r->reganch |= ROPT_CANY_SEEN;
3713     Newxz(r->startp, RExC_npar, I32);
3714     Newxz(r->endp, RExC_npar, I32);
3715
3716     DEBUG_r( RX_DEBUG_on(r) );
3717     DEBUG_DUMP_r({
3718         PerlIO_printf(Perl_debug_log,"Final program:\n");
3719         regdump(r);
3720     });
3721     DEBUG_OFFSETS_r(if (r->offsets) {
3722         const U32 len = r->offsets[0];
3723         U32 i;
3724         GET_RE_DEBUG_FLAGS_DECL;
3725         PerlIO_printf(Perl_debug_log, "Offsets: [%"UVuf"]\n\t", (UV)r->offsets[0]);
3726         for (i = 1; i <= len; i++) {
3727             if (r->offsets[i*2-1] || r->offsets[i*2])
3728                 PerlIO_printf(Perl_debug_log, "%"UVuf":%"UVuf"[%"UVuf"] ",
3729                 i, (UV)r->offsets[i*2-1], (UV)r->offsets[i*2]);
3730             }
3731         PerlIO_printf(Perl_debug_log, "\n");
3732     });
3733     return(r);
3734 }
3735
3736
3737 #define DEBUG_PARSE_MSG(funcname)     DEBUG_PARSE_r({           \
3738     int rem=(int)(RExC_end - RExC_parse);                       \
3739     int cut;                                                    \
3740     int num;                                                    \
3741     int iscut=0;                                                \
3742     if (rem>10) {                                               \
3743         rem=10;                                                 \
3744         iscut=1;                                                \
3745     }                                                           \
3746     cut=10-rem;                                                 \
3747     if (RExC_lastparse!=RExC_parse)                             \
3748         PerlIO_printf(Perl_debug_log," >%.*s%-*s",              \
3749             rem, RExC_parse,                                    \
3750             cut + 4,                                            \
3751             iscut ? "..." : "<"                                 \
3752         );                                                      \
3753     else                                                        \
3754         PerlIO_printf(Perl_debug_log,"%16s","");                \
3755                                                                 \
3756     if (SIZE_ONLY)                                              \
3757        num=RExC_size;                                           \
3758     else                                                        \
3759        num=REG_NODE_NUM(RExC_emit);                             \
3760     if (RExC_lastnum!=num)                                      \
3761        PerlIO_printf(Perl_debug_log,"|%4d",num);                 \
3762     else                                                        \
3763        PerlIO_printf(Perl_debug_log,"|%4s","");                  \
3764     PerlIO_printf(Perl_debug_log,"|%*s%-4s",                    \
3765         (int)((depth*2)), "",                                   \
3766         (funcname)                                              \
3767     );                                                          \
3768     RExC_lastnum=num;                                           \
3769     RExC_lastparse=RExC_parse;                                  \
3770 })
3771
3772
3773
3774 #define DEBUG_PARSE(funcname)     DEBUG_PARSE_r({           \
3775     DEBUG_PARSE_MSG((funcname));                            \
3776     PerlIO_printf(Perl_debug_log,"%4s","\n");               \
3777 })
3778 /*
3779  - reg - regular expression, i.e. main body or parenthesized thing
3780  *
3781  * Caller must absorb opening parenthesis.
3782  *
3783  * Combining parenthesis handling with the base level of regular expression
3784  * is a trifle forced, but the need to tie the tails of the branches to what
3785  * follows makes it hard to avoid.
3786  */
3787 #define REGTAIL(x,y,z) regtail((x),(y),(z),depth+1)
3788 #ifdef DEBUGGING
3789 #define REGTAIL_STUDY(x,y,z) regtail_study((x),(y),(z),depth+1)
3790 #else
3791 #define REGTAIL_STUDY(x,y,z) regtail((x),(y),(z),depth+1)
3792 #endif
3793
3794 STATIC regnode *
3795 S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
3796     /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
3797 {
3798     dVAR;
3799     register regnode *ret;              /* Will be the head of the group. */
3800     register regnode *br;
3801     register regnode *lastbr;
3802     register regnode *ender = NULL;
3803     register I32 parno = 0;
3804     I32 flags;
3805     const I32 oregflags = RExC_flags;
3806     bool have_branch = 0;
3807     bool is_open = 0;
3808
3809     /* for (?g), (?gc), and (?o) warnings; warning
3810        about (?c) will warn about (?g) -- japhy    */
3811
3812 #define WASTED_O  0x01
3813 #define WASTED_G  0x02
3814 #define WASTED_C  0x04
3815 #define WASTED_GC (0x02|0x04)
3816     I32 wastedflags = 0x00;
3817
3818     char * parse_start = RExC_parse; /* MJD */
3819     char * const oregcomp_parse = RExC_parse;
3820
3821     GET_RE_DEBUG_FLAGS_DECL;
3822     DEBUG_PARSE("reg ");
3823
3824
3825     *flagp = 0;                         /* Tentatively. */
3826
3827
3828     /* Make an OPEN node, if parenthesized. */
3829     if (paren) {
3830         if (*RExC_parse == '?') { /* (?...) */
3831             U32 posflags = 0, negflags = 0;
3832             U32 *flagsp = &posflags;
3833             bool is_logical = 0;
3834             const char * const seqstart = RExC_parse;
3835
3836             RExC_parse++;
3837             paren = *RExC_parse++;
3838             ret = NULL;                 /* For look-ahead/behind. */
3839             switch (paren) {
3840             case '<':           /* (?<...) */
3841                 RExC_seen |= REG_SEEN_LOOKBEHIND;
3842                 if (*RExC_parse == '!')
3843                     paren = ',';
3844                 if (*RExC_parse != '=' && *RExC_parse != '!')
3845                     goto unknown;
3846                 RExC_parse++;
3847             case '=':           /* (?=...) */
3848             case '!':           /* (?!...) */
3849                 RExC_seen_zerolen++;
3850             case ':':           /* (?:...) */
3851             case '>':           /* (?>...) */
3852                 break;
3853             case '$':           /* (?$...) */
3854             case '@':           /* (?@...) */
3855                 vFAIL2("Sequence (?%c...) not implemented", (int)paren);
3856                 break;
3857             case '#':           /* (?#...) */
3858                 while (*RExC_parse && *RExC_parse != ')')
3859                     RExC_parse++;
3860                 if (*RExC_parse != ')')
3861                     FAIL("Sequence (?#... not terminated");
3862                 nextchar(pRExC_state);
3863                 *flagp = TRYAGAIN;
3864                 return NULL;
3865             case 'p':           /* (?p...) */
3866                 if (SIZE_ONLY && ckWARN2(WARN_DEPRECATED, WARN_REGEXP))
3867                     vWARNdep(RExC_parse, "(?p{}) is deprecated - use (??{})");
3868                 /* FALL THROUGH*/
3869             case '?':           /* (??...) */
3870                 is_logical = 1;
3871                 if (*RExC_parse != '{')
3872                     goto unknown;
3873                 paren = *RExC_parse++;
3874                 /* FALL THROUGH */
3875             case '{':           /* (?{...}) */
3876             {
3877                 I32 count = 1, n = 0;
3878                 char c;
3879                 char *s = RExC_parse;
3880
3881                 RExC_seen_zerolen++;
3882                 RExC_seen |= REG_SEEN_EVAL;
3883                 while (count && (c = *RExC_parse)) {
3884                     if (c == '\\') {
3885                         if (RExC_parse[1])
3886                             RExC_parse++;
3887                     }
3888                     else if (c == '{')
3889                         count++;
3890                     else if (c == '}')
3891                         count--;
3892                     RExC_parse++;
3893                 }
3894                 if (*RExC_parse != ')') {
3895                     RExC_parse = s;             
3896                     vFAIL("Sequence (?{...}) not terminated or not {}-balanced");
3897                 }
3898                 if (!SIZE_ONLY) {
3899                     PAD *pad;
3900                     OP_4tree *sop, *rop;
3901                     SV * const sv = newSVpvn(s, RExC_parse - 1 - s);
3902
3903                     ENTER;
3904                     Perl_save_re_context(aTHX);
3905                     rop = sv_compile_2op(sv, &sop, "re", &pad);
3906                     sop->op_private |= OPpREFCOUNTED;
3907                     /* re_dup will OpREFCNT_inc */
3908                     OpREFCNT_set(sop, 1);
3909                     LEAVE;
3910
3911                     n = add_data(pRExC_state, 3, "nop");
3912                     RExC_rx->data->data[n] = (void*)rop;
3913                     RExC_rx->data->data[n+1] = (void*)sop;
3914                     RExC_rx->data->data[n+2] = (void*)pad;
3915                     SvREFCNT_dec(sv);
3916                 }
3917                 else {                                          /* First pass */
3918                     if (PL_reginterp_cnt < ++RExC_seen_evals
3919                         && IN_PERL_RUNTIME)
3920                         /* No compiled RE interpolated, has runtime
3921                            components ===> unsafe.  */