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