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