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