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