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