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