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