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