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