quieten warning by avoiding a comment-within-a-comment
[p5sagit/p5-mst-13.2.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 #include "re_top.h"
34 #endif
35
36 /*
37  * pregcomp and pregexec -- regsub and regerror are not used in perl
38  *
39  *      Copyright (c) 1986 by University of Toronto.
40  *      Written by Henry Spencer.  Not derived from licensed software.
41  *
42  *      Permission is granted to anyone to use this software for any
43  *      purpose on any computer system, and to redistribute it freely,
44  *      subject to the following restrictions:
45  *
46  *      1. The author is not responsible for the consequences of use of
47  *              this software, no matter how awful, even if they arise
48  *              from defects in it.
49  *
50  *      2. The origin of this software must not be misrepresented, either
51  *              by explicit claim or by omission.
52  *
53  *      3. Altered versions must be plainly marked as such, and must not
54  *              be misrepresented as being the original software.
55  *
56  *
57  ****    Alterations to Henry's code are...
58  ****
59  ****    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
60  ****    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
61  ****
62  ****    You may distribute under the terms of either the GNU General Public
63  ****    License or the Artistic License, as specified in the README file.
64
65  *
66  * Beware that some of this code is subtly aware of the way operator
67  * precedence is structured in regular expressions.  Serious changes in
68  * regular-expression syntax might require a total rethink.
69  */
70 #include "EXTERN.h"
71 #define PERL_IN_REGCOMP_C
72 #include "perl.h"
73
74 #ifndef PERL_IN_XSUB_RE
75 #  include "INTERN.h"
76 #endif
77
78 #define REG_COMP_C
79 #ifdef PERL_IN_XSUB_RE
80 #  include "re_comp.h"
81 #else
82 #  include "regcomp.h"
83 #endif
84
85 #ifdef op
86 #undef op
87 #endif /* op */
88
89 #ifdef MSDOS
90 #  if defined(BUGGY_MSC6)
91  /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
92 #    pragma optimize("a",off)
93  /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
94 #    pragma optimize("w",on )
95 #  endif /* BUGGY_MSC6 */
96 #endif /* MSDOS */
97
98 #ifndef STATIC
99 #define STATIC  static
100 #endif
101
102 typedef struct RExC_state_t {
103     U32         flags;                  /* are we folding, multilining? */
104     char        *precomp;               /* uncompiled string. */
105     regexp      *rx;
106     char        *start;                 /* Start of input for compile */
107     char        *end;                   /* End of input for compile */
108     char        *parse;                 /* Input-scan pointer. */
109     I32         whilem_seen;            /* number of WHILEM in this expr */
110     regnode     *emit_start;            /* Start of emitted-code area */
111     regnode     *emit;                  /* Code-emit pointer; &regdummy = don't = compiling */
112     I32         naughty;                /* How bad is this pattern? */
113     I32         sawback;                /* Did we see \1, ...? */
114     U32         seen;
115     I32         size;                   /* Code size. */
116     I32         npar;                   /* () count. */
117     I32         extralen;
118     I32         seen_zerolen;
119     I32         seen_evals;
120     I32         utf8;
121 #if ADD_TO_REGEXEC
122     char        *starttry;              /* -Dr: where regtry was called. */
123 #define RExC_starttry   (pRExC_state->starttry)
124 #endif
125 #ifdef DEBUGGING
126     const char  *lastparse;
127     I32         lastnum;
128 #define RExC_lastparse  (pRExC_state->lastparse)
129 #define RExC_lastnum    (pRExC_state->lastnum)
130 #endif
131 } RExC_state_t;
132
133 #define RExC_flags      (pRExC_state->flags)
134 #define RExC_precomp    (pRExC_state->precomp)
135 #define RExC_rx         (pRExC_state->rx)
136 #define RExC_start      (pRExC_state->start)
137 #define RExC_end        (pRExC_state->end)
138 #define RExC_parse      (pRExC_state->parse)
139 #define RExC_whilem_seen        (pRExC_state->whilem_seen)
140 #define RExC_offsets    (pRExC_state->rx->offsets) /* I am not like the others */
141 #define RExC_emit       (pRExC_state->emit)
142 #define RExC_emit_start (pRExC_state->emit_start)
143 #define RExC_naughty    (pRExC_state->naughty)
144 #define RExC_sawback    (pRExC_state->sawback)
145 #define RExC_seen       (pRExC_state->seen)
146 #define RExC_size       (pRExC_state->size)
147 #define RExC_npar       (pRExC_state->npar)
148 #define RExC_extralen   (pRExC_state->extralen)
149 #define RExC_seen_zerolen       (pRExC_state->seen_zerolen)
150 #define RExC_seen_evals (pRExC_state->seen_evals)
151 #define RExC_utf8       (pRExC_state->utf8)
152
153 #define ISMULT1(c)      ((c) == '*' || (c) == '+' || (c) == '?')
154 #define ISMULT2(s)      ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
155         ((*s) == '{' && regcurly(s)))
156
157 #ifdef SPSTART
158 #undef SPSTART          /* dratted cpp namespace... */
159 #endif
160 /*
161  * Flags to be passed up and down.
162  */
163 #define WORST           0       /* Worst case. */
164 #define HASWIDTH        0x1     /* Known to match non-null strings. */
165 #define SIMPLE          0x2     /* Simple enough to be STAR/PLUS operand. */
166 #define SPSTART         0x4     /* Starts with * or +. */
167 #define TRYAGAIN        0x8     /* Weeded out a declaration. */
168
169 #define REG_NODE_NUM(x) ((x) ? (int)((x)-RExC_emit_start) : -1)
170
171 /* whether trie related optimizations are enabled */
172 #if PERL_ENABLE_EXTENDED_TRIE_OPTIMISATION
173 #define TRIE_STUDY_OPT
174 #define TRIE_STCLASS
175 #endif
176 /* Length of a variant. */
177
178 typedef struct scan_data_t {
179     I32 len_min;
180     I32 len_delta;
181     I32 pos_min;
182     I32 pos_delta;
183     SV *last_found;
184     I32 last_end;                       /* min value, <0 unless valid. */
185     I32 last_start_min;
186     I32 last_start_max;
187     SV **longest;                       /* Either &l_fixed, or &l_float. */
188     SV *longest_fixed;
189     I32 offset_fixed;
190     SV *longest_float;
191     I32 offset_float_min;
192     I32 offset_float_max;
193     I32 flags;
194     I32 whilem_c;
195     I32 *last_closep;
196     struct regnode_charclass_class *start_class;
197 } scan_data_t;
198
199 /*
200  * Forward declarations for pregcomp()'s friends.
201  */
202
203 static const scan_data_t zero_scan_data =
204   { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
205
206 #define SF_BEFORE_EOL           (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
207 #define SF_BEFORE_SEOL          0x0001
208 #define SF_BEFORE_MEOL          0x0002
209 #define SF_FIX_BEFORE_EOL       (SF_FIX_BEFORE_SEOL|SF_FIX_BEFORE_MEOL)
210 #define SF_FL_BEFORE_EOL        (SF_FL_BEFORE_SEOL|SF_FL_BEFORE_MEOL)
211
212 #ifdef NO_UNARY_PLUS
213 #  define SF_FIX_SHIFT_EOL      (0+2)
214 #  define SF_FL_SHIFT_EOL               (0+4)
215 #else
216 #  define SF_FIX_SHIFT_EOL      (+2)
217 #  define SF_FL_SHIFT_EOL               (+4)
218 #endif
219
220 #define SF_FIX_BEFORE_SEOL      (SF_BEFORE_SEOL << SF_FIX_SHIFT_EOL)
221 #define SF_FIX_BEFORE_MEOL      (SF_BEFORE_MEOL << SF_FIX_SHIFT_EOL)
222
223 #define SF_FL_BEFORE_SEOL       (SF_BEFORE_SEOL << SF_FL_SHIFT_EOL)
224 #define SF_FL_BEFORE_MEOL       (SF_BEFORE_MEOL << SF_FL_SHIFT_EOL) /* 0x20 */
225 #define SF_IS_INF               0x0040
226 #define SF_HAS_PAR              0x0080
227 #define SF_IN_PAR               0x0100
228 #define SF_HAS_EVAL             0x0200
229 #define SCF_DO_SUBSTR           0x0400
230 #define SCF_DO_STCLASS_AND      0x0800
231 #define SCF_DO_STCLASS_OR       0x1000
232 #define SCF_DO_STCLASS          (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR)
233 #define SCF_WHILEM_VISITED_POS  0x2000
234
235 #define SCF_EXACT_TRIE          0x4000 /* should re study once we are done? */
236
237 #define UTF (RExC_utf8 != 0)
238 #define LOC ((RExC_flags & PMf_LOCALE) != 0)
239 #define FOLD ((RExC_flags & PMf_FOLD) != 0)
240
241 #define OOB_UNICODE             12345678
242 #define OOB_NAMEDCLASS          -1
243
244 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
245 #define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
246
247
248 /* length of regex to show in messages that don't mark a position within */
249 #define RegexLengthToShowInErrorMessages 127
250
251 /*
252  * If MARKER[12] are adjusted, be sure to adjust the constants at the top
253  * of t/op/regmesg.t, the tests in t/op/re_tests, and those in
254  * op/pragma/warn/regcomp.
255  */
256 #define MARKER1 "<-- HERE"    /* marker as it appears in the description */
257 #define MARKER2 " <-- HERE "  /* marker as it appears within the regex */
258
259 #define REPORT_LOCATION " in regex; marked by " MARKER1 " in m/%.*s" MARKER2 "%s/"
260
261 /*
262  * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
263  * arg. Show regex, up to a maximum length. If it's too long, chop and add
264  * "...".
265  */
266 #define FAIL(msg) STMT_START {                                          \
267     const char *ellipses = "";                                          \
268     IV len = RExC_end - RExC_precomp;                                   \
269                                                                         \
270     if (!SIZE_ONLY)                                                     \
271         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx);                      \
272     if (len > RegexLengthToShowInErrorMessages) {                       \
273         /* chop 10 shorter than the max, to ensure meaning of "..." */  \
274         len = RegexLengthToShowInErrorMessages - 10;                    \
275         ellipses = "...";                                               \
276     }                                                                   \
277     Perl_croak(aTHX_ "%s in regex m/%.*s%s/",                           \
278             msg, (int)len, RExC_precomp, ellipses);                     \
279 } STMT_END
280
281 /*
282  * Simple_vFAIL -- like FAIL, but marks the current location in the scan
283  */
284 #define Simple_vFAIL(m) STMT_START {                                    \
285     const IV offset = RExC_parse - RExC_precomp;                        \
286     Perl_croak(aTHX_ "%s" REPORT_LOCATION,                              \
287             m, (int)offset, RExC_precomp, RExC_precomp + offset);       \
288 } STMT_END
289
290 /*
291  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL()
292  */
293 #define vFAIL(m) STMT_START {                           \
294     if (!SIZE_ONLY)                                     \
295         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx);      \
296     Simple_vFAIL(m);                                    \
297 } STMT_END
298
299 /*
300  * Like Simple_vFAIL(), but accepts two arguments.
301  */
302 #define Simple_vFAIL2(m,a1) STMT_START {                        \
303     const IV offset = RExC_parse - RExC_precomp;                        \
304     S_re_croak2(aTHX_ m, REPORT_LOCATION, a1,                   \
305             (int)offset, RExC_precomp, RExC_precomp + offset);  \
306 } STMT_END
307
308 /*
309  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL2().
310  */
311 #define vFAIL2(m,a1) STMT_START {                       \
312     if (!SIZE_ONLY)                                     \
313         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx);      \
314     Simple_vFAIL2(m, a1);                               \
315 } STMT_END
316
317
318 /*
319  * Like Simple_vFAIL(), but accepts three arguments.
320  */
321 #define Simple_vFAIL3(m, a1, a2) STMT_START {                   \
322     const IV offset = RExC_parse - RExC_precomp;                \
323     S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2,               \
324             (int)offset, RExC_precomp, RExC_precomp + offset);  \
325 } STMT_END
326
327 /*
328  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL3().
329  */
330 #define vFAIL3(m,a1,a2) STMT_START {                    \
331     if (!SIZE_ONLY)                                     \
332         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx);      \
333     Simple_vFAIL3(m, a1, a2);                           \
334 } STMT_END
335
336 /*
337  * Like Simple_vFAIL(), but accepts four arguments.
338  */
339 #define Simple_vFAIL4(m, a1, a2, a3) STMT_START {               \
340     const IV offset = RExC_parse - RExC_precomp;                \
341     S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3,           \
342             (int)offset, RExC_precomp, RExC_precomp + offset);  \
343 } STMT_END
344
345 #define vWARN(loc,m) STMT_START {                                       \
346     const IV offset = loc - RExC_precomp;                               \
347     Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s" REPORT_LOCATION,      \
348             m, (int)offset, RExC_precomp, RExC_precomp + offset);       \
349 } STMT_END
350
351 #define vWARNdep(loc,m) STMT_START {                                    \
352     const IV offset = loc - RExC_precomp;                               \
353     Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP),          \
354             "%s" REPORT_LOCATION,                                       \
355             m, (int)offset, RExC_precomp, RExC_precomp + offset);       \
356 } STMT_END
357
358
359 #define vWARN2(loc, m, a1) STMT_START {                                 \
360     const IV offset = loc - RExC_precomp;                               \
361     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
362             a1, (int)offset, RExC_precomp, RExC_precomp + offset);      \
363 } STMT_END
364
365 #define vWARN3(loc, m, a1, a2) STMT_START {                             \
366     const IV offset = loc - RExC_precomp;                               \
367     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
368             a1, a2, (int)offset, RExC_precomp, RExC_precomp + offset);  \
369 } STMT_END
370
371 #define vWARN4(loc, m, a1, a2, a3) STMT_START {                         \
372     const IV offset = loc - RExC_precomp;                               \
373     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
374             a1, a2, a3, (int)offset, RExC_precomp, RExC_precomp + offset); \
375 } STMT_END
376
377 #define vWARN5(loc, m, a1, a2, a3, a4) STMT_START {                     \
378     const IV offset = loc - RExC_precomp;                               \
379     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
380             a1, a2, a3, a4, (int)offset, RExC_precomp, RExC_precomp + offset); \
381 } STMT_END
382
383
384 /* Allow for side effects in s */
385 #define REGC(c,s) STMT_START {                  \
386     if (!SIZE_ONLY) *(s) = (c); else (void)(s); \
387 } STMT_END
388
389 /* Macros for recording node offsets.   20001227 mjd@plover.com 
390  * Nodes are numbered 1, 2, 3, 4.  Node #n's position is recorded in
391  * element 2*n-1 of the array.  Element #2n holds the byte length node #n.
392  * Element 0 holds the number n.
393  * Position is 1 indexed.
394  */
395
396 #define Set_Node_Offset_To_R(node,byte) STMT_START {                    \
397     if (! SIZE_ONLY) {                                                  \
398         MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n",         \
399                     __LINE__, (node), (int)(byte)));                    \
400         if((node) < 0) {                                                \
401             Perl_croak(aTHX_ "value of node is %d in Offset macro", (int)(node)); \
402         } else {                                                        \
403             RExC_offsets[2*(node)-1] = (byte);                          \
404         }                                                               \
405     }                                                                   \
406 } STMT_END
407
408 #define Set_Node_Offset(node,byte) \
409     Set_Node_Offset_To_R((node)-RExC_emit_start, (byte)-RExC_start)
410 #define Set_Cur_Node_Offset Set_Node_Offset(RExC_emit, RExC_parse)
411
412 #define Set_Node_Length_To_R(node,len) STMT_START {                     \
413     if (! SIZE_ONLY) {                                                  \
414         MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n",           \
415                 __LINE__, (int)(node), (int)(len)));                    \
416         if((node) < 0) {                                                \
417             Perl_croak(aTHX_ "value of node is %d in Length macro", (int)(node)); \
418         } else {                                                        \
419             RExC_offsets[2*(node)] = (len);                             \
420         }                                                               \
421     }                                                                   \
422 } STMT_END
423
424 #define Set_Node_Length(node,len) \
425     Set_Node_Length_To_R((node)-RExC_emit_start, len)
426 #define Set_Cur_Node_Length(len) Set_Node_Length(RExC_emit, len)
427 #define Set_Node_Cur_Length(node) \
428     Set_Node_Length(node, RExC_parse - parse_start)
429
430 /* Get offsets and lengths */
431 #define Node_Offset(n) (RExC_offsets[2*((n)-RExC_emit_start)-1])
432 #define Node_Length(n) (RExC_offsets[2*((n)-RExC_emit_start)])
433
434 #define Set_Node_Offset_Length(node,offset,len) STMT_START {    \
435     Set_Node_Offset_To_R((node)-RExC_emit_start, (offset));     \
436     Set_Node_Length_To_R((node)-RExC_emit_start, (len));        \
437 } STMT_END
438
439
440 #if PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS
441 #define EXPERIMENTAL_INPLACESCAN
442 #endif
443
444 static void clear_re(pTHX_ void *r);
445
446 /* Mark that we cannot extend a found fixed substring at this point.
447    Updata the longest found anchored substring and the longest found
448    floating substrings if needed. */
449
450 STATIC void
451 S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data)
452 {
453     const STRLEN l = CHR_SVLEN(data->last_found);
454     const STRLEN old_l = CHR_SVLEN(*data->longest);
455
456     if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
457         SvSetMagicSV(*data->longest, data->last_found);
458         if (*data->longest == data->longest_fixed) {
459             data->offset_fixed = l ? data->last_start_min : data->pos_min;
460             if (data->flags & SF_BEFORE_EOL)
461                 data->flags
462                     |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL);
463             else
464                 data->flags &= ~SF_FIX_BEFORE_EOL;
465         }
466         else {
467             data->offset_float_min = l ? data->last_start_min : data->pos_min;
468             data->offset_float_max = (l
469                                       ? data->last_start_max
470                                       : data->pos_min + data->pos_delta);
471             if ((U32)data->offset_float_max > (U32)I32_MAX)
472                 data->offset_float_max = I32_MAX;
473             if (data->flags & SF_BEFORE_EOL)
474                 data->flags
475                     |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL);
476             else
477                 data->flags &= ~SF_FL_BEFORE_EOL;
478         }
479     }
480     SvCUR_set(data->last_found, 0);
481     {
482         SV * const sv = data->last_found;
483         if (SvUTF8(sv) && SvMAGICAL(sv)) {
484             MAGIC * const mg = mg_find(sv, PERL_MAGIC_utf8);
485             if (mg)
486                 mg->mg_len = 0;
487         }
488     }
489     data->last_end = -1;
490     data->flags &= ~SF_BEFORE_EOL;
491 }
492
493 /* Can match anything (initialization) */
494 STATIC void
495 S_cl_anything(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
496 {
497     ANYOF_CLASS_ZERO(cl);
498     ANYOF_BITMAP_SETALL(cl);
499     cl->flags = ANYOF_EOS|ANYOF_UNICODE_ALL;
500     if (LOC)
501         cl->flags |= ANYOF_LOCALE;
502 }
503
504 /* Can match anything (initialization) */
505 STATIC int
506 S_cl_is_anything(const struct regnode_charclass_class *cl)
507 {
508     int value;
509
510     for (value = 0; value <= ANYOF_MAX; value += 2)
511         if (ANYOF_CLASS_TEST(cl, value) && ANYOF_CLASS_TEST(cl, value + 1))
512             return 1;
513     if (!(cl->flags & ANYOF_UNICODE_ALL))
514         return 0;
515     if (!ANYOF_BITMAP_TESTALLSET(cl))
516         return 0;
517     return 1;
518 }
519
520 /* Can match anything (initialization) */
521 STATIC void
522 S_cl_init(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
523 {
524     Zero(cl, 1, struct regnode_charclass_class);
525     cl->type = ANYOF;
526     cl_anything(pRExC_state, cl);
527 }
528
529 STATIC void
530 S_cl_init_zero(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
531 {
532     Zero(cl, 1, struct regnode_charclass_class);
533     cl->type = ANYOF;
534     cl_anything(pRExC_state, cl);
535     if (LOC)
536         cl->flags |= ANYOF_LOCALE;
537 }
538
539 /* 'And' a given class with another one.  Can create false positives */
540 /* We assume that cl is not inverted */
541 STATIC void
542 S_cl_and(struct regnode_charclass_class *cl,
543         const struct regnode_charclass_class *and_with)
544 {
545     if (!(and_with->flags & ANYOF_CLASS)
546         && !(cl->flags & ANYOF_CLASS)
547         && (and_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
548         && !(and_with->flags & ANYOF_FOLD)
549         && !(cl->flags & ANYOF_FOLD)) {
550         int i;
551
552         if (and_with->flags & ANYOF_INVERT)
553             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
554                 cl->bitmap[i] &= ~and_with->bitmap[i];
555         else
556             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
557                 cl->bitmap[i] &= and_with->bitmap[i];
558     } /* XXXX: logic is complicated otherwise, leave it along for a moment. */
559     if (!(and_with->flags & ANYOF_EOS))
560         cl->flags &= ~ANYOF_EOS;
561
562     if (cl->flags & ANYOF_UNICODE_ALL && and_with->flags & ANYOF_UNICODE &&
563         !(and_with->flags & ANYOF_INVERT)) {
564         cl->flags &= ~ANYOF_UNICODE_ALL;
565         cl->flags |= ANYOF_UNICODE;
566         ARG_SET(cl, ARG(and_with));
567     }
568     if (!(and_with->flags & ANYOF_UNICODE_ALL) &&
569         !(and_with->flags & ANYOF_INVERT))
570         cl->flags &= ~ANYOF_UNICODE_ALL;
571     if (!(and_with->flags & (ANYOF_UNICODE|ANYOF_UNICODE_ALL)) &&
572         !(and_with->flags & ANYOF_INVERT))
573         cl->flags &= ~ANYOF_UNICODE;
574 }
575
576 /* 'OR' a given class with another one.  Can create false positives */
577 /* We assume that cl is not inverted */
578 STATIC void
579 S_cl_or(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, const struct regnode_charclass_class *or_with)
580 {
581     if (or_with->flags & ANYOF_INVERT) {
582         /* We do not use
583          * (B1 | CL1) | (!B2 & !CL2) = (B1 | !B2 & !CL2) | (CL1 | (!B2 & !CL2))
584          *   <= (B1 | !B2) | (CL1 | !CL2)
585          * which is wasteful if CL2 is small, but we ignore CL2:
586          *   (B1 | CL1) | (!B2 & !CL2) <= (B1 | CL1) | !B2 = (B1 | !B2) | CL1
587          * XXXX Can we handle case-fold?  Unclear:
588          *   (OK1(i) | OK1(i')) | !(OK1(i) | OK1(i')) =
589          *   (OK1(i) | OK1(i')) | (!OK1(i) & !OK1(i'))
590          */
591         if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
592              && !(or_with->flags & ANYOF_FOLD)
593              && !(cl->flags & ANYOF_FOLD) ) {
594             int i;
595
596             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
597                 cl->bitmap[i] |= ~or_with->bitmap[i];
598         } /* XXXX: logic is complicated otherwise */
599         else {
600             cl_anything(pRExC_state, cl);
601         }
602     } else {
603         /* (B1 | CL1) | (B2 | CL2) = (B1 | B2) | (CL1 | CL2)) */
604         if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
605              && (!(or_with->flags & ANYOF_FOLD)
606                  || (cl->flags & ANYOF_FOLD)) ) {
607             int i;
608
609             /* OR char bitmap and class bitmap separately */
610             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
611                 cl->bitmap[i] |= or_with->bitmap[i];
612             if (or_with->flags & ANYOF_CLASS) {
613                 for (i = 0; i < ANYOF_CLASSBITMAP_SIZE; i++)
614                     cl->classflags[i] |= or_with->classflags[i];
615                 cl->flags |= ANYOF_CLASS;
616             }
617         }
618         else { /* XXXX: logic is complicated, leave it along for a moment. */
619             cl_anything(pRExC_state, cl);
620         }
621     }
622     if (or_with->flags & ANYOF_EOS)
623         cl->flags |= ANYOF_EOS;
624
625     if (cl->flags & ANYOF_UNICODE && or_with->flags & ANYOF_UNICODE &&
626         ARG(cl) != ARG(or_with)) {
627         cl->flags |= ANYOF_UNICODE_ALL;
628         cl->flags &= ~ANYOF_UNICODE;
629     }
630     if (or_with->flags & ANYOF_UNICODE_ALL) {
631         cl->flags |= ANYOF_UNICODE_ALL;
632         cl->flags &= ~ANYOF_UNICODE;
633     }
634 }
635
636 /*
637
638  make_trie(startbranch,first,last,tail,flags,depth)
639   startbranch: the first branch in the whole branch sequence
640   first      : start branch of sequence of branch-exact nodes.
641                May be the same as startbranch
642   last       : Thing following the last branch.
643                May be the same as tail.
644   tail       : item following the branch sequence
645   flags      : currently the OP() type we will be building one of /EXACT(|F|Fl)/
646   depth      : indent depth
647
648 Inplace optimizes a sequence of 2 or more Branch-Exact nodes into a TRIE node.
649
650 A trie is an N'ary tree where the branches are determined by digital
651 decomposition of the key. IE, at the root node you look up the 1st character and
652 follow that branch repeat until you find the end of the branches. Nodes can be
653 marked as "accepting" meaning they represent a complete word. Eg:
654
655   /he|she|his|hers/
656
657 would convert into the following structure. Numbers represent states, letters
658 following numbers represent valid transitions on the letter from that state, if
659 the number is in square brackets it represents an accepting state, otherwise it
660 will be in parenthesis.
661
662       +-h->+-e->[3]-+-r->(8)-+-s->[9]
663       |    |
664       |   (2)
665       |    |
666      (1)   +-i->(6)-+-s->[7]
667       |
668       +-s->(3)-+-h->(4)-+-e->[5]
669
670       Accept Word Mapping: 3=>1 (he),5=>2 (she), 7=>3 (his), 9=>4 (hers)
671
672 This shows that when matching against the string 'hers' we will begin at state 1
673 read 'h' and move to state 2, read 'e' and move to state 3 which is accepting,
674 then read 'r' and go to state 8 followed by 's' which takes us to state 9 which
675 is also accepting. Thus we know that we can match both 'he' and 'hers' with a
676 single traverse. We store a mapping from accepting to state to which word was
677 matched, and then when we have multiple possibilities we try to complete the
678 rest of the regex in the order in which they occured in the alternation.
679
680 The only prior NFA like behaviour that would be changed by the TRIE support is
681 the silent ignoring of duplicate alternations which are of the form:
682
683  / (DUPE|DUPE) X? (?{ ... }) Y /x
684
685 Thus EVAL blocks follwing a trie may be called a different number of times with
686 and without the optimisation. With the optimisations dupes will be silently
687 ignored. This inconsistant behaviour of EVAL type nodes is well established as
688 the following demonstrates:
689
690  'words'=~/(word|word|word)(?{ print $1 })[xyz]/
691
692 which prints out 'word' three times, but
693
694  'words'=~/(word|word|word)(?{ print $1 })S/
695
696 which doesnt print it out at all. This is due to other optimisations kicking in.
697
698 Example of what happens on a structural level:
699
700 The regexp /(ac|ad|ab)+/ will produce the folowing debug output:
701
702    1: CURLYM[1] {1,32767}(18)
703    5:   BRANCH(8)
704    6:     EXACT <ac>(16)
705    8:   BRANCH(11)
706    9:     EXACT <ad>(16)
707   11:   BRANCH(14)
708   12:     EXACT <ab>(16)
709   16:   SUCCEED(0)
710   17:   NOTHING(18)
711   18: END(0)
712
713 This would be optimizable with startbranch=5, first=5, last=16, tail=16
714 and should turn into:
715
716    1: CURLYM[1] {1,32767}(18)
717    5:   TRIE(16)
718         [Words:3 Chars Stored:6 Unique Chars:4 States:5 NCP:1]
719           <ac>
720           <ad>
721           <ab>
722   16:   SUCCEED(0)
723   17:   NOTHING(18)
724   18: END(0)
725
726 Cases where tail != last would be like /(?foo|bar)baz/:
727
728    1: BRANCH(4)
729    2:   EXACT <foo>(8)
730    4: BRANCH(7)
731    5:   EXACT <bar>(8)
732    7: TAIL(8)
733    8: EXACT <baz>(10)
734   10: END(0)
735
736 which would be optimizable with startbranch=1, first=1, last=7, tail=8
737 and would end up looking like:
738
739     1: TRIE(8)
740       [Words:2 Chars Stored:6 Unique Chars:5 States:7 NCP:1]
741         <foo>
742         <bar>
743    7: TAIL(8)
744    8: EXACT <baz>(10)
745   10: END(0)
746
747     d = uvuni_to_utf8_flags(d, uv, 0);
748
749 is the recommended Unicode-aware way of saying
750
751     *(d++) = uv;
752 */
753
754 #define TRIE_STORE_REVCHAR                                                    \
755     STMT_START {                                                           \
756         SV *tmp = Perl_newSVpvf_nocontext( "%c", (int)uvc );               \
757         av_push( TRIE_REVCHARMAP(trie), tmp );                             \
758     } STMT_END
759
760 #define TRIE_READ_CHAR STMT_START {                                           \
761     wordlen++;                                                                \
762     if ( UTF ) {                                                              \
763         if ( folder ) {                                                       \
764             if ( foldlen > 0 ) {                                              \
765                uvc = utf8n_to_uvuni( scan, UTF8_MAXLEN, &len, uniflags );     \
766                foldlen -= len;                                                \
767                scan += len;                                                   \
768                len = 0;                                                       \
769             } else {                                                          \
770                 uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
771                 uvc = to_uni_fold( uvc, foldbuf, &foldlen );                  \
772                 foldlen -= UNISKIP( uvc );                                    \
773                 scan = foldbuf + UNISKIP( uvc );                              \
774             }                                                                 \
775         } else {                                                              \
776             uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
777         }                                                                     \
778     } else {                                                                  \
779         uvc = (U32)*uc;                                                       \
780         len = 1;                                                              \
781     }                                                                         \
782 } STMT_END
783
784
785 #define TRIE_LIST_ITEM(state,idx) (trie->states[state].trans.list)[ idx ]
786 #define TRIE_LIST_CUR(state)  ( TRIE_LIST_ITEM( state, 0 ).forid )
787 #define TRIE_LIST_LEN(state) ( TRIE_LIST_ITEM( state, 0 ).newstate )
788 #define TRIE_LIST_USED(idx)  ( trie->states[state].trans.list ? (TRIE_LIST_CUR( idx ) - 1) : 0 )
789
790 #define TRIE_LIST_PUSH(state,fid,ns) STMT_START {               \
791     if ( TRIE_LIST_CUR( state ) >=TRIE_LIST_LEN( state ) ) {    \
792         TRIE_LIST_LEN( state ) *= 2;                            \
793         Renew( trie->states[ state ].trans.list,                \
794                TRIE_LIST_LEN( state ), reg_trie_trans_le );     \
795     }                                                           \
796     TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).forid = fid;     \
797     TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).newstate = ns;   \
798     TRIE_LIST_CUR( state )++;                                   \
799 } STMT_END
800
801 #define TRIE_LIST_NEW(state) STMT_START {                       \
802     Newxz( trie->states[ state ].trans.list,               \
803         4, reg_trie_trans_le );                                 \
804      TRIE_LIST_CUR( state ) = 1;                                \
805      TRIE_LIST_LEN( state ) = 4;                                \
806 } STMT_END
807
808 #define TRIE_HANDLE_WORD(state) STMT_START {                            \
809             if ( !trie->states[ state ].wordnum ) {                     \
810                 /* we haven't inserted this word into the structure yet. */ \
811                 if (trie->wordlen)                                      \
812                     trie->wordlen[ curword ] = wordlen;                 \
813                 trie->states[ state ].wordnum = ++curword;              \
814                 DEBUG_r({                                               \
815                     /* store the word for dumping */                    \
816                     SV* tmp;                                            \
817                     if (OP(noper) != NOTHING)                           \
818                         tmp = newSVpvn(STRING(noper), STR_LEN(noper));  \
819                     else                                                \
820                         tmp = newSVpvn( "", 0 );                        \
821                     if ( UTF ) SvUTF8_on( tmp );                        \
822                     av_push( trie->words, tmp );                        \
823                 });                                                     \
824             } else {                                                    \
825                 NOOP;   /* It's a dupe. So ignore it. */                \
826             }                                                           \
827 } STMT_END
828
829 #ifdef DEBUGGING
830 /*
831    dump_trie(trie)
832    dump_trie_interim_list(trie,next_alloc)
833    dump_trie_interim_table(trie,next_alloc)
834
835    These routines dump out a trie in a somewhat readable format.
836    The _interim_ variants are used for debugging the interim
837    tables that are used to generate the final compressed
838    representation which is what dump_trie expects.
839
840    Part of the reason for their existance is to provide a form
841    of documentation as to how the different representations function.
842
843 */
844
845 /*
846   dump_trie(trie)
847   Dumps the final compressed table form of the trie to Perl_debug_log.
848   Used for debugging make_trie().
849 */
850  
851 STATIC void
852 S_dump_trie(pTHX_ const struct _reg_trie_data *trie,U32 depth)
853 {
854     U32 state;
855     GET_RE_DEBUG_FLAGS_DECL;
856
857     PerlIO_printf( Perl_debug_log, "%*sChar : %-6s%-6s%-4s ",
858         (int)depth * 2 + 2,"",
859         "Match","Base","Ofs" );
860
861     for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
862         SV ** const tmp = av_fetch( trie->revcharmap, state, 0);
863         if ( tmp ) {
864           PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen_const( *tmp ) );
865         }
866     }
867     PerlIO_printf( Perl_debug_log, "\n%*sState|-----------------------",
868         (int)depth * 2 + 2,"");
869
870     for( state = 0 ; state < trie->uniquecharcount ; state++ )
871         PerlIO_printf( Perl_debug_log, "-----");
872     PerlIO_printf( Perl_debug_log, "\n");
873
874     for( state = 1 ; state < TRIE_LASTSTATE(trie) ; state++ ) {
875         const U32 base = trie->states[ state ].trans.base;
876
877         PerlIO_printf( Perl_debug_log, "%*s#%4"UVXf"|", (int)depth * 2 + 2,"", (UV)state);
878
879         if ( trie->states[ state ].wordnum ) {
880             PerlIO_printf( Perl_debug_log, " W%4X", trie->states[ state ].wordnum );
881         } else {
882             PerlIO_printf( Perl_debug_log, "%6s", "" );
883         }
884
885         PerlIO_printf( Perl_debug_log, " @%4"UVXf" ", (UV)base );
886
887         if ( base ) {
888             U32 ofs = 0;
889
890             while( ( base + ofs  < trie->uniquecharcount ) ||
891                    ( base + ofs - trie->uniquecharcount < trie->lasttrans
892                      && trie->trans[ base + ofs - trie->uniquecharcount ].check != state))
893                     ofs++;
894
895             PerlIO_printf( Perl_debug_log, "+%2"UVXf"[ ", (UV)ofs);
896
897             for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
898                 if ( ( base + ofs >= trie->uniquecharcount ) &&
899                      ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
900                      trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
901                 {
902                    PerlIO_printf( Perl_debug_log, "%4"UVXf" ",
903                     (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next );
904                 } else {
905                     PerlIO_printf( Perl_debug_log, "%4s ","   ." );
906                 }
907             }
908
909             PerlIO_printf( Perl_debug_log, "]");
910
911         }
912         PerlIO_printf( Perl_debug_log, "\n" );
913     }
914 }    
915 /*
916   dump_trie_interim_list(trie,next_alloc)
917   Dumps a fully constructed but uncompressed trie in list form.
918   List tries normally only are used for construction when the number of 
919   possible chars (trie->uniquecharcount) is very high.
920   Used for debugging make_trie().
921 */
922 STATIC void
923 S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, U32 next_alloc,U32 depth)
924 {
925     U32 state;
926     GET_RE_DEBUG_FLAGS_DECL;
927     /* print out the table precompression.  */
928     PerlIO_printf( Perl_debug_log, "%*sState :Word | Transition Data\n%*s",
929         (int)depth * 2 + 2,"", (int)depth * 2 + 2,"");
930     PerlIO_printf( Perl_debug_log,   "------:-----+-----------------" );
931     
932     for( state=1 ; state < next_alloc ; state ++ ) {
933         U16 charid;
934     
935         PerlIO_printf( Perl_debug_log, "\n%*s %4"UVXf" :",
936             (int)depth * 2 + 2,"", (UV)state  );
937         if ( ! trie->states[ state ].wordnum ) {
938             PerlIO_printf( Perl_debug_log, "%5s| ","");
939         } else {
940             PerlIO_printf( Perl_debug_log, "W%4x| ",
941                 trie->states[ state ].wordnum
942             );
943         }
944         for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
945             SV ** const tmp = av_fetch( trie->revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0);
946             PerlIO_printf( Perl_debug_log, "%s:%3X=%4"UVXf" | ",
947                 SvPV_nolen_const( *tmp ),
948                 TRIE_LIST_ITEM(state,charid).forid,
949                 (UV)TRIE_LIST_ITEM(state,charid).newstate
950             );
951         }
952     
953     }
954 }    
955
956 /*
957   dump_trie_interim_table(trie,next_alloc)
958   Dumps a fully constructed but uncompressed trie in table form.
959   This is the normal DFA style state transition table, with a few 
960   twists to facilitate compression later. 
961   Used for debugging make_trie().
962 */
963 STATIC void
964 S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, U32 next_alloc, U32 depth)
965 {
966     U32 state;
967     U16 charid;
968     GET_RE_DEBUG_FLAGS_DECL;
969     
970     /*
971        print out the table precompression so that we can do a visual check
972        that they are identical.
973      */
974     
975     PerlIO_printf( Perl_debug_log, "%*sChar : ",(int)depth * 2 + 2,"" );
976
977     for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
978         SV ** const tmp = av_fetch( trie->revcharmap, charid, 0);
979         if ( tmp ) {
980           PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen_const( *tmp ) );
981         }
982     }
983
984     PerlIO_printf( Perl_debug_log, "\n%*sState+-",(int)depth * 2 + 2,"" );
985
986     for( charid=0 ; charid < trie->uniquecharcount ; charid++ ) {
987         PerlIO_printf( Perl_debug_log, "%4s-", "----" );
988     }
989
990     PerlIO_printf( Perl_debug_log, "\n" );
991
992     for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
993
994         PerlIO_printf( Perl_debug_log, "%*s%4"UVXf" : ", 
995             (int)depth * 2 + 2,"",
996             (UV)TRIE_NODENUM( state ) );
997
998         for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
999             PerlIO_printf( Perl_debug_log, "%4"UVXf" ",
1000                 (UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next ) );
1001         }
1002         if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
1003             PerlIO_printf( Perl_debug_log, " (%4"UVXf")\n", (UV)trie->trans[ state ].check );
1004         } else {
1005             PerlIO_printf( Perl_debug_log, " (%4"UVXf") W%4X\n", (UV)trie->trans[ state ].check,
1006             trie->states[ TRIE_NODENUM( state ) ].wordnum );
1007         }
1008     }
1009 }
1010
1011 #endif
1012
1013 #define TRIE_TRANS_STATE(state,base,ucharcount,charid,special)          \
1014      ( ( base + charid >=  ucharcount                                   \
1015          && base + charid < ubound                                      \
1016          && state == trie->trans[ base - ucharcount + charid ].check    \
1017          && trie->trans[ base - ucharcount + charid ].next )            \
1018            ? trie->trans[ base - ucharcount + charid ].next             \
1019            : ( state==1 ? special : 0 )                                 \
1020       )
1021
1022 STATIC void
1023 S_make_trie_failtable(pTHX_ RExC_state_t *pRExC_state, regnode *source,  regnode *stclass, U32 depth)
1024 {
1025 /* The Trie is constructed and compressed now so we can build a fail array now if its needed
1026
1027    This is apparently the Aho-Corasick algorithm. Its from exercise 3.31 and 3.32 in the
1028    "Red Dragon" -- Compilers, principles, techniques, and tools. Aho, Sethi, Ullman 1985/88
1029    ISBN 0-201-10088-6
1030
1031    We find the fail state for each state in the trie, this state is the longest proper
1032    suffix of the current states 'word' that is also a proper prefix of another word in our
1033    trie. State 1 represents the word '' and is the thus the default fail state. This allows
1034    the DFA not to have to restart after its tried and failed a word at a given point, it
1035    simply continues as though it had been matching the other word in the first place.
1036    Consider
1037       'abcdgu'=~/abcdefg|cdgu/
1038    When we get to 'd' we are still matching the first word, we would encounter 'g' which would
1039    fail, which would bring use to the state representing 'd' in the second word where we would
1040    try 'g' and succeed, prodceding to match 'cdgu'.
1041  */
1042  /* add a fail transition */
1043     reg_trie_data *trie=(reg_trie_data *)RExC_rx->data->data[ARG(source)];
1044     U32 *q;
1045     const U32 ucharcount = trie->uniquecharcount;
1046     const U32 numstates = trie->laststate;
1047     const U32 ubound = trie->lasttrans + ucharcount;
1048     U32 q_read = 0;
1049     U32 q_write = 0;
1050     U32 charid;
1051     U32 base = trie->states[ 1 ].trans.base;
1052     U32 *fail;
1053     reg_ac_data *aho;
1054     const U32 data_slot = add_data( pRExC_state, 1, "T" );
1055     GET_RE_DEBUG_FLAGS_DECL;
1056 #ifndef DEBUGGING
1057     PERL_UNUSED_ARG(depth);
1058 #endif    
1059
1060
1061     ARG_SET( stclass, data_slot );
1062     Newxz( aho, 1, reg_ac_data );
1063     RExC_rx->data->data[ data_slot ] = (void*)aho;
1064     aho->trie=trie;
1065     aho->states=(reg_trie_state *)savepvn((const char*)trie->states, 
1066         (trie->laststate+1)*sizeof(reg_trie_state));
1067     Newxz( q, numstates, U32);
1068     Newxz( aho->fail, numstates, U32 );
1069     aho->refcount = 1;
1070     fail = aho->fail;
1071     fail[ 0 ] = fail[ 1 ] = 1;
1072
1073     for ( charid = 0; charid < ucharcount ; charid++ ) {
1074         const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 );
1075         if ( newstate ) {
1076             q[ q_write ] = newstate;
1077             /* set to point at the root */
1078             fail[ q[ q_write++ ] ]=1;
1079         }
1080     }
1081     while ( q_read < q_write) {
1082         const U32 cur = q[ q_read++ % numstates ];
1083         base = trie->states[ cur ].trans.base;
1084
1085         for ( charid = 0 ; charid < ucharcount ; charid++ ) {
1086             const U32 ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 );
1087             if (ch_state) {
1088                 U32 fail_state = cur;
1089                 U32 fail_base;
1090                 do {
1091                     fail_state = fail[ fail_state ];
1092                     fail_base = aho->states[ fail_state ].trans.base;
1093                 } while ( !TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 ) );
1094
1095                 fail_state = TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 );
1096                 fail[ ch_state ] = fail_state;
1097                 if ( !aho->states[ ch_state ].wordnum && aho->states[ fail_state ].wordnum )
1098                 {
1099                         aho->states[ ch_state ].wordnum =  aho->states[ fail_state ].wordnum;
1100                 }
1101                 q[ q_write++ % numstates] = ch_state;
1102             }
1103         }
1104     }
1105
1106     DEBUG_TRIE_COMPILE_MORE_r({
1107         PerlIO_printf(Perl_debug_log, "%*sFail: 1", (int)(depth * 2), "");
1108         for( q_read=2; q_read<numstates; q_read++ ) {
1109             PerlIO_printf(Perl_debug_log, ", %"UVuf, fail[q_read]);
1110         }
1111         PerlIO_printf(Perl_debug_log, "\n");
1112     });
1113     Safefree(q);
1114     /*RExC_seen |= REG_SEEN_TRIEDFA;*/
1115 }
1116
1117
1118
1119 STATIC I32
1120 S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 flags, U32 depth)
1121 {
1122     dVAR;
1123     /* first pass, loop through and scan words */
1124     reg_trie_data *trie;
1125     regnode *cur;
1126     const U32 uniflags = UTF8_ALLOW_DEFAULT;
1127     STRLEN len = 0;
1128     UV uvc = 0;
1129     U16 curword = 0;
1130     U32 next_alloc = 0;
1131     /* we just use folder as a flag in utf8 */
1132     const U8 * const folder = ( flags == EXACTF
1133                        ? PL_fold
1134                        : ( flags == EXACTFL
1135                            ? PL_fold_locale
1136                            : NULL
1137                          )
1138                      );
1139
1140     const U32 data_slot = add_data( pRExC_state, 1, "t" );
1141     SV *re_trie_maxbuff;
1142 #ifndef DEBUGGING
1143     /* these are only used during construction but are useful during
1144      * debugging so we store them in the struct when debugging.
1145      * Wordcount is actually superfluous in debugging as we have
1146      * (AV*)trie->words to use for it, but that's not available when
1147      * not debugging... We could make the macro use the AV during
1148      * debugging though...
1149      */
1150     U16 trie_wordcount=0;
1151     STRLEN trie_charcount=0;
1152     /*U32 trie_laststate=0;*/
1153     AV *trie_revcharmap;
1154 #endif
1155     GET_RE_DEBUG_FLAGS_DECL;
1156 #ifndef DEBUGGING
1157     PERL_UNUSED_ARG(depth);
1158 #endif
1159
1160     Newxz( trie, 1, reg_trie_data );
1161     trie->refcount = 1;
1162     trie->startstate = 1;
1163     RExC_rx->data->data[ data_slot ] = (void*)trie;
1164     Newxz( trie->charmap, 256, U16 );
1165     if (!(UTF && folder))
1166         Newxz( trie->bitmap, ANYOF_BITMAP_SIZE, char );
1167     DEBUG_r({
1168         trie->words = newAV();
1169     });
1170     TRIE_REVCHARMAP(trie) = newAV();
1171
1172     re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
1173     if (!SvIOK(re_trie_maxbuff)) {
1174         sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
1175     }
1176     DEBUG_OPTIMISE_r({
1177                 PerlIO_printf( Perl_debug_log,
1178                   "%*smake_trie start==%d, first==%d, last==%d, tail==%d\n", 
1179                   (int)depth * 2 + 2, "", 
1180                   REG_NODE_NUM(startbranch),REG_NODE_NUM(first), 
1181                   REG_NODE_NUM(last), REG_NODE_NUM(tail));
1182     });
1183     /*  -- First loop and Setup --
1184
1185        We first traverse the branches and scan each word to determine if it
1186        contains widechars, and how many unique chars there are, this is
1187        important as we have to build a table with at least as many columns as we
1188        have unique chars.
1189
1190        We use an array of integers to represent the character codes 0..255
1191        (trie->charmap) and we use a an HV* to store unicode characters. We use the
1192        native representation of the character value as the key and IV's for the
1193        coded index.
1194
1195        *TODO* If we keep track of how many times each character is used we can
1196        remap the columns so that the table compression later on is more
1197        efficient in terms of memory by ensuring most common value is in the
1198        middle and the least common are on the outside.  IMO this would be better
1199        than a most to least common mapping as theres a decent chance the most
1200        common letter will share a node with the least common, meaning the node
1201        will not be compressable. With a middle is most common approach the worst
1202        case is when we have the least common nodes twice.
1203
1204      */
1205
1206     for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1207         regnode * const noper = NEXTOPER( cur );
1208         const U8 *uc = (U8*)STRING( noper );
1209         const U8 * const e  = uc + STR_LEN( noper );
1210         STRLEN foldlen = 0;
1211         U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1212         const U8 *scan = (U8*)NULL;
1213         U32 wordlen      = 0;         /* required init */
1214         STRLEN chars=0;
1215
1216         TRIE_WORDCOUNT(trie)++;
1217         if (OP(noper) == NOTHING) {
1218             trie->minlen= 0;
1219             continue;
1220         }
1221         if (trie->bitmap) {
1222             TRIE_BITMAP_SET(trie,*uc);
1223             if ( folder ) TRIE_BITMAP_SET(trie,folder[ *uc ]);            
1224         }
1225         for ( ; uc < e ; uc += len ) {
1226             TRIE_CHARCOUNT(trie)++;
1227             TRIE_READ_CHAR;
1228             chars++;
1229             if ( uvc < 256 ) {
1230                 if ( !trie->charmap[ uvc ] ) {
1231                     trie->charmap[ uvc ]=( ++trie->uniquecharcount );
1232                     if ( folder )
1233                         trie->charmap[ folder[ uvc ] ] = trie->charmap[ uvc ];
1234                     TRIE_STORE_REVCHAR;
1235                 }
1236             } else {
1237                 SV** svpp;
1238                 if ( !trie->widecharmap )
1239                     trie->widecharmap = newHV();
1240
1241                 svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 1 );
1242
1243                 if ( !svpp )
1244                     Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%"UVXf, uvc );
1245
1246                 if ( !SvTRUE( *svpp ) ) {
1247                     sv_setiv( *svpp, ++trie->uniquecharcount );
1248                     TRIE_STORE_REVCHAR;
1249                 }
1250             }
1251         }
1252         if( cur == first ) {
1253             trie->minlen=chars;
1254             trie->maxlen=chars;
1255         } else if (chars < trie->minlen) {
1256             trie->minlen=chars;
1257         } else if (chars > trie->maxlen) {
1258             trie->maxlen=chars;
1259         }
1260
1261     } /* end first pass */
1262     DEBUG_TRIE_COMPILE_r(
1263         PerlIO_printf( Perl_debug_log, "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
1264                 (int)depth * 2 + 2,"",
1265                 ( trie->widecharmap ? "UTF8" : "NATIVE" ), TRIE_WORDCOUNT(trie),
1266                 (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount,
1267                 (int)trie->minlen, (int)trie->maxlen )
1268     );
1269     Newxz( trie->wordlen, TRIE_WORDCOUNT(trie), U32 );
1270
1271     /*
1272         We now know what we are dealing with in terms of unique chars and
1273         string sizes so we can calculate how much memory a naive
1274         representation using a flat table  will take. If it's over a reasonable
1275         limit (as specified by ${^RE_TRIE_MAXBUF}) we use a more memory
1276         conservative but potentially much slower representation using an array
1277         of lists.
1278
1279         At the end we convert both representations into the same compressed
1280         form that will be used in regexec.c for matching with. The latter
1281         is a form that cannot be used to construct with but has memory
1282         properties similar to the list form and access properties similar
1283         to the table form making it both suitable for fast searches and
1284         small enough that its feasable to store for the duration of a program.
1285
1286         See the comment in the code where the compressed table is produced
1287         inplace from the flat tabe representation for an explanation of how
1288         the compression works.
1289
1290     */
1291
1292
1293     if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1) > SvIV(re_trie_maxbuff) ) {
1294         /*
1295             Second Pass -- Array Of Lists Representation
1296
1297             Each state will be represented by a list of charid:state records
1298             (reg_trie_trans_le) the first such element holds the CUR and LEN
1299             points of the allocated array. (See defines above).
1300
1301             We build the initial structure using the lists, and then convert
1302             it into the compressed table form which allows faster lookups
1303             (but cant be modified once converted).
1304         */
1305
1306         STRLEN transcount = 1;
1307
1308         Newxz( trie->states, TRIE_CHARCOUNT(trie) + 2, reg_trie_state );
1309         TRIE_LIST_NEW(1);
1310         next_alloc = 2;
1311
1312         for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1313
1314             regnode * const noper = NEXTOPER( cur );
1315             U8 *uc           = (U8*)STRING( noper );
1316             const U8 * const e = uc + STR_LEN( noper );
1317             U32 state        = 1;         /* required init */
1318             U16 charid       = 0;         /* sanity init */
1319             U8 *scan         = (U8*)NULL; /* sanity init */
1320             STRLEN foldlen   = 0;         /* required init */
1321             U32 wordlen      = 0;         /* required init */
1322             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1323
1324             if (OP(noper) != NOTHING) {
1325             for ( ; uc < e ; uc += len ) {
1326
1327                 TRIE_READ_CHAR;
1328
1329                 if ( uvc < 256 ) {
1330                     charid = trie->charmap[ uvc ];
1331                 } else {
1332                     SV** const svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 0);
1333                     if ( !svpp ) {
1334                         charid = 0;
1335                     } else {
1336                         charid=(U16)SvIV( *svpp );
1337                     }
1338                 }
1339                 if ( charid ) {
1340
1341                     U16 check;
1342                     U32 newstate = 0;
1343
1344                     charid--;
1345                     if ( !trie->states[ state ].trans.list ) {
1346                         TRIE_LIST_NEW( state );
1347                     }
1348                     for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) {
1349                         if ( TRIE_LIST_ITEM( state, check ).forid == charid ) {
1350                             newstate = TRIE_LIST_ITEM( state, check ).newstate;
1351                             break;
1352                         }
1353                     }
1354                     if ( ! newstate ) {
1355                         newstate = next_alloc++;
1356                         TRIE_LIST_PUSH( state, charid, newstate );
1357                         transcount++;
1358                     }
1359                     state = newstate;
1360                 } else {
1361                     Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1362                 }
1363                 /* charid is now 0 if we dont know the char read, or nonzero if we do */
1364             }
1365             }
1366             TRIE_HANDLE_WORD(state);
1367
1368         } /* end second pass */
1369
1370         TRIE_LASTSTATE(trie) = next_alloc;
1371         Renew( trie->states, next_alloc, reg_trie_state );
1372
1373         /* and now dump it out before we compress it */
1374         DEBUG_TRIE_COMPILE_MORE_r(
1375             dump_trie_interim_list(trie,next_alloc,depth+1)
1376                     );
1377
1378         Newxz( trie->trans, transcount ,reg_trie_trans );
1379         {
1380             U32 state;
1381             U32 tp = 0;
1382             U32 zp = 0;
1383
1384
1385             for( state=1 ; state < next_alloc ; state ++ ) {
1386                 U32 base=0;
1387
1388                 /*
1389                 DEBUG_TRIE_COMPILE_MORE_r(
1390                     PerlIO_printf( Perl_debug_log, "tp: %d zp: %d ",tp,zp)
1391                 );
1392                 */
1393
1394                 if (trie->states[state].trans.list) {
1395                     U16 minid=TRIE_LIST_ITEM( state, 1).forid;
1396                     U16 maxid=minid;
1397                     U16 idx;
1398
1399                     for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1400                         const U16 forid = TRIE_LIST_ITEM( state, idx).forid;
1401                         if ( forid < minid ) {
1402                             minid=forid;
1403                         } else if ( forid > maxid ) {
1404                             maxid=forid;
1405                         }
1406                     }
1407                     if ( transcount < tp + maxid - minid + 1) {
1408                         transcount *= 2;
1409                         Renew( trie->trans, transcount, reg_trie_trans );
1410                         Zero( trie->trans + (transcount / 2), transcount / 2 , reg_trie_trans );
1411                     }
1412                     base = trie->uniquecharcount + tp - minid;
1413                     if ( maxid == minid ) {
1414                         U32 set = 0;
1415                         for ( ; zp < tp ; zp++ ) {
1416                             if ( ! trie->trans[ zp ].next ) {
1417                                 base = trie->uniquecharcount + zp - minid;
1418                                 trie->trans[ zp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1419                                 trie->trans[ zp ].check = state;
1420                                 set = 1;
1421                                 break;
1422                             }
1423                         }
1424                         if ( !set ) {
1425                             trie->trans[ tp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1426                             trie->trans[ tp ].check = state;
1427                             tp++;
1428                             zp = tp;
1429                         }
1430                     } else {
1431                         for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1432                             const U32 tid = base -  trie->uniquecharcount + TRIE_LIST_ITEM( state, idx ).forid;
1433                             trie->trans[ tid ].next = TRIE_LIST_ITEM( state, idx ).newstate;
1434                             trie->trans[ tid ].check = state;
1435                         }
1436                         tp += ( maxid - minid + 1 );
1437                     }
1438                     Safefree(trie->states[ state ].trans.list);
1439                 }
1440                 /*
1441                 DEBUG_TRIE_COMPILE_MORE_r(
1442                     PerlIO_printf( Perl_debug_log, " base: %d\n",base);
1443                 );
1444                 */
1445                 trie->states[ state ].trans.base=base;
1446             }
1447             trie->lasttrans = tp + 1;
1448         }
1449     } else {
1450         /*
1451            Second Pass -- Flat Table Representation.
1452
1453            we dont use the 0 slot of either trans[] or states[] so we add 1 to each.
1454            We know that we will need Charcount+1 trans at most to store the data
1455            (one row per char at worst case) So we preallocate both structures
1456            assuming worst case.
1457
1458            We then construct the trie using only the .next slots of the entry
1459            structs.
1460
1461            We use the .check field of the first entry of the node  temporarily to
1462            make compression both faster and easier by keeping track of how many non
1463            zero fields are in the node.
1464
1465            Since trans are numbered from 1 any 0 pointer in the table is a FAIL
1466            transition.
1467
1468            There are two terms at use here: state as a TRIE_NODEIDX() which is a
1469            number representing the first entry of the node, and state as a
1470            TRIE_NODENUM() which is the trans number. state 1 is TRIE_NODEIDX(1) and
1471            TRIE_NODENUM(1), state 2 is TRIE_NODEIDX(2) and TRIE_NODENUM(3) if there
1472            are 2 entrys per node. eg:
1473
1474              A B       A B
1475           1. 2 4    1. 3 7
1476           2. 0 3    3. 0 5
1477           3. 0 0    5. 0 0
1478           4. 0 0    7. 0 0
1479
1480            The table is internally in the right hand, idx form. However as we also
1481            have to deal with the states array which is indexed by nodenum we have to
1482            use TRIE_NODENUM() to convert.
1483
1484         */
1485
1486
1487         Newxz( trie->trans, ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1,
1488               reg_trie_trans );
1489         Newxz( trie->states, TRIE_CHARCOUNT(trie) + 2, reg_trie_state );
1490         next_alloc = trie->uniquecharcount + 1;
1491
1492
1493         for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1494
1495             regnode * const noper   = NEXTOPER( cur );
1496             const U8 *uc     = (U8*)STRING( noper );
1497             const U8 * const e = uc + STR_LEN( noper );
1498
1499             U32 state        = 1;         /* required init */
1500
1501             U16 charid       = 0;         /* sanity init */
1502             U32 accept_state = 0;         /* sanity init */
1503             U8 *scan         = (U8*)NULL; /* sanity init */
1504
1505             STRLEN foldlen   = 0;         /* required init */
1506             U32 wordlen      = 0;         /* required init */
1507             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1508
1509             if ( OP(noper) != NOTHING ) {
1510             for ( ; uc < e ; uc += len ) {
1511
1512                 TRIE_READ_CHAR;
1513
1514                 if ( uvc < 256 ) {
1515                     charid = trie->charmap[ uvc ];
1516                 } else {
1517                     SV* const * const svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 0);
1518                     charid = svpp ? (U16)SvIV(*svpp) : 0;
1519                 }
1520                 if ( charid ) {
1521                     charid--;
1522                     if ( !trie->trans[ state + charid ].next ) {
1523                         trie->trans[ state + charid ].next = next_alloc;
1524                         trie->trans[ state ].check++;
1525                         next_alloc += trie->uniquecharcount;
1526                     }
1527                     state = trie->trans[ state + charid ].next;
1528                 } else {
1529                     Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1530                 }
1531                 /* charid is now 0 if we dont know the char read, or nonzero if we do */
1532             }
1533             }
1534             accept_state = TRIE_NODENUM( state );
1535             TRIE_HANDLE_WORD(accept_state);
1536
1537         } /* end second pass */
1538
1539         /* and now dump it out before we compress it */
1540         DEBUG_TRIE_COMPILE_MORE_r(
1541             dump_trie_interim_table(trie,next_alloc,depth+1)
1542         );
1543
1544         {
1545         /*
1546            * Inplace compress the table.*
1547
1548            For sparse data sets the table constructed by the trie algorithm will
1549            be mostly 0/FAIL transitions or to put it another way mostly empty.
1550            (Note that leaf nodes will not contain any transitions.)
1551
1552            This algorithm compresses the tables by eliminating most such
1553            transitions, at the cost of a modest bit of extra work during lookup:
1554
1555            - Each states[] entry contains a .base field which indicates the
1556            index in the state[] array wheres its transition data is stored.
1557
1558            - If .base is 0 there are no  valid transitions from that node.
1559
1560            - If .base is nonzero then charid is added to it to find an entry in
1561            the trans array.
1562
1563            -If trans[states[state].base+charid].check!=state then the
1564            transition is taken to be a 0/Fail transition. Thus if there are fail
1565            transitions at the front of the node then the .base offset will point
1566            somewhere inside the previous nodes data (or maybe even into a node
1567            even earlier), but the .check field determines if the transition is
1568            valid.
1569
1570            The following process inplace converts the table to the compressed
1571            table: We first do not compress the root node 1,and mark its all its
1572            .check pointers as 1 and set its .base pointer as 1 as well. This
1573            allows to do a DFA construction from the compressed table later, and
1574            ensures that any .base pointers we calculate later are greater than
1575            0.
1576
1577            - We set 'pos' to indicate the first entry of the second node.
1578
1579            - We then iterate over the columns of the node, finding the first and
1580            last used entry at l and m. We then copy l..m into pos..(pos+m-l),
1581            and set the .check pointers accordingly, and advance pos
1582            appropriately and repreat for the next node. Note that when we copy
1583            the next pointers we have to convert them from the original
1584            NODEIDX form to NODENUM form as the former is not valid post
1585            compression.
1586
1587            - If a node has no transitions used we mark its base as 0 and do not
1588            advance the pos pointer.
1589
1590            - If a node only has one transition we use a second pointer into the
1591            structure to fill in allocated fail transitions from other states.
1592            This pointer is independent of the main pointer and scans forward
1593            looking for null transitions that are allocated to a state. When it
1594            finds one it writes the single transition into the "hole".  If the
1595            pointer doesnt find one the single transition is appeneded as normal.
1596
1597            - Once compressed we can Renew/realloc the structures to release the
1598            excess space.
1599
1600            See "Table-Compression Methods" in sec 3.9 of the Red Dragon,
1601            specifically Fig 3.47 and the associated pseudocode.
1602
1603            demq
1604         */
1605         const U32 laststate = TRIE_NODENUM( next_alloc );
1606         U32 state, charid;
1607         U32 pos = 0, zp=0;
1608         TRIE_LASTSTATE(trie) = laststate;
1609
1610         for ( state = 1 ; state < laststate ; state++ ) {
1611             U8 flag = 0;
1612             const U32 stateidx = TRIE_NODEIDX( state );
1613             const U32 o_used = trie->trans[ stateidx ].check;
1614             U32 used = trie->trans[ stateidx ].check;
1615             trie->trans[ stateidx ].check = 0;
1616
1617             for ( charid = 0 ; used && charid < trie->uniquecharcount ; charid++ ) {
1618                 if ( flag || trie->trans[ stateidx + charid ].next ) {
1619                     if ( trie->trans[ stateidx + charid ].next ) {
1620                         if (o_used == 1) {
1621                             for ( ; zp < pos ; zp++ ) {
1622                                 if ( ! trie->trans[ zp ].next ) {
1623                                     break;
1624                                 }
1625                             }
1626                             trie->states[ state ].trans.base = zp + trie->uniquecharcount - charid ;
1627                             trie->trans[ zp ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1628                             trie->trans[ zp ].check = state;
1629                             if ( ++zp > pos ) pos = zp;
1630                             break;
1631                         }
1632                         used--;
1633                     }
1634                     if ( !flag ) {
1635                         flag = 1;
1636                         trie->states[ state ].trans.base = pos + trie->uniquecharcount - charid ;
1637                     }
1638                     trie->trans[ pos ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1639                     trie->trans[ pos ].check = state;
1640                     pos++;
1641                 }
1642             }
1643         }
1644         trie->lasttrans = pos + 1;
1645         Renew( trie->states, laststate + 1, reg_trie_state);
1646         DEBUG_TRIE_COMPILE_MORE_r(
1647                 PerlIO_printf( Perl_debug_log,
1648                     "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
1649                     (int)depth * 2 + 2,"",
1650                     (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1 ),
1651                     (IV)next_alloc,
1652                     (IV)pos,
1653                     ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
1654             );
1655
1656         } /* end table compress */
1657     }
1658     /* resize the trans array to remove unused space */
1659     Renew( trie->trans, trie->lasttrans, reg_trie_trans);
1660
1661     /* and now dump out the compressed format */
1662     DEBUG_TRIE_COMPILE_r(
1663         dump_trie(trie,depth+1)
1664     );
1665
1666     {   /* Modify the program and insert the new TRIE node*/ 
1667         regnode *convert;
1668         U8 nodetype =(U8)(flags & 0xFF);
1669         char *str=NULL;
1670 #ifdef DEBUGGING
1671         U32 mjd_offset;
1672         U32 mjd_nodelen;
1673 #endif
1674         /*
1675            This means we convert either the first branch or the first Exact,
1676            depending on whether the thing following (in 'last') is a branch
1677            or not and whther first is the startbranch (ie is it a sub part of
1678            the alternation or is it the whole thing.)
1679            Assuming its a sub part we conver the EXACT otherwise we convert
1680            the whole branch sequence, including the first.
1681          */
1682         /* Find the node we are going to overwrite */
1683         if ( first == startbranch && OP( last ) != BRANCH ) {
1684             /* whole branch chain */
1685             convert = first;
1686             DEBUG_r({
1687                 const  regnode *nop = NEXTOPER( convert );
1688                 mjd_offset= Node_Offset((nop));
1689                 mjd_nodelen= Node_Length((nop));
1690             });
1691         } else {
1692             /* branch sub-chain */
1693             convert = NEXTOPER( first );
1694             NEXT_OFF( first ) = (U16)(last - first);
1695             DEBUG_r({
1696                 mjd_offset= Node_Offset((convert));
1697                 mjd_nodelen= Node_Length((convert));
1698             });
1699         }
1700         DEBUG_OPTIMISE_r(
1701             PerlIO_printf(Perl_debug_log, "%*sMJD offset:%"UVuf" MJD length:%"UVuf"\n",
1702                 (int)depth * 2 + 2, "",
1703                 mjd_offset,mjd_nodelen)
1704         );
1705
1706         /* But first we check to see if there is a common prefix we can 
1707            split out as an EXACT and put in front of the TRIE node.  */
1708         trie->startstate= 1;
1709         if ( trie->bitmap && !trie->widecharmap  ) {
1710             U32 state;
1711             DEBUG_OPTIMISE_r(
1712                 PerlIO_printf(Perl_debug_log, "%*sLaststate:%"UVuf"\n",
1713                     (int)depth * 2 + 2, "",
1714                     TRIE_LASTSTATE(trie))
1715             );
1716             for ( state = 1 ; state < TRIE_LASTSTATE(trie)-1 ; state++ ) {
1717                 U32 ofs = 0;
1718                 I32 idx = -1;
1719                 U32 count = 0;
1720                 const U32 base = trie->states[ state ].trans.base;
1721
1722                 if ( trie->states[state].wordnum )
1723                         count = 1;
1724
1725                 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
1726                     if ( ( base + ofs >= trie->uniquecharcount ) &&
1727                          ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
1728                          trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
1729                     {
1730                         if ( ++count > 1 ) {
1731                             SV **tmp = av_fetch( TRIE_REVCHARMAP(trie), ofs, 0);
1732                             const U8 *ch = (U8*)SvPV_nolen_const( *tmp );
1733                             if ( state == 1 ) break;
1734                             if ( count == 2 ) {
1735                                 Zero(trie->bitmap, ANYOF_BITMAP_SIZE, char);
1736                                 DEBUG_OPTIMISE_r(
1737                                     PerlIO_printf(Perl_debug_log,
1738                                         "%*sNew Start State=%"UVuf" Class: [",
1739                                         (int)depth * 2 + 2, "",
1740                                         state));
1741                                 if (idx >= 0) {
1742                                     SV ** const tmp = av_fetch( TRIE_REVCHARMAP(trie), idx, 0);
1743                                     const U8 * const ch = (U8*)SvPV_nolen_const( *tmp );
1744
1745                                     TRIE_BITMAP_SET(trie,*ch);
1746                                     if ( folder )
1747                                         TRIE_BITMAP_SET(trie, folder[ *ch ]);
1748                                     DEBUG_OPTIMISE_r(
1749                                         PerlIO_printf(Perl_debug_log, (char*)ch)
1750                                     );
1751                                 }
1752                             }
1753                             TRIE_BITMAP_SET(trie,*ch);
1754                             if ( folder )
1755                                 TRIE_BITMAP_SET(trie,folder[ *ch ]);
1756                             DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"%s", ch));
1757                         }
1758                         idx = ofs;
1759                     }
1760                 }
1761                 if ( count == 1 ) {
1762                     SV **tmp = av_fetch( TRIE_REVCHARMAP(trie), idx, 0);
1763                     const char *ch = SvPV_nolen_const( *tmp );
1764                     DEBUG_OPTIMISE_r(
1765                         PerlIO_printf( Perl_debug_log,
1766                             "%*sPrefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
1767                             (int)depth * 2 + 2, "",
1768                             state, idx, ch)
1769                     );
1770                     if ( state==1 ) {
1771                         OP( convert ) = nodetype;
1772                         str=STRING(convert);
1773                         STR_LEN(convert)=0;
1774                     }
1775                     *str++=*ch;
1776                     STR_LEN(convert)++;
1777
1778                 } else {
1779 #ifdef DEBUGGING            
1780                     if (state>1)
1781                         DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"]\n"));
1782 #endif
1783                     break;
1784                 }
1785             }
1786             if (str) {
1787                 regnode *n = convert+NODE_SZ_STR(convert);
1788                 NEXT_OFF(convert) = NODE_SZ_STR(convert);
1789                 trie->startstate = state;
1790                 trie->minlen -= (state - 1);
1791                 trie->maxlen -= (state - 1);
1792                 DEBUG_r({
1793                     regnode *fix = convert;
1794                     mjd_nodelen++;
1795                     Set_Node_Offset_Length(convert, mjd_offset, state - 1);
1796                     while( ++fix < n ) {
1797                         Set_Node_Offset_Length(fix, 0, 0);
1798                     }
1799                 });
1800                 if (trie->maxlen) {
1801                     convert = n;
1802                 } else {
1803                     NEXT_OFF(convert) = (U16)(tail - convert);
1804                 }
1805             }
1806         }
1807         if ( trie->maxlen ) {
1808             OP( convert ) = TRIE;
1809             NEXT_OFF( convert ) = (U16)(tail - convert);
1810             ARG_SET( convert, data_slot );
1811
1812             /* store the type in the flags */
1813             convert->flags = nodetype;
1814             /* XXX We really should free up the resource in trie now, as we wont use them */
1815         }
1816         /* needed for dumping*/
1817         DEBUG_r({
1818             regnode *optimize = convert + NODE_STEP_REGNODE + regarglen[ TRIE ];
1819             regnode *opt = convert;
1820             while (++opt<optimize) {
1821                 Set_Node_Offset_Length(opt,0,0);
1822             }
1823             /* We now need to mark all of the space originally used by the
1824                branches as optimized away. This keeps the dumpuntil from
1825                throwing a wobbly as it doesnt use regnext() to traverse the
1826                opcodes.
1827                We also "fix" the offsets 
1828              */
1829             while( optimize < last ) {
1830                 mjd_nodelen += Node_Length((optimize));
1831                 OP( optimize ) = OPTIMIZED;
1832                 Set_Node_Offset_Length(optimize,0,0);
1833                 optimize++;
1834             }
1835             Set_Node_Offset_Length(convert,mjd_offset,mjd_nodelen);
1836         });
1837     } /* end node insert */
1838 #ifndef DEBUGGING
1839     SvREFCNT_dec(TRIE_REVCHARMAP(trie));
1840 #endif
1841     return 1;
1842 }
1843
1844 /*
1845  * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2.
1846  * These need to be revisited when a newer toolchain becomes available.
1847  */
1848 #if defined(__sparc64__) && defined(__GNUC__)
1849 #   if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
1850 #       undef  SPARC64_GCC_WORKAROUND
1851 #       define SPARC64_GCC_WORKAROUND 1
1852 #   endif
1853 #endif
1854
1855 #define DEBUG_PEEP(str,scan,depth) \
1856     DEBUG_OPTIMISE_r({ \
1857        SV * const mysv=sv_newmortal(); \
1858        regnode *Next = regnext(scan); \
1859        regprop(RExC_rx, mysv, scan); \
1860        PerlIO_printf(Perl_debug_log, "%*s" str ">%3d: %s [%d]\n", \
1861        (int)depth*2, "", REG_NODE_NUM(scan), SvPV_nolen_const(mysv),\
1862        Next ? (REG_NODE_NUM(Next)) : 0 ); \
1863    });
1864
1865 #define JOIN_EXACT(scan,min,flags) \
1866     if (PL_regkind[OP(scan)] == EXACT) \
1867         join_exact(pRExC_state,(scan),(min),(flags),NULL,depth+1)
1868
1869 STATIC U32
1870 S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, I32 *min, U32 flags,regnode *val, U32 depth) {
1871     /* Merge several consecutive EXACTish nodes into one. */
1872     regnode *n = regnext(scan);
1873     U32 stringok = 1;
1874     regnode *next = scan + NODE_SZ_STR(scan);
1875     U32 merged = 0;
1876     U32 stopnow = 0;
1877 #ifdef DEBUGGING
1878     regnode *stop = scan;
1879     GET_RE_DEBUG_FLAGS_DECL;
1880 #else
1881     PERL_UNUSED_ARG(flags);
1882     PERL_UNUSED_ARG(val);
1883     PERL_UNUSED_ARG(depth);
1884 #endif
1885     DEBUG_PEEP("join",scan,depth);
1886     
1887     /* Skip NOTHING, merge EXACT*. */
1888     while (n &&
1889            ( PL_regkind[OP(n)] == NOTHING ||
1890              (stringok && (OP(n) == OP(scan))))
1891            && NEXT_OFF(n)
1892            && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
1893         
1894         if (OP(n) == TAIL || n > next)
1895             stringok = 0;
1896         if (PL_regkind[OP(n)] == NOTHING) {
1897         
1898             DEBUG_PEEP("skip:",n,depth);
1899             NEXT_OFF(scan) += NEXT_OFF(n);
1900             next = n + NODE_STEP_REGNODE;
1901 #ifdef DEBUGGING
1902             if (stringok)
1903                 stop = n;
1904 #endif
1905             n = regnext(n);
1906         }
1907         else if (stringok) {
1908             const int oldl = STR_LEN(scan);
1909             regnode * const nnext = regnext(n);
1910             
1911             DEBUG_PEEP("merg",n,depth);
1912             
1913             merged++;
1914             if (oldl + STR_LEN(n) > U8_MAX)
1915                 break;
1916             NEXT_OFF(scan) += NEXT_OFF(n);
1917             STR_LEN(scan) += STR_LEN(n);
1918             next = n + NODE_SZ_STR(n);
1919             /* Now we can overwrite *n : */
1920             Move(STRING(n), STRING(scan) + oldl, STR_LEN(n), char);
1921 #ifdef DEBUGGING
1922             stop = next - 1;
1923 #endif
1924             n = nnext;
1925             if (stopnow) break;
1926         }
1927
1928 #ifdef  EXPERIMENTAL_INPLACESCAN
1929         if (flags && !NEXT_OFF(n)) {
1930             DEBUG_PEEP("atch",val,depth);            
1931             if (reg_off_by_arg[OP(n)]) {
1932                 ARG_SET(n, val - n);
1933             }
1934             else {
1935                 NEXT_OFF(n) = val - n;
1936             }
1937             stopnow=1;
1938         }            
1939 #endif
1940     }
1941     
1942     if (UTF && ( OP(scan) == EXACTF ) && ( STR_LEN(scan) >= 6 ) ) {
1943     /*
1944     Two problematic code points in Unicode casefolding of EXACT nodes:
1945     
1946     U+0390 - GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
1947     U+03B0 - GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
1948     
1949     which casefold to
1950     
1951     Unicode                      UTF-8
1952     
1953     U+03B9 U+0308 U+0301         0xCE 0xB9 0xCC 0x88 0xCC 0x81
1954     U+03C5 U+0308 U+0301         0xCF 0x85 0xCC 0x88 0xCC 0x81
1955     
1956     This means that in case-insensitive matching (or "loose matching",
1957     as Unicode calls it), an EXACTF of length six (the UTF-8 encoded byte
1958     length of the above casefolded versions) can match a target string
1959     of length two (the byte length of UTF-8 encoded U+0390 or U+03B0).
1960     This would rather mess up the minimum length computation.
1961     
1962     What we'll do is to look for the tail four bytes, and then peek
1963     at the preceding two bytes to see whether we need to decrease
1964     the minimum length by four (six minus two).
1965     
1966     Thanks to the design of UTF-8, there cannot be false matches:
1967     A sequence of valid UTF-8 bytes cannot be a subsequence of
1968     another valid sequence of UTF-8 bytes.
1969     
1970     */
1971          char * const s0 = STRING(scan), *s, *t;
1972          char * const s1 = s0 + STR_LEN(scan) - 1;
1973          char * const s2 = s1 - 4;
1974          const char t0[] = "\xcc\x88\xcc\x81";
1975          const char * const t1 = t0 + 3;
1976     
1977          for (s = s0 + 2;
1978               s < s2 && (t = ninstr(s, s1, t0, t1));
1979               s = t + 4) {
1980               if (((U8)t[-1] == 0xB9 && (U8)t[-2] == 0xCE) ||
1981                   ((U8)t[-1] == 0x85 && (U8)t[-2] == 0xCF))
1982                    *min -= 4;
1983          }
1984     }
1985     
1986 #ifdef DEBUGGING
1987     /* Allow dumping */
1988     n = scan + NODE_SZ_STR(scan);
1989     while (n <= stop) {
1990         if (PL_regkind[OP(n)] != NOTHING || OP(n) == NOTHING) {
1991             OP(n) = OPTIMIZED;
1992             NEXT_OFF(n) = 0;
1993         }
1994         n++;
1995     }
1996 #endif
1997     DEBUG_OPTIMISE_r(if (merged){DEBUG_PEEP("finl",scan,depth)});
1998     return stopnow;
1999 }
2000
2001 /* REx optimizer.  Converts nodes into quickier variants "in place".
2002    Finds fixed substrings.  */
2003
2004 /* Stops at toplevel WHILEM as well as at "last". At end *scanp is set
2005    to the position after last scanned or to NULL. */
2006
2007
2008
2009 STATIC I32
2010 S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
2011                         regnode *last, scan_data_t *data, U32 flags, U32 depth)
2012                         /* scanp: Start here (read-write). */
2013                         /* deltap: Write maxlen-minlen here. */
2014                         /* last: Stop before this one. */
2015 {
2016     dVAR;
2017     I32 min = 0, pars = 0, code;
2018     regnode *scan = *scanp, *next;
2019     I32 delta = 0;
2020     int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
2021     int is_inf_internal = 0;            /* The studied chunk is infinite */
2022     I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
2023     scan_data_t data_fake;
2024     struct regnode_charclass_class and_with; /* Valid if flags & SCF_DO_STCLASS_OR */
2025     SV *re_trie_maxbuff = NULL;
2026
2027     GET_RE_DEBUG_FLAGS_DECL;
2028 #ifdef DEBUGGING
2029     StructCopy(&zero_scan_data, &data_fake, scan_data_t);    
2030 #endif
2031
2032     while (scan && OP(scan) != END && scan < last) {
2033         /* Peephole optimizer: */
2034         DEBUG_PEEP("Peep",scan,depth);
2035
2036         JOIN_EXACT(scan,&min,0);
2037
2038         /* Follow the next-chain of the current node and optimize
2039            away all the NOTHINGs from it.  */
2040         if (OP(scan) != CURLYX) {
2041             const int max = (reg_off_by_arg[OP(scan)]
2042                        ? I32_MAX
2043                        /* I32 may be smaller than U16 on CRAYs! */
2044                        : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
2045             int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
2046             int noff;
2047             regnode *n = scan;
2048         
2049             /* Skip NOTHING and LONGJMP. */
2050             while ((n = regnext(n))
2051                    && ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
2052                        || ((OP(n) == LONGJMP) && (noff = ARG(n))))
2053                    && off + noff < max)
2054                 off += noff;
2055             if (reg_off_by_arg[OP(scan)])
2056                 ARG(scan) = off;
2057             else
2058                 NEXT_OFF(scan) = off;
2059         }
2060
2061
2062
2063         /* The principal pseudo-switch.  Cannot be a switch, since we
2064            look into several different things.  */
2065         if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
2066                    || OP(scan) == IFTHEN || OP(scan) == SUSPEND) {
2067             next = regnext(scan);
2068             code = OP(scan);
2069             /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
2070         
2071             if (OP(next) == code || code == IFTHEN || code == SUSPEND) {
2072                 I32 max1 = 0, min1 = I32_MAX, num = 0;
2073                 struct regnode_charclass_class accum;
2074                 regnode * const startbranch=scan;
2075                 
2076                 if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
2077                     scan_commit(pRExC_state, data); /* Cannot merge strings after this. */
2078                 if (flags & SCF_DO_STCLASS)
2079                     cl_init_zero(pRExC_state, &accum);
2080
2081                 while (OP(scan) == code) {
2082                     I32 deltanext, minnext, f = 0, fake;
2083                     struct regnode_charclass_class this_class;
2084
2085                     num++;
2086                     data_fake.flags = 0;
2087                     if (data) {         
2088                         data_fake.whilem_c = data->whilem_c;
2089                         data_fake.last_closep = data->last_closep;
2090                     }
2091                     else
2092                         data_fake.last_closep = &fake;
2093                     next = regnext(scan);
2094                     scan = NEXTOPER(scan);
2095                     if (code != BRANCH)
2096                         scan = NEXTOPER(scan);
2097                     if (flags & SCF_DO_STCLASS) {
2098                         cl_init(pRExC_state, &this_class);
2099                         data_fake.start_class = &this_class;
2100                         f = SCF_DO_STCLASS_AND;
2101                     }           
2102                     if (flags & SCF_WHILEM_VISITED_POS)
2103                         f |= SCF_WHILEM_VISITED_POS;
2104
2105                     /* we suppose the run is continuous, last=next...*/
2106                     minnext = study_chunk(pRExC_state, &scan, &deltanext,
2107                                           next, &data_fake, f,depth+1);
2108                     if (min1 > minnext)
2109                         min1 = minnext;
2110                     if (max1 < minnext + deltanext)
2111                         max1 = minnext + deltanext;
2112                     if (deltanext == I32_MAX)
2113                         is_inf = is_inf_internal = 1;
2114                     scan = next;
2115                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
2116                         pars++;
2117                     if (data) {
2118                         if (data_fake.flags & SF_HAS_EVAL)
2119                             data->flags |= SF_HAS_EVAL;
2120                         data->whilem_c = data_fake.whilem_c;
2121                     }
2122                     if (flags & SCF_DO_STCLASS)
2123                         cl_or(pRExC_state, &accum, &this_class);
2124                     if (code == SUSPEND)
2125                         break;
2126                 }
2127                 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
2128                     min1 = 0;
2129                 if (flags & SCF_DO_SUBSTR) {
2130                     data->pos_min += min1;
2131                     data->pos_delta += max1 - min1;
2132                     if (max1 != min1 || is_inf)
2133                         data->longest = &(data->longest_float);
2134                 }
2135                 min += min1;
2136                 delta += max1 - min1;
2137                 if (flags & SCF_DO_STCLASS_OR) {
2138                     cl_or(pRExC_state, data->start_class, &accum);
2139                     if (min1) {
2140                         cl_and(data->start_class, &and_with);
2141                         flags &= ~SCF_DO_STCLASS;
2142                     }
2143                 }
2144                 else if (flags & SCF_DO_STCLASS_AND) {
2145                     if (min1) {
2146                         cl_and(data->start_class, &accum);
2147                         flags &= ~SCF_DO_STCLASS;
2148                     }
2149                     else {
2150                         /* Switch to OR mode: cache the old value of
2151                          * data->start_class */
2152                         StructCopy(data->start_class, &and_with,
2153                                    struct regnode_charclass_class);
2154                         flags &= ~SCF_DO_STCLASS_AND;
2155                         StructCopy(&accum, data->start_class,
2156                                    struct regnode_charclass_class);
2157                         flags |= SCF_DO_STCLASS_OR;
2158                         data->start_class->flags |= ANYOF_EOS;
2159                     }
2160                 }
2161
2162                 /* demq.
2163
2164                    Assuming this was/is a branch we are dealing with: 'scan' now
2165                    points at the item that follows the branch sequence, whatever
2166                    it is. We now start at the beginning of the sequence and look
2167                    for subsequences of
2168
2169                    BRANCH->EXACT=>X
2170                    BRANCH->EXACT=>X
2171
2172                    which would be constructed from a pattern like /A|LIST|OF|WORDS/
2173
2174                    If we can find such a subseqence we need to turn the first
2175                    element into a trie and then add the subsequent branch exact
2176                    strings to the trie.
2177
2178                    We have two cases
2179
2180                      1. patterns where the whole set of branch can be converted to a trie,
2181
2182                      2. patterns where only a subset of the alternations can be
2183                      converted to a trie.
2184
2185                    In case 1 we can replace the whole set with a single regop
2186                    for the trie. In case 2 we need to keep the start and end
2187                    branchs so
2188
2189                      'BRANCH EXACT; BRANCH EXACT; BRANCH X'
2190                      becomes BRANCH TRIE; BRANCH X;
2191
2192                    Hypthetically when we know the regex isnt anchored we can
2193                    turn a case 1 into a DFA and let it rip... Every time it finds a match
2194                    it would just call its tail, no WHILEM/CURLY needed.
2195
2196                 */
2197                 if (PERL_ENABLE_TRIE_OPTIMISATION) {
2198                     int made=0;
2199                     if (!re_trie_maxbuff) {
2200                         re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
2201                         if (!SvIOK(re_trie_maxbuff))
2202                             sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
2203                     }
2204                     if ( SvIV(re_trie_maxbuff)>=0 && OP( startbranch )==BRANCH ) {
2205                         regnode *cur;
2206                         regnode *first = (regnode *)NULL;
2207                         regnode *last = (regnode *)NULL;
2208                         regnode *tail = scan;
2209                         U8 optype = 0;
2210                         U32 count=0;
2211
2212 #ifdef DEBUGGING
2213                         SV * const mysv = sv_newmortal();       /* for dumping */
2214 #endif
2215                         /* var tail is used because there may be a TAIL
2216                            regop in the way. Ie, the exacts will point to the
2217                            thing following the TAIL, but the last branch will
2218                            point at the TAIL. So we advance tail. If we
2219                            have nested (?:) we may have to move through several
2220                            tails.
2221                          */
2222
2223                         while ( OP( tail ) == TAIL ) {
2224                             /* this is the TAIL generated by (?:) */
2225                             tail = regnext( tail );
2226                         }
2227
2228                         
2229                         DEBUG_OPTIMISE_r({
2230                             regprop(RExC_rx, mysv, tail );
2231                             PerlIO_printf( Perl_debug_log, "%*s%s%s\n",
2232                                 (int)depth * 2 + 2, "", 
2233                                 "Looking for TRIE'able sequences. Tail node is: ", 
2234                                 SvPV_nolen_const( mysv )
2235                             );
2236                         });
2237                         
2238                         /*
2239
2240                            step through the branches, cur represents each
2241                            branch, noper is the first thing to be matched
2242                            as part of that branch and noper_next is the
2243                            regnext() of that node. if noper is an EXACT
2244                            and noper_next is the same as scan (our current
2245                            position in the regex) then the EXACT branch is
2246                            a possible optimization target. Once we have
2247                            two or more consequetive such branches we can
2248                            create a trie of the EXACT's contents and stich
2249                            it in place. If the sequence represents all of
2250                            the branches we eliminate the whole thing and
2251                            replace it with a single TRIE. If it is a
2252                            subsequence then we need to stitch it in. This
2253                            means the first branch has to remain, and needs
2254                            to be repointed at the item on the branch chain
2255                            following the last branch optimized. This could
2256                            be either a BRANCH, in which case the
2257                            subsequence is internal, or it could be the
2258                            item following the branch sequence in which
2259                            case the subsequence is at the end.
2260
2261                         */
2262
2263                         /* dont use tail as the end marker for this traverse */
2264                         for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) {
2265                             regnode * const noper = NEXTOPER( cur );
2266                             regnode * const noper_next = regnext( noper );
2267
2268                             DEBUG_OPTIMISE_r({
2269                                 regprop(RExC_rx, mysv, cur);
2270                                 PerlIO_printf( Perl_debug_log, "%*s- %s (%d)",
2271                                    (int)depth * 2 + 2,"", SvPV_nolen_const( mysv ), REG_NODE_NUM(cur) );
2272
2273                                 regprop(RExC_rx, mysv, noper);
2274                                 PerlIO_printf( Perl_debug_log, " -> %s",
2275                                     SvPV_nolen_const(mysv));
2276
2277                                 if ( noper_next ) {
2278                                   regprop(RExC_rx, mysv, noper_next );
2279                                   PerlIO_printf( Perl_debug_log,"\t=> %s\t",
2280                                     SvPV_nolen_const(mysv));
2281                                 }
2282                                 PerlIO_printf( Perl_debug_log, "(First==%d,Last==%d,Cur==%d)\n",
2283                                    REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur) );
2284                             });
2285                             if ( (((first && optype!=NOTHING) ? OP( noper ) == optype
2286                                          : PL_regkind[ OP( noper ) ] == EXACT )
2287                                   || OP(noper) == NOTHING )
2288                                   && noper_next == tail && count<U16_MAX)
2289                             {
2290                                 count++;
2291                                 if ( !first || optype == NOTHING ) {
2292                                     if (!first) first = cur;
2293                                     optype = OP( noper );
2294                                 } else {
2295                                     last = cur;
2296                                 }
2297                             } else {
2298                                 if ( last ) {
2299                                     made+=make_trie( pRExC_state, startbranch, first, cur, tail, optype, depth+1 );
2300                                 }
2301                                 if ( PL_regkind[ OP( noper ) ] == EXACT
2302                                      && noper_next == tail )
2303                                 {
2304                                     count = 1;
2305                                     first = cur;
2306                                     optype = OP( noper );
2307                                 } else {
2308                                     count = 0;
2309                                     first = NULL;
2310                                     optype = 0;
2311                                 }
2312                                 last = NULL;
2313                             }
2314                         }
2315                         DEBUG_OPTIMISE_r({
2316                             regprop(RExC_rx, mysv, cur);
2317                             PerlIO_printf( Perl_debug_log,
2318                               "%*s- %s (%d) <SCAN FINISHED>\n", (int)depth * 2 + 2,
2319                               "", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
2320
2321                         });
2322                         if ( last ) {
2323                             made+= make_trie( pRExC_state, startbranch, first, scan, tail, optype, depth+1 );
2324 #ifdef TRIE_STUDY_OPT   
2325                             if ( made && startbranch == first ) {
2326                                 if ( OP(first)!=TRIE )
2327                                     flags |= SCF_EXACT_TRIE;
2328                                 else {
2329                                     regnode *chk=*scanp;
2330                                     while ( OP( chk ) == OPEN ) 
2331                                         chk = regnext( chk );
2332                                     if (chk==first) 
2333                                         flags |= SCF_EXACT_TRIE;
2334                                 }
2335                             }                   
2336 #endif
2337                         }
2338                     }
2339                     
2340                 } /* do trie */
2341             }
2342             else if ( code == BRANCHJ ) {  /* single branch is optimized. */
2343                 scan = NEXTOPER(NEXTOPER(scan));
2344             } else                      /* single branch is optimized. */
2345                 scan = NEXTOPER(scan);
2346             continue;
2347         }
2348         else if (OP(scan) == EXACT) {
2349             I32 l = STR_LEN(scan);
2350             UV uc;
2351             if (UTF) {
2352                 const U8 * const s = (U8*)STRING(scan);
2353                 l = utf8_length(s, s + l);
2354                 uc = utf8_to_uvchr(s, NULL);
2355             } else {
2356                 uc = *((U8*)STRING(scan));
2357             }
2358             min += l;
2359             if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
2360                 /* The code below prefers earlier match for fixed
2361                    offset, later match for variable offset.  */
2362                 if (data->last_end == -1) { /* Update the start info. */
2363                     data->last_start_min = data->pos_min;
2364                     data->last_start_max = is_inf
2365                         ? I32_MAX : data->pos_min + data->pos_delta;
2366                 }
2367                 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
2368                 if (UTF)
2369                     SvUTF8_on(data->last_found);
2370                 {
2371                     SV * const sv = data->last_found;
2372                     MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
2373                         mg_find(sv, PERL_MAGIC_utf8) : NULL;
2374                     if (mg && mg->mg_len >= 0)
2375                         mg->mg_len += utf8_length((U8*)STRING(scan),
2376                                                   (U8*)STRING(scan)+STR_LEN(scan));
2377                 }
2378                 data->last_end = data->pos_min + l;
2379                 data->pos_min += l; /* As in the first entry. */
2380                 data->flags &= ~SF_BEFORE_EOL;
2381             }
2382             if (flags & SCF_DO_STCLASS_AND) {
2383                 /* Check whether it is compatible with what we know already! */
2384                 int compat = 1;
2385
2386                 if (uc >= 0x100 ||
2387                     (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
2388                     && !ANYOF_BITMAP_TEST(data->start_class, uc)
2389                     && (!(data->start_class->flags & ANYOF_FOLD)
2390                         || !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
2391                     )
2392                     compat = 0;
2393                 ANYOF_CLASS_ZERO(data->start_class);
2394                 ANYOF_BITMAP_ZERO(data->start_class);
2395                 if (compat)
2396                     ANYOF_BITMAP_SET(data->start_class, uc);
2397                 data->start_class->flags &= ~ANYOF_EOS;
2398                 if (uc < 0x100)
2399                   data->start_class->flags &= ~ANYOF_UNICODE_ALL;
2400             }
2401             else if (flags & SCF_DO_STCLASS_OR) {
2402                 /* false positive possible if the class is case-folded */
2403                 if (uc < 0x100)
2404                     ANYOF_BITMAP_SET(data->start_class, uc);
2405                 else
2406                     data->start_class->flags |= ANYOF_UNICODE_ALL;
2407                 data->start_class->flags &= ~ANYOF_EOS;
2408                 cl_and(data->start_class, &and_with);
2409             }
2410             flags &= ~SCF_DO_STCLASS;
2411         }
2412         else if (PL_regkind[OP(scan)] == EXACT) { /* But OP != EXACT! */
2413             I32 l = STR_LEN(scan);
2414             UV uc = *((U8*)STRING(scan));
2415
2416             /* Search for fixed substrings supports EXACT only. */
2417             if (flags & SCF_DO_SUBSTR) {
2418                 assert(data);
2419                 scan_commit(pRExC_state, data);
2420             }
2421             if (UTF) {
2422                 const U8 * const s = (U8 *)STRING(scan);
2423                 l = utf8_length(s, s + l);
2424                 uc = utf8_to_uvchr(s, NULL);
2425             }
2426             min += l;
2427             if (flags & SCF_DO_SUBSTR)
2428                 data->pos_min += l;
2429             if (flags & SCF_DO_STCLASS_AND) {
2430                 /* Check whether it is compatible with what we know already! */
2431                 int compat = 1;
2432
2433                 if (uc >= 0x100 ||
2434                     (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
2435                     && !ANYOF_BITMAP_TEST(data->start_class, uc)
2436                      && !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
2437                     compat = 0;
2438                 ANYOF_CLASS_ZERO(data->start_class);
2439                 ANYOF_BITMAP_ZERO(data->start_class);
2440                 if (compat) {
2441                     ANYOF_BITMAP_SET(data->start_class, uc);
2442                     data->start_class->flags &= ~ANYOF_EOS;
2443                     data->start_class->flags |= ANYOF_FOLD;
2444                     if (OP(scan) == EXACTFL)
2445                         data->start_class->flags |= ANYOF_LOCALE;
2446                 }
2447             }
2448             else if (flags & SCF_DO_STCLASS_OR) {
2449                 if (data->start_class->flags & ANYOF_FOLD) {
2450                     /* false positive possible if the class is case-folded.
2451                        Assume that the locale settings are the same... */
2452                     if (uc < 0x100)
2453                         ANYOF_BITMAP_SET(data->start_class, uc);
2454                     data->start_class->flags &= ~ANYOF_EOS;
2455                 }
2456                 cl_and(data->start_class, &and_with);
2457             }
2458             flags &= ~SCF_DO_STCLASS;
2459         }
2460 #ifdef TRIE_STUDY_OPT   
2461         else if (OP(scan) == TRIE) {
2462             reg_trie_data *trie=RExC_rx->data->data[ ARG(scan) ];
2463             min += trie->minlen;
2464             delta += (trie->maxlen - trie->minlen);
2465             flags &= ~SCF_DO_STCLASS; /* xxx */
2466             if (flags & SCF_DO_SUBSTR) {
2467                 scan_commit(pRExC_state,data);  /* Cannot expect anything... */
2468                 data->pos_min += trie->minlen;
2469                 data->pos_delta += (trie->maxlen - trie->minlen);
2470                 if (trie->maxlen != trie->minlen)
2471                     data->longest = &(data->longest_float);
2472             }
2473         }
2474 #endif  
2475         else if (strchr((const char*)PL_varies,OP(scan))) {
2476             I32 mincount, maxcount, minnext, deltanext, fl = 0;
2477             I32 f = flags, pos_before = 0;
2478             regnode * const oscan = scan;
2479             struct regnode_charclass_class this_class;
2480             struct regnode_charclass_class *oclass = NULL;
2481             I32 next_is_eval = 0;
2482
2483             switch (PL_regkind[OP(scan)]) {
2484             case WHILEM:                /* End of (?:...)* . */
2485                 scan = NEXTOPER(scan);
2486                 goto finish;
2487             case PLUS:
2488                 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
2489                     next = NEXTOPER(scan);
2490                     if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
2491                         mincount = 1;
2492                         maxcount = REG_INFTY;
2493                         next = regnext(scan);
2494                         scan = NEXTOPER(scan);
2495                         goto do_curly;
2496                     }
2497                 }
2498                 if (flags & SCF_DO_SUBSTR)
2499                     data->pos_min++;
2500                 min++;
2501                 /* Fall through. */
2502             case STAR:
2503                 if (flags & SCF_DO_STCLASS) {
2504                     mincount = 0;
2505                     maxcount = REG_INFTY;
2506                     next = regnext(scan);
2507                     scan = NEXTOPER(scan);
2508                     goto do_curly;
2509                 }
2510                 is_inf = is_inf_internal = 1;
2511                 scan = regnext(scan);
2512                 if (flags & SCF_DO_SUBSTR) {
2513                     scan_commit(pRExC_state, data); /* Cannot extend fixed substrings */
2514                     data->longest = &(data->longest_float);
2515                 }
2516                 goto optimize_curly_tail;
2517             case CURLY:
2518                 mincount = ARG1(scan);
2519                 maxcount = ARG2(scan);
2520                 next = regnext(scan);
2521                 if (OP(scan) == CURLYX) {
2522                     I32 lp = (data ? *(data->last_closep) : 0);
2523                     scan->flags = ((lp <= U8_MAX) ? (U8)lp : U8_MAX);
2524                 }
2525                 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
2526                 next_is_eval = (OP(scan) == EVAL);
2527               do_curly:
2528                 if (flags & SCF_DO_SUBSTR) {
2529                     if (mincount == 0) scan_commit(pRExC_state,data); /* Cannot extend fixed substrings */
2530                     pos_before = data->pos_min;
2531                 }
2532                 if (data) {
2533                     fl = data->flags;
2534                     data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
2535                     if (is_inf)
2536                         data->flags |= SF_IS_INF;
2537                 }
2538                 if (flags & SCF_DO_STCLASS) {
2539                     cl_init(pRExC_state, &this_class);
2540                     oclass = data->start_class;
2541                     data->start_class = &this_class;
2542                     f |= SCF_DO_STCLASS_AND;
2543                     f &= ~SCF_DO_STCLASS_OR;
2544                 }
2545                 /* These are the cases when once a subexpression
2546                    fails at a particular position, it cannot succeed
2547                    even after backtracking at the enclosing scope.
2548                 
2549                    XXXX what if minimal match and we are at the
2550                         initial run of {n,m}? */
2551                 if ((mincount != maxcount - 1) && (maxcount != REG_INFTY))
2552                     f &= ~SCF_WHILEM_VISITED_POS;
2553
2554                 /* This will finish on WHILEM, setting scan, or on NULL: */
2555                 minnext = study_chunk(pRExC_state, &scan, &deltanext, last, data,
2556                                       (mincount == 0
2557                                         ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
2558
2559                 if (flags & SCF_DO_STCLASS)
2560                     data->start_class = oclass;
2561                 if (mincount == 0 || minnext == 0) {
2562                     if (flags & SCF_DO_STCLASS_OR) {
2563                         cl_or(pRExC_state, data->start_class, &this_class);
2564                     }
2565                     else if (flags & SCF_DO_STCLASS_AND) {
2566                         /* Switch to OR mode: cache the old value of
2567                          * data->start_class */
2568                         StructCopy(data->start_class, &and_with,
2569                                    struct regnode_charclass_class);
2570                         flags &= ~SCF_DO_STCLASS_AND;
2571                         StructCopy(&this_class, data->start_class,
2572                                    struct regnode_charclass_class);
2573                         flags |= SCF_DO_STCLASS_OR;
2574                         data->start_class->flags |= ANYOF_EOS;
2575                     }
2576                 } else {                /* Non-zero len */
2577                     if (flags & SCF_DO_STCLASS_OR) {
2578                         cl_or(pRExC_state, data->start_class, &this_class);
2579                         cl_and(data->start_class, &and_with);
2580                     }
2581                     else if (flags & SCF_DO_STCLASS_AND)
2582                         cl_and(data->start_class, &this_class);
2583                     flags &= ~SCF_DO_STCLASS;
2584                 }
2585                 if (!scan)              /* It was not CURLYX, but CURLY. */
2586                     scan = next;
2587                 if ( /* ? quantifier ok, except for (?{ ... }) */
2588                     (next_is_eval || !(mincount == 0 && maxcount == 1))
2589                     && (minnext == 0) && (deltanext == 0)
2590                     && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
2591                     && maxcount <= REG_INFTY/3 /* Complement check for big count */
2592                     && ckWARN(WARN_REGEXP))
2593                 {
2594                     vWARN(RExC_parse,
2595                           "Quantifier unexpected on zero-length expression");
2596                 }
2597
2598                 min += minnext * mincount;
2599                 is_inf_internal |= ((maxcount == REG_INFTY
2600                                      && (minnext + deltanext) > 0)
2601                                     || deltanext == I32_MAX);
2602                 is_inf |= is_inf_internal;
2603                 delta += (minnext + deltanext) * maxcount - minnext * mincount;
2604
2605                 /* Try powerful optimization CURLYX => CURLYN. */
2606                 if (  OP(oscan) == CURLYX && data
2607                       && data->flags & SF_IN_PAR
2608                       && !(data->flags & SF_HAS_EVAL)
2609                       && !deltanext && minnext == 1 ) {
2610                     /* Try to optimize to CURLYN.  */
2611                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
2612                     regnode * const nxt1 = nxt;
2613 #ifdef DEBUGGING
2614                     regnode *nxt2;
2615 #endif
2616
2617                     /* Skip open. */
2618                     nxt = regnext(nxt);
2619                     if (!strchr((const char*)PL_simple,OP(nxt))
2620                         && !(PL_regkind[OP(nxt)] == EXACT
2621                              && STR_LEN(nxt) == 1))
2622                         goto nogo;
2623 #ifdef DEBUGGING
2624                     nxt2 = nxt;
2625 #endif
2626                     nxt = regnext(nxt);
2627                     if (OP(nxt) != CLOSE)
2628                         goto nogo;
2629                     /* Now we know that nxt2 is the only contents: */
2630                     oscan->flags = (U8)ARG(nxt);
2631                     OP(oscan) = CURLYN;
2632                     OP(nxt1) = NOTHING; /* was OPEN. */
2633 #ifdef DEBUGGING
2634                     OP(nxt1 + 1) = OPTIMIZED; /* was count. */
2635                     NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
2636                     NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */
2637                     OP(nxt) = OPTIMIZED;        /* was CLOSE. */
2638                     OP(nxt + 1) = OPTIMIZED; /* was count. */
2639                     NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
2640 #endif
2641                 }
2642               nogo:
2643
2644                 /* Try optimization CURLYX => CURLYM. */
2645                 if (  OP(oscan) == CURLYX && data
2646                       && !(data->flags & SF_HAS_PAR)
2647                       && !(data->flags & SF_HAS_EVAL)
2648                       && !deltanext     /* atom is fixed width */
2649                       && minnext != 0   /* CURLYM can't handle zero width */
2650                 ) {
2651                     /* XXXX How to optimize if data == 0? */
2652                     /* Optimize to a simpler form.  */
2653                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
2654                     regnode *nxt2;
2655
2656                     OP(oscan) = CURLYM;
2657                     while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
2658                             && (OP(nxt2) != WHILEM))
2659                         nxt = nxt2;
2660                     OP(nxt2)  = SUCCEED; /* Whas WHILEM */
2661                     /* Need to optimize away parenths. */
2662                     if (data->flags & SF_IN_PAR) {
2663                         /* Set the parenth number.  */
2664                         regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
2665
2666                         if (OP(nxt) != CLOSE)
2667                             FAIL("Panic opt close");
2668                         oscan->flags = (U8)ARG(nxt);
2669                         OP(nxt1) = OPTIMIZED;   /* was OPEN. */
2670                         OP(nxt) = OPTIMIZED;    /* was CLOSE. */
2671 #ifdef DEBUGGING
2672                         OP(nxt1 + 1) = OPTIMIZED; /* was count. */
2673                         OP(nxt + 1) = OPTIMIZED; /* was count. */
2674                         NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
2675                         NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
2676 #endif
2677 #if 0
2678                         while ( nxt1 && (OP(nxt1) != WHILEM)) {
2679                             regnode *nnxt = regnext(nxt1);
2680                         
2681                             if (nnxt == nxt) {
2682                                 if (reg_off_by_arg[OP(nxt1)])
2683                                     ARG_SET(nxt1, nxt2 - nxt1);
2684                                 else if (nxt2 - nxt1 < U16_MAX)
2685                                     NEXT_OFF(nxt1) = nxt2 - nxt1;
2686                                 else
2687                                     OP(nxt) = NOTHING;  /* Cannot beautify */
2688                             }
2689                             nxt1 = nnxt;
2690                         }
2691 #endif
2692                         /* Optimize again: */
2693                         study_chunk(pRExC_state, &nxt1, &deltanext, nxt,
2694                                     NULL, 0,depth+1);
2695                     }
2696                     else
2697                         oscan->flags = 0;
2698                 }
2699                 else if ((OP(oscan) == CURLYX)
2700                          && (flags & SCF_WHILEM_VISITED_POS)
2701                          /* See the comment on a similar expression above.
2702                             However, this time it not a subexpression
2703                             we care about, but the expression itself. */
2704                          && (maxcount == REG_INFTY)
2705                          && data && ++data->whilem_c < 16) {
2706                     /* This stays as CURLYX, we can put the count/of pair. */
2707                     /* Find WHILEM (as in regexec.c) */
2708                     regnode *nxt = oscan + NEXT_OFF(oscan);
2709
2710                     if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
2711                         nxt += ARG(nxt);
2712                     PREVOPER(nxt)->flags = (U8)(data->whilem_c
2713                         | (RExC_whilem_seen << 4)); /* On WHILEM */
2714                 }
2715                 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
2716                     pars++;
2717                 if (flags & SCF_DO_SUBSTR) {
2718                     SV *last_str = NULL;
2719                     int counted = mincount != 0;
2720
2721                     if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
2722 #if defined(SPARC64_GCC_WORKAROUND)
2723                         I32 b = 0;
2724                         STRLEN l = 0;
2725                         const char *s = NULL;
2726                         I32 old = 0;
2727
2728                         if (pos_before >= data->last_start_min)
2729                             b = pos_before;
2730                         else
2731                             b = data->last_start_min;
2732
2733                         l = 0;
2734                         s = SvPV_const(data->last_found, l);
2735                         old = b - data->last_start_min;
2736
2737 #else
2738                         I32 b = pos_before >= data->last_start_min
2739                             ? pos_before : data->last_start_min;
2740                         STRLEN l;
2741                         const char * const s = SvPV_const(data->last_found, l);
2742                         I32 old = b - data->last_start_min;
2743 #endif
2744
2745                         if (UTF)
2746                             old = utf8_hop((U8*)s, old) - (U8*)s;
2747                         
2748                         l -= old;
2749                         /* Get the added string: */
2750                         last_str = newSVpvn(s  + old, l);
2751                         if (UTF)
2752                             SvUTF8_on(last_str);
2753                         if (deltanext == 0 && pos_before == b) {
2754                             /* What was added is a constant string */
2755                             if (mincount > 1) {
2756                                 SvGROW(last_str, (mincount * l) + 1);
2757                                 repeatcpy(SvPVX(last_str) + l,
2758                                           SvPVX_const(last_str), l, mincount - 1);
2759                                 SvCUR_set(last_str, SvCUR(last_str) * mincount);
2760                                 /* Add additional parts. */
2761                                 SvCUR_set(data->last_found,
2762                                           SvCUR(data->last_found) - l);
2763                                 sv_catsv(data->last_found, last_str);
2764                                 {
2765                                     SV * sv = data->last_found;
2766                                     MAGIC *mg =
2767                                         SvUTF8(sv) && SvMAGICAL(sv) ?
2768                                         mg_find(sv, PERL_MAGIC_utf8) : NULL;
2769                                     if (mg && mg->mg_len >= 0)
2770                                         mg->mg_len += CHR_SVLEN(last_str);
2771                                 }
2772                                 data->last_end += l * (mincount - 1);
2773                             }
2774                         } else {
2775                             /* start offset must point into the last copy */
2776                             data->last_start_min += minnext * (mincount - 1);
2777                             data->last_start_max += is_inf ? I32_MAX
2778                                 : (maxcount - 1) * (minnext + data->pos_delta);
2779                         }
2780                     }
2781                     /* It is counted once already... */
2782                     data->pos_min += minnext * (mincount - counted);
2783                     data->pos_delta += - counted * deltanext +
2784                         (minnext + deltanext) * maxcount - minnext * mincount;
2785                     if (mincount != maxcount) {
2786                          /* Cannot extend fixed substrings found inside
2787                             the group.  */
2788                         scan_commit(pRExC_state,data);
2789                         if (mincount && last_str) {
2790                             SV * const sv = data->last_found;
2791                             MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
2792                                 mg_find(sv, PERL_MAGIC_utf8) : NULL;
2793
2794                             if (mg)
2795                                 mg->mg_len = -1;
2796                             sv_setsv(sv, last_str);
2797                             data->last_end = data->pos_min;
2798                             data->last_start_min =
2799                                 data->pos_min - CHR_SVLEN(last_str);
2800                             data->last_start_max = is_inf
2801                                 ? I32_MAX
2802                                 : data->pos_min + data->pos_delta
2803                                 - CHR_SVLEN(last_str);
2804                         }
2805                         data->longest = &(data->longest_float);
2806                     }
2807                     SvREFCNT_dec(last_str);
2808                 }
2809                 if (data && (fl & SF_HAS_EVAL))
2810                     data->flags |= SF_HAS_EVAL;
2811               optimize_curly_tail:
2812                 if (OP(oscan) != CURLYX) {
2813                     while (PL_regkind[OP(next = regnext(oscan))] == NOTHING
2814                            && NEXT_OFF(next))
2815                         NEXT_OFF(oscan) += NEXT_OFF(next);
2816                 }
2817                 continue;
2818             default:                    /* REF and CLUMP only? */
2819                 if (flags & SCF_DO_SUBSTR) {
2820                     scan_commit(pRExC_state,data);      /* Cannot expect anything... */
2821                     data->longest = &(data->longest_float);
2822                 }
2823                 is_inf = is_inf_internal = 1;
2824                 if (flags & SCF_DO_STCLASS_OR)
2825                     cl_anything(pRExC_state, data->start_class);
2826                 flags &= ~SCF_DO_STCLASS;
2827                 break;
2828             }
2829         }
2830         else if (strchr((const char*)PL_simple,OP(scan))) {
2831             int value = 0;
2832
2833             if (flags & SCF_DO_SUBSTR) {
2834                 scan_commit(pRExC_state,data);
2835                 data->pos_min++;
2836             }
2837             min++;
2838             if (flags & SCF_DO_STCLASS) {
2839                 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
2840
2841                 /* Some of the logic below assumes that switching
2842                    locale on will only add false positives. */
2843                 switch (PL_regkind[OP(scan)]) {
2844                 case SANY:
2845                 default:
2846                   do_default:
2847                     /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
2848                     if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
2849                         cl_anything(pRExC_state, data->start_class);
2850                     break;
2851                 case REG_ANY:
2852                     if (OP(scan) == SANY)
2853                         goto do_default;
2854                     if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
2855                         value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
2856                                  || (data->start_class->flags & ANYOF_CLASS));
2857                         cl_anything(pRExC_state, data->start_class);
2858                     }
2859                     if (flags & SCF_DO_STCLASS_AND || !value)
2860                         ANYOF_BITMAP_CLEAR(data->start_class,'\n');
2861                     break;
2862                 case ANYOF:
2863                     if (flags & SCF_DO_STCLASS_AND)
2864                         cl_and(data->start_class,
2865                                (struct regnode_charclass_class*)scan);
2866                     else
2867                         cl_or(pRExC_state, data->start_class,
2868                               (struct regnode_charclass_class*)scan);
2869                     break;
2870                 case ALNUM:
2871                     if (flags & SCF_DO_STCLASS_AND) {
2872                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
2873                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
2874                             for (value = 0; value < 256; value++)
2875                                 if (!isALNUM(value))
2876                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
2877                         }
2878                     }
2879                     else {
2880                         if (data->start_class->flags & ANYOF_LOCALE)
2881                             ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
2882                         else {
2883                             for (value = 0; value < 256; value++)
2884                                 if (isALNUM(value))
2885                                     ANYOF_BITMAP_SET(data->start_class, value);                 
2886                         }
2887                     }
2888                     break;
2889                 case ALNUML:
2890                     if (flags & SCF_DO_STCLASS_AND) {
2891                         if (data->start_class->flags & ANYOF_LOCALE)
2892                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
2893                     }
2894                     else {
2895                         ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
2896                         data->start_class->flags |= ANYOF_LOCALE;
2897                     }
2898                     break;
2899                 case NALNUM:
2900                     if (flags & SCF_DO_STCLASS_AND) {
2901                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
2902                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
2903                             for (value = 0; value < 256; value++)
2904                                 if (isALNUM(value))
2905                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
2906                         }
2907                     }
2908                     else {
2909                         if (data->start_class->flags & ANYOF_LOCALE)
2910                             ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
2911                         else {
2912                             for (value = 0; value < 256; value++)
2913                                 if (!isALNUM(value))
2914                                     ANYOF_BITMAP_SET(data->start_class, value);                 
2915                         }
2916                     }
2917                     break;
2918                 case NALNUML:
2919                     if (flags & SCF_DO_STCLASS_AND) {
2920                         if (data->start_class->flags & ANYOF_LOCALE)
2921                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
2922                     }
2923                     else {
2924                         data->start_class->flags |= ANYOF_LOCALE;
2925                         ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
2926                     }
2927                     break;
2928                 case SPACE:
2929                     if (flags & SCF_DO_STCLASS_AND) {
2930                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
2931                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
2932                             for (value = 0; value < 256; value++)
2933                                 if (!isSPACE(value))
2934                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
2935                         }
2936                     }
2937                     else {
2938                         if (data->start_class->flags & ANYOF_LOCALE)
2939                             ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
2940                         else {
2941                             for (value = 0; value < 256; value++)
2942                                 if (isSPACE(value))
2943                                     ANYOF_BITMAP_SET(data->start_class, value);                 
2944                         }
2945                     }
2946                     break;
2947                 case SPACEL:
2948                     if (flags & SCF_DO_STCLASS_AND) {
2949                         if (data->start_class->flags & ANYOF_LOCALE)
2950                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
2951                     }
2952                     else {
2953                         data->start_class->flags |= ANYOF_LOCALE;
2954                         ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
2955                     }
2956                     break;
2957                 case NSPACE:
2958                     if (flags & SCF_DO_STCLASS_AND) {
2959                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
2960                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
2961                             for (value = 0; value < 256; value++)
2962                                 if (isSPACE(value))
2963                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
2964                         }
2965                     }
2966                     else {
2967                         if (data->start_class->flags & ANYOF_LOCALE)
2968                             ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
2969                         else {
2970                             for (value = 0; value < 256; value++)
2971                                 if (!isSPACE(value))
2972                                     ANYOF_BITMAP_SET(data->start_class, value);                 
2973                         }
2974                     }
2975                     break;
2976                 case NSPACEL:
2977                     if (flags & SCF_DO_STCLASS_AND) {
2978                         if (data->start_class->flags & ANYOF_LOCALE) {
2979                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
2980                             for (value = 0; value < 256; value++)
2981                                 if (!isSPACE(value))
2982                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
2983                         }
2984                     }
2985                     else {
2986                         data->start_class->flags |= ANYOF_LOCALE;
2987                         ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
2988                     }
2989                     break;
2990                 case DIGIT:
2991                     if (flags & SCF_DO_STCLASS_AND) {
2992                         ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
2993                         for (value = 0; value < 256; value++)
2994                             if (!isDIGIT(value))
2995                                 ANYOF_BITMAP_CLEAR(data->start_class, value);
2996                     }
2997                     else {
2998                         if (data->start_class->flags & ANYOF_LOCALE)
2999                             ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
3000                         else {
3001                             for (value = 0; value < 256; value++)
3002                                 if (isDIGIT(value))
3003                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3004                         }
3005                     }
3006                     break;
3007                 case NDIGIT:
3008                     if (flags & SCF_DO_STCLASS_AND) {
3009                         ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
3010                         for (value = 0; value < 256; value++)
3011                             if (isDIGIT(value))
3012                                 ANYOF_BITMAP_CLEAR(data->start_class, value);
3013                     }
3014                     else {
3015                         if (data->start_class->flags & ANYOF_LOCALE)
3016                             ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
3017                         else {
3018                             for (value = 0; value < 256; value++)
3019                                 if (!isDIGIT(value))
3020                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3021                         }
3022                     }
3023                     break;
3024                 }
3025                 if (flags & SCF_DO_STCLASS_OR)
3026                     cl_and(data->start_class, &and_with);
3027                 flags &= ~SCF_DO_STCLASS;
3028             }
3029         }
3030         else if (PL_regkind[OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
3031             data->flags |= (OP(scan) == MEOL
3032                             ? SF_BEFORE_MEOL
3033                             : SF_BEFORE_SEOL);
3034         }
3035         else if (  PL_regkind[OP(scan)] == BRANCHJ
3036                  /* Lookbehind, or need to calculate parens/evals/stclass: */
3037                    && (scan->flags || data || (flags & SCF_DO_STCLASS))
3038                    && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
3039             /* Lookahead/lookbehind */
3040             I32 deltanext, minnext, fake = 0;
3041             regnode *nscan;
3042             struct regnode_charclass_class intrnl;
3043             int f = 0;
3044
3045             data_fake.flags = 0;
3046             if (data) {         
3047                 data_fake.whilem_c = data->whilem_c;
3048                 data_fake.last_closep = data->last_closep;
3049             }
3050             else
3051                 data_fake.last_closep = &fake;
3052             if ( flags & SCF_DO_STCLASS && !scan->flags
3053                  && OP(scan) == IFMATCH ) { /* Lookahead */
3054                 cl_init(pRExC_state, &intrnl);
3055                 data_fake.start_class = &intrnl;
3056                 f |= SCF_DO_STCLASS_AND;
3057             }
3058             if (flags & SCF_WHILEM_VISITED_POS)
3059                 f |= SCF_WHILEM_VISITED_POS;
3060             next = regnext(scan);
3061             nscan = NEXTOPER(NEXTOPER(scan));
3062             minnext = study_chunk(pRExC_state, &nscan, &deltanext, last, &data_fake, f,depth+1);
3063             if (scan->flags) {
3064                 if (deltanext) {
3065                     vFAIL("Variable length lookbehind not implemented");
3066                 }
3067                 else if (minnext > U8_MAX) {
3068                     vFAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
3069                 }
3070                 scan->flags = (U8)minnext;
3071             }
3072             if (data) {
3073                 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3074                     pars++;
3075                 if (data_fake.flags & SF_HAS_EVAL)
3076                     data->flags |= SF_HAS_EVAL;
3077                 data->whilem_c = data_fake.whilem_c;
3078             }
3079             if (f & SCF_DO_STCLASS_AND) {
3080                 const int was = (data->start_class->flags & ANYOF_EOS);
3081
3082                 cl_and(data->start_class, &intrnl);
3083                 if (was)
3084                     data->start_class->flags |= ANYOF_EOS;
3085             }
3086         }
3087         else if (OP(scan) == OPEN) {
3088             pars++;
3089         }
3090         else if (OP(scan) == CLOSE) {
3091             if ((I32)ARG(scan) == is_par) {
3092                 next = regnext(scan);
3093
3094                 if ( next && (OP(next) != WHILEM) && next < last)
3095                     is_par = 0;         /* Disable optimization */
3096             }
3097             if (data)
3098                 *(data->last_closep) = ARG(scan);
3099         }
3100         else if (OP(scan) == EVAL) {
3101                 if (data)
3102                     data->flags |= SF_HAS_EVAL;
3103         }
3104         else if (OP(scan) == LOGICAL && scan->flags == 2) { /* Embedded follows */
3105                 if (flags & SCF_DO_SUBSTR) {
3106                     scan_commit(pRExC_state,data);
3107                     data->longest = &(data->longest_float);
3108                 }
3109                 is_inf = is_inf_internal = 1;
3110                 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3111                     cl_anything(pRExC_state, data->start_class);
3112                 flags &= ~SCF_DO_STCLASS;
3113         }
3114         /* Else: zero-length, ignore. */
3115         scan = regnext(scan);
3116     }
3117
3118   finish:
3119     *scanp = scan;
3120     *deltap = is_inf_internal ? I32_MAX : delta;
3121     if (flags & SCF_DO_SUBSTR && is_inf)
3122         data->pos_delta = I32_MAX - data->pos_min;
3123     if (is_par > U8_MAX)
3124         is_par = 0;
3125     if (is_par && pars==1 && data) {
3126         data->flags |= SF_IN_PAR;
3127         data->flags &= ~SF_HAS_PAR;
3128     }
3129     else if (pars && data) {
3130         data->flags |= SF_HAS_PAR;
3131         data->flags &= ~SF_IN_PAR;
3132     }
3133     if (flags & SCF_DO_STCLASS_OR)
3134         cl_and(data->start_class, &and_with);
3135     if (flags & SCF_EXACT_TRIE) 
3136         data->flags |=  SCF_EXACT_TRIE;
3137     return min;
3138 }
3139
3140 STATIC I32
3141 S_add_data(RExC_state_t *pRExC_state, I32 n, const char *s)
3142 {
3143     if (RExC_rx->data) {
3144         Renewc(RExC_rx->data,
3145                sizeof(*RExC_rx->data) + sizeof(void*) * (RExC_rx->data->count + n - 1),
3146                char, struct reg_data);
3147         Renew(RExC_rx->data->what, RExC_rx->data->count + n, U8);
3148         RExC_rx->data->count += n;
3149     }
3150     else {
3151         Newxc(RExC_rx->data, sizeof(*RExC_rx->data) + sizeof(void*) * (n - 1),
3152              char, struct reg_data);
3153         Newx(RExC_rx->data->what, n, U8);
3154         RExC_rx->data->count = n;
3155     }
3156     Copy(s, RExC_rx->data->what + RExC_rx->data->count - n, n, U8);
3157     return RExC_rx->data->count - n;
3158 }
3159
3160 #ifndef PERL_IN_XSUB_RE
3161 void
3162 Perl_reginitcolors(pTHX)
3163 {
3164     dVAR;
3165     const char * const s = PerlEnv_getenv("PERL_RE_COLORS");
3166     if (s) {
3167         char *t = savepv(s);
3168         int i = 0;
3169         PL_colors[0] = t;
3170         while (++i < 6) {
3171             t = strchr(t, '\t');
3172             if (t) {
3173                 *t = '\0';
3174                 PL_colors[i] = ++t;
3175             }
3176             else
3177                 PL_colors[i] = t = (char *)"";
3178         }
3179     } else {
3180         int i = 0;
3181         while (i < 6)
3182             PL_colors[i++] = (char *)"";
3183     }
3184     PL_colorset = 1;
3185 }
3186 #endif
3187
3188
3189 /*
3190  - pregcomp - compile a regular expression into internal code
3191  *
3192  * We can't allocate space until we know how big the compiled form will be,
3193  * but we can't compile it (and thus know how big it is) until we've got a
3194  * place to put the code.  So we cheat:  we compile it twice, once with code
3195  * generation turned off and size counting turned on, and once "for real".
3196  * This also means that we don't allocate space until we are sure that the
3197  * thing really will compile successfully, and we never have to move the
3198  * code and thus invalidate pointers into it.  (Note that it has to be in
3199  * one piece because free() must be able to free it all.) [NB: not true in perl]
3200  *
3201  * Beware that the optimization-preparation code in here knows about some
3202  * of the structure of the compiled regexp.  [I'll say.]
3203  */
3204 regexp *
3205 Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
3206 {
3207     dVAR;
3208     register regexp *r;
3209     regnode *scan;
3210     regnode *first;
3211     I32 flags;
3212     I32 minlen = 0;
3213     I32 sawplus = 0;
3214     I32 sawopen = 0;
3215     scan_data_t data;
3216     RExC_state_t RExC_state;
3217     RExC_state_t * const pRExC_state = &RExC_state;
3218 #ifdef TRIE_STUDY_OPT    
3219     int restudied= 0;
3220     RExC_state_t copyRExC_state;
3221 #endif    
3222
3223     GET_RE_DEBUG_FLAGS_DECL;
3224
3225     if (exp == NULL)
3226         FAIL("NULL regexp argument");
3227
3228     RExC_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
3229
3230     RExC_precomp = exp;
3231     DEBUG_r(if (!PL_colorset) reginitcolors());
3232     DEBUG_COMPILE_r({
3233          PerlIO_printf(Perl_debug_log, "%sCompiling REx%s \"%s%*s%s\"\n",
3234                        PL_colors[4],PL_colors[5],PL_colors[0],
3235                        (int)(xend - exp), RExC_precomp, PL_colors[1]);
3236     });
3237     RExC_flags = pm->op_pmflags;
3238     RExC_sawback = 0;
3239
3240     RExC_seen = 0;
3241     RExC_seen_zerolen = *exp == '^' ? -1 : 0;
3242     RExC_seen_evals = 0;
3243     RExC_extralen = 0;
3244
3245     /* First pass: determine size, legality. */
3246     RExC_parse = exp;
3247     RExC_start = exp;
3248     RExC_end = xend;
3249     RExC_naughty = 0;
3250     RExC_npar = 1;
3251     RExC_size = 0L;
3252     RExC_emit = &PL_regdummy;
3253     RExC_whilem_seen = 0;
3254 #if 0 /* REGC() is (currently) a NOP at the first pass.
3255        * Clever compilers notice this and complain. --jhi */
3256     REGC((U8)REG_MAGIC, (char*)RExC_emit);
3257 #endif
3258     DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "Starting first pass (sizing)\n"));
3259     if (reg(pRExC_state, 0, &flags,1) == NULL) {
3260         RExC_precomp = NULL;
3261         return(NULL);
3262     }
3263     DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "Required "));
3264     DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" nodes ", (IV)RExC_size));
3265     DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "\nStarting second pass (creation)\n"));
3266     DEBUG_PARSE_r({
3267         RExC_lastnum=0; 
3268         RExC_lastparse=NULL; 
3269     });
3270
3271     
3272     /* Small enough for pointer-storage convention?
3273        If extralen==0, this means that we will not need long jumps. */
3274     if (RExC_size >= 0x10000L && RExC_extralen)
3275         RExC_size += RExC_extralen;
3276     else
3277         RExC_extralen = 0;
3278     if (RExC_whilem_seen > 15)
3279         RExC_whilem_seen = 15;
3280
3281     /* Allocate space and initialize. */
3282     Newxc(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode),
3283          char, regexp);
3284     if (r == NULL)
3285         FAIL("Regexp out of space");
3286
3287 #ifdef DEBUGGING
3288     /* avoid reading uninitialized memory in DEBUGGING code in study_chunk() */
3289     Zero(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode), char);
3290 #endif
3291     r->refcnt = 1;
3292     r->prelen = xend - exp;
3293     r->precomp = savepvn(RExC_precomp, r->prelen);
3294     r->subbeg = NULL;
3295 #ifdef PERL_OLD_COPY_ON_WRITE
3296     r->saved_copy = NULL;
3297 #endif
3298     r->reganch = pm->op_pmflags & PMf_COMPILETIME;
3299     r->nparens = RExC_npar - 1; /* set early to validate backrefs */
3300     r->lastparen = 0;                   /* mg.c reads this.  */
3301
3302     r->substrs = 0;                     /* Useful during FAIL. */
3303     r->startp = 0;                      /* Useful during FAIL. */
3304     r->endp = 0;                        /* Useful during FAIL. */
3305
3306     Newxz(r->offsets, 2*RExC_size+1, U32); /* MJD 20001228 */
3307     if (r->offsets) {
3308         r->offsets[0] = RExC_size;
3309     }
3310     DEBUG_OFFSETS_r(PerlIO_printf(Perl_debug_log,
3311                           "%s %"UVuf" bytes for offset annotations.\n",
3312                           r->offsets ? "Got" : "Couldn't get",
3313                           (UV)((2*RExC_size+1) * sizeof(U32))));
3314
3315     RExC_rx = r;
3316
3317     /* Second pass: emit code. */
3318     RExC_flags = pm->op_pmflags;        /* don't let top level (?i) bleed */
3319     RExC_parse = exp;
3320     RExC_end = xend;
3321     RExC_naughty = 0;
3322     RExC_npar = 1;
3323     RExC_emit_start = r->program;
3324     RExC_emit = r->program;
3325     /* Store the count of eval-groups for security checks: */
3326     RExC_emit->next_off = (U16)((RExC_seen_evals > U16_MAX) ? U16_MAX : RExC_seen_evals);
3327     REGC((U8)REG_MAGIC, (char*) RExC_emit++);
3328     r->data = 0;
3329     if (reg(pRExC_state, 0, &flags,1) == NULL)
3330         return(NULL);
3331     /* XXXX To minimize changes to RE engine we always allocate
3332        3-units-long substrs field. */
3333     Newx(r->substrs, 1, struct reg_substr_data);
3334
3335 reStudy:
3336     Zero(r->substrs, 1, struct reg_substr_data);
3337     StructCopy(&zero_scan_data, &data, scan_data_t);
3338
3339 #ifdef TRIE_STUDY_OPT
3340     if ( restudied ) {
3341         DEBUG_OPTIMISE_r(PerlIO_printf(Perl_debug_log,"Restudying\n"));
3342         RExC_state=copyRExC_state;
3343         if (data.longest_fixed)
3344             SvREFCNT_dec(data.longest_fixed);
3345         if (data.longest_float)
3346             SvREFCNT_dec(data.longest_float);
3347         if (data.last_found)
3348             SvREFCNT_dec(data.last_found);
3349     } else {
3350         copyRExC_state=RExC_state;
3351     }
3352 #endif    
3353     /* Dig out information for optimizations. */
3354     r->reganch = pm->op_pmflags & PMf_COMPILETIME; /* Again? */
3355     pm->op_pmflags = RExC_flags;
3356     if (UTF)
3357         r->reganch |= ROPT_UTF8;        /* Unicode in it? */
3358     r->regstclass = NULL;
3359     if (RExC_naughty >= 10)     /* Probably an expensive pattern. */
3360         r->reganch |= ROPT_NAUGHTY;
3361     scan = r->program + 1;              /* First BRANCH. */
3362
3363     /* XXXX Should not we check for something else?  Usually it is OPEN1... */
3364     if (OP(scan) != BRANCH) {   /* Only one top-level choice. */
3365         I32 fake;
3366         STRLEN longest_float_length, longest_fixed_length;
3367         struct regnode_charclass_class ch_class; /* pointed to by data */
3368         int stclass_flag;
3369         I32 last_close = 0; /* pointed to by data */
3370
3371         first = scan;
3372         /* Skip introductions and multiplicators >= 1. */
3373         while ((OP(first) == OPEN && (sawopen = 1)) ||
3374                /* An OR of *one* alternative - should not happen now. */
3375             (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
3376             /* for now we can't handle lookbehind IFMATCH*/
3377             (OP(first) == IFMATCH && !first->flags) || 
3378             (OP(first) == PLUS) ||
3379             (OP(first) == MINMOD) ||
3380                /* An {n,m} with n>0 */
3381             (PL_regkind[OP(first)] == CURLY && ARG1(first) > 0) ) 
3382         {
3383                 DEBUG_PEEP("first:",first,0);
3384                 if (OP(first) == PLUS)
3385                     sawplus = 1;
3386                 else
3387                     first += regarglen[OP(first)];
3388                 if (OP(first) == IFMATCH) {
3389                     first = NEXTOPER(first);
3390                     first += EXTRA_STEP_2ARGS;
3391                 } else  /* XXX possible optimisation for /(?=)/  */
3392                     first = NEXTOPER(first);
3393         }
3394
3395         /* Starting-point info. */
3396       again:
3397         /* Ignore EXACT as we deal with it later. */
3398         if (PL_regkind[OP(first)] == EXACT) {
3399             if (OP(first) == EXACT)
3400                 NOOP;   /* Empty, get anchored substr later. */
3401             else if ((OP(first) == EXACTF || OP(first) == EXACTFL))
3402                 r->regstclass = first;
3403         }
3404 #ifdef TRIE_STCLASS     
3405         else if (OP(first) == TRIE &&
3406                 ((reg_trie_data *)r->data->data[ ARG(first) ])->minlen>0) 
3407         {
3408             /* this can happen only on restudy */
3409             struct regnode_1 *trie_op;
3410             Newxz(trie_op,1,struct regnode_1);
3411             StructCopy(first,trie_op,struct regnode_1);
3412             make_trie_failtable(pRExC_state, (regnode *)first, (regnode *)trie_op, 0);
3413             r->regstclass = (regnode *)trie_op;
3414         }
3415 #endif  
3416         else if (strchr((const char*)PL_simple,OP(first)))
3417             r->regstclass = first;
3418         else if (PL_regkind[OP(first)] == BOUND ||
3419                  PL_regkind[OP(first)] == NBOUND)
3420             r->regstclass = first;
3421         else if (PL_regkind[OP(first)] == BOL) {
3422             r->reganch |= (OP(first) == MBOL
3423                            ? ROPT_ANCH_MBOL
3424                            : (OP(first) == SBOL
3425                               ? ROPT_ANCH_SBOL
3426                               : ROPT_ANCH_BOL));
3427             first = NEXTOPER(first);
3428             goto again;
3429         }
3430         else if (OP(first) == GPOS) {
3431             r->reganch |= ROPT_ANCH_GPOS;
3432             first = NEXTOPER(first);
3433             goto again;
3434         }
3435         else if (!sawopen && (OP(first) == STAR &&
3436             PL_regkind[OP(NEXTOPER(first))] == REG_ANY) &&
3437             !(r->reganch & ROPT_ANCH) )
3438         {
3439             /* turn .* into ^.* with an implied $*=1 */
3440             const int type =
3441                 (OP(NEXTOPER(first)) == REG_ANY)
3442                     ? ROPT_ANCH_MBOL
3443                     : ROPT_ANCH_SBOL;
3444             r->reganch |= type | ROPT_IMPLICIT;
3445             first = NEXTOPER(first);
3446             goto again;
3447         }
3448         if (sawplus && (!sawopen || !RExC_sawback)
3449             && !(RExC_seen & REG_SEEN_EVAL)) /* May examine pos and $& */
3450             /* x+ must match at the 1st pos of run of x's */
3451             r->reganch |= ROPT_SKIP;
3452
3453         /* Scan is after the zeroth branch, first is atomic matcher. */
3454 #ifdef TRIE_STUDY_OPT
3455         DEBUG_COMPILE_r(
3456             if (!restudied)
3457                 PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
3458                               (IV)(first - scan + 1))
3459         );
3460 #else
3461         DEBUG_COMPILE_r(
3462             PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
3463                 (IV)(first - scan + 1))
3464         );
3465 #endif
3466
3467
3468         /*
3469         * If there's something expensive in the r.e., find the
3470         * longest literal string that must appear and make it the
3471         * regmust.  Resolve ties in favor of later strings, since
3472         * the regstart check works with the beginning of the r.e.
3473         * and avoiding duplication strengthens checking.  Not a
3474         * strong reason, but sufficient in the absence of others.
3475         * [Now we resolve ties in favor of the earlier string if
3476         * it happens that c_offset_min has been invalidated, since the
3477         * earlier string may buy us something the later one won't.]
3478         */
3479         minlen = 0;
3480
3481         data.longest_fixed = newSVpvs("");
3482         data.longest_float = newSVpvs("");
3483         data.last_found = newSVpvs("");
3484         data.longest = &(data.longest_fixed);
3485         first = scan;
3486         if (!r->regstclass) {
3487             cl_init(pRExC_state, &ch_class);
3488             data.start_class = &ch_class;
3489             stclass_flag = SCF_DO_STCLASS_AND;
3490         } else                          /* XXXX Check for BOUND? */
3491             stclass_flag = 0;
3492         data.last_closep = &last_close;
3493
3494         minlen = study_chunk(pRExC_state, &first, &fake, scan + RExC_size, /* Up to end */
3495                              &data, SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag,0);
3496
3497 #ifdef TRIE_STUDY_OPT           
3498         if ( (data.flags & SCF_EXACT_TRIE) && ! restudied++ ) {
3499             goto reStudy;
3500         }
3501 #endif  
3502         
3503         if ( RExC_npar == 1 && data.longest == &(data.longest_fixed)
3504              && data.last_start_min == 0 && data.last_end > 0
3505              && !RExC_seen_zerolen
3506              && (!(RExC_seen & REG_SEEN_GPOS) || (r->reganch & ROPT_ANCH_GPOS)))
3507             r->reganch |= ROPT_CHECK_ALL;
3508         scan_commit(pRExC_state, &data);
3509         SvREFCNT_dec(data.last_found);
3510
3511         longest_float_length = CHR_SVLEN(data.longest_float);
3512         if (longest_float_length
3513             || (data.flags & SF_FL_BEFORE_EOL
3514                 && (!(data.flags & SF_FL_BEFORE_MEOL)
3515                     || (RExC_flags & PMf_MULTILINE)))) {
3516             int t;
3517
3518             if (SvCUR(data.longest_fixed)                       /* ok to leave SvCUR */
3519                 && data.offset_fixed == data.offset_float_min
3520                 && SvCUR(data.longest_fixed) == SvCUR(data.longest_float))
3521                     goto remove_float;          /* As in (a)+. */
3522
3523             if (SvUTF8(data.longest_float)) {
3524                 r->float_utf8 = data.longest_float;
3525                 r->float_substr = NULL;
3526             } else {
3527                 r->float_substr = data.longest_float;
3528                 r->float_utf8 = NULL;
3529             }
3530             r->float_min_offset = data.offset_float_min;
3531             r->float_max_offset = data.offset_float_max;
3532             t = (data.flags & SF_FL_BEFORE_EOL /* Can't have SEOL and MULTI */
3533                        && (!(data.flags & SF_FL_BEFORE_MEOL)
3534                            || (RExC_flags & PMf_MULTILINE)));
3535             fbm_compile(data.longest_float, t ? FBMcf_TAIL : 0);
3536         }
3537         else {
3538           remove_float:
3539             r->float_substr = r->float_utf8 = NULL;
3540             SvREFCNT_dec(data.longest_float);
3541             longest_float_length = 0;
3542         }
3543
3544         longest_fixed_length = CHR_SVLEN(data.longest_fixed);
3545         if (longest_fixed_length
3546             || (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
3547                 && (!(data.flags & SF_FIX_BEFORE_MEOL)
3548                     || (RExC_flags & PMf_MULTILINE)))) {
3549             int t;
3550
3551             if (SvUTF8(data.longest_fixed)) {
3552                 r->anchored_utf8 = data.longest_fixed;
3553                 r->anchored_substr = NULL;
3554             } else {
3555                 r->anchored_substr = data.longest_fixed;
3556                 r->anchored_utf8 = NULL;
3557             }
3558             r->anchored_offset = data.offset_fixed;
3559             t = (data.flags & SF_FIX_BEFORE_EOL /* Can't have SEOL and MULTI */
3560                  && (!(data.flags & SF_FIX_BEFORE_MEOL)
3561                      || (RExC_flags & PMf_MULTILINE)));
3562             fbm_compile(data.longest_fixed, t ? FBMcf_TAIL : 0);
3563         }
3564         else {
3565             r->anchored_substr = r->anchored_utf8 = NULL;
3566             SvREFCNT_dec(data.longest_fixed);
3567             longest_fixed_length = 0;
3568         }
3569         if (r->regstclass
3570             && (OP(r->regstclass) == REG_ANY || OP(r->regstclass) == SANY))
3571             r->regstclass = NULL;
3572         if ((!(r->anchored_substr || r->anchored_utf8) || r->anchored_offset)
3573             && stclass_flag
3574             && !(data.start_class->flags & ANYOF_EOS)
3575             && !cl_is_anything(data.start_class))
3576         {
3577             const I32 n = add_data(pRExC_state, 1, "f");
3578
3579             Newx(RExC_rx->data->data[n], 1,
3580                 struct regnode_charclass_class);
3581             StructCopy(data.start_class,
3582                        (struct regnode_charclass_class*)RExC_rx->data->data[n],
3583                        struct regnode_charclass_class);
3584             r->regstclass = (regnode*)RExC_rx->data->data[n];
3585             r->reganch &= ~ROPT_SKIP;   /* Used in find_byclass(). */
3586             DEBUG_COMPILE_r({ SV *sv = sv_newmortal();
3587                       regprop(r, sv, (regnode*)data.start_class);
3588                       PerlIO_printf(Perl_debug_log,
3589                                     "synthetic stclass \"%s\".\n",
3590                                     SvPVX_const(sv));});
3591         }
3592
3593         /* A temporary algorithm prefers floated substr to fixed one to dig more info. */
3594         if (longest_fixed_length > longest_float_length) {
3595             r->check_substr = r->anchored_substr;
3596             r->check_utf8 = r->anchored_utf8;
3597             r->check_offset_min = r->check_offset_max = r->anchored_offset;
3598             if (r->reganch & ROPT_ANCH_SINGLE)
3599                 r->reganch |= ROPT_NOSCAN;
3600         }
3601         else {
3602             r->check_substr = r->float_substr;
3603             r->check_utf8 = r->float_utf8;
3604             r->check_offset_min = data.offset_float_min;
3605             r->check_offset_max = data.offset_float_max;
3606         }
3607         /* XXXX Currently intuiting is not compatible with ANCH_GPOS.
3608            This should be changed ASAP!  */
3609         if ((r->check_substr || r->check_utf8) && !(r->reganch & ROPT_ANCH_GPOS)) {
3610             r->reganch |= RE_USE_INTUIT;
3611             if (SvTAIL(r->check_substr ? r->check_substr : r->check_utf8))
3612                 r->reganch |= RE_INTUIT_TAIL;
3613         }
3614     }
3615     else {
3616         /* Several toplevels. Best we can is to set minlen. */
3617         I32 fake;
3618         struct regnode_charclass_class ch_class;
3619         I32 last_close = 0;
3620         
3621         DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "\n"));
3622
3623         scan = r->program + 1;
3624         cl_init(pRExC_state, &ch_class);
3625         data.start_class = &ch_class;
3626         data.last_closep = &last_close;
3627
3628         minlen = study_chunk(pRExC_state, &scan, &fake, scan + RExC_size,
3629             &data, SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS,0);
3630
3631 #ifdef TRIE_STUDY_OPT
3632         if ( (data.flags & SCF_EXACT_TRIE) && ! restudied++ ) {
3633             goto reStudy;
3634         }
3635 #endif
3636
3637         r->check_substr = r->check_utf8 = r->anchored_substr = r->anchored_utf8
3638                 = r->float_substr = r->float_utf8 = NULL;
3639         if (!(data.start_class->flags & ANYOF_EOS)
3640             && !cl_is_anything(data.start_class))
3641         {
3642             const I32 n = add_data(pRExC_state, 1, "f");
3643
3644             Newx(RExC_rx->data->data[n], 1,
3645                 struct regnode_charclass_class);
3646             StructCopy(data.start_class,
3647                        (struct regnode_charclass_class*)RExC_rx->data->data[n],
3648                        struct regnode_charclass_class);
3649             r->regstclass = (regnode*)RExC_rx->data->data[n];
3650             r->reganch &= ~ROPT_SKIP;   /* Used in find_byclass(). */
3651             DEBUG_COMPILE_r({ SV* sv = sv_newmortal();
3652                       regprop(r, sv, (regnode*)data.start_class);
3653                       PerlIO_printf(Perl_debug_log,
3654                                     "synthetic stclass \"%s\".\n",
3655                                     SvPVX_const(sv));});
3656         }
3657     }
3658
3659     r->minlen = minlen;
3660     if (RExC_seen & REG_SEEN_GPOS)
3661         r->reganch |= ROPT_GPOS_SEEN;
3662     if (RExC_seen & REG_SEEN_LOOKBEHIND)
3663         r->reganch |= ROPT_LOOKBEHIND_SEEN;
3664     if (RExC_seen & REG_SEEN_EVAL)
3665         r->reganch |= ROPT_EVAL_SEEN;
3666     if (RExC_seen & REG_SEEN_CANY)
3667         r->reganch |= ROPT_CANY_SEEN;
3668     Newxz(r->startp, RExC_npar, I32);
3669     Newxz(r->endp, RExC_npar, I32);
3670
3671     DEBUG_r( RX_DEBUG_on(r) );
3672     DEBUG_DUMP_r({
3673         PerlIO_printf(Perl_debug_log,"Final program:\n");
3674         regdump(r);
3675     });
3676     DEBUG_OFFSETS_r(if (r->offsets) {
3677         const U32 len = r->offsets[0];
3678         U32 i;
3679         GET_RE_DEBUG_FLAGS_DECL;
3680         PerlIO_printf(Perl_debug_log, "Offsets: [%"UVuf"]\n\t", (UV)r->offsets[0]);
3681         for (i = 1; i <= len; i++) {
3682             if (r->offsets[i*2-1] || r->offsets[i*2])
3683                 PerlIO_printf(Perl_debug_log, "%"UVuf":%"UVuf"[%"UVuf"] ",
3684                 i, (UV)r->offsets[i*2-1], (UV)r->offsets[i*2]);
3685             }
3686         PerlIO_printf(Perl_debug_log, "\n");
3687     });
3688     return(r);
3689 }
3690
3691
3692 #define DEBUG_PARSE_MSG(funcname)     DEBUG_PARSE_r({           \
3693     int rem=(int)(RExC_end - RExC_parse);                       \
3694     int cut;                                                    \
3695     int num;                                                    \
3696     int iscut=0;                                                \
3697     if (rem>10) {                                               \
3698         rem=10;                                                 \
3699         iscut=1;                                                \
3700     }                                                           \
3701     cut=10-rem;                                                 \
3702     if (RExC_lastparse!=RExC_parse)                             \
3703         PerlIO_printf(Perl_debug_log," >%.*s%-*s",              \
3704             rem, RExC_parse,                                    \
3705             cut + 4,                                            \
3706             iscut ? "..." : "<"                                 \
3707         );                                                      \
3708     else                                                        \
3709         PerlIO_printf(Perl_debug_log,"%16s","");                \
3710                                                                 \
3711     if (SIZE_ONLY)                                              \
3712        num=RExC_size;                                           \
3713     else                                                        \
3714        num=REG_NODE_NUM(RExC_emit);                             \
3715     if (RExC_lastnum!=num)                                      \
3716        PerlIO_printf(Perl_debug_log,"|%4d",num);                 \
3717     else                                                        \
3718        PerlIO_printf(Perl_debug_log,"|%4s","");                  \
3719     PerlIO_printf(Perl_debug_log,"|%*s%-4s",                    \
3720         (int)((depth*2)), "",                                   \
3721         (funcname)                                              \
3722     );                                                          \
3723     RExC_lastnum=num;                                           \
3724     RExC_lastparse=RExC_parse;                                  \
3725 })
3726
3727
3728
3729 #define DEBUG_PARSE(funcname)     DEBUG_PARSE_r({           \
3730     DEBUG_PARSE_MSG((funcname));                            \
3731     PerlIO_printf(Perl_debug_log,"%4s","\n");               \
3732 })
3733 /*
3734  - reg - regular expression, i.e. main body or parenthesized thing
3735  *
3736  * Caller must absorb opening parenthesis.
3737  *
3738  * Combining parenthesis handling with the base level of regular expression
3739  * is a trifle forced, but the need to tie the tails of the branches to what
3740  * follows makes it hard to avoid.
3741  */
3742 #define REGTAIL(x,y,z) regtail((x),(y),(z),depth+1)
3743 #ifdef DEBUGGING
3744 #define REGTAIL_STUDY(x,y,z) regtail_study((x),(y),(z),depth+1)
3745 #else
3746 #define REGTAIL_STUDY(x,y,z) regtail((x),(y),(z),depth+1)
3747 #endif
3748
3749 STATIC regnode *
3750 S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
3751     /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
3752 {
3753     dVAR;
3754     register regnode *ret;              /* Will be the head of the group. */
3755     register regnode *br;
3756     register regnode *lastbr;
3757     register regnode *ender = NULL;
3758     register I32 parno = 0;
3759     I32 flags;
3760     const I32 oregflags = RExC_flags;
3761     bool have_branch = 0;
3762     bool is_open = 0;
3763
3764     /* for (?g), (?gc), and (?o) warnings; warning
3765        about (?c) will warn about (?g) -- japhy    */
3766
3767 #define WASTED_O  0x01
3768 #define WASTED_G  0x02
3769 #define WASTED_C  0x04
3770 #define WASTED_GC (0x02|0x04)
3771     I32 wastedflags = 0x00;
3772
3773     char * parse_start = RExC_parse; /* MJD */
3774     char * const oregcomp_parse = RExC_parse;
3775
3776     GET_RE_DEBUG_FLAGS_DECL;
3777     DEBUG_PARSE("reg ");
3778
3779
3780     *flagp = 0;                         /* Tentatively. */
3781
3782
3783     /* Make an OPEN node, if parenthesized. */
3784     if (paren) {
3785         if (*RExC_parse == '?') { /* (?...) */
3786             U32 posflags = 0, negflags = 0;
3787             U32 *flagsp = &posflags;
3788             bool is_logical = 0;
3789             const char * const seqstart = RExC_parse;
3790
3791             RExC_parse++;
3792             paren = *RExC_parse++;
3793             ret = NULL;                 /* For look-ahead/behind. */
3794             switch (paren) {
3795             case '<':           /* (?<...) */
3796                 RExC_seen |= REG_SEEN_LOOKBEHIND;
3797                 if (*RExC_parse == '!')
3798                     paren = ',';
3799                 if (*RExC_parse != '=' && *RExC_parse != '!')
3800                     goto unknown;
3801                 RExC_parse++;
3802             case '=':           /* (?=...) */
3803             case '!':           /* (?!...) */
3804                 RExC_seen_zerolen++;
3805             case ':':           /* (?:...) */
3806             case '>':           /* (?>...) */
3807                 break;
3808             case '$':           /* (?$...) */
3809             case '@':           /* (?@...) */
3810                 vFAIL2("Sequence (?%c...) not implemented", (int)paren);
3811                 break;
3812             case '#':           /* (?#...) */
3813                 while (*RExC_parse && *RExC_parse != ')')
3814                     RExC_parse++;
3815                 if (*RExC_parse != ')')
3816                     FAIL("Sequence (?#... not terminated");
3817                 nextchar(pRExC_state);
3818                 *flagp = TRYAGAIN;
3819                 return NULL;
3820             case 'p':           /* (?p...) */
3821                 if (SIZE_ONLY && ckWARN2(WARN_DEPRECATED, WARN_REGEXP))
3822                     vWARNdep(RExC_parse, "(?p{}) is deprecated - use (??{})");
3823                 /* FALL THROUGH*/
3824             case '?':           /* (??...) */
3825                 is_logical = 1;
3826                 if (*RExC_parse != '{')
3827                     goto unknown;
3828                 paren = *RExC_parse++;
3829                 /* FALL THROUGH */
3830             case '{':           /* (?{...}) */
3831             {
3832                 I32 count = 1, n = 0;
3833                 char c;
3834                 char *s = RExC_parse;
3835
3836                 RExC_seen_zerolen++;
3837                 RExC_seen |= REG_SEEN_EVAL;
3838                 while (count && (c = *RExC_parse)) {
3839                     if (c == '\\') {
3840                         if (RExC_parse[1])
3841                             RExC_parse++;
3842                     }
3843                     else if (c == '{')
3844                         count++;
3845                     else if (c == '}')
3846                         count--;
3847                     RExC_parse++;
3848                 }
3849                 if (*RExC_parse != ')') {
3850                     RExC_parse = s;             
3851                     vFAIL("Sequence (?{...}) not terminated or not {}-balanced");
3852                 }
3853                 if (!SIZE_ONLY) {
3854                     PAD *pad;
3855                     OP_4tree *sop, *rop;
3856                     SV * const sv = newSVpvn(s, RExC_parse - 1 - s);
3857
3858                     ENTER;
3859                     Perl_save_re_context(aTHX);
3860                     rop = sv_compile_2op(sv, &sop, "re", &pad);
3861                     sop->op_private |= OPpREFCOUNTED;
3862                     /* re_dup will OpREFCNT_inc */
3863                     OpREFCNT_set(sop, 1);
3864                     LEAVE;
3865
3866                     n = add_data(pRExC_state, 3, "nop");
3867                     RExC_rx->data->data[n] = (void*)rop;
3868                     RExC_rx->data->data[n+1] = (void*)sop;
3869                     RExC_rx->data->data[n+2] = (void*)pad;
3870                     SvREFCNT_dec(sv);
3871                 }
3872                 else {                                          /* First pass */
3873                     if (PL_reginterp_cnt < ++RExC_seen_evals
3874                         && IN_PERL_RUNTIME)
3875                         /* No compiled RE interpolated, has runtime
3876                            components ===> unsafe.  */
3877                         FAIL("Eval-group not allowed at runtime, use re 'eval'");
3878                     if (PL_tainting && PL_tainted)
3879                         FAIL("Eval-group in insecure regular expression");
3880 #if PERL_VERSION > 8
3881                     if (IN_PERL_COMPILETIME)
3882                         PL_cv_has_eval = 1;
3883 #endif
3884                 }
3885
3886                 nextchar(pRExC_state);
3887                 if (is_logical) {
3888                     ret = reg_node(pRExC_state, LOGICAL);
3889                     if (!SIZE_ONLY)
3890                         ret->flags = 2;
3891                     REGTAIL(pRExC_state, ret, reganode(pRExC_state, EVAL, n));
3892                     /* deal with the length of this later - MJD */
3893                     return ret;
3894                 }
3895                 ret = reganode(pRExC_state, EVAL, n);
3896                 Set_Node_Length(ret, RExC_parse - parse_start + 1);
3897                 Set_Node_Offset(ret, parse_start);
3898                 return ret;
3899             }
3900             case '(':           /* (?(?{...})...) and (?(?=...)...) */
3901             {
3902                 if (RExC_parse[0] == '?') {        /* (?(?...)) */
3903                     if (RExC_parse[1] == '=' || RExC_parse[1] == '!'
3904                         || RExC_parse[1] == '<'
3905                         || RExC_parse[1] == '{') { /* Lookahead or eval. */
3906                         I32 flag;
3907                         
3908                         ret = reg_node(pRExC_state, LOGICAL);
3909                         if (!SIZE_ONLY)
3910                             ret->flags = 1;
3911                         REGTAIL(pRExC_state, ret, reg(pRExC_state, 1, &flag,depth+1));
3912                         goto insert_if;
3913                     }
3914                 }
3915                 else if (RExC_parse[0] >= '1' && RExC_parse[0] <= '9' ) {
3916                     /* (?(1)...) */
3917                     char c;
3918                     parno = atoi(RExC_parse++);
3919
3920                     while (isDIGIT(*RExC_parse))
3921                         RExC_parse++;
3922                     ret = reganode(pRExC_state, GROUPP, parno);
3923
3924                     if ((c = *nextchar(pRExC_state)) != ')')
3925                         vFAIL("Switch condition not recognized");
3926                   insert_if:
3927                     REGTAIL(pRExC_state, ret, reganode(pRExC_state, IFTHEN, 0));
3928                     br = regbranch(pRExC_state, &flags, 1,depth+1);
3929                     if (br == NULL)
3930                         br = reganode(pRExC_state, LONGJMP, 0);
3931                     else
3932                         REGTAIL(pRExC_state, br, reganode(pRExC_state, LONGJMP, 0));
3933                     c = *nextchar(pRExC_state);
3934                     if (flags&HASWIDTH)
3935                         *flagp |= HASWIDTH;
3936                     if (c == '|') {
3937                         lastbr = reganode(pRExC_state, IFTHEN, 0); /* Fake one for optimizer. */
3938                         regbranch(pRExC_state, &flags, 1,depth+1);
3939                         REGTAIL(pRExC_state, ret, lastbr);
3940                         if (flags&HASWIDTH)
3941                             *flagp |= HASWIDTH;
3942                         c = *nextchar(pRExC_state);
3943                     }
3944                     else
3945                         lastbr = NULL;
3946                     if (c != ')')
3947                         vFAIL("Switch (?(condition)... contains too many branches");
3948                     ender = reg_node(pRExC_state, TAIL);
3949                     REGTAIL(pRExC_state, br, ender);
3950                     if (lastbr) {
3951                         REGTAIL(pRExC_state, lastbr, ender);
3952                         REGTAIL(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender);
3953                     }
3954                     else
3955                         REGTAIL(pRExC_state, ret, ender);
3956                     return ret;
3957                 }
3958                 else {
3959                     vFAIL2("Unknown switch condition (?(%.2s", RExC_parse);
3960                 }
3961             }
3962             case 0:
3963                 RExC_parse--; /* for vFAIL to print correctly */
3964                 vFAIL("Sequence (? incomplete");
3965                 break;
3966             default:
3967                 --RExC_parse;
3968               parse_flags:      /* (?i) */
3969                 while (*RExC_parse && strchr("iogcmsx", *RExC_parse)) {
3970                     /* (?g), (?gc) and (?o) are useless here
3971                        and must be globally applied -- japhy */
3972
3973                     if (*RExC_parse == 'o' || *RExC_parse == 'g') {
3974                         if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
3975                             const I32 wflagbit = *RExC_parse == 'o' ? WASTED_O : WASTED_G;
3976                             if (! (wastedflags & wflagbit) ) {
3977                                 wastedflags |= wflagbit;
3978                                 vWARN5(
3979                                     RExC_parse + 1,
3980                                     "Useless (%s%c) - %suse /%c modifier",
3981                                     flagsp == &negflags ? "?-" : "?",
3982                                     *RExC_parse,
3983                                     flagsp == &negflags ? "don't " : "",
3984                                     *RExC_parse
3985                                 );
3986                             }
3987                         }
3988                     }
3989                     else if (*RExC_parse == 'c') {
3990                         if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
3991                             if (! (wastedflags & WASTED_C) ) {
3992                                 wastedflags |= WASTED_GC;
3993                                 vWARN3(
3994                                     RExC_parse + 1,
3995                                     "Useless (%sc) - %suse /gc modifier",
3996                                     flagsp == &negflags ? "?-" : "?",
3997                                     flagsp == &negflags ? "don't " : ""
3998                                 );
3999                             }
4000                         }
4001                     }
4002                     else { pmflag(flagsp, *RExC_parse); }
4003
4004                     ++RExC_parse;
4005                 }
4006                 if (*RExC_parse == '-') {
4007                     flagsp = &negflags;
4008                     wastedflags = 0;  /* reset so (?g-c) warns twice */
4009                     ++RExC_parse;
4010                     goto parse_flags;
4011                 }
4012                 RExC_flags |= posflags;
4013                 RExC_flags &= ~negflags;
4014                 if (*RExC_parse == ':') {
4015                     RExC_parse++;
4016                     paren = ':';
4017                     break;
4018                 }               
4019               unknown:
4020                 if (*RExC_parse != ')') {
4021                     RExC_parse++;
4022                     vFAIL3("Sequence (%.*s...) not recognized", RExC_parse-seqstart, seqstart);
4023                 }
4024                 nextchar(pRExC_state);
4025                 *flagp = TRYAGAIN;
4026                 return NULL;
4027             }
4028         }
4029         else {                  /* (...) */
4030             parno = RExC_npar;
4031             RExC_npar++;
4032             ret = reganode(pRExC_state, OPEN, parno);
4033             Set_Node_Length(ret, 1); /* MJD */
4034             Set_Node_Offset(ret, RExC_parse); /* MJD */
4035             is_open = 1;
4036         }
4037     }
4038     else                        /* ! paren */
4039         ret = NULL;
4040
4041     /* Pick up the branches, linking them together. */
4042     parse_start = RExC_parse;   /* MJD */
4043     br = regbranch(pRExC_state, &flags, 1,depth+1);
4044     /*     branch_len = (paren != 0); */
4045
4046     if (br == NULL)
4047         return(NULL);
4048     if (*RExC_parse == '|') {
4049         if (!SIZE_ONLY && RExC_extralen) {
4050             reginsert(pRExC_state, BRANCHJ, br);
4051         }
4052         else {                  /* MJD */
4053             reginsert(pRExC_state, BRANCH, br);
4054             Set_Node_Length(br, paren != 0);
4055             Set_Node_Offset_To_R(br-RExC_emit_start, parse_start-RExC_start);
4056         }
4057         have_branch = 1;
4058         if (SIZE_ONLY)
4059             RExC_extralen += 1;         /* For BRANCHJ-BRANCH. */
4060     }
4061     else if (paren == ':') {
4062         *flagp |= flags&SIMPLE;
4063     }
4064     if (is_open) {                              /* Starts with OPEN. */
4065         REGTAIL(pRExC_state, ret, br);          /* OPEN -> first. */
4066     }
4067     else if (paren != '?')              /* Not Conditional */
4068         ret = br;
4069     *flagp |= flags & (SPSTART | HASWIDTH);
4070     lastbr = br;
4071     while (*RExC_parse == '|') {
4072         if (!SIZE_ONLY && RExC_extralen) {
4073             ender = reganode(pRExC_state, LONGJMP,0);
4074             REGTAIL(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender); /* Append to the previous. */
4075         }
4076         if (SIZE_ONLY)
4077             RExC_extralen += 2;         /* Account for LONGJMP. */
4078         nextchar(pRExC_state);
4079         br = regbranch(pRExC_state, &flags, 0, depth+1);
4080
4081         if (br == NULL)
4082             return(NULL);
4083         REGTAIL(pRExC_state, lastbr, br);               /* BRANCH -> BRANCH. */
4084         lastbr = br;
4085         if (flags&HASWIDTH)
4086             *flagp |= HASWIDTH;
4087         *flagp |= flags&SPSTART;
4088     }
4089
4090     if (have_branch || paren != ':') {
4091         /* Make a closing node, and hook it on the end. */
4092         switch (paren) {
4093         case ':':
4094             ender = reg_node(pRExC_state, TAIL);
4095             break;
4096         case 1:
4097             ender = reganode(pRExC_state, CLOSE, parno);
4098             Set_Node_Offset(ender,RExC_parse+1); /* MJD */
4099             Set_Node_Length(ender,1); /* MJD */
4100             break;
4101         case '<':
4102         case ',':
4103         case '=':
4104         case '!':
4105             *flagp &= ~HASWIDTH;
4106             /* FALL THROUGH */
4107         case '>':
4108             ender = reg_node(pRExC_state, SUCCEED);
4109             break;
4110         case 0:
4111             ender = reg_node(pRExC_state, END);
4112             break;
4113         }
4114         REGTAIL_STUDY(pRExC_state, lastbr, ender);
4115
4116         if (have_branch && !SIZE_ONLY) {
4117             /* Hook the tails of the branches to the closing node. */
4118             for (br = ret; br; br = regnext(br)) {
4119                 const U8 op = PL_regkind[OP(br)];
4120                 if (op == BRANCH) {
4121                     REGTAIL_STUDY(pRExC_state, NEXTOPER(br), ender);
4122                 }
4123                 else if (op == BRANCHJ) {
4124                     REGTAIL_STUDY(pRExC_state, NEXTOPER(NEXTOPER(br)), ender);
4125                 }
4126             }
4127         }
4128     }
4129
4130     {
4131         const char *p;
4132         static const char parens[] = "=!<,>";
4133
4134         if (paren && (p = strchr(parens, paren))) {
4135             U8 node = ((p - parens) % 2) ? UNLESSM : IFMATCH;
4136             int flag = (p - parens) > 1;
4137
4138             if (paren == '>')
4139                 node = SUSPEND, flag = 0;
4140             reginsert(pRExC_state, node,ret);
4141             Set_Node_Cur_Length(ret);
4142             Set_Node_Offset(ret, parse_start + 1);
4143             ret->flags = flag;
4144             REGTAIL_STUDY(pRExC_state, ret, reg_node(pRExC_state, TAIL));
4145         }
4146     }
4147
4148     /* Check for proper termination. */
4149     if (paren) {
4150         RExC_flags = oregflags;
4151         if (RExC_parse >= RExC_end || *nextchar(pRExC_state) != ')') {
4152             RExC_parse = oregcomp_parse;
4153             vFAIL("Unmatched (");
4154         }
4155     }
4156     else if (!paren && RExC_parse < RExC_end) {
4157         if (*RExC_parse == ')') {
4158             RExC_parse++;
4159             vFAIL("Unmatched )");
4160         }
4161         else
4162             FAIL("Junk on end of regexp");      /* "Can't happen". */
4163         /* NOTREACHED */
4164     }
4165
4166     return(ret);
4167 }
4168
4169 /*
4170  - regbranch - one alternative of an | operator
4171  *
4172  * Implements the concatenation operator.
4173  */
4174 STATIC regnode *
4175 S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first, U32 depth)
4176 {
4177     dVAR;
4178     register regnode *ret;
4179     register regnode *chain = NULL;
4180     register regnode *latest;
4181     I32 flags = 0, c = 0;
4182     GET_RE_DEBUG_FLAGS_DECL;
4183     DEBUG_PARSE("brnc");
4184     if (first)
4185         ret = NULL;
4186     else {
4187         if (!SIZE_ONLY && RExC_extralen)
4188             ret = reganode(pRExC_state, BRANCHJ,0);
4189         else {
4190             ret = reg_node(pRExC_state, BRANCH);
4191             Set_Node_Length(ret, 1);
4192         }
4193     }
4194         
4195     if (!first && SIZE_ONLY)
4196         RExC_extralen += 1;                     /* BRANCHJ */
4197
4198     *flagp = WORST;                     /* Tentatively. */
4199
4200     RExC_parse--;
4201     nextchar(pRExC_state);
4202     while (RExC_parse < RExC_end && *RExC_parse != '|' && *RExC_parse != ')') {
4203         flags &= ~TRYAGAIN;
4204         latest = regpiece(pRExC_state, &flags,depth+1);
4205         if (latest == NULL) {
4206             if (flags & TRYAGAIN)
4207                 continue;
4208             return(NULL);
4209         }
4210         else if (ret == NULL)
4211             ret = latest;
4212         *flagp |= flags&HASWIDTH;
4213         if (chain == NULL)      /* First piece. */
4214             *flagp |= flags&SPSTART;
4215         else {
4216             RExC_naughty++;
4217             REGTAIL(pRExC_state, chain, latest);
4218         }
4219         chain = latest;
4220         c++;
4221     }
4222     if (chain == NULL) {        /* Loop ran zero times. */
4223         chain = reg_node(pRExC_state, NOTHING);
4224         if (ret == NULL)
4225             ret = chain;
4226     }
4227     if (c == 1) {
4228         *flagp |= flags&SIMPLE;
4229     }
4230
4231     return ret;
4232 }
4233
4234 /*
4235  - regpiece - something followed by possible [*+?]
4236  *
4237  * Note that the branching code sequences used for ? and the general cases
4238  * of * and + are somewhat optimized:  they use the same NOTHING node as
4239  * both the endmarker for their branch list and the body of the last branch.
4240  * It might seem that this node could be dispensed with entirely, but the
4241  * endmarker role is not redundant.
4242  */
4243 STATIC regnode *
4244 S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
4245 {
4246     dVAR;
4247     register regnode *ret;
4248     register char op;
4249     register char *next;
4250     I32 flags;
4251     const char * const origparse = RExC_parse;
4252     I32 min;
4253     I32 max = REG_INFTY;
4254     char *parse_start;
4255     GET_RE_DEBUG_FLAGS_DECL;
4256     DEBUG_PARSE("piec");
4257
4258     ret = regatom(pRExC_state, &flags,depth+1);
4259     if (ret == NULL) {
4260         if (flags & TRYAGAIN)
4261             *flagp |= TRYAGAIN;
4262         return(NULL);
4263     }
4264
4265     op = *RExC_parse;
4266
4267     if (op == '{' && regcurly(RExC_parse)) {
4268         const char *maxpos = NULL;
4269         parse_start = RExC_parse; /* MJD */
4270         next = RExC_parse + 1;
4271         while (isDIGIT(*next) || *next == ',') {
4272             if (*next == ',') {
4273                 if (maxpos)
4274                     break;
4275                 else
4276                     maxpos = next;
4277             }
4278             next++;
4279         }
4280         if (*next == '}') {             /* got one */
4281             if (!maxpos)
4282                 maxpos = next;
4283             RExC_parse++;
4284             min = atoi(RExC_parse);
4285             if (*maxpos == ',')
4286                 maxpos++;
4287             else
4288                 maxpos = RExC_parse;
4289             max = atoi(maxpos);
4290             if (!max && *maxpos != '0')
4291                 max = REG_INFTY;                /* meaning "infinity" */
4292             else if (max >= REG_INFTY)
4293                 vFAIL2("Quantifier in {,} bigger than %d", REG_INFTY - 1);
4294             RExC_parse = next;
4295             nextchar(pRExC_state);
4296
4297         do_curly:
4298             if ((flags&SIMPLE)) {
4299                 RExC_naughty += 2 + RExC_naughty / 2;
4300                 reginsert(pRExC_state, CURLY, ret);
4301                 Set_Node_Offset(ret, parse_start+1); /* MJD */
4302                 Set_Node_Cur_Length(ret);
4303             }
4304             else {
4305                 regnode * const w = reg_node(pRExC_state, WHILEM);
4306
4307                 w->flags = 0;
4308                 REGTAIL(pRExC_state, ret, w);
4309                 if (!SIZE_ONLY && RExC_extralen) {
4310                     reginsert(pRExC_state, LONGJMP,ret);
4311                     reginsert(pRExC_state, NOTHING,ret);
4312                     NEXT_OFF(ret) = 3;  /* Go over LONGJMP. */
4313                 }
4314                 reginsert(pRExC_state, CURLYX,ret);
4315                                 /* MJD hk */
4316                 Set_Node_Offset(ret, parse_start+1);
4317                 Set_Node_Length(ret,
4318                                 op == '{' ? (RExC_parse - parse_start) : 1);
4319
4320                 if (!SIZE_ONLY && RExC_extralen)
4321                     NEXT_OFF(ret) = 3;  /* Go over NOTHING to LONGJMP. */
4322                 REGTAIL(pRExC_state, ret, reg_node(pRExC_state, NOTHING));
4323                 if (SIZE_ONLY)
4324                     RExC_whilem_seen++, RExC_extralen += 3;
4325                 RExC_naughty += 4 + RExC_naughty;       /* compound interest */
4326             }
4327             ret->flags = 0;
4328
4329             if (min > 0)
4330                 *flagp = WORST;
4331             if (max > 0)
4332                 *flagp |= HASWIDTH;
4333             if (max && max < min)
4334                 vFAIL("Can't do {n,m} with n > m");
4335             if (!SIZE_ONLY) {
4336                 ARG1_SET(ret, (U16)min);
4337                 ARG2_SET(ret, (U16)max);
4338             }
4339
4340             goto nest_check;
4341         }
4342     }
4343
4344     if (!ISMULT1(op)) {
4345         *flagp = flags;
4346         return(ret);
4347     }
4348
4349 #if 0                           /* Now runtime fix should be reliable. */
4350
4351     /* if this is reinstated, don't forget to put this back into perldiag:
4352
4353             =item Regexp *+ operand could be empty at {#} in regex m/%s/
4354
4355            (F) The part of the regexp subject to either the * or + quantifier
4356            could match an empty string. The {#} shows in the regular
4357            expression about where the problem was discovered.
4358
4359     */
4360
4361     if (!(flags&HASWIDTH) && op != '?')
4362       vFAIL("Regexp *+ operand could be empty");
4363 #endif
4364
4365     parse_start = RExC_parse;
4366     nextchar(pRExC_state);
4367
4368     *flagp = (op != '+') ? (WORST|SPSTART|HASWIDTH) : (WORST|HASWIDTH);
4369
4370     if (op == '*' && (flags&SIMPLE)) {
4371         reginsert(pRExC_state, STAR, ret);
4372         ret->flags = 0;
4373         RExC_naughty += 4;
4374     }
4375     else if (op == '*') {
4376         min = 0;
4377         goto do_curly;
4378     }
4379     else if (op == '+' && (flags&SIMPLE)) {
4380         reginsert(pRExC_state, PLUS, ret);
4381         ret->flags = 0;
4382         RExC_naughty += 3;
4383     }
4384     else if (op == '+') {
4385         min = 1;
4386         goto do_curly;
4387     }
4388     else if (op == '?') {
4389         min = 0; max = 1;
4390         goto do_curly;
4391     }
4392   nest_check:
4393     if (!SIZE_ONLY && !(flags&HASWIDTH) && max > REG_INFTY/3 && ckWARN(WARN_REGEXP)) {
4394         vWARN3(RExC_parse,
4395                "%.*s matches null string many times",
4396                (int)(RExC_parse >= origparse ? RExC_parse - origparse : 0),
4397                origparse);
4398     }
4399
4400     if (*RExC_parse == '?') {
4401         nextchar(pRExC_state);
4402         reginsert(pRExC_state, MINMOD, ret);
4403         REGTAIL(pRExC_state, ret, ret + NODE_STEP_REGNODE);
4404     }
4405     if (ISMULT2(RExC_parse)) {
4406         RExC_parse++;
4407         vFAIL("Nested quantifiers");
4408     }
4409
4410     return(ret);
4411 }
4412
4413 /*
4414  - regatom - the lowest level
4415  *
4416  * Optimization:  gobbles an entire sequence of ordinary characters so that
4417  * it can turn them into a single node, which is smaller to store and
4418  * faster to run.  Backslashed characters are exceptions, each becoming a
4419  * separate node; the code is simpler that way and it's not worth fixing.
4420  *
4421  * [Yes, it is worth fixing, some scripts can run twice the speed.]
4422  * [It looks like its ok, as in S_study_chunk we merge adjacent EXACT nodes]
4423  */
4424 STATIC regnode *
4425 S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
4426 {
4427     dVAR;
4428     register regnode *ret = NULL;
4429     I32 flags;
4430     char *parse_start = RExC_parse;
4431     GET_RE_DEBUG_FLAGS_DECL;
4432     DEBUG_PARSE("atom");
4433     *flagp = WORST;             /* Tentatively. */
4434
4435 tryagain:
4436     switch (*RExC_parse) {
4437     case '^':
4438         RExC_seen_zerolen++;
4439         nextchar(pRExC_state);
4440         if (RExC_flags & PMf_MULTILINE)
4441             ret = reg_node(pRExC_state, MBOL);
4442         else if (RExC_flags & PMf_SINGLELINE)
4443             ret = reg_node(pRExC_state, SBOL);
4444         else
4445             ret = reg_node(pRExC_state, BOL);
4446         Set_Node_Length(ret, 1); /* MJD */
4447         break;
4448     case '$':
4449         nextchar(pRExC_state);
4450         if (*RExC_parse)
4451             RExC_seen_zerolen++;
4452         if (RExC_flags & PMf_MULTILINE)
4453             ret = reg_node(pRExC_state, MEOL);
4454         else if (RExC_flags & PMf_SINGLELINE)
4455             ret = reg_node(pRExC_state, SEOL);
4456         else
4457             ret = reg_node(pRExC_state, EOL);
4458         Set_Node_Length(ret, 1); /* MJD */
4459         break;
4460     case '.':
4461         nextchar(pRExC_state);
4462         if (RExC_flags & PMf_SINGLELINE)
4463             ret = reg_node(pRExC_state, SANY);
4464         else
4465             ret = reg_node(pRExC_state, REG_ANY);
4466         *flagp |= HASWIDTH|SIMPLE;
4467         RExC_naughty++;
4468         Set_Node_Length(ret, 1); /* MJD */
4469         break;
4470     case '[':
4471     {
4472         char * const oregcomp_parse = ++RExC_parse;
4473         ret = regclass(pRExC_state,depth+1);
4474         if (*RExC_parse != ']') {
4475             RExC_parse = oregcomp_parse;
4476             vFAIL("Unmatched [");
4477         }
4478         nextchar(pRExC_state);
4479         *flagp |= HASWIDTH|SIMPLE;
4480         Set_Node_Length(ret, RExC_parse - oregcomp_parse + 1); /* MJD */
4481         break;
4482     }
4483     case '(':
4484         nextchar(pRExC_state);
4485         ret = reg(pRExC_state, 1, &flags,depth+1);
4486         if (ret == NULL) {
4487                 if (flags & TRYAGAIN) {
4488                     if (RExC_parse == RExC_end) {
4489                          /* Make parent create an empty node if needed. */
4490                         *flagp |= TRYAGAIN;
4491                         return(NULL);
4492                     }
4493                     goto tryagain;
4494                 }
4495                 return(NULL);
4496         }
4497         *flagp |= flags&(HASWIDTH|SPSTART|SIMPLE);
4498         break;
4499     case '|':
4500     case ')':
4501         if (flags & TRYAGAIN) {
4502             *flagp |= TRYAGAIN;
4503             return NULL;
4504         }
4505         vFAIL("Internal urp");
4506                                 /* Supposed to be caught earlier. */
4507         break;
4508     case '{':
4509         if (!regcurly(RExC_parse)) {
4510             RExC_parse++;
4511             goto defchar;
4512         }
4513         /* FALL THROUGH */
4514     case '?':
4515     case '+':
4516     case '*':
4517         RExC_parse++;
4518         vFAIL("Quantifier follows nothing");
4519         break;
4520     case '\\':
4521         switch (*++RExC_parse) {
4522         case 'A':
4523             RExC_seen_zerolen++;
4524             ret = reg_node(pRExC_state, SBOL);
4525             *flagp |= SIMPLE;
4526             nextchar(pRExC_state);
4527             Set_Node_Length(ret, 2); /* MJD */
4528             break;
4529         case 'G':
4530             ret = reg_node(pRExC_state, GPOS);
4531             RExC_seen |= REG_SEEN_GPOS;
4532             *flagp |= SIMPLE;
4533             nextchar(pRExC_state);
4534             Set_Node_Length(ret, 2); /* MJD */
4535             break;
4536         case 'Z':
4537             ret = reg_node(pRExC_state, SEOL);
4538             *flagp |= SIMPLE;
4539             RExC_seen_zerolen++;                /* Do not optimize RE away */
4540             nextchar(pRExC_state);
4541             break;
4542         case 'z':
4543             ret = reg_node(pRExC_state, EOS);
4544             *flagp |= SIMPLE;
4545             RExC_seen_zerolen++;                /* Do not optimize RE away */
4546             nextchar(pRExC_state);
4547             Set_Node_Length(ret, 2); /* MJD */
4548             break;
4549         case 'C':
4550             ret = reg_node(pRExC_state, CANY);
4551             RExC_seen |= REG_SEEN_CANY;
4552             *flagp |= HASWIDTH|SIMPLE;
4553             nextchar(pRExC_state);
4554             Set_Node_Length(ret, 2); /* MJD */
4555             break;
4556         case 'X':
4557             ret = reg_node(pRExC_state, CLUMP);
4558             *flagp |= HASWIDTH;
4559             nextchar(pRExC_state);
4560             Set_Node_Length(ret, 2); /* MJD */
4561             break;
4562         case 'w':
4563             ret = reg_node(pRExC_state, (U8)(LOC ? ALNUML     : ALNUM));
4564             *flagp |= HASWIDTH|SIMPLE;
4565             nextchar(pRExC_state);
4566             Set_Node_Length(ret, 2); /* MJD */
4567             break;
4568         case 'W':
4569             ret = reg_node(pRExC_state, (U8)(LOC ? NALNUML    : NALNUM));
4570             *flagp |= HASWIDTH|SIMPLE;
4571             nextchar(pRExC_state);
4572             Set_Node_Length(ret, 2); /* MJD */
4573             break;
4574         case 'b':
4575             RExC_seen_zerolen++;
4576             RExC_seen |= REG_SEEN_LOOKBEHIND;
4577             ret = reg_node(pRExC_state, (U8)(LOC ? BOUNDL     : BOUND));
4578             *flagp |= SIMPLE;
4579             nextchar(pRExC_state);
4580             Set_Node_Length(ret, 2); /* MJD */
4581             break;
4582         case 'B':
4583             RExC_seen_zerolen++;
4584             RExC_seen |= REG_SEEN_LOOKBEHIND;
4585             ret = reg_node(pRExC_state, (U8)(LOC ? NBOUNDL    : NBOUND));
4586             *flagp |= SIMPLE;
4587             nextchar(pRExC_state);
4588             Set_Node_Length(ret, 2); /* MJD */
4589             break;
4590         case 's':
4591             ret = reg_node(pRExC_state, (U8)(LOC ? SPACEL     : SPACE));
4592             *flagp |= HASWIDTH|SIMPLE;
4593             nextchar(pRExC_state);
4594             Set_Node_Length(ret, 2); /* MJD */
4595             break;
4596         case 'S':
4597             ret = reg_node(pRExC_state, (U8)(LOC ? NSPACEL    : NSPACE));
4598             *flagp |= HASWIDTH|SIMPLE;
4599             nextchar(pRExC_state);
4600             Set_Node_Length(ret, 2); /* MJD */
4601             break;
4602         case 'd':
4603             ret = reg_node(pRExC_state, DIGIT);
4604             *flagp |= HASWIDTH|SIMPLE;
4605             nextchar(pRExC_state);
4606             Set_Node_Length(ret, 2); /* MJD */
4607             break;
4608         case 'D':
4609             ret = reg_node(pRExC_state, NDIGIT);
4610             *flagp |= HASWIDTH|SIMPLE;
4611             nextchar(pRExC_state);
4612             Set_Node_Length(ret, 2); /* MJD */
4613             break;
4614         case 'p':
4615         case 'P':
4616             {   
4617                 char* const oldregxend = RExC_end;
4618                 char* parse_start = RExC_parse - 2;
4619
4620                 if (RExC_parse[1] == '{') {
4621                   /* a lovely hack--pretend we saw [\pX] instead */
4622                     RExC_end = strchr(RExC_parse, '}');
4623                     if (!RExC_end) {
4624                         const U8 c = (U8)*RExC_parse;
4625                         RExC_parse += 2;
4626                         RExC_end = oldregxend;
4627                         vFAIL2("Missing right brace on \\%c{}", c);
4628                     }
4629                     RExC_end++;
4630                 }
4631                 else {
4632                     RExC_end = RExC_parse + 2;
4633                     if (RExC_end > oldregxend)
4634                         RExC_end = oldregxend;
4635                 }
4636                 RExC_parse--;
4637
4638                 ret = regclass(pRExC_state,depth+1);
4639
4640                 RExC_end = oldregxend;
4641                 RExC_parse--;
4642
4643                 Set_Node_Offset(ret, parse_start + 2);
4644                 Set_Node_Cur_Length(ret);
4645                 nextchar(pRExC_state);
4646                 *flagp |= HASWIDTH|SIMPLE;
4647             }
4648             break;
4649         case 'n':
4650         case 'r':
4651         case 't':
4652         case 'f':
4653         case 'e':
4654         case 'a':
4655         case 'x':
4656         case 'c':
4657         case '0':
4658             goto defchar;
4659         case '1': case '2': case '3': case '4':
4660         case '5': case '6': case '7': case '8': case '9':
4661             {
4662                 const I32 num = atoi(RExC_parse);
4663
4664                 if (num > 9 && num >= RExC_npar)
4665                     goto defchar;
4666                 else {
4667                     char * const parse_start = RExC_parse - 1; /* MJD */
4668                     while (isDIGIT(*RExC_parse))
4669                         RExC_parse++;
4670
4671                     if (!SIZE_ONLY && num > (I32)RExC_rx->nparens)
4672                         vFAIL("Reference to nonexistent group");
4673                     RExC_sawback = 1;
4674                     ret = reganode(pRExC_state,
4675                                    (U8)(FOLD ? (LOC ? REFFL : REFF) : REF),
4676                                    num);
4677                     *flagp |= HASWIDTH;
4678
4679                     /* override incorrect value set in reganode MJD */
4680                     Set_Node_Offset(ret, parse_start+1);
4681                     Set_Node_Cur_Length(ret); /* MJD */
4682                     RExC_parse--;
4683                     nextchar(pRExC_state);
4684                 }
4685             }
4686             break;
4687         case '\0':
4688             if (RExC_parse >= RExC_end)
4689                 FAIL("Trailing \\");
4690             /* FALL THROUGH */
4691         default:
4692             /* Do not generate "unrecognized" warnings here, we fall
4693                back into the quick-grab loop below */
4694             parse_start--;
4695             goto defchar;
4696         }
4697         break;
4698
4699     case '#':
4700         if (RExC_flags & PMf_EXTENDED) {
4701             while (RExC_parse < RExC_end && *RExC_parse != '\n')
4702                 RExC_parse++;
4703             if (RExC_parse < RExC_end)
4704                 goto tryagain;
4705         }
4706         /* FALL THROUGH */
4707
4708     default: {
4709             register STRLEN len;
4710             register UV ender;
4711             register char *p;
4712             char *s;
4713             STRLEN foldlen;
4714             U8 tmpbuf[UTF8_MAXBYTES_CASE+1], *foldbuf;
4715
4716             parse_start = RExC_parse - 1;
4717
4718             RExC_parse++;
4719
4720         defchar:
4721             ender = 0;
4722             ret = reg_node(pRExC_state,
4723                            (U8)(FOLD ? (LOC ? EXACTFL : EXACTF) : EXACT));
4724             s = STRING(ret);
4725             for (len = 0, p = RExC_parse - 1;
4726               len < 127 && p < RExC_end;
4727               len++)
4728             {
4729                 char * const oldp = p;
4730
4731                 if (RExC_flags & PMf_EXTENDED)
4732                     p = regwhite(p, RExC_end);
4733                 switch (*p) {
4734                 case '^':
4735                 case '$':
4736                 case '.':
4737                 case '[':
4738                 case '(':
4739                 case ')':
4740                 case '|':
4741                     goto loopdone;
4742                 case '\\':
4743                     switch (*++p) {
4744                     case 'A':
4745                     case 'C':
4746                     case 'X':
4747                     case 'G':
4748                     case 'Z':
4749                     case 'z':
4750                     case 'w':
4751                     case 'W':
4752                     case 'b':
4753                     case 'B':
4754                     case 's':
4755                     case 'S':
4756                     case 'd':
4757                     case 'D':
4758                     case 'p':
4759                     case 'P':
4760                         --p;
4761                         goto loopdone;
4762                     case 'n':
4763                         ender = '\n';
4764                         p++;
4765                         break;
4766                     case 'r':
4767                         ender = '\r';
4768                         p++;
4769                         break;
4770                     case 't':
4771                         ender = '\t';
4772                         p++;
4773                         break;
4774                     case 'f':
4775                         ender = '\f';
4776                         p++;
4777                         break;
4778                     case 'e':
4779                           ender = ASCII_TO_NATIVE('\033');
4780                         p++;
4781                         break;
4782                     case 'a':
4783                           ender = ASCII_TO_NATIVE('\007');
4784                         p++;
4785                         break;
4786                     case 'x':
4787                         if (*++p == '{') {
4788                             char* const e = strchr(p, '}');
4789         
4790                             if (!e) {
4791                                 RExC_parse = p + 1;
4792                                 vFAIL("Missing right brace on \\x{}");
4793                             }
4794                             else {
4795                                 I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
4796                                     | PERL_SCAN_DISALLOW_PREFIX;
4797                                 STRLEN numlen = e - p - 1;
4798                                 ender = grok_hex(p + 1, &numlen, &flags, NULL);
4799                                 if (ender > 0xff)
4800                                     RExC_utf8 = 1;
4801                                 p = e + 1;
4802                             }
4803                         }
4804                         else {
4805                             I32 flags = PERL_SCAN_DISALLOW_PREFIX;
4806                             STRLEN numlen = 2;
4807                             ender = grok_hex(p, &numlen, &flags, NULL);
4808                             p += numlen;
4809                         }
4810                         break;
4811                     case 'c':
4812                         p++;
4813                         ender = UCHARAT(p++);
4814                         ender = toCTRL(ender);
4815                         break;
4816                     case '0': case '1': case '2': case '3':case '4':
4817                     case '5': case '6': case '7': case '8':case '9':
4818                         if (*p == '0' ||
4819                           (isDIGIT(p[1]) && atoi(p) >= RExC_npar) ) {
4820                             I32 flags = 0;
4821                             STRLEN numlen = 3;
4822                             ender = grok_oct(p, &numlen, &flags, NULL);
4823                             p += numlen;
4824                         }
4825                         else {
4826                             --p;
4827                             goto loopdone;
4828                         }
4829                         break;
4830                     case '\0':
4831                         if (p >= RExC_end)
4832                             FAIL("Trailing \\");
4833                         /* FALL THROUGH */
4834                     default:
4835                         if (!SIZE_ONLY&& isALPHA(*p) && ckWARN(WARN_REGEXP))
4836                             vWARN2(p + 1, "Unrecognized escape \\%c passed through", UCHARAT(p));
4837                         goto normal_default;
4838                     }
4839                     break;
4840                 default:
4841                   normal_default:
4842                     if (UTF8_IS_START(*p) && UTF) {
4843                         STRLEN numlen;
4844                         ender = utf8n_to_uvchr((U8*)p, RExC_end - p,
4845                                                &numlen, UTF8_ALLOW_DEFAULT);
4846                         p += numlen;
4847                     }
4848                     else
4849                         ender = *p++;
4850                     break;
4851                 }
4852                 if (RExC_flags & PMf_EXTENDED)
4853                     p = regwhite(p, RExC_end);
4854                 if (UTF && FOLD) {
4855                     /* Prime the casefolded buffer. */
4856                     ender = toFOLD_uni(ender, tmpbuf, &foldlen);
4857                 }
4858                 if (ISMULT2(p)) { /* Back off on ?+*. */
4859                     if (len)
4860                         p = oldp;
4861                     else if (UTF) {
4862                          if (FOLD) {
4863                               /* Emit all the Unicode characters. */
4864                               STRLEN numlen;
4865                               for (foldbuf = tmpbuf;
4866                                    foldlen;
4867                                    foldlen -= numlen) {
4868                                    ender = utf8_to_uvchr(foldbuf, &numlen);
4869                                    if (numlen > 0) {
4870                                         const STRLEN unilen = reguni(pRExC_state, ender, s);
4871                                         s       += unilen;
4872                                         len     += unilen;
4873                                         /* In EBCDIC the numlen
4874                                          * and unilen can differ. */
4875                                         foldbuf += numlen;
4876                                         if (numlen >= foldlen)
4877                                              break;
4878                                    }
4879                                    else
4880                                         break; /* "Can't happen." */
4881                               }
4882                          }
4883                          else {
4884                               const STRLEN unilen = reguni(pRExC_state, ender, s);
4885                               if (unilen > 0) {
4886                                    s   += unilen;
4887                                    len += unilen;
4888                               }
4889                          }
4890                     }
4891                     else {
4892                         len++;
4893                         REGC((char)ender, s++);
4894                     }
4895                     break;
4896                 }
4897                 if (UTF) {
4898                      if (FOLD) {
4899                           /* Emit all the Unicode characters. */
4900                           STRLEN numlen;
4901                           for (foldbuf = tmpbuf;
4902                                foldlen;
4903                                foldlen -= numlen) {
4904                                ender = utf8_to_uvchr(foldbuf, &numlen);
4905                                if (numlen > 0) {
4906                                     const STRLEN unilen = reguni(pRExC_state, ender, s);
4907                                     len     += unilen;
4908                                     s       += unilen;
4909                                     /* In EBCDIC the numlen
4910                                      * and unilen can differ. */
4911                                     foldbuf += numlen;
4912                                     if (numlen >= foldlen)
4913                                          break;
4914                                }
4915                                else
4916                                     break;
4917                           }
4918                      }
4919                      else {
4920                           const STRLEN unilen = reguni(pRExC_state, ender, s);
4921                           if (unilen > 0) {
4922                                s   += unilen;
4923                                len += unilen;
4924                           }
4925                      }
4926                      len--;
4927                 }
4928                 else
4929                     REGC((char)ender, s++);
4930             }
4931         loopdone:
4932             RExC_parse = p - 1;
4933             Set_Node_Cur_Length(ret); /* MJD */
4934             nextchar(pRExC_state);
4935             {
4936                 /* len is STRLEN which is unsigned, need to copy to signed */
4937                 IV iv = len;
4938                 if (iv < 0)
4939                     vFAIL("Internal disaster");
4940             }
4941             if (len > 0)
4942                 *flagp |= HASWIDTH;
4943             if (len == 1 && UNI_IS_INVARIANT(ender))
4944                 *flagp |= SIMPLE;
4945                 
4946             if (SIZE_ONLY)
4947                 RExC_size += STR_SZ(len);
4948             else {
4949                 STR_LEN(ret) = len;
4950                 RExC_emit += STR_SZ(len);
4951             }
4952         }
4953         break;
4954     }
4955
4956     /* If the encoding pragma is in effect recode the text of
4957      * any EXACT-kind nodes. */
4958     if (PL_encoding && PL_regkind[OP(ret)] == EXACT) {
4959         const STRLEN oldlen = STR_LEN(ret);
4960         SV * const sv = sv_2mortal(newSVpvn(STRING(ret), oldlen));
4961
4962         if (RExC_utf8)
4963             SvUTF8_on(sv);
4964         if (sv_utf8_downgrade(sv, TRUE)) {
4965             const char * const s = sv_recode_to_utf8(sv, PL_encoding);
4966             const STRLEN newlen = SvCUR(sv);
4967
4968             if (SvUTF8(sv))
4969                 RExC_utf8 = 1;
4970             if (!SIZE_ONLY) {
4971                 GET_RE_DEBUG_FLAGS_DECL;
4972                 DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "recode %*s to %*s\n",
4973                                       (int)oldlen, STRING(ret),
4974                                       (int)newlen, s));
4975                 Copy(s, STRING(ret), newlen, char);
4976                 STR_LEN(ret) += newlen - oldlen;
4977                 RExC_emit += STR_SZ(newlen) - STR_SZ(oldlen);
4978             } else
4979                 RExC_size += STR_SZ(newlen) - STR_SZ(oldlen);
4980         }
4981     }
4982
4983     return(ret);
4984 }
4985
4986 STATIC char *
4987 S_regwhite(char *p, const char *e)
4988 {
4989     while (p < e) {
4990         if (isSPACE(*p))
4991             ++p;
4992         else if (*p == '#') {
4993             do {
4994                 p++;
4995             } while (p < e && *p != '\n');
4996         }
4997         else
4998             break;
4999     }
5000     return p;
5001 }
5002
5003 /* Parse POSIX character classes: [[:foo:]], [[=foo=]], [[.foo.]].
5004    Character classes ([:foo:]) can also be negated ([:^foo:]).
5005    Returns a named class id (ANYOF_XXX) if successful, -1 otherwise.
5006    Equivalence classes ([=foo=]) and composites ([.foo.]) are parsed,
5007    but trigger failures because they are currently unimplemented. */
5008
5009 #define POSIXCC_DONE(c)   ((c) == ':')
5010 #define POSIXCC_NOTYET(c) ((c) == '=' || (c) == '.')
5011 #define POSIXCC(c) (POSIXCC_DONE(c) || POSIXCC_NOTYET(c))
5012
5013 STATIC I32
5014 S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value)
5015 {
5016     dVAR;
5017     I32 namedclass = OOB_NAMEDCLASS;
5018
5019     if (value == '[' && RExC_parse + 1 < RExC_end &&
5020         /* I smell either [: or [= or [. -- POSIX has been here, right? */
5021         POSIXCC(UCHARAT(RExC_parse))) {
5022         const char c = UCHARAT(RExC_parse);
5023         char* const s = RExC_parse++;
5024         
5025         while (RExC_parse < RExC_end && UCHARAT(RExC_parse) != c)
5026             RExC_parse++;
5027         if (RExC_parse == RExC_end)
5028             /* Grandfather lone [:, [=, [. */
5029             RExC_parse = s;
5030         else {
5031             const char* const t = RExC_parse++; /* skip over the c */
5032             assert(*t == c);
5033
5034             if (UCHARAT(RExC_parse) == ']') {
5035                 const char *posixcc = s + 1;
5036                 RExC_parse++; /* skip over the ending ] */
5037
5038                 if (*s == ':') {
5039                     const I32 complement = *posixcc == '^' ? *posixcc++ : 0;
5040                     const I32 skip = t - posixcc;
5041
5042                     /* Initially switch on the length of the name.  */
5043                     switch (skip) {
5044                     case 4:
5045                         if (memEQ(posixcc, "word", 4)) /* this is not POSIX, this is the Perl \w */
5046                             namedclass = complement ? ANYOF_NALNUM : ANYOF_ALNUM;
5047                         break;
5048                     case 5:
5049                         /* Names all of length 5.  */
5050                         /* alnum alpha ascii blank cntrl digit graph lower
5051                            print punct space upper  */
5052                         /* Offset 4 gives the best switch position.  */
5053                         switch (posixcc[4]) {
5054                         case 'a':
5055                             if (memEQ(posixcc, "alph", 4)) /* alpha */
5056                                 namedclass = complement ? ANYOF_NALPHA : ANYOF_ALPHA;
5057                             break;
5058                         case 'e':
5059                             if (memEQ(posixcc, "spac", 4)) /* space */
5060                                 namedclass = complement ? ANYOF_NPSXSPC : ANYOF_PSXSPC;
5061                             break;
5062                         case 'h':
5063                             if (memEQ(posixcc, "grap", 4)) /* graph */
5064                                 namedclass = complement ? ANYOF_NGRAPH : ANYOF_GRAPH;
5065                             break;
5066                         case 'i':
5067                             if (memEQ(posixcc, "asci", 4)) /* ascii */
5068                                 namedclass = complement ? ANYOF_NASCII : ANYOF_ASCII;
5069                             break;
5070                         case 'k':
5071                             if (memEQ(posixcc, "blan", 4)) /* blank */
5072                                 namedclass = complement ? ANYOF_NBLANK : ANYOF_BLANK;
5073                             break;
5074                         case 'l':
5075                             if (memEQ(posixcc, "cntr", 4)) /* cntrl */
5076                                 namedclass = complement ? ANYOF_NCNTRL : ANYOF_CNTRL;
5077                             break;
5078                         case 'm':
5079                             if (memEQ(posixcc, "alnu", 4)) /* alnum */
5080                                 namedclass = complement ? ANYOF_NALNUMC : ANYOF_ALNUMC;
5081                             break;
5082                         case 'r':
5083                             if (memEQ(posixcc, "lowe", 4)) /* lower */
5084                                 namedclass = complement ? ANYOF_NLOWER : ANYOF_LOWER;
5085                             else if (memEQ(posixcc, "uppe", 4)) /* upper */
5086                                 namedclass = complement ? ANYOF_NUPPER : ANYOF_UPPER;
5087                             break;
5088                         case 't':
5089                             if (memEQ(posixcc, "digi", 4)) /* digit */
5090                                 namedclass = complement ? ANYOF_NDIGIT : ANYOF_DIGIT;
5091                             else if (memEQ(posixcc, "prin", 4)) /* print */
5092                                 namedclass = complement ? ANYOF_NPRINT : ANYOF_PRINT;
5093                             else if (memEQ(posixcc, "punc", 4)) /* punct */
5094                                 namedclass = complement ? ANYOF_NPUNCT : ANYOF_PUNCT;
5095                             break;
5096                         }
5097                         break;
5098                     case 6:
5099                         if (memEQ(posixcc, "xdigit", 6))
5100                             namedclass = complement ? ANYOF_NXDIGIT : ANYOF_XDIGIT;
5101                         break;
5102                     }
5103
5104                     if (namedclass == OOB_NAMEDCLASS)
5105                         Simple_vFAIL3("POSIX class [:%.*s:] unknown",
5106                                       t - s - 1, s + 1);
5107                     assert (posixcc[skip] == ':');
5108                     assert (posixcc[skip+1] == ']');
5109                 } else if (!SIZE_ONLY) {
5110                     /* [[=foo=]] and [[.foo.]] are still future. */
5111
5112                     /* adjust RExC_parse so the warning shows after
5113                        the class closes */
5114                     while (UCHARAT(RExC_parse) && UCHARAT(RExC_parse) != ']')
5115                         RExC_parse++;
5116                     Simple_vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c);
5117                 }
5118             } else {
5119                 /* Maternal grandfather:
5120                  * "[:" ending in ":" but not in ":]" */
5121                 RExC_parse = s;
5122             }
5123         }
5124     }
5125
5126     return namedclass;
5127 }
5128
5129 STATIC void
5130 S_checkposixcc(pTHX_ RExC_state_t *pRExC_state)
5131 {
5132     dVAR;
5133     if (POSIXCC(UCHARAT(RExC_parse))) {
5134         const char *s = RExC_parse;
5135         const char  c = *s++;
5136
5137         while (isALNUM(*s))
5138             s++;
5139         if (*s && c == *s && s[1] == ']') {
5140             if (ckWARN(WARN_REGEXP))
5141                 vWARN3(s+2,
5142                         "POSIX syntax [%c %c] belongs inside character classes",
5143                         c, c);
5144
5145             /* [[=foo=]] and [[.foo.]] are still future. */
5146             if (POSIXCC_NOTYET(c)) {
5147                 /* adjust RExC_parse so the error shows after
5148                    the class closes */
5149                 while (UCHARAT(RExC_parse) && UCHARAT(RExC_parse++) != ']')
5150                     NOOP;
5151                 Simple_vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c);
5152             }
5153         }
5154     }
5155 }
5156
5157
5158 /*
5159    parse a class specification and produce either an ANYOF node that
5160    matches the pattern. If the pattern matches a single char only and
5161    that char is < 256 then we produce an EXACT node instead.
5162 */
5163 STATIC regnode *
5164 S_regclass(pTHX_ RExC_state_t *pRExC_state, U32 depth)
5165 {
5166     dVAR;
5167     register UV value;
5168     register UV nextvalue;
5169     register IV prevvalue = OOB_UNICODE;
5170     register IV range = 0;
5171     register regnode *ret;
5172     STRLEN numlen;
5173     IV namedclass;
5174     char *rangebegin = NULL;
5175     bool need_class = 0;
5176     SV *listsv = NULL;
5177     UV n;
5178     bool optimize_invert   = TRUE;
5179     AV* unicode_alternate  = NULL;
5180 #ifdef EBCDIC
5181     UV literal_endpoint = 0;
5182 #endif
5183     UV stored = 0;  /* number of chars stored in the class */
5184
5185     regnode * const orig_emit = RExC_emit; /* Save the original RExC_emit in
5186         case we need to change the emitted regop to an EXACT. */
5187     const char * orig_parse = RExC_parse;
5188     GET_RE_DEBUG_FLAGS_DECL;
5189 #ifndef DEBUGGING
5190     PERL_UNUSED_ARG(depth);
5191 #endif
5192
5193     DEBUG_PARSE("clas");
5194
5195     /* Assume we are going to generate an ANYOF node. */
5196     ret = reganode(pRExC_state, ANYOF, 0);
5197
5198     if (!SIZE_ONLY)
5199         ANYOF_FLAGS(ret) = 0;
5200
5201     if (UCHARAT(RExC_parse) == '^') {   /* Complement of range. */
5202         RExC_naughty++;
5203         RExC_parse++;
5204         if (!SIZE_ONLY)
5205             ANYOF_FLAGS(ret) |= ANYOF_INVERT;
5206     }
5207
5208     if (SIZE_ONLY) {
5209         RExC_size += ANYOF_SKIP;
5210         listsv = &PL_sv_undef; /* For code scanners: listsv always non-NULL. */
5211     }
5212     else {
5213         RExC_emit += ANYOF_SKIP;
5214         if (FOLD)
5215             ANYOF_FLAGS(ret) |= ANYOF_FOLD;
5216         if (LOC)
5217             ANYOF_FLAGS(ret) |= ANYOF_LOCALE;
5218         ANYOF_BITMAP_ZERO(ret);
5219         listsv = newSVpvs("# comment\n");
5220     }
5221
5222     nextvalue = RExC_parse < RExC_end ? UCHARAT(RExC_parse) : 0;
5223
5224     if (!SIZE_ONLY && POSIXCC(nextvalue))
5225         checkposixcc(pRExC_state);
5226
5227     /* allow 1st char to be ] (allowing it to be - is dealt with later) */
5228     if (UCHARAT(RExC_parse) == ']')
5229         goto charclassloop;
5230
5231     while (RExC_parse < RExC_end && UCHARAT(RExC_parse) != ']') {
5232
5233     charclassloop:
5234
5235         namedclass = OOB_NAMEDCLASS; /* initialize as illegal */
5236
5237         if (!range)
5238             rangebegin = RExC_parse;
5239         if (UTF) {
5240             value = utf8n_to_uvchr((U8*)RExC_parse,
5241                                    RExC_end - RExC_parse,
5242                                    &numlen, UTF8_ALLOW_DEFAULT);
5243             RExC_parse += numlen;
5244         }
5245         else
5246             value = UCHARAT(RExC_parse++);
5247
5248         nextvalue = RExC_parse < RExC_end ? UCHARAT(RExC_parse) : 0;
5249         if (value == '[' && POSIXCC(nextvalue))
5250             namedclass = regpposixcc(pRExC_state, value);
5251         else if (value == '\\') {
5252             if (UTF) {
5253                 value = utf8n_to_uvchr((U8*)RExC_parse,
5254                                    RExC_end - RExC_parse,
5255                                    &numlen, UTF8_ALLOW_DEFAULT);
5256                 RExC_parse += numlen;
5257             }
5258             else
5259                 value = UCHARAT(RExC_parse++);
5260             /* Some compilers cannot handle switching on 64-bit integer
5261              * values, therefore value cannot be an UV.  Yes, this will
5262              * be a problem later if we want switch on Unicode.
5263              * A similar issue a little bit later when switching on
5264              * namedclass. --jhi */
5265             switch ((I32)value) {
5266             case 'w':   namedclass = ANYOF_ALNUM;       break;
5267             case 'W':   namedclass = ANYOF_NALNUM;      break;
5268             case 's':   namedclass = ANYOF_SPACE;       break;
5269             case 'S':   namedclass = ANYOF_NSPACE;      break;
5270             case 'd':   namedclass = ANYOF_DIGIT;       break;
5271             case 'D':   namedclass = ANYOF_NDIGIT;      break;
5272             case 'p':
5273             case 'P':
5274                 {
5275                 char *e;
5276                 if (RExC_parse >= RExC_end)
5277                     vFAIL2("Empty \\%c{}", (U8)value);
5278                 if (*RExC_parse == '{') {
5279                     const U8 c = (U8)value;
5280                     e = strchr(RExC_parse++, '}');
5281                     if (!e)
5282                         vFAIL2("Missing right brace on \\%c{}", c);
5283                     while (isSPACE(UCHARAT(RExC_parse)))
5284                         RExC_parse++;
5285                     if (e == RExC_parse)
5286                         vFAIL2("Empty \\%c{}", c);
5287                     n = e - RExC_parse;
5288                     while (isSPACE(UCHARAT(RExC_parse + n - 1)))
5289                         n--;
5290                 }
5291                 else {
5292                     e = RExC_parse;
5293                     n = 1;
5294                 }
5295                 if (!SIZE_ONLY) {
5296                     if (UCHARAT(RExC_parse) == '^') {
5297                          RExC_parse++;
5298                          n--;
5299                          value = value == 'p' ? 'P' : 'p'; /* toggle */
5300                          while (isSPACE(UCHARAT(RExC_parse))) {
5301                               RExC_parse++;
5302                               n--;
5303                          }
5304                     }
5305                     Perl_sv_catpvf(aTHX_ listsv, "%cutf8::%.*s\n",
5306                         (value=='p' ? '+' : '!'), (int)n, RExC_parse);
5307                 }
5308                 RExC_parse = e + 1;
5309                 ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
5310                 namedclass = ANYOF_MAX;  /* no official name, but it's named */
5311                 }
5312                 break;
5313             case 'n':   value = '\n';                   break;
5314             case 'r':   value = '\r';                   break;
5315             case 't':   value = '\t';                   break;
5316             case 'f':   value = '\f';                   break;
5317             case 'b':   value = '\b';                   break;
5318             case 'e':   value = ASCII_TO_NATIVE('\033');break;
5319             case 'a':   value = ASCII_TO_NATIVE('\007');break;
5320             case 'x':
5321                 if (*RExC_parse == '{') {
5322                     I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
5323                         | PERL_SCAN_DISALLOW_PREFIX;
5324                     char * const e = strchr(RExC_parse++, '}');
5325                     if (!e)
5326                         vFAIL("Missing right brace on \\x{}");
5327
5328                     numlen = e - RExC_parse;
5329                     value = grok_hex(RExC_parse, &numlen, &flags, NULL);
5330                     RExC_parse = e + 1;
5331                 }
5332                 else {
5333                     I32 flags = PERL_SCAN_DISALLOW_PREFIX;
5334                     numlen = 2;
5335                     value = grok_hex(RExC_parse, &numlen, &flags, NULL);
5336                     RExC_parse += numlen;
5337                 }
5338                 break;
5339             case 'c':
5340                 value = UCHARAT(RExC_parse++);
5341                 value = toCTRL(value);
5342                 break;
5343             case '0': case '1': case '2': case '3': case '4':
5344             case '5': case '6': case '7': case '8': case '9':
5345             {
5346                 I32 flags = 0;
5347                 numlen = 3;
5348                 value = grok_oct(--RExC_parse, &numlen, &flags, NULL);
5349                 RExC_parse += numlen;
5350                 break;
5351             }
5352             default:
5353                 if (!SIZE_ONLY && isALPHA(value) && ckWARN(WARN_REGEXP))
5354                     vWARN2(RExC_parse,
5355                            "Unrecognized escape \\%c in character class passed through",
5356                            (int)value);
5357                 break;
5358             }
5359         } /* end of \blah */
5360 #ifdef EBCDIC
5361         else
5362             literal_endpoint++;
5363 #endif
5364
5365         if (namedclass > OOB_NAMEDCLASS) { /* this is a named class \blah */
5366
5367             if (!SIZE_ONLY && !need_class)
5368                 ANYOF_CLASS_ZERO(ret);
5369
5370             need_class = 1;
5371
5372             /* a bad range like a-\d, a-[:digit:] ? */
5373             if (range) {
5374                 if (!SIZE_ONLY) {
5375                     if (ckWARN(WARN_REGEXP)) {
5376                         const int w =
5377                             RExC_parse >= rangebegin ?
5378                             RExC_parse - rangebegin : 0;
5379                         vWARN4(RExC_parse,
5380                                "False [] range \"%*.*s\"",
5381                                w, w, rangebegin);
5382                     }
5383                     if (prevvalue < 256) {
5384                         ANYOF_BITMAP_SET(ret, prevvalue);
5385                         ANYOF_BITMAP_SET(ret, '-');
5386                     }
5387                     else {
5388                         ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
5389                         Perl_sv_catpvf(aTHX_ listsv,
5390                                        "%04"UVxf"\n%04"UVxf"\n", (UV)prevvalue, (UV) '-');
5391                     }
5392                 }
5393
5394                 range = 0; /* this was not a true range */
5395             }
5396
5397             if (!SIZE_ONLY) {
5398                 const char *what = NULL;
5399                 char yesno = 0;
5400
5401                 if (namedclass > OOB_NAMEDCLASS)
5402                     optimize_invert = FALSE;
5403                 /* Possible truncation here but in some 64-bit environments
5404                  * the compiler gets heartburn about switch on 64-bit values.
5405                  * A similar issue a little earlier when switching on value.
5406                  * --jhi */
5407                 switch ((I32)namedclass) {
5408                 case ANYOF_ALNUM:
5409                     if (LOC)
5410                         ANYOF_CLASS_SET(ret, ANYOF_ALNUM);
5411                     else {
5412                         for (value = 0; value < 256; value++)
5413                             if (isALNUM(value))
5414                                 ANYOF_BITMAP_SET(ret, value);
5415                     }
5416                     yesno = '+';
5417                     what = "Word";      
5418                     break;
5419                 case ANYOF_NALNUM:
5420                     if (LOC)
5421                         ANYOF_CLASS_SET(ret, ANYOF_NALNUM);
5422                     else {
5423                         for (value = 0; value < 256; value++)
5424                             if (!isALNUM(value))
5425                                 ANYOF_BITMAP_SET(ret, value);
5426                     }
5427                     yesno = '!';
5428                     what = "Word";
5429                     break;
5430                 case ANYOF_ALNUMC:
5431                     if (LOC)
5432                         ANYOF_CLASS_SET(ret, ANYOF_ALNUMC);
5433                     else {
5434                         for (value = 0; value < 256; value++)
5435                             if (isALNUMC(value))
5436                                 ANYOF_BITMAP_SET(ret, value);
5437                     }
5438                     yesno = '+';
5439                     what = "Alnum";
5440                     break;
5441                 case ANYOF_NALNUMC:
5442                     if (LOC)
5443                         ANYOF_CLASS_SET(ret, ANYOF_NALNUMC);
5444                     else {
5445                         for (value = 0; value < 256; value++)
5446                             if (!isALNUMC(value))
5447                                 ANYOF_BITMAP_SET(ret, value);
5448                     }
5449                     yesno = '!';
5450                     what = "Alnum";
5451                     break;
5452                 case ANYOF_ALPHA:
5453                     if (LOC)
5454                         ANYOF_CLASS_SET(ret, ANYOF_ALPHA);
5455                     else {
5456                         for (value = 0; value < 256; value++)
5457                             if (isALPHA(value))
5458                                 ANYOF_BITMAP_SET(ret, value);
5459                     }
5460                     yesno = '+';
5461                     what = "Alpha";
5462                     break;
5463                 case ANYOF_NALPHA:
5464                     if (LOC)
5465                         ANYOF_CLASS_SET(ret, ANYOF_NALPHA);
5466                     else {
5467                         for (value = 0; value < 256; value++)
5468                             if (!isALPHA(value))
5469                                 ANYOF_BITMAP_SET(ret, value);
5470                     }
5471                     yesno = '!';
5472                     what = "Alpha";
5473                     break;
5474                 case ANYOF_ASCII:
5475                     if (LOC)
5476                         ANYOF_CLASS_SET(ret, ANYOF_ASCII);
5477                     else {
5478 #ifndef EBCDIC
5479                         for (value = 0; value < 128; value++)
5480                             ANYOF_BITMAP_SET(ret, value);
5481 #else  /* EBCDIC */
5482                         for (value = 0; value < 256; value++) {
5483                             if (isASCII(value))
5484                                 ANYOF_BITMAP_SET(ret, value);
5485                         }
5486 #endif /* EBCDIC */
5487                     }
5488                     yesno = '+';
5489                     what = "ASCII";
5490                     break;
5491                 case ANYOF_NASCII:
5492                     if (LOC)
5493                         ANYOF_CLASS_SET(ret, ANYOF_NASCII);
5494                     else {
5495 #ifndef EBCDIC
5496                         for (value = 128; value < 256; value++)
5497                             ANYOF_BITMAP_SET(ret, value);
5498 #else  /* EBCDIC */
5499                         for (value = 0; value < 256; value++) {
5500                             if (!isASCII(value))
5501                                 ANYOF_BITMAP_SET(ret, value);
5502                         }
5503 #endif /* EBCDIC */
5504                     }
5505                     yesno = '!';
5506                     what = "ASCII";
5507                     break;
5508                 case ANYOF_BLANK:
5509                     if (LOC)
5510                         ANYOF_CLASS_SET(ret, ANYOF_BLANK);
5511                     else {
5512                         for (value = 0; value < 256; value++)
5513                             if (isBLANK(value))
5514                                 ANYOF_BITMAP_SET(ret, value);
5515                     }
5516                     yesno = '+';
5517                     what = "Blank";
5518                     break;
5519                 case ANYOF_NBLANK:
5520                     if (LOC)
5521                         ANYOF_CLASS_SET(ret, ANYOF_NBLANK);
5522                     else {
5523                         for (value = 0; value < 256; value++)
5524                             if (!isBLANK(value))
5525                                 ANYOF_BITMAP_SET(ret, value);
5526                     }
5527                     yesno = '!';
5528                     what = "Blank";
5529                     break;
5530                 case ANYOF_CNTRL:
5531                     if (LOC)
5532                         ANYOF_CLASS_SET(ret, ANYOF_CNTRL);
5533                     else {
5534                         for (value = 0; value < 256; value++)
5535                             if (isCNTRL(value))
5536                                 ANYOF_BITMAP_SET(ret, value);
5537                     }
5538                     yesno = '+';
5539                     what = "Cntrl";
5540                     break;
5541                 case ANYOF_NCNTRL:
5542                     if (LOC)
5543                         ANYOF_CLASS_SET(ret, ANYOF_NCNTRL);
5544                     else {
5545                         for (value = 0; value < 256; value++)
5546                             if (!isCNTRL(value))
5547                                 ANYOF_BITMAP_SET(ret, value);
5548                     }
5549                     yesno = '!';
5550                     what = "Cntrl";
5551                     break;
5552                 case ANYOF_DIGIT:
5553                     if (LOC)
5554                         ANYOF_CLASS_SET(ret, ANYOF_DIGIT);
5555                     else {
5556                         /* consecutive digits assumed */
5557                         for (value = '0'; value <= '9'; value++)
5558                             ANYOF_BITMAP_SET(ret, value);
5559                     }
5560                     yesno = '+';
5561                     what = "Digit";
5562                     break;
5563                 case ANYOF_NDIGIT:
5564                     if (LOC)
5565                         ANYOF_CLASS_SET(ret, ANYOF_NDIGIT);
5566                     else {
5567                         /* consecutive digits assumed */
5568                         for (value = 0; value < '0'; value++)
5569                             ANYOF_BITMAP_SET(ret, value);
5570                         for (value = '9' + 1; value < 256; value++)
5571                             ANYOF_BITMAP_SET(ret, value);
5572                     }
5573                     yesno = '!';
5574                     what = "Digit";
5575                     break;
5576                 case ANYOF_GRAPH:
5577                     if (LOC)
5578                         ANYOF_CLASS_SET(ret, ANYOF_GRAPH);
5579                     else {
5580                         for (value = 0; value < 256; value++)
5581                             if (isGRAPH(value))
5582                                 ANYOF_BITMAP_SET(ret, value);
5583                     }
5584                     yesno = '+';
5585                     what = "Graph";
5586                     break;
5587                 case ANYOF_NGRAPH:
5588                     if (LOC)
5589                         ANYOF_CLASS_SET(ret, ANYOF_NGRAPH);
5590                     else {
5591                         for (value = 0; value < 256; value++)
5592                             if (!isGRAPH(value))
5593                                 ANYOF_BITMAP_SET(ret, value);
5594                     }
5595                     yesno = '!';
5596                     what = "Graph";
5597                     break;
5598                 case ANYOF_LOWER:
5599                     if (LOC)
5600                         ANYOF_CLASS_SET(ret, ANYOF_LOWER);
5601                     else {
5602                         for (value = 0; value < 256; value++)
5603                             if (isLOWER(value))
5604                                 ANYOF_BITMAP_SET(ret, value);
5605                     }
5606                     yesno = '+';
5607                     what = "Lower";
5608                     break;
5609                 case ANYOF_NLOWER:
5610                     if (LOC)
5611                         ANYOF_CLASS_SET(ret, ANYOF_NLOWER);
5612                     else {
5613                         for (value = 0; value < 256; value++)
5614                             if (!isLOWER(value))
5615                                 ANYOF_BITMAP_SET(ret, value);
5616                     }
5617                     yesno = '!';
5618                     what = "Lower";
5619                     break;
5620                 case ANYOF_PRINT:
5621                     if (LOC)
5622                         ANYOF_CLASS_SET(ret, ANYOF_PRINT);
5623                     else {
5624                         for (value = 0; value < 256; value++)
5625                             if (isPRINT(value))
5626                                 ANYOF_BITMAP_SET(ret, value);
5627                     }
5628                     yesno = '+';
5629                     what = "Print";
5630                     break;
5631                 case ANYOF_NPRINT:
5632                     if (LOC)
5633                         ANYOF_CLASS_SET(ret, ANYOF_NPRINT);
5634                     else {
5635                         for (value = 0; value < 256; value++)
5636                             if (!isPRINT(value))
5637                                 ANYOF_BITMAP_SET(ret, value);
5638                     }
5639                     yesno = '!';
5640                     what = "Print";
5641                     break;
5642                 case ANYOF_PSXSPC:
5643                     if (LOC)
5644                         ANYOF_CLASS_SET(ret, ANYOF_PSXSPC);
5645                     else {
5646                         for (value = 0; value < 256; value++)
5647                             if (isPSXSPC(value))
5648                                 ANYOF_BITMAP_SET(ret, value);
5649                     }
5650                     yesno = '+';
5651                     what = "Space";
5652                     break;
5653                 case ANYOF_NPSXSPC:
5654                     if (LOC)
5655                         ANYOF_CLASS_SET(ret, ANYOF_NPSXSPC);
5656                     else {
5657                         for (value = 0; value < 256; value++)
5658                             if (!isPSXSPC(value))
5659                                 ANYOF_BITMAP_SET(ret, value);
5660                     }
5661                     yesno = '!';
5662                     what = "Space";
5663                     break;
5664                 case ANYOF_PUNCT:
5665                     if (LOC)
5666                         ANYOF_CLASS_SET(ret, ANYOF_PUNCT);
5667                     else {
5668                         for (value = 0; value < 256; value++)
5669                             if (isPUNCT(value))
5670                                 ANYOF_BITMAP_SET(ret, value);
5671                     }
5672                     yesno = '+';
5673                     what = "Punct";
5674                     break;
5675                 case ANYOF_NPUNCT:
5676                     if (LOC)
5677                         ANYOF_CLASS_SET(ret, ANYOF_NPUNCT);
5678                     else {
5679                         for (value = 0; value < 256; value++)
5680                             if (!isPUNCT(value))
5681                                 ANYOF_BITMAP_SET(ret, value);
5682                     }
5683                     yesno = '!';
5684                     what = "Punct";
5685                     break;
5686                 case ANYOF_SPACE:
5687                     if (LOC)
5688                         ANYOF_CLASS_SET(ret, ANYOF_SPACE);
5689                     else {
5690                         for (value = 0; value < 256; value++)
5691                             if (isSPACE(value))
5692                                 ANYOF_BITMAP_SET(ret, value);
5693                     }
5694                     yesno = '+';
5695                     what = "SpacePerl";
5696                     break;
5697                 case ANYOF_NSPACE:
5698                     if (LOC)
5699                         ANYOF_CLASS_SET(ret, ANYOF_NSPACE);
5700                     else {
5701                         for (value = 0; value < 256; value++)
5702                             if (!isSPACE(value))
5703                                 ANYOF_BITMAP_SET(ret, value);
5704                     }
5705                     yesno = '!';
5706                     what = "SpacePerl";
5707                     break;
5708                 case ANYOF_UPPER:
5709                     if (LOC)
5710                         ANYOF_CLASS_SET(ret, ANYOF_UPPER);
5711                     else {
5712                         for (value = 0; value < 256; value++)
5713                             if (isUPPER(value))
5714                                 ANYOF_BITMAP_SET(ret, value);
5715                     }
5716                     yesno = '+';
5717                     what = "Upper";
5718                     break;
5719                 case ANYOF_NUPPER:
5720                     if (LOC)
5721                         ANYOF_CLASS_SET(ret, ANYOF_NUPPER);
5722                     else {
5723                         for (value = 0; value < 256; value++)
5724                             if (!isUPPER(value))
5725                                 ANYOF_BITMAP_SET(ret, value);
5726                     }
5727                     yesno = '!';
5728                     what = "Upper";
5729                     break;
5730                 case ANYOF_XDIGIT:
5731                     if (LOC)
5732                         ANYOF_CLASS_SET(ret, ANYOF_XDIGIT);
5733                     else {
5734                         for (value = 0; value < 256; value++)
5735                             if (isXDIGIT(value))
5736                                 ANYOF_BITMAP_SET(ret, value);
5737                     }
5738                     yesno = '+';
5739                     what = "XDigit";
5740                     break;
5741                 case ANYOF_NXDIGIT:
5742                     if (LOC)
5743                         ANYOF_CLASS_SET(ret, ANYOF_NXDIGIT);
5744                     else {
5745                         for (value = 0; value < 256; value++)
5746                             if (!isXDIGIT(value))
5747                                 ANYOF_BITMAP_SET(ret, value);
5748                     }
5749                     yesno = '!';
5750                     what = "XDigit";
5751                     break;
5752                 case ANYOF_MAX:
5753                     /* this is to handle \p and \P */
5754                     break;
5755                 default:
5756                     vFAIL("Invalid [::] class");
5757                     break;
5758                 }
5759                 if (what) {
5760                     /* Strings such as "+utf8::isWord\n" */
5761                     Perl_sv_catpvf(aTHX_ listsv, "%cutf8::Is%s\n", yesno, what);
5762                 }
5763                 if (LOC)
5764                     ANYOF_FLAGS(ret) |= ANYOF_CLASS;
5765                 continue;
5766             }
5767         } /* end of namedclass \blah */
5768
5769         if (range) {
5770             if (prevvalue > (IV)value) /* b-a */ {
5771                 const int w = RExC_parse - rangebegin;
5772                 Simple_vFAIL4("Invalid [] range \"%*.*s\"", w, w, rangebegin);
5773                 range = 0; /* not a valid range */
5774             }
5775         }
5776         else {
5777             prevvalue = value; /* save the beginning of the range */
5778             if (*RExC_parse == '-' && RExC_parse+1 < RExC_end &&
5779                 RExC_parse[1] != ']') {
5780                 RExC_parse++;
5781
5782                 /* a bad range like \w-, [:word:]- ? */
5783                 if (namedclass > OOB_NAMEDCLASS) {
5784                     if (ckWARN(WARN_REGEXP)) {
5785                         const int w =
5786                             RExC_parse >= rangebegin ?
5787                             RExC_parse - rangebegin : 0;
5788                         vWARN4(RExC_parse,
5789                                "False [] range \"%*.*s\"",
5790                                w, w, rangebegin);
5791                     }
5792                     if (!SIZE_ONLY)
5793                         ANYOF_BITMAP_SET(ret, '-');
5794                 } else
5795                     range = 1;  /* yeah, it's a range! */
5796                 continue;       /* but do it the next time */
5797             }
5798         }
5799
5800         /* now is the next time */
5801         /*stored += (value - prevvalue + 1);*/
5802         if (!SIZE_ONLY) {
5803             if (prevvalue < 256) {
5804                 const IV ceilvalue = value < 256 ? value : 255;
5805                 IV i;
5806 #ifdef EBCDIC
5807                 /* In EBCDIC [\x89-\x91] should include
5808                  * the \x8e but [i-j] should not. */
5809                 if (literal_endpoint == 2 &&
5810                     ((isLOWER(prevvalue) && isLOWER(ceilvalue)) ||
5811                      (isUPPER(prevvalue) && isUPPER(ceilvalue))))
5812                 {
5813                     if (isLOWER(prevvalue)) {
5814                         for (i = prevvalue; i <= ceilvalue; i++)
5815                             if (isLOWER(i))
5816                                 ANYOF_BITMAP_SET(ret, i);
5817                     } else {
5818                         for (i = prevvalue; i <= ceilvalue; i++)
5819                             if (isUPPER(i))
5820                                 ANYOF_BITMAP_SET(ret, i);
5821                     }
5822                 }
5823                 else
5824 #endif
5825                       for (i = prevvalue; i <= ceilvalue; i++) {
5826                         if (!ANYOF_BITMAP_TEST(ret,i)) {
5827                             stored++;  
5828                             ANYOF_BITMAP_SET(ret, i);
5829                         }
5830                       }
5831           }
5832           if (value > 255 || UTF) {
5833                 const UV prevnatvalue  = NATIVE_TO_UNI(prevvalue);
5834                 const UV natvalue      = NATIVE_TO_UNI(value);
5835                 stored+=2; /* can't optimize this class */
5836                 ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
5837                 if (prevnatvalue < natvalue) { /* what about > ? */
5838                     Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\t%04"UVxf"\n",
5839                                    prevnatvalue, natvalue);
5840                 }
5841                 else if (prevnatvalue == natvalue) {
5842                     Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\n", natvalue);
5843                     if (FOLD) {
5844                          U8 foldbuf[UTF8_MAXBYTES_CASE+1];
5845                          STRLEN foldlen;
5846                          const UV f = to_uni_fold(natvalue, foldbuf, &foldlen);
5847
5848                          /* If folding and foldable and a single
5849                           * character, insert also the folded version
5850                           * to the charclass. */
5851                          if (f != value) {
5852                               if (foldlen == (STRLEN)UNISKIP(f))
5853                                   Perl_sv_catpvf(aTHX_ listsv,
5854                                                  "%04"UVxf"\n", f);
5855                               else {
5856                                   /* Any multicharacter foldings
5857                                    * require the following transform:
5858                                    * [ABCDEF] -> (?:[ABCabcDEFd]|pq|rst)
5859                                    * where E folds into "pq" and F folds
5860                                    * into "rst", all other characters
5861                                    * fold to single characters.  We save
5862                                    * away these multicharacter foldings,
5863                                    * to be later saved as part of the
5864                                    * additional "s" data. */
5865                                   SV *sv;
5866
5867                                   if (!unicode_alternate)
5868                                       unicode_alternate = newAV();
5869                                   sv = newSVpvn((char*)foldbuf, foldlen);
5870                                   SvUTF8_on(sv);
5871                                   av_push(unicode_alternate, sv);
5872                               }
5873                          }
5874
5875                          /* If folding and the value is one of the Greek
5876                           * sigmas insert a few more sigmas to make the
5877                           * folding rules of the sigmas to work right.
5878                           * Note that not all the possible combinations
5879                           * are handled here: some of them are handled
5880                           * by the standard folding rules, and some of
5881                           * them (literal or EXACTF cases) are handled
5882                           * during runtime in regexec.c:S_find_byclass(). */
5883                          if (value == UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA) {
5884                               Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\n",
5885                                              (UV)UNICODE_GREEK_CAPITAL_LETTER_SIGMA);
5886                               Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\n",
5887                                              (UV)UNICODE_GREEK_SMALL_LETTER_SIGMA);
5888                          }
5889                          else if (value == UNICODE_GREEK_CAPITAL_LETTER_SIGMA)
5890                               Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\n",
5891                                              (UV)UNICODE_GREEK_SMALL_LETTER_SIGMA);
5892                     }
5893                 }
5894             }
5895 #ifdef EBCDIC
5896             literal_endpoint = 0;
5897 #endif
5898         }
5899
5900         range = 0; /* this range (if it was one) is done now */
5901     }
5902
5903     if (need_class) {
5904         ANYOF_FLAGS(ret) |= ANYOF_LARGE;
5905         if (SIZE_ONLY)
5906             RExC_size += ANYOF_CLASS_ADD_SKIP;
5907         else
5908             RExC_emit += ANYOF_CLASS_ADD_SKIP;
5909     }
5910
5911
5912     if (SIZE_ONLY)
5913         return ret;
5914     /****** !SIZE_ONLY AFTER HERE *********/
5915
5916     if( stored == 1 && value < 256
5917         && !( ANYOF_FLAGS(ret) & ( ANYOF_FLAGS_ALL ^ ANYOF_FOLD ) )
5918     ) {
5919         /* optimize single char class to an EXACT node
5920            but *only* when its not a UTF/high char  */
5921         const char * cur_parse= RExC_parse;
5922         RExC_emit = (regnode *)orig_emit;
5923         RExC_parse = (char *)orig_parse;
5924         ret = reg_node(pRExC_state,
5925                        (U8)((ANYOF_FLAGS(ret) & ANYOF_FOLD) ? EXACTF : EXACT));
5926         RExC_parse = (char *)cur_parse;
5927         *STRING(ret)= (char)value;
5928         STR_LEN(ret)= 1;
5929         RExC_emit += STR_SZ(1);
5930         return ret;
5931     }
5932     /* optimize case-insensitive simple patterns (e.g. /[a-z]/i) */
5933     if ( /* If the only flag is folding (plus possibly inversion). */
5934         ((ANYOF_FLAGS(ret) & (ANYOF_FLAGS_ALL ^ ANYOF_INVERT)) == ANYOF_FOLD)
5935        ) {
5936         for (value = 0; value < 256; ++value) {
5937             if (ANYOF_BITMAP_TEST(ret, value)) {
5938                 UV fold = PL_fold[value];
5939
5940                 if (fold != value)
5941                     ANYOF_BITMAP_SET(ret, fold);
5942             }
5943         }
5944         ANYOF_FLAGS(ret) &= ~ANYOF_FOLD;
5945     }
5946
5947     /* optimize inverted simple patterns (e.g. [^a-z]) */
5948     if (optimize_invert &&
5949         /* If the only flag is inversion. */
5950         (ANYOF_FLAGS(ret) & ANYOF_FLAGS_ALL) == ANYOF_INVERT) {
5951         for (value = 0; value < ANYOF_BITMAP_SIZE; ++value)
5952             ANYOF_BITMAP(ret)[value] ^= ANYOF_FLAGS_ALL;
5953         ANYOF_FLAGS(ret) = ANYOF_UNICODE_ALL;
5954     }
5955     {
5956         AV * const av = newAV();
5957         SV *rv;
5958         /* The 0th element stores the character class description
5959          * in its textual form: used later (regexec.c:Perl_regclass_swash())
5960          * to initialize the appropriate swash (which gets stored in
5961          * the 1st element), and also useful for dumping the regnode.
5962          * The 2nd element stores the multicharacter foldings,
5963          * used later (regexec.c:S_reginclass()). */
5964         av_store(av, 0, listsv);
5965         av_store(av, 1, NULL);
5966         av_store(av, 2, (SV*)unicode_alternate);
5967         rv = newRV_noinc((SV*)av);
5968         n = add_data(pRExC_state, 1, "s");
5969         RExC_rx->data->data[n] = (void*)rv;
5970         ARG_SET(ret, n);
5971     }
5972     return ret;
5973 }
5974
5975 STATIC char*
5976 S_nextchar(pTHX_ RExC_state_t *pRExC_state)
5977 {
5978     char* const retval = RExC_parse++;
5979
5980     for (;;) {
5981         if (*RExC_parse == '(' && RExC_parse[1] == '?' &&
5982                 RExC_parse[2] == '#') {
5983             while (*RExC_parse != ')') {
5984                 if (RExC_parse == RExC_end)
5985                     FAIL("Sequence (?#... not terminated");
5986                 RExC_parse++;
5987             }
5988             RExC_parse++;
5989             continue;
5990         }
5991         if (RExC_flags & PMf_EXTENDED) {
5992             if (isSPACE(*RExC_parse)) {
5993                 RExC_parse++;
5994                 continue;
5995             }
5996             else if (*RExC_parse == '#') {
5997                 while (RExC_parse < RExC_end)
5998                     if (*RExC_parse++ == '\n') break;
5999                 continue;
6000             }
6001         }
6002         return retval;
6003     }
6004 }
6005
6006 /*
6007 - reg_node - emit a node
6008 */
6009 STATIC regnode *                        /* Location. */
6010 S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op)
6011 {
6012     dVAR;
6013     register regnode *ptr;
6014     regnode * const ret = RExC_emit;
6015     GET_RE_DEBUG_FLAGS_DECL;
6016
6017     if (SIZE_ONLY) {
6018         SIZE_ALIGN(RExC_size);
6019         RExC_size += 1;
6020         return(ret);
6021     }
6022     NODE_ALIGN_FILL(ret);
6023     ptr = ret;
6024     FILL_ADVANCE_NODE(ptr, op);
6025     if (RExC_offsets) {         /* MJD */
6026         MJD_OFFSET_DEBUG(("%s:%d: (op %s) %s %"UVuf" (len %"UVuf") (max %"UVuf").\n", 
6027               "reg_node", __LINE__, 
6028               reg_name[op],
6029               (UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0] 
6030                 ? "Overwriting end of array!\n" : "OK",
6031               (UV)(RExC_emit - RExC_emit_start),
6032               (UV)(RExC_parse - RExC_start),
6033               (UV)RExC_offsets[0])); 
6034         Set_Node_Offset(RExC_emit, RExC_parse + (op == END));
6035     }
6036
6037     RExC_emit = ptr;
6038
6039     return(ret);
6040 }
6041
6042 /*
6043 - reganode - emit a node with an argument
6044 */
6045 STATIC regnode *                        /* Location. */
6046 S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg)
6047 {
6048     dVAR;
6049     register regnode *ptr;
6050     regnode * const ret = RExC_emit;
6051     GET_RE_DEBUG_FLAGS_DECL;
6052
6053     if (SIZE_ONLY) {
6054         SIZE_ALIGN(RExC_size);
6055         RExC_size += 2;
6056         return(ret);
6057     }
6058
6059     NODE_ALIGN_FILL(ret);
6060     ptr = ret;
6061     FILL_ADVANCE_NODE_ARG(ptr, op, arg);
6062     if (RExC_offsets) {         /* MJD */
6063         MJD_OFFSET_DEBUG(("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n", 
6064               "reganode",
6065               __LINE__,
6066               reg_name[op],
6067               (UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0] ? 
6068               "Overwriting end of array!\n" : "OK",
6069               (UV)(RExC_emit - RExC_emit_start),
6070               (UV)(RExC_parse - RExC_start),
6071               (UV)RExC_offsets[0])); 
6072         Set_Cur_Node_Offset;
6073     }
6074             
6075     RExC_emit = ptr;
6076
6077     return(ret);
6078 }
6079
6080 /*
6081 - reguni - emit (if appropriate) a Unicode character
6082 */
6083 STATIC STRLEN
6084 S_reguni(pTHX_ const RExC_state_t *pRExC_state, UV uv, char* s)
6085 {
6086     dVAR;
6087     return SIZE_ONLY ? UNISKIP(uv) : (uvchr_to_utf8((U8*)s, uv) - (U8*)s);
6088 }
6089
6090 /*
6091 - reginsert - insert an operator in front of already-emitted operand
6092 *
6093 * Means relocating the operand.
6094 */
6095 STATIC void
6096 S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd)
6097 {
6098     dVAR;
6099     register regnode *src;
6100     register regnode *dst;
6101     register regnode *place;
6102     const int offset = regarglen[(U8)op];
6103     GET_RE_DEBUG_FLAGS_DECL;
6104 /* (PL_regkind[(U8)op] == CURLY ? EXTRA_STEP_2ARGS : 0); */
6105
6106     if (SIZE_ONLY) {
6107         RExC_size += NODE_STEP_REGNODE + offset;
6108         return;
6109     }
6110
6111     src = RExC_emit;
6112     RExC_emit += NODE_STEP_REGNODE + offset;
6113     dst = RExC_emit;
6114     while (src > opnd) {
6115         StructCopy(--src, --dst, regnode);
6116         if (RExC_offsets) {     /* MJD 20010112 */
6117             MJD_OFFSET_DEBUG(("%s(%d): (op %s) %s copy %"UVuf" -> %"UVuf" (max %"UVuf").\n",
6118                   "reg_insert",
6119                   __LINE__,
6120                   reg_name[op],
6121                   (UV)(dst - RExC_emit_start) > RExC_offsets[0] 
6122                     ? "Overwriting end of array!\n" : "OK",
6123                   (UV)(src - RExC_emit_start),
6124                   (UV)(dst - RExC_emit_start),
6125                   (UV)RExC_offsets[0])); 
6126             Set_Node_Offset_To_R(dst-RExC_emit_start, Node_Offset(src));
6127             Set_Node_Length_To_R(dst-RExC_emit_start, Node_Length(src));
6128         }
6129     }
6130     
6131
6132     place = opnd;               /* Op node, where operand used to be. */
6133     if (RExC_offsets) {         /* MJD */
6134         MJD_OFFSET_DEBUG(("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n", 
6135               "reginsert",
6136               __LINE__,
6137               reg_name[op],
6138               (UV)(place - RExC_emit_start) > RExC_offsets[0] 
6139               ? "Overwriting end of array!\n" : "OK",
6140               (UV)(place - RExC_emit_start),
6141               (UV)(RExC_parse - RExC_start),
6142               RExC_offsets[0])); 
6143         Set_Node_Offset(place, RExC_parse);
6144         Set_Node_Length(place, 1);
6145     }
6146     src = NEXTOPER(place);
6147     FILL_ADVANCE_NODE(place, op);
6148     Zero(src, offset, regnode);
6149 }
6150
6151 /*
6152 - regtail - set the next-pointer at the end of a node chain of p to val.
6153 - SEE ALSO: regtail_study
6154 */
6155 /* TODO: All three parms should be const */
6156 STATIC void
6157 S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p, const regnode *val,U32 depth)
6158 {
6159     dVAR;
6160     register regnode *scan;
6161     GET_RE_DEBUG_FLAGS_DECL;
6162 #ifndef DEBUGGING
6163     PERL_UNUSED_ARG(depth);
6164 #endif
6165
6166     if (SIZE_ONLY)
6167         return;
6168
6169     /* Find last node. */
6170     scan = p;
6171     for (;;) {
6172         regnode * const temp = regnext(scan);
6173         DEBUG_PARSE_r({
6174             SV * const mysv=sv_newmortal();
6175             DEBUG_PARSE_MSG((scan==p ? "tail" : ""));
6176             regprop(RExC_rx, mysv, scan);
6177             PerlIO_printf(Perl_debug_log, "~ %s (%d)\n",
6178                 SvPV_nolen_const(mysv), REG_NODE_NUM(scan));
6179         });
6180         if (temp == NULL)
6181             break;
6182         scan = temp;
6183     }
6184
6185     if (reg_off_by_arg[OP(scan)]) {
6186         ARG_SET(scan, val - scan);
6187     }
6188     else {
6189         NEXT_OFF(scan) = val - scan;
6190     }
6191 }
6192
6193 #ifdef DEBUGGING
6194 /*
6195 - regtail_study - set the next-pointer at the end of a node chain of p to val.
6196 - Look for optimizable sequences at the same time.
6197 - currently only looks for EXACT chains.
6198
6199 This is expermental code. The idea is to use this routine to perform 
6200 in place optimizations on branches and groups as they are constructed,
6201 with the long term intention of removing optimization from study_chunk so
6202 that it is purely analytical.
6203
6204 Currently only used when in DEBUG mode. The macro REGTAIL_STUDY() is used
6205 to control which is which.
6206
6207 */
6208 /* TODO: All four parms should be const */
6209
6210 STATIC U8
6211 S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode *p, const regnode *val,U32 depth)
6212 {
6213     dVAR;
6214     register regnode *scan;
6215     U8 exact = PSEUDO;
6216 #ifdef EXPERIMENTAL_INPLACESCAN
6217     I32 min = 0;
6218 #endif
6219
6220     GET_RE_DEBUG_FLAGS_DECL;
6221
6222
6223     if (SIZE_ONLY)
6224         return exact;
6225
6226     /* Find last node. */
6227
6228     scan = p;
6229     for (;;) {
6230         regnode * const temp = regnext(scan);
6231 #ifdef EXPERIMENTAL_INPLACESCAN
6232         if (PL_regkind[OP(scan)] == EXACT)
6233             if (join_exact(pRExC_state,scan,&min,1,val,depth+1))
6234                 return EXACT;
6235 #endif
6236         if ( exact ) {
6237             switch (OP(scan)) {
6238                 case EXACT:
6239                 case EXACTF:
6240                 case EXACTFL:
6241                         if( exact == PSEUDO )
6242                             exact= OP(scan);
6243                         else if ( exact != OP(scan) )
6244                             exact= 0;
6245                 case NOTHING:
6246                     break;
6247                 default:
6248                     exact= 0;
6249             }
6250         }
6251         DEBUG_PARSE_r({
6252             SV * const mysv=sv_newmortal();
6253             DEBUG_PARSE_MSG((scan==p ? "tsdy" : ""));
6254             regprop(RExC_rx, mysv, scan);
6255             PerlIO_printf(Perl_debug_log, "~ %s (%s) (%d)\n",
6256                 SvPV_nolen_const(mysv),
6257                 reg_name[exact],
6258                 REG_NODE_NUM(scan));
6259         });
6260         if (temp == NULL)
6261             break;
6262         scan = temp;
6263     }
6264     DEBUG_PARSE_r({
6265         SV * const mysv_val=sv_newmortal();
6266         DEBUG_PARSE_MSG("");
6267         regprop(RExC_rx, mysv_val, val);
6268         PerlIO_printf(Perl_debug_log, "~ attach to %s (%d) offset to %d\n",
6269             SvPV_nolen_const(mysv_val),
6270             REG_NODE_NUM(val),
6271             val - scan
6272         );
6273     });
6274     if (reg_off_by_arg[OP(scan)]) {
6275         ARG_SET(scan, val - scan);
6276     }
6277     else {
6278         NEXT_OFF(scan) = val - scan;
6279     }
6280
6281     return exact;
6282 }
6283 #endif
6284
6285 /*
6286  - regcurly - a little FSA that accepts {\d+,?\d*}
6287  */
6288 STATIC I32
6289 S_regcurly(register const char *s)
6290 {
6291     if (*s++ != '{')
6292         return FALSE;
6293     if (!isDIGIT(*s))
6294         return FALSE;
6295     while (isDIGIT(*s))
6296         s++;
6297     if (*s == ',')
6298         s++;
6299     while (isDIGIT(*s))
6300         s++;
6301     if (*s != '}')
6302         return FALSE;
6303     return TRUE;
6304 }
6305
6306
6307 /*
6308  - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
6309  */
6310 void
6311 Perl_regdump(pTHX_ const regexp *r)
6312 {
6313 #ifdef DEBUGGING
6314     dVAR;
6315     SV * const sv = sv_newmortal();
6316
6317     (void)dumpuntil(r, r->program, r->program + 1, NULL, sv, 0);
6318
6319     /* Header fields of interest. */
6320     if (r->anchored_substr)
6321         PerlIO_printf(Perl_debug_log,
6322                       "anchored \"%s%.*s%s\"%s at %"IVdf" ",
6323                       PL_colors[0],
6324                       (int)(SvCUR(r->anchored_substr) - (SvTAIL(r->anchored_substr)!=0)),
6325                       SvPVX_const(r->anchored_substr),
6326                       PL_colors[1],
6327                       SvTAIL(r->anchored_substr) ? "$" : "",
6328                       (IV)r->anchored_offset);
6329     else if (r->anchored_utf8)
6330         PerlIO_printf(Perl_debug_log,
6331                       "anchored utf8 \"%s%.*s%s\"%s at %"IVdf" ",
6332                       PL_colors[0],
6333                       (int)(SvCUR(r->anchored_utf8) - (SvTAIL(r->anchored_utf8)!=0)),
6334                       SvPVX_const(r->anchored_utf8),
6335                       PL_colors[1],
6336                       SvTAIL(r->anchored_utf8) ? "$" : "",
6337                       (IV)r->anchored_offset);
6338     if (r->float_substr)
6339         PerlIO_printf(Perl_debug_log,
6340                       "floating \"%s%.*s%s\"%s at %"IVdf"..%"UVuf" ",
6341                       PL_colors[0],
6342                       (int)(SvCUR(r->float_substr) - (SvTAIL(r->float_substr)!=0)),
6343                       SvPVX_const(r->float_substr),
6344                       PL_colors[1],
6345                       SvTAIL(r->float_substr) ? "$" : "",
6346                       (IV)r->float_min_offset, (UV)r->float_max_offset);
6347     else if (r->float_utf8)
6348         PerlIO_printf(Perl_debug_log,
6349                       "floating utf8 \"%s%.*s%s\"%s at %"IVdf"..%"UVuf" ",
6350                       PL_colors[0],
6351                       (int)(SvCUR(r->float_utf8) - (SvTAIL(r->float_utf8)!=0)),
6352                       SvPVX_const(r->float_utf8),
6353                       PL_colors[1],
6354                       SvTAIL(r->float_utf8) ? "$" : "",
6355                       (IV)r->float_min_offset, (UV)r->float_max_offset);
6356     if (r->check_substr || r->check_utf8)
6357         PerlIO_printf(Perl_debug_log,
6358                       r->check_substr == r->float_substr
6359                       && r->check_utf8 == r->float_utf8
6360                       ? "(checking floating" : "(checking anchored");
6361     if (r->reganch & ROPT_NOSCAN)
6362         PerlIO_printf(Perl_debug_log, " noscan");
6363     if (r->reganch & ROPT_CHECK_ALL)
6364         PerlIO_printf(Perl_debug_log, " isall");
6365     if (r->check_substr || r->check_utf8)
6366         PerlIO_printf(Perl_debug_log, ") ");
6367
6368     if (r->regstclass) {
6369         regprop(r, sv, r->regstclass);
6370         PerlIO_printf(Perl_debug_log, "stclass \"%s\" ", SvPVX_const(sv));
6371     }
6372     if (r->reganch & ROPT_ANCH) {
6373         PerlIO_printf(Perl_debug_log, "anchored");
6374         if (r->reganch & ROPT_ANCH_BOL)
6375             PerlIO_printf(Perl_debug_log, "(BOL)");
6376         if (r->reganch & ROPT_ANCH_MBOL)
6377             PerlIO_printf(Perl_debug_log, "(MBOL)");
6378         if (r->reganch & ROPT_ANCH_SBOL)
6379             PerlIO_printf(Perl_debug_log, "(SBOL)");
6380         if (r->reganch & ROPT_ANCH_GPOS)
6381             PerlIO_printf(Perl_debug_log, "(GPOS)");
6382         PerlIO_putc(Perl_debug_log, ' ');
6383     }
6384     if (r->reganch & ROPT_GPOS_SEEN)
6385         PerlIO_printf(Perl_debug_log, "GPOS ");
6386     if (r->reganch & ROPT_SKIP)
6387         PerlIO_printf(Perl_debug_log, "plus ");
6388     if (r->reganch & ROPT_IMPLICIT)
6389         PerlIO_printf(Perl_debug_log, "implicit ");
6390     PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen);
6391     if (r->reganch & ROPT_EVAL_SEEN)
6392         PerlIO_printf(Perl_debug_log, "with eval ");
6393     PerlIO_printf(Perl_debug_log, "\n");
6394 #else
6395     PERL_UNUSED_CONTEXT;
6396     PERL_UNUSED_ARG(r);
6397 #endif  /* DEBUGGING */
6398 }
6399
6400 /*
6401 - regprop - printable representation of opcode
6402 */
6403 void
6404 Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
6405 {
6406 #ifdef DEBUGGING
6407     dVAR;
6408     register int k;
6409
6410     sv_setpvn(sv, "", 0);
6411     if (OP(o) >= reg_num)               /* regnode.type is unsigned */
6412         /* It would be nice to FAIL() here, but this may be called from
6413            regexec.c, and it would be hard to supply pRExC_state. */
6414         Perl_croak(aTHX_ "Corrupted regexp opcode");
6415     sv_catpv(sv, reg_name[OP(o)]); /* Take off const! */
6416
6417     k = PL_regkind[OP(o)];
6418
6419     if (k == EXACT) {
6420         SV * const dsv = sv_2mortal(newSVpvs(""));
6421         /* Using is_utf8_string() is a crude hack but it may
6422          * be the best for now since we have no flag "this EXACTish
6423          * node was UTF-8" --jhi */
6424         const bool do_utf8 = is_utf8_string((U8*)STRING(o), STR_LEN(o));
6425         const char * const s = do_utf8 ?
6426           pv_uni_display(dsv, (U8*)STRING(o), STR_LEN(o), 60,
6427                          UNI_DISPLAY_REGEX) :
6428           STRING(o);
6429         const int len = do_utf8 ?
6430           strlen(s) :
6431           STR_LEN(o);
6432         Perl_sv_catpvf(aTHX_ sv, " <%s%.*s%s>",
6433                        PL_colors[0],
6434                        len, s,
6435                        PL_colors[1]);
6436     } else if (k == TRIE) {
6437         Perl_sv_catpvf(aTHX_ sv, "-%s",reg_name[o->flags]);
6438         /* print the details of the trie in dumpuntil instead, as
6439          * prog->data isn't available here */
6440     } else if (k == CURLY) {
6441         if (OP(o) == CURLYM || OP(o) == CURLYN || OP(o) == CURLYX)
6442             Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* Parenth number */
6443         Perl_sv_catpvf(aTHX_ sv, " {%d,%d}", ARG1(o), ARG2(o));
6444     }
6445     else if (k == WHILEM && o->flags)                   /* Ordinal/of */
6446         Perl_sv_catpvf(aTHX_ sv, "[%d/%d]", o->flags & 0xf, o->flags>>4);
6447     else if (k == REF || k == OPEN || k == CLOSE || k == GROUPP )
6448         Perl_sv_catpvf(aTHX_ sv, "%d", (int)ARG(o));    /* Parenth number */
6449     else if (k == LOGICAL)
6450         Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags);     /* 2: embedded, otherwise 1 */
6451     else if (k == ANYOF) {
6452         int i, rangestart = -1;
6453         const U8 flags = ANYOF_FLAGS(o);
6454
6455         /* Should be synchronized with * ANYOF_ #xdefines in regcomp.h */
6456         static const char * const anyofs[] = {
6457             "\\w",
6458             "\\W",
6459             "\\s",
6460             "\\S",
6461             "\\d",
6462             "\\D",
6463             "[:alnum:]",
6464             "[:^alnum:]",
6465             "[:alpha:]",
6466             "[:^alpha:]",
6467             "[:ascii:]",
6468             "[:^ascii:]",
6469             "[:ctrl:]",
6470             "[:^ctrl:]",
6471             "[:graph:]",
6472             "[:^graph:]",
6473             "[:lower:]",
6474             "[:^lower:]",
6475             "[:print:]",
6476             "[:^print:]",
6477             "[:punct:]",
6478             "[:^punct:]",
6479             "[:upper:]",
6480             "[:^upper:]",
6481             "[:xdigit:]",
6482             "[:^xdigit:]",
6483             "[:space:]",
6484             "[:^space:]",
6485             "[:blank:]",
6486             "[:^blank:]"
6487         };
6488
6489         if (flags & ANYOF_LOCALE)
6490             sv_catpvs(sv, "{loc}");
6491         if (flags & ANYOF_FOLD)
6492             sv_catpvs(sv, "{i}");
6493         Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]);
6494         if (flags & ANYOF_INVERT)
6495             sv_catpvs(sv, "^");
6496         for (i = 0; i <= 256; i++) {
6497             if (i < 256 && ANYOF_BITMAP_TEST(o,i)) {
6498                 if (rangestart == -1)
6499                     rangestart = i;
6500             } else if (rangestart != -1) {
6501                 if (i <= rangestart + 3)
6502                     for (; rangestart < i; rangestart++)
6503                         put_byte(sv, rangestart);
6504                 else {
6505                     put_byte(sv, rangestart);
6506                     sv_catpvs(sv, "-");
6507                     put_byte(sv, i - 1);
6508                 }
6509                 rangestart = -1;
6510             }
6511         }
6512
6513         if (o->flags & ANYOF_CLASS)
6514             for (i = 0; i < (int)(sizeof(anyofs)/sizeof(char*)); i++)
6515                 if (ANYOF_CLASS_TEST(o,i))
6516                     sv_catpv(sv, anyofs[i]);
6517
6518         if (flags & ANYOF_UNICODE)
6519             sv_catpvs(sv, "{unicode}");
6520         else if (flags & ANYOF_UNICODE_ALL)
6521             sv_catpvs(sv, "{unicode_all}");
6522
6523         {
6524             SV *lv;
6525             SV * const sw = regclass_swash(prog, o, FALSE, &lv, 0);
6526         
6527             if (lv) {
6528                 if (sw) {
6529                     U8 s[UTF8_MAXBYTES_CASE+1];
6530                 
6531                     for (i = 0; i <= 256; i++) { /* just the first 256 */
6532                         uvchr_to_utf8(s, i);
6533                         
6534                         if (i < 256 && swash_fetch(sw, s, TRUE)) {
6535                             if (rangestart == -1)
6536                                 rangestart = i;
6537                         } else if (rangestart != -1) {
6538                             if (i <= rangestart + 3)
6539                                 for (; rangestart < i; rangestart++) {
6540                                     const U8 * const e = uvchr_to_utf8(s,rangestart);
6541                                     U8 *p;
6542                                     for(p = s; p < e; p++)
6543                                         put_byte(sv, *p);
6544                                 }
6545                             else {
6546                                 const U8 *e = uvchr_to_utf8(s,rangestart);
6547                                 U8 *p;
6548                                 for (p = s; p < e; p++)
6549                                     put_byte(sv, *p);
6550                                 sv_catpvs(sv, "-");
6551                                 e = uvchr_to_utf8(s, i-1);
6552                                 for (p = s; p < e; p++)
6553                                     put_byte(sv, *p);
6554                                 }
6555                                 rangestart = -1;
6556                             }
6557                         }
6558                         
6559                     sv_catpvs(sv, "..."); /* et cetera */
6560                 }
6561
6562                 {
6563                     char *s = savesvpv(lv);
6564                     char * const origs = s;
6565                 
6566                     while (*s && *s != '\n')
6567                         s++;
6568                 
6569                     if (*s == '\n') {
6570                         const char * const t = ++s;
6571                         
6572                         while (*s) {
6573                             if (*s == '\n')
6574                                 *s = ' ';
6575                             s++;
6576                         }
6577                         if (s[-1] == ' ')
6578                             s[-1] = 0;
6579                         
6580                         sv_catpv(sv, t);
6581                     }
6582                 
6583                     Safefree(origs);
6584                 }
6585             }
6586         }
6587
6588         Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]);
6589     }
6590     else if (k == BRANCHJ && (OP(o) == UNLESSM || OP(o) == IFMATCH))
6591         Perl_sv_catpvf(aTHX_ sv, "[%d]", -(o->flags));
6592 #else
6593     PERL_UNUSED_CONTEXT;
6594     PERL_UNUSED_ARG(sv);
6595     PERL_UNUSED_ARG(o);
6596     PERL_UNUSED_ARG(prog);
6597 #endif  /* DEBUGGING */
6598 }
6599
6600 SV *
6601 Perl_re_intuit_string(pTHX_ regexp *prog)
6602 {                               /* Assume that RE_INTUIT is set */
6603     dVAR;
6604     GET_RE_DEBUG_FLAGS_DECL;
6605     PERL_UNUSED_CONTEXT;
6606
6607     DEBUG_COMPILE_r(
6608         {
6609             const char * const s = SvPV_nolen_const(prog->check_substr
6610                       ? prog->check_substr : prog->check_utf8);
6611
6612             if (!PL_colorset) reginitcolors();
6613             PerlIO_printf(Perl_debug_log,
6614                       "%sUsing REx %ssubstr:%s \"%s%.60s%s%s\"\n",
6615                       PL_colors[4],
6616                       prog->check_substr ? "" : "utf8 ",
6617                       PL_colors[5],PL_colors[0],
6618                       s,
6619                       PL_colors[1],
6620                       (strlen(s) > 60 ? "..." : ""));
6621         } );
6622
6623     return prog->check_substr ? prog->check_substr : prog->check_utf8;
6624 }
6625
6626 void
6627 Perl_pregfree(pTHX_ struct regexp *r)
6628 {
6629     dVAR;
6630 #ifdef DEBUGGING
6631     SV * const dsv = PERL_DEBUG_PAD_ZERO(0);
6632 #endif
6633     GET_RE_DEBUG_FLAGS_DECL;
6634
6635     if (!r || (--r->refcnt > 0))
6636         return;
6637     DEBUG_COMPILE_r(if (RX_DEBUG(r)){
6638         const char * const s = (r->reganch & ROPT_UTF8)
6639             ? pv_uni_display(dsv, (U8*)r->precomp, r->prelen, 60, UNI_DISPLAY_REGEX)
6640             : pv_display(dsv, r->precomp, r->prelen, 0, 60);
6641         const int len = SvCUR(dsv);
6642          if (!PL_colorset)
6643               reginitcolors();
6644          PerlIO_printf(Perl_debug_log,
6645                        "%sFreeing REx:%s %s%*.*s%s%s\n",
6646                        PL_colors[4],PL_colors[5],PL_colors[0],
6647                        len, len, s,
6648                        PL_colors[1],
6649                        len > 60 ? "..." : "");
6650     });
6651
6652     /* gcov results gave these as non-null 100% of the time, so there's no
6653        optimisation in checking them before calling Safefree  */
6654     Safefree(r->precomp);
6655     Safefree(r->offsets);             /* 20010421 MJD */
6656     RX_MATCH_COPY_FREE(r);
6657 #ifdef PERL_OLD_COPY_ON_WRITE
6658     if (r->saved_copy)
6659         SvREFCNT_dec(r->saved_copy);
6660 #endif
6661     if (r->substrs) {
6662         if (r->anchored_substr)
6663             SvREFCNT_dec(r->anchored_substr);
6664         if (r->anchored_utf8)
6665             SvREFCNT_dec(r->anchored_utf8);
6666         if (r->float_substr)
6667             SvREFCNT_dec(r->float_substr);
6668         if (r->float_utf8)
6669             SvREFCNT_dec(r->float_utf8);
6670         Safefree(r->substrs);
6671     }
6672     if (r->data) {
6673         int n = r->data->count;
6674         PAD* new_comppad = NULL;
6675         PAD* old_comppad;
6676         PADOFFSET refcnt;
6677
6678         while (--n >= 0) {
6679           /* If you add a ->what type here, update the comment in regcomp.h */
6680             switch (r->data->what[n]) {
6681             case 's':
6682                 SvREFCNT_dec((SV*)r->data->data[n]);
6683                 break;
6684             case 'f':
6685                 Safefree(r->data->data[n]);
6686                 break;
6687             case 'p':
6688                 new_comppad = (AV*)r->data->data[n];
6689                 break;
6690             case 'o':
6691                 if (new_comppad == NULL)
6692                     Perl_croak(aTHX_ "panic: pregfree comppad");
6693                 PAD_SAVE_LOCAL(old_comppad,
6694                     /* Watch out for global destruction's random ordering. */
6695                     (SvTYPE(new_comppad) == SVt_PVAV) ? new_comppad : NULL
6696                 );
6697                 OP_REFCNT_LOCK;
6698                 refcnt = OpREFCNT_dec((OP_4tree*)r->data->data[n]);
6699                 OP_REFCNT_UNLOCK;
6700                 if (!refcnt)
6701                     op_free((OP_4tree*)r->data->data[n]);
6702
6703                 PAD_RESTORE_LOCAL(old_comppad);
6704                 SvREFCNT_dec((SV*)new_comppad);
6705                 new_comppad = NULL;
6706                 break;
6707             case 'n':
6708                 break;
6709             case 'T':           
6710                 { /* Aho Corasick add-on structure for a trie node.
6711                      Used in stclass optimization only */
6712                     U32 refcount;
6713                     reg_ac_data *aho=(reg_ac_data*)r->data->data[n];
6714                     OP_REFCNT_LOCK;
6715                     refcount = --aho->refcount;
6716                     OP_REFCNT_UNLOCK;
6717                     if ( !refcount ) {
6718                         Safefree(aho->states);
6719                         Safefree(aho->fail);
6720                         aho->trie=NULL; /* not necessary to free this as it is 
6721                                            handled by the 't' case */
6722                         Safefree(r->data->data[n]); /* do this last!!!! */
6723                         Safefree(r->regstclass);
6724                     }
6725                 }
6726                 break;
6727             case 't':
6728                 {
6729                     /* trie structure. */
6730                     U32 refcount;
6731                     reg_trie_data *trie=(reg_trie_data*)r->data->data[n];
6732                     OP_REFCNT_LOCK;
6733                     refcount = --trie->refcount;
6734                     OP_REFCNT_UNLOCK;
6735                     if ( !refcount ) {
6736                         Safefree(trie->charmap);
6737                         if (trie->widecharmap)
6738                             SvREFCNT_dec((SV*)trie->widecharmap);
6739                         Safefree(trie->states);
6740                         Safefree(trie->trans);
6741                         if (trie->bitmap)
6742                             Safefree(trie->bitmap);
6743                         if (trie->wordlen)
6744                             Safefree(trie->wordlen);
6745 #ifdef DEBUGGING
6746                         if (RX_DEBUG(r)) {
6747                             if (trie->words)
6748                                 SvREFCNT_dec((SV*)trie->words);
6749                             if (trie->revcharmap)
6750                                 SvREFCNT_dec((SV*)trie->revcharmap);
6751                         }
6752 #endif
6753                         Safefree(r->data->data[n]); /* do this last!!!! */
6754                     }
6755                 }
6756                 break;
6757             default:
6758                 Perl_croak(aTHX_ "panic: regfree data code '%c'", r->data->what[n]);
6759             }
6760         }
6761         Safefree(r->data->what);
6762         Safefree(r->data);
6763     }
6764     Safefree(r->startp);
6765     Safefree(r->endp);
6766     Safefree(r);
6767 }
6768
6769 #ifndef PERL_IN_XSUB_RE
6770 /*
6771  - regnext - dig the "next" pointer out of a node
6772  */
6773 regnode *
6774 Perl_regnext(pTHX_ register regnode *p)
6775 {
6776     dVAR;
6777     register I32 offset;
6778
6779     if (p == &PL_regdummy)
6780         return(NULL);
6781
6782     offset = (reg_off_by_arg[OP(p)] ? ARG(p) : NEXT_OFF(p));
6783     if (offset == 0)
6784         return(NULL);
6785
6786     return(p+offset);
6787 }
6788 #endif
6789
6790 STATIC void     
6791 S_re_croak2(pTHX_ const char* pat1,const char* pat2,...)
6792 {
6793     va_list args;
6794     STRLEN l1 = strlen(pat1);
6795     STRLEN l2 = strlen(pat2);
6796     char buf[512];
6797     SV *msv;
6798     const char *message;
6799
6800     if (l1 > 510)
6801         l1 = 510;
6802     if (l1 + l2 > 510)
6803         l2 = 510 - l1;
6804     Copy(pat1, buf, l1 , char);
6805     Copy(pat2, buf + l1, l2 , char);
6806     buf[l1 + l2] = '\n';
6807     buf[l1 + l2 + 1] = '\0';
6808 #ifdef I_STDARG
6809     /* ANSI variant takes additional second argument */
6810     va_start(args, pat2);
6811 #else
6812     va_start(args);
6813 #endif
6814     msv = vmess(buf, &args);
6815     va_end(args);
6816     message = SvPV_const(msv,l1);
6817     if (l1 > 512)
6818         l1 = 512;
6819     Copy(message, buf, l1 , char);
6820     buf[l1-1] = '\0';                   /* Overwrite \n */
6821     Perl_croak(aTHX_ "%s", buf);
6822 }
6823
6824 /* XXX Here's a total kludge.  But we need to re-enter for swash routines. */
6825
6826 #ifndef PERL_IN_XSUB_RE
6827 void
6828 Perl_save_re_context(pTHX)
6829 {
6830     dVAR;
6831
6832     struct re_save_state *state;
6833
6834     SAVEVPTR(PL_curcop);
6835     SSGROW(SAVESTACK_ALLOC_FOR_RE_SAVE_STATE + 1);
6836
6837     state = (struct re_save_state *)(PL_savestack + PL_savestack_ix);
6838     PL_savestack_ix += SAVESTACK_ALLOC_FOR_RE_SAVE_STATE;
6839     SSPUSHINT(SAVEt_RE_STATE);
6840
6841     Copy(&PL_reg_state, state, 1, struct re_save_state);
6842
6843     PL_reg_start_tmp = 0;
6844     PL_reg_start_tmpl = 0;
6845     PL_reg_oldsaved = NULL;
6846     PL_reg_oldsavedlen = 0;
6847     PL_reg_maxiter = 0;
6848     PL_reg_leftiter = 0;
6849     PL_reg_poscache = NULL;
6850     PL_reg_poscache_size = 0;
6851 #ifdef PERL_OLD_COPY_ON_WRITE
6852     PL_nrs = NULL;
6853 #endif
6854
6855     /* Save $1..$n (#18107: UTF-8 s/(\w+)/uc($1)/e); AMS 20021106. */
6856     if (PL_curpm) {
6857         const REGEXP * const rx = PM_GETRE(PL_curpm);
6858         if (rx) {
6859             U32 i;
6860             for (i = 1; i <= rx->nparens; i++) {
6861                 char digits[TYPE_CHARS(long)];
6862                 const STRLEN len = my_snprintf(digits, sizeof(digits), "%lu", (long)i);
6863                 GV *const *const gvp
6864                     = (GV**)hv_fetch(PL_defstash, digits, len, 0);
6865
6866                 if (gvp) {
6867                     GV * const gv = *gvp;
6868                     if (SvTYPE(gv) == SVt_PVGV && GvSV(gv))
6869                         save_scalar(gv);
6870                 }
6871             }
6872         }
6873     }
6874 }
6875 #endif
6876
6877 static void
6878 clear_re(pTHX_ void *r)
6879 {
6880     dVAR;
6881     ReREFCNT_dec((regexp *)r);
6882 }
6883
6884 #ifdef DEBUGGING
6885
6886 STATIC void
6887 S_put_byte(pTHX_ SV *sv, int c)
6888 {
6889     if (isCNTRL(c) || c == 255 || !isPRINT(c))
6890         Perl_sv_catpvf(aTHX_ sv, "\\%o", c);
6891     else if (c == '-' || c == ']' || c == '\\' || c == '^')
6892         Perl_sv_catpvf(aTHX_ sv, "\\%c", c);
6893     else
6894         Perl_sv_catpvf(aTHX_ sv, "%c", c);
6895 }
6896
6897 #define CLEAR_OPTSTART \
6898     if (optstart) STMT_START { \
6899             DEBUG_OPTIMISE_r(PerlIO_printf(Perl_debug_log, " (%d nodes)\n", node - optstart)); \
6900             optstart=NULL; \
6901     } STMT_END
6902
6903 #define DUMPUNTIL(a,b,c,d,e,f) CLEAR_OPTSTART; node=dumpuntil(a,b,c,d,e,f);
6904
6905 STATIC const regnode *
6906 S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
6907             const regnode *last, SV* sv, I32 l)
6908 {
6909     dVAR;
6910     register U8 op = EXACT;     /* Arbitrary non-END op. */
6911     register const regnode *next;
6912     const regnode *optstart= NULL;
6913     GET_RE_DEBUG_FLAGS_DECL;
6914
6915     while (op != END && (!last || node < last)) {
6916         /* While that wasn't END last time... */
6917
6918         NODE_ALIGN(node);
6919         op = OP(node);
6920         if (op == CLOSE)
6921             l--;        
6922         next = regnext((regnode *)node);
6923         
6924         /* Where, what. */
6925         if (OP(node) == OPTIMIZED) {
6926             if (!optstart && RE_DEBUG_FLAG(RE_DEBUG_COMPILE_OPTIMISE))
6927                 optstart = node;
6928             else
6929                 goto after_print;
6930         } else
6931             CLEAR_OPTSTART;
6932             
6933         regprop(r, sv, node);
6934         PerlIO_printf(Perl_debug_log, "%4"IVdf":%*s%s", (IV)(node - start),
6935                       (int)(2*l + 1), "", SvPVX_const(sv));
6936
6937         if (OP(node) != OPTIMIZED) {
6938             if (next == NULL)           /* Next ptr. */
6939                 PerlIO_printf(Perl_debug_log, "(0)");
6940             else
6941                 PerlIO_printf(Perl_debug_log, "(%"IVdf")", (IV)(next - start));
6942             (void)PerlIO_putc(Perl_debug_log, '\n');
6943         }
6944
6945       after_print:
6946         if (PL_regkind[(U8)op] == BRANCHJ) {
6947             assert(next);
6948             {
6949                 register const regnode *nnode = (OP(next) == LONGJMP
6950                                              ? regnext((regnode *)next)
6951                                              : next);
6952                 if (last && nnode > last)
6953                     nnode = last;
6954                 DUMPUNTIL(r, start, NEXTOPER(NEXTOPER(node)), nnode, sv, l + 1);
6955             }
6956         }
6957         else if (PL_regkind[(U8)op] == BRANCH) {
6958             assert(next);
6959             DUMPUNTIL(r, start, NEXTOPER(node), next, sv, l + 1);
6960         }
6961         else if ( PL_regkind[(U8)op]  == TRIE ) {
6962             const I32 n = ARG(node);
6963             const reg_trie_data * const trie = (reg_trie_data*)r->data->data[n];
6964             const I32 arry_len = av_len(trie->words)+1;
6965             I32 word_idx;
6966             PerlIO_printf(Perl_debug_log,
6967                     "%*s[StS:%"UVuf" Wds:%d Cs:%d Uq:%d #Sts:%"IVdf" Mn:%d Mx:%d",
6968                     (int)(2*(l+3)),
6969                     "",
6970                     trie->startstate,
6971                     TRIE_WORDCOUNT(trie),
6972                     (int)TRIE_CHARCOUNT(trie),
6973                     trie->uniquecharcount,
6974                     (IV)TRIE_LASTSTATE(trie)-1,
6975                     (int)trie->minlen,
6976                     (int)trie->maxlen
6977                 );
6978            if (trie->bitmap) {
6979                 int i;
6980                 int rangestart= -1;
6981                 sv_setpvn(sv, "", 0);
6982                 for (i = 0; i <= 256; i++) {
6983                     if (i < 256 && TRIE_BITMAP_TEST(trie,i)) {
6984                         if (rangestart == -1)
6985                             rangestart = i;
6986                     } else if (rangestart != -1) {
6987                         if (i <= rangestart + 3)
6988                             for (; rangestart < i; rangestart++)
6989                                 put_byte(sv, rangestart);
6990                         else {
6991                             put_byte(sv, rangestart);
6992                             sv_catpvs(sv, "-");
6993                             put_byte(sv, i - 1);
6994                         }
6995                         rangestart = -1;
6996                     }
6997                 }
6998                 PerlIO_printf(Perl_debug_log, " Stcls:%s]\n", SvPVX_const(sv));
6999             } else
7000                 PerlIO_printf(Perl_debug_log, " No-Stcls]\n");
7001
7002             for (word_idx=0; word_idx < arry_len; word_idx++) {
7003                 SV ** const elem_ptr = av_fetch(trie->words,word_idx,0);
7004                 if (elem_ptr) {
7005                     PerlIO_printf(Perl_debug_log, "%*s<%s%s%s>\n",
7006                        (int)(2*(l+4)), "",
7007                        PL_colors[0],
7008                        SvPV_nolen_const(*elem_ptr),
7009                        PL_colors[1]
7010                     );
7011                 }
7012             }
7013
7014             node = NEXTOPER(node);
7015             node += regarglen[(U8)op];
7016
7017         }
7018         else if ( op == CURLY) {   /* "next" might be very big: optimizer */
7019             DUMPUNTIL(r, start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
7020                              NEXTOPER(node) + EXTRA_STEP_2ARGS + 1, sv, l + 1);
7021         }
7022         else if (PL_regkind[(U8)op] == CURLY && op != CURLYX) {
7023             assert(next);
7024             DUMPUNTIL(r, start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
7025                              next, sv, l + 1);
7026         }
7027         else if ( op == PLUS || op == STAR) {
7028             DUMPUNTIL(r, start, NEXTOPER(node), NEXTOPER(node) + 1, sv, l + 1);
7029         }
7030         else if (op == ANYOF) {
7031             /* arglen 1 + class block */
7032             node += 1 + ((ANYOF_FLAGS(node) & ANYOF_LARGE)
7033                     ? ANYOF_CLASS_SKIP : ANYOF_SKIP);
7034             node = NEXTOPER(node);
7035         }
7036         else if (PL_regkind[(U8)op] == EXACT) {
7037             /* Literal string, where present. */
7038             node += NODE_SZ_STR(node) - 1;
7039             node = NEXTOPER(node);
7040         }
7041         else {
7042             node = NEXTOPER(node);
7043             node += regarglen[(U8)op];
7044         }
7045         if (op == CURLYX || op == OPEN)
7046             l++;
7047         else if (op == WHILEM)
7048             l--;
7049     }
7050     CLEAR_OPTSTART;
7051     return node;
7052 }
7053
7054 #endif  /* DEBUGGING */
7055
7056 /*
7057  * Local variables:
7058  * c-indentation-style: bsd
7059  * c-basic-offset: 4
7060  * indent-tabs-mode: t
7061  * End:
7062  *
7063  * ex: set ts=8 sts=4 sw=4 noet:
7064  */