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