This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regmatch: fix a || vs | typo in CACHEsayYES and add a test from Hugo.
[perl5.git] / regcomp.c
1 /*    regcomp.c
2  */
3
4 /*
5  * "A fair jaw-cracker dwarf-language must be."  --Samwise Gamgee
6  */
7
8 /* This file contains functions for compiling a regular expression.  See
9  * also regexec.c which funnily enough, contains functions for executing
10  * a regular expression.
11  *
12  * This file is also copied at build time to ext/re/re_comp.c, where
13  * it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
14  * This causes the main functions to be compiled under new names and with
15  * debugging support added, which makes "use re 'debug'" work.
16  */
17
18 /* NOTE: this is derived from Henry Spencer's regexp code, and should not
19  * confused with the original package (see point 3 below).  Thanks, Henry!
20  */
21
22 /* Additional note: this code is very heavily munged from Henry's version
23  * in places.  In some spots I've traded clarity for efficiency, so don't
24  * blame Henry for some of the lack of readability.
25  */
26
27 /* The names of the functions have been changed from regcomp and
28  * regexec to  pregcomp and pregexec in order to avoid conflicts
29  * with the POSIX routines of the same names.
30 */
31
32 #ifdef PERL_EXT_RE_BUILD
33 /* need to replace pregcomp et al, so enable that */
34 #  ifndef PERL_IN_XSUB_RE
35 #    define PERL_IN_XSUB_RE
36 #  endif
37 /* need access to debugger hooks */
38 #  if defined(PERL_EXT_RE_DEBUG) && !defined(DEBUGGING)
39 #    define DEBUGGING
40 #  endif
41 #endif
42
43 #ifdef PERL_IN_XSUB_RE
44 /* We *really* need to overwrite these symbols: */
45 #  define Perl_pregcomp my_regcomp
46 #  define Perl_regdump my_regdump
47 #  define Perl_regprop my_regprop
48 #  define Perl_pregfree my_regfree
49 #  define Perl_re_intuit_string my_re_intuit_string
50 /* *These* symbols are masked to allow static link. */
51 #  define Perl_regnext my_regnext
52 #  define Perl_save_re_context my_save_re_context
53 #  define Perl_reginitcolors my_reginitcolors
54
55 #  define PERL_NO_GET_CONTEXT
56 #endif
57
58 /*
59  * pregcomp and pregexec -- regsub and regerror are not used in perl
60  *
61  *      Copyright (c) 1986 by University of Toronto.
62  *      Written by Henry Spencer.  Not derived from licensed software.
63  *
64  *      Permission is granted to anyone to use this software for any
65  *      purpose on any computer system, and to redistribute it freely,
66  *      subject to the following restrictions:
67  *
68  *      1. The author is not responsible for the consequences of use of
69  *              this software, no matter how awful, even if they arise
70  *              from defects in it.
71  *
72  *      2. The origin of this software must not be misrepresented, either
73  *              by explicit claim or by omission.
74  *
75  *      3. Altered versions must be plainly marked as such, and must not
76  *              be misrepresented as being the original software.
77  *
78  *
79  ****    Alterations to Henry's code are...
80  ****
81  ****    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
82  ****    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
83  ****
84  ****    You may distribute under the terms of either the GNU General Public
85  ****    License or the Artistic License, as specified in the README file.
86
87  *
88  * Beware that some of this code is subtly aware of the way operator
89  * precedence is structured in regular expressions.  Serious changes in
90  * regular-expression syntax might require a total rethink.
91  */
92 #include "EXTERN.h"
93 #define PERL_IN_REGCOMP_C
94 #include "perl.h"
95
96 #ifndef PERL_IN_XSUB_RE
97 #  include "INTERN.h"
98 #endif
99
100 #define REG_COMP_C
101 #include "regcomp.h"
102
103 #ifdef op
104 #undef op
105 #endif /* op */
106
107 #ifdef MSDOS
108 #  if defined(BUGGY_MSC6)
109  /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
110 #    pragma optimize("a",off)
111  /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
112 #    pragma optimize("w",on )
113 #  endif /* BUGGY_MSC6 */
114 #endif /* MSDOS */
115
116 #ifndef STATIC
117 #define STATIC  static
118 #endif
119
120 typedef struct RExC_state_t {
121     U32         flags;                  /* are we folding, multilining? */
122     char        *precomp;               /* uncompiled string. */
123     regexp      *rx;
124     char        *start;                 /* Start of input for compile */
125     char        *end;                   /* End of input for compile */
126     char        *parse;                 /* Input-scan pointer. */
127     I32         whilem_seen;            /* number of WHILEM in this expr */
128     regnode     *emit_start;            /* Start of emitted-code area */
129     regnode     *emit;                  /* Code-emit pointer; &regdummy = don't = compiling */
130     I32         naughty;                /* How bad is this pattern? */
131     I32         sawback;                /* Did we see \1, ...? */
132     U32         seen;
133     I32         size;                   /* Code size. */
134     I32         npar;                   /* () count. */
135     I32         extralen;
136     I32         seen_zerolen;
137     I32         seen_evals;
138     I32         utf8;
139 #if ADD_TO_REGEXEC
140     char        *starttry;              /* -Dr: where regtry was called. */
141 #define RExC_starttry   (pRExC_state->starttry)
142 #endif
143 } RExC_state_t;
144
145 #define RExC_flags      (pRExC_state->flags)
146 #define RExC_precomp    (pRExC_state->precomp)
147 #define RExC_rx         (pRExC_state->rx)
148 #define RExC_start      (pRExC_state->start)
149 #define RExC_end        (pRExC_state->end)
150 #define RExC_parse      (pRExC_state->parse)
151 #define RExC_whilem_seen        (pRExC_state->whilem_seen)
152 #define RExC_offsets    (pRExC_state->rx->offsets) /* I am not like the others */
153 #define RExC_emit       (pRExC_state->emit)
154 #define RExC_emit_start (pRExC_state->emit_start)
155 #define RExC_naughty    (pRExC_state->naughty)
156 #define RExC_sawback    (pRExC_state->sawback)
157 #define RExC_seen       (pRExC_state->seen)
158 #define RExC_size       (pRExC_state->size)
159 #define RExC_npar       (pRExC_state->npar)
160 #define RExC_extralen   (pRExC_state->extralen)
161 #define RExC_seen_zerolen       (pRExC_state->seen_zerolen)
162 #define RExC_seen_evals (pRExC_state->seen_evals)
163 #define RExC_utf8       (pRExC_state->utf8)
164
165 #define ISMULT1(c)      ((c) == '*' || (c) == '+' || (c) == '?')
166 #define ISMULT2(s)      ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
167         ((*s) == '{' && regcurly(s)))
168
169 #ifdef SPSTART
170 #undef SPSTART          /* dratted cpp namespace... */
171 #endif
172 /*
173  * Flags to be passed up and down.
174  */
175 #define WORST           0       /* Worst case. */
176 #define HASWIDTH        0x1     /* Known to match non-null strings. */
177 #define SIMPLE          0x2     /* Simple enough to be STAR/PLUS operand. */
178 #define SPSTART         0x4     /* Starts with * or +. */
179 #define TRYAGAIN        0x8     /* Weeded out a declaration. */
180
181 /* Length of a variant. */
182
183 typedef struct scan_data_t {
184     I32 len_min;
185     I32 len_delta;
186     I32 pos_min;
187     I32 pos_delta;
188     SV *last_found;
189     I32 last_end;                       /* min value, <0 unless valid. */
190     I32 last_start_min;
191     I32 last_start_max;
192     SV **longest;                       /* Either &l_fixed, or &l_float. */
193     SV *longest_fixed;
194     I32 offset_fixed;
195     SV *longest_float;
196     I32 offset_float_min;
197     I32 offset_float_max;
198     I32 flags;
199     I32 whilem_c;
200     I32 *last_closep;
201     struct regnode_charclass_class *start_class;
202 } scan_data_t;
203
204 /*
205  * Forward declarations for pregcomp()'s friends.
206  */
207
208 static const scan_data_t zero_scan_data =
209   { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
210
211 #define SF_BEFORE_EOL           (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
212 #define SF_BEFORE_SEOL          0x1
213 #define SF_BEFORE_MEOL          0x2
214 #define SF_FIX_BEFORE_EOL       (SF_FIX_BEFORE_SEOL|SF_FIX_BEFORE_MEOL)
215 #define SF_FL_BEFORE_EOL        (SF_FL_BEFORE_SEOL|SF_FL_BEFORE_MEOL)
216
217 #ifdef NO_UNARY_PLUS
218 #  define SF_FIX_SHIFT_EOL      (0+2)
219 #  define SF_FL_SHIFT_EOL               (0+4)
220 #else
221 #  define SF_FIX_SHIFT_EOL      (+2)
222 #  define SF_FL_SHIFT_EOL               (+4)
223 #endif
224
225 #define SF_FIX_BEFORE_SEOL      (SF_BEFORE_SEOL << SF_FIX_SHIFT_EOL)
226 #define SF_FIX_BEFORE_MEOL      (SF_BEFORE_MEOL << SF_FIX_SHIFT_EOL)
227
228 #define SF_FL_BEFORE_SEOL       (SF_BEFORE_SEOL << SF_FL_SHIFT_EOL)
229 #define SF_FL_BEFORE_MEOL       (SF_BEFORE_MEOL << SF_FL_SHIFT_EOL) /* 0x20 */
230 #define SF_IS_INF               0x40
231 #define SF_HAS_PAR              0x80
232 #define SF_IN_PAR               0x100
233 #define SF_HAS_EVAL             0x200
234 #define SCF_DO_SUBSTR           0x400
235 #define SCF_DO_STCLASS_AND      0x0800
236 #define SCF_DO_STCLASS_OR       0x1000
237 #define SCF_DO_STCLASS          (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR)
238 #define SCF_WHILEM_VISITED_POS  0x2000
239
240 #define UTF (RExC_utf8 != 0)
241 #define LOC ((RExC_flags & PMf_LOCALE) != 0)
242 #define FOLD ((RExC_flags & PMf_FOLD) != 0)
243
244 #define OOB_UNICODE             12345678
245 #define OOB_NAMEDCLASS          -1
246
247 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
248 #define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
249
250
251 /* length of regex to show in messages that don't mark a position within */
252 #define RegexLengthToShowInErrorMessages 127
253
254 /*
255  * If MARKER[12] are adjusted, be sure to adjust the constants at the top
256  * of t/op/regmesg.t, the tests in t/op/re_tests, and those in
257  * op/pragma/warn/regcomp.
258  */
259 #define MARKER1 "<-- HERE"    /* marker as it appears in the description */
260 #define MARKER2 " <-- HERE "  /* marker as it appears within the regex */
261
262 #define REPORT_LOCATION " in regex; marked by " MARKER1 " in m/%.*s" MARKER2 "%s/"
263
264 /*
265  * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
266  * arg. Show regex, up to a maximum length. If it's too long, chop and add
267  * "...".
268  */
269 #define FAIL(msg) STMT_START {                                          \
270     const char *ellipses = "";                                          \
271     IV len = RExC_end - RExC_precomp;                                   \
272                                                                         \
273     if (!SIZE_ONLY)                                                     \
274         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx);                      \
275     if (len > RegexLengthToShowInErrorMessages) {                       \
276         /* chop 10 shorter than the max, to ensure meaning of "..." */  \
277         len = RegexLengthToShowInErrorMessages - 10;                    \
278         ellipses = "...";                                               \
279     }                                                                   \
280     Perl_croak(aTHX_ "%s in regex m/%.*s%s/",                           \
281             msg, (int)len, RExC_precomp, ellipses);                     \
282 } STMT_END
283
284 /*
285  * Simple_vFAIL -- like FAIL, but marks the current location in the scan
286  */
287 #define Simple_vFAIL(m) STMT_START {                                    \
288     const IV offset = RExC_parse - RExC_precomp;                        \
289     Perl_croak(aTHX_ "%s" REPORT_LOCATION,                              \
290             m, (int)offset, RExC_precomp, RExC_precomp + offset);       \
291 } STMT_END
292
293 /*
294  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL()
295  */
296 #define vFAIL(m) STMT_START {                           \
297     if (!SIZE_ONLY)                                     \
298         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx);      \
299     Simple_vFAIL(m);                                    \
300 } STMT_END
301
302 /*
303  * Like Simple_vFAIL(), but accepts two arguments.
304  */
305 #define Simple_vFAIL2(m,a1) STMT_START {                        \
306     const IV offset = RExC_parse - RExC_precomp;                        \
307     S_re_croak2(aTHX_ m, REPORT_LOCATION, a1,                   \
308             (int)offset, RExC_precomp, RExC_precomp + offset);  \
309 } STMT_END
310
311 /*
312  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL2().
313  */
314 #define vFAIL2(m,a1) STMT_START {                       \
315     if (!SIZE_ONLY)                                     \
316         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx);      \
317     Simple_vFAIL2(m, a1);                               \
318 } STMT_END
319
320
321 /*
322  * Like Simple_vFAIL(), but accepts three arguments.
323  */
324 #define Simple_vFAIL3(m, a1, a2) STMT_START {                   \
325     const IV offset = RExC_parse - RExC_precomp;                \
326     S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2,               \
327             (int)offset, RExC_precomp, RExC_precomp + offset);  \
328 } STMT_END
329
330 /*
331  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL3().
332  */
333 #define vFAIL3(m,a1,a2) STMT_START {                    \
334     if (!SIZE_ONLY)                                     \
335         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx);      \
336     Simple_vFAIL3(m, a1, a2);                           \
337 } STMT_END
338
339 /*
340  * Like Simple_vFAIL(), but accepts four arguments.
341  */
342 #define Simple_vFAIL4(m, a1, a2, a3) STMT_START {               \
343     const IV offset = RExC_parse - RExC_precomp;                \
344     S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3,           \
345             (int)offset, RExC_precomp, RExC_precomp + offset);  \
346 } STMT_END
347
348 #define vWARN(loc,m) STMT_START {                                       \
349     const IV offset = loc - RExC_precomp;                               \
350     Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s" REPORT_LOCATION,      \
351             m, (int)offset, RExC_precomp, RExC_precomp + offset);       \
352 } STMT_END
353
354 #define vWARNdep(loc,m) STMT_START {                                    \
355     const IV offset = loc - RExC_precomp;                               \
356     Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP),          \
357             "%s" REPORT_LOCATION,                                       \
358             m, (int)offset, RExC_precomp, RExC_precomp + offset);       \
359 } STMT_END
360
361
362 #define vWARN2(loc, m, a1) STMT_START {                                 \
363     const IV offset = loc - RExC_precomp;                               \
364     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
365             a1, (int)offset, RExC_precomp, RExC_precomp + offset);      \
366 } STMT_END
367
368 #define vWARN3(loc, m, a1, a2) STMT_START {                             \
369     const IV offset = loc - RExC_precomp;                               \
370     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
371             a1, a2, (int)offset, RExC_precomp, RExC_precomp + offset);  \
372 } STMT_END
373
374 #define vWARN4(loc, m, a1, a2, a3) STMT_START {                         \
375     const IV offset = loc - RExC_precomp;                               \
376     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
377             a1, a2, a3, (int)offset, RExC_precomp, RExC_precomp + offset); \
378 } STMT_END
379
380 #define vWARN5(loc, m, a1, a2, a3, a4) STMT_START {                     \
381     const IV offset = loc - RExC_precomp;                               \
382     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
383             a1, a2, a3, a4, (int)offset, RExC_precomp, RExC_precomp + offset); \
384 } STMT_END
385
386
387 /* Allow for side effects in s */
388 #define REGC(c,s) STMT_START {                  \
389     if (!SIZE_ONLY) *(s) = (c); else (void)(s); \
390 } STMT_END
391
392 /* Macros for recording node offsets.   20001227 mjd@plover.com 
393  * Nodes are numbered 1, 2, 3, 4.  Node #n's position is recorded in
394  * element 2*n-1 of the array.  Element #2n holds the byte length node #n.
395  * Element 0 holds the number n.
396  */
397
398 #define MJD_OFFSET_DEBUG(x)
399 /* #define MJD_OFFSET_DEBUG(x) DEBUG_r(Perl_warn_nocontext x) */
400
401
402 #define Set_Node_Offset_To_R(node,byte) STMT_START {                    \
403     if (! SIZE_ONLY) {                                                  \
404         MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n",         \
405                 __LINE__, (node), (byte)));                             \
406         if((node) < 0) {                                                \
407             Perl_croak(aTHX_ "value of node is %d in Offset macro", (int)(node)); \
408         } else {                                                        \
409             RExC_offsets[2*(node)-1] = (byte);                          \
410         }                                                               \
411     }                                                                   \
412 } STMT_END
413
414 #define Set_Node_Offset(node,byte) \
415     Set_Node_Offset_To_R((node)-RExC_emit_start, (byte)-RExC_start)
416 #define Set_Cur_Node_Offset Set_Node_Offset(RExC_emit, RExC_parse)
417
418 #define Set_Node_Length_To_R(node,len) STMT_START {                     \
419     if (! SIZE_ONLY) {                                                  \
420         MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n",           \
421                 __LINE__, (int)(node), (int)(len)));                    \
422         if((node) < 0) {                                                \
423             Perl_croak(aTHX_ "value of node is %d in Length macro", (int)(node)); \
424         } else {                                                        \
425             RExC_offsets[2*(node)] = (len);                             \
426         }                                                               \
427     }                                                                   \
428 } STMT_END
429
430 #define Set_Node_Length(node,len) \
431     Set_Node_Length_To_R((node)-RExC_emit_start, len)
432 #define Set_Cur_Node_Length(len) Set_Node_Length(RExC_emit, len)
433 #define Set_Node_Cur_Length(node) \
434     Set_Node_Length(node, RExC_parse - parse_start)
435
436 /* Get offsets and lengths */
437 #define Node_Offset(n) (RExC_offsets[2*((n)-RExC_emit_start)-1])
438 #define Node_Length(n) (RExC_offsets[2*((n)-RExC_emit_start)])
439
440 static void clear_re(pTHX_ void *r);
441
442 /* Mark that we cannot extend a found fixed substring at this point.
443    Updata the longest found anchored substring and the longest found
444    floating substrings if needed. */
445
446 STATIC void
447 S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data)
448 {
449     const STRLEN l = CHR_SVLEN(data->last_found);
450     const STRLEN old_l = CHR_SVLEN(*data->longest);
451
452     if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
453         SvSetMagicSV(*data->longest, data->last_found);
454         if (*data->longest == data->longest_fixed) {
455             data->offset_fixed = l ? data->last_start_min : data->pos_min;
456             if (data->flags & SF_BEFORE_EOL)
457                 data->flags
458                     |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL);
459             else
460                 data->flags &= ~SF_FIX_BEFORE_EOL;
461         }
462         else {
463             data->offset_float_min = l ? data->last_start_min : data->pos_min;
464             data->offset_float_max = (l
465                                       ? data->last_start_max
466                                       : data->pos_min + data->pos_delta);
467             if ((U32)data->offset_float_max > (U32)I32_MAX)
468                 data->offset_float_max = I32_MAX;
469             if (data->flags & SF_BEFORE_EOL)
470                 data->flags
471                     |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL);
472             else
473                 data->flags &= ~SF_FL_BEFORE_EOL;
474         }
475     }
476     SvCUR_set(data->last_found, 0);
477     {
478         SV * const sv = data->last_found;
479         if (SvUTF8(sv) && SvMAGICAL(sv)) {
480             MAGIC * const mg = mg_find(sv, PERL_MAGIC_utf8);
481             if (mg)
482                 mg->mg_len = 0;
483         }
484     }
485     data->last_end = -1;
486     data->flags &= ~SF_BEFORE_EOL;
487 }
488
489 /* Can match anything (initialization) */
490 STATIC void
491 S_cl_anything(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
492 {
493     ANYOF_CLASS_ZERO(cl);
494     ANYOF_BITMAP_SETALL(cl);
495     cl->flags = ANYOF_EOS|ANYOF_UNICODE_ALL;
496     if (LOC)
497         cl->flags |= ANYOF_LOCALE;
498 }
499
500 /* Can match anything (initialization) */
501 STATIC int
502 S_cl_is_anything(const struct regnode_charclass_class *cl)
503 {
504     int value;
505
506     for (value = 0; value <= ANYOF_MAX; value += 2)
507         if (ANYOF_CLASS_TEST(cl, value) && ANYOF_CLASS_TEST(cl, value + 1))
508             return 1;
509     if (!(cl->flags & ANYOF_UNICODE_ALL))
510         return 0;
511     if (!ANYOF_BITMAP_TESTALLSET(cl))
512         return 0;
513     return 1;
514 }
515
516 /* Can match anything (initialization) */
517 STATIC void
518 S_cl_init(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
519 {
520     Zero(cl, 1, struct regnode_charclass_class);
521     cl->type = ANYOF;
522     cl_anything(pRExC_state, cl);
523 }
524
525 STATIC void
526 S_cl_init_zero(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
527 {
528     Zero(cl, 1, struct regnode_charclass_class);
529     cl->type = ANYOF;
530     cl_anything(pRExC_state, cl);
531     if (LOC)
532         cl->flags |= ANYOF_LOCALE;
533 }
534
535 /* 'And' a given class with another one.  Can create false positives */
536 /* We assume that cl is not inverted */
537 STATIC void
538 S_cl_and(struct regnode_charclass_class *cl,
539         const struct regnode_charclass_class *and_with)
540 {
541     if (!(and_with->flags & ANYOF_CLASS)
542         && !(cl->flags & ANYOF_CLASS)
543         && (and_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
544         && !(and_with->flags & ANYOF_FOLD)
545         && !(cl->flags & ANYOF_FOLD)) {
546         int i;
547
548         if (and_with->flags & ANYOF_INVERT)
549             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
550                 cl->bitmap[i] &= ~and_with->bitmap[i];
551         else
552             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
553                 cl->bitmap[i] &= and_with->bitmap[i];
554     } /* XXXX: logic is complicated otherwise, leave it along for a moment. */
555     if (!(and_with->flags & ANYOF_EOS))
556         cl->flags &= ~ANYOF_EOS;
557
558     if (cl->flags & ANYOF_UNICODE_ALL && and_with->flags & ANYOF_UNICODE &&
559         !(and_with->flags & ANYOF_INVERT)) {
560         cl->flags &= ~ANYOF_UNICODE_ALL;
561         cl->flags |= ANYOF_UNICODE;
562         ARG_SET(cl, ARG(and_with));
563     }
564     if (!(and_with->flags & ANYOF_UNICODE_ALL) &&
565         !(and_with->flags & ANYOF_INVERT))
566         cl->flags &= ~ANYOF_UNICODE_ALL;
567     if (!(and_with->flags & (ANYOF_UNICODE|ANYOF_UNICODE_ALL)) &&
568         !(and_with->flags & ANYOF_INVERT))
569         cl->flags &= ~ANYOF_UNICODE;
570 }
571
572 /* 'OR' a given class with another one.  Can create false positives */
573 /* We assume that cl is not inverted */
574 STATIC void
575 S_cl_or(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, const struct regnode_charclass_class *or_with)
576 {
577     if (or_with->flags & ANYOF_INVERT) {
578         /* We do not use
579          * (B1 | CL1) | (!B2 & !CL2) = (B1 | !B2 & !CL2) | (CL1 | (!B2 & !CL2))
580          *   <= (B1 | !B2) | (CL1 | !CL2)
581          * which is wasteful if CL2 is small, but we ignore CL2:
582          *   (B1 | CL1) | (!B2 & !CL2) <= (B1 | CL1) | !B2 = (B1 | !B2) | CL1
583          * XXXX Can we handle case-fold?  Unclear:
584          *   (OK1(i) | OK1(i')) | !(OK1(i) | OK1(i')) =
585          *   (OK1(i) | OK1(i')) | (!OK1(i) & !OK1(i'))
586          */
587         if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
588              && !(or_with->flags & ANYOF_FOLD)
589              && !(cl->flags & ANYOF_FOLD) ) {
590             int i;
591
592             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
593                 cl->bitmap[i] |= ~or_with->bitmap[i];
594         } /* XXXX: logic is complicated otherwise */
595         else {
596             cl_anything(pRExC_state, cl);
597         }
598     } else {
599         /* (B1 | CL1) | (B2 | CL2) = (B1 | B2) | (CL1 | CL2)) */
600         if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
601              && (!(or_with->flags & ANYOF_FOLD)
602                  || (cl->flags & ANYOF_FOLD)) ) {
603             int i;
604
605             /* OR char bitmap and class bitmap separately */
606             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
607                 cl->bitmap[i] |= or_with->bitmap[i];
608             if (or_with->flags & ANYOF_CLASS) {
609                 for (i = 0; i < ANYOF_CLASSBITMAP_SIZE; i++)
610                     cl->classflags[i] |= or_with->classflags[i];
611                 cl->flags |= ANYOF_CLASS;
612             }
613         }
614         else { /* XXXX: logic is complicated, leave it along for a moment. */
615             cl_anything(pRExC_state, cl);
616         }
617     }
618     if (or_with->flags & ANYOF_EOS)
619         cl->flags |= ANYOF_EOS;
620
621     if (cl->flags & ANYOF_UNICODE && or_with->flags & ANYOF_UNICODE &&
622         ARG(cl) != ARG(or_with)) {
623         cl->flags |= ANYOF_UNICODE_ALL;
624         cl->flags &= ~ANYOF_UNICODE;
625     }
626     if (or_with->flags & ANYOF_UNICODE_ALL) {
627         cl->flags |= ANYOF_UNICODE_ALL;
628         cl->flags &= ~ANYOF_UNICODE;
629     }
630 }
631
632 /*
633
634  make_trie(startbranch,first,last,tail,flags)
635   startbranch: the first branch in the whole branch sequence
636   first      : start branch of sequence of branch-exact nodes.
637                May be the same as startbranch
638   last       : Thing following the last branch.
639                May be the same as tail.
640   tail       : item following the branch sequence
641   flags      : currently the OP() type we will be building one of /EXACT(|F|Fl)/
642
643 Inplace optimizes a sequence of 2 or more Branch-Exact nodes into a TRIE node.
644
645 A trie is an N'ary tree where the branches are determined by digital
646 decomposition of the key. IE, at the root node you look up the 1st character and
647 follow that branch repeat until you find the end of the branches. Nodes can be
648 marked as "accepting" meaning they represent a complete word. Eg:
649
650   /he|she|his|hers/
651
652 would convert into the following structure. Numbers represent states, letters
653 following numbers represent valid transitions on the letter from that state, if
654 the number is in square brackets it represents an accepting state, otherwise it
655 will be in parenthesis.
656
657       +-h->+-e->[3]-+-r->(8)-+-s->[9]
658       |    |
659       |   (2)
660       |    |
661      (1)   +-i->(6)-+-s->[7]
662       |
663       +-s->(3)-+-h->(4)-+-e->[5]
664
665       Accept Word Mapping: 3=>1 (he),5=>2 (she), 7=>3 (his), 9=>4 (hers)
666
667 This shows that when matching against the string 'hers' we will begin at state 1
668 read 'h' and move to state 2, read 'e' and move to state 3 which is accepting,
669 then read 'r' and go to state 8 followed by 's' which takes us to state 9 which
670 is also accepting. Thus we know that we can match both 'he' and 'hers' with a
671 single traverse. We store a mapping from accepting to state to which word was
672 matched, and then when we have multiple possibilities we try to complete the
673 rest of the regex in the order in which they occured in the alternation.
674
675 The only prior NFA like behaviour that would be changed by the TRIE support is
676 the silent ignoring of duplicate alternations which are of the form:
677
678  / (DUPE|DUPE) X? (?{ ... }) Y /x
679
680 Thus EVAL blocks follwing a trie may be called a different number of times with
681 and without the optimisation. With the optimisations dupes will be silently
682 ignored. This inconsistant behaviour of EVAL type nodes is well established as
683 the following demonstrates:
684
685  'words'=~/(word|word|word)(?{ print $1 })[xyz]/
686
687 which prints out 'word' three times, but
688
689  'words'=~/(word|word|word)(?{ print $1 })S/
690
691 which doesnt print it out at all. This is due to other optimisations kicking in.
692
693 Example of what happens on a structural level:
694
695 The regexp /(ac|ad|ab)+/ will produce the folowing debug output:
696
697    1: CURLYM[1] {1,32767}(18)
698    5:   BRANCH(8)
699    6:     EXACT <ac>(16)
700    8:   BRANCH(11)
701    9:     EXACT <ad>(16)
702   11:   BRANCH(14)
703   12:     EXACT <ab>(16)
704   16:   SUCCEED(0)
705   17:   NOTHING(18)
706   18: END(0)
707
708 This would be optimizable with startbranch=5, first=5, last=16, tail=16
709 and should turn into:
710
711    1: CURLYM[1] {1,32767}(18)
712    5:   TRIE(16)
713         [Words:3 Chars Stored:6 Unique Chars:4 States:5 NCP:1]
714           <ac>
715           <ad>
716           <ab>
717   16:   SUCCEED(0)
718   17:   NOTHING(18)
719   18: END(0)
720
721 Cases where tail != last would be like /(?foo|bar)baz/:
722
723    1: BRANCH(4)
724    2:   EXACT <foo>(8)
725    4: BRANCH(7)
726    5:   EXACT <bar>(8)
727    7: TAIL(8)
728    8: EXACT <baz>(10)
729   10: END(0)
730
731 which would be optimizable with startbranch=1, first=1, last=7, tail=8
732 and would end up looking like:
733
734     1: TRIE(8)
735       [Words:2 Chars Stored:6 Unique Chars:5 States:7 NCP:1]
736         <foo>
737         <bar>
738    7: TAIL(8)
739    8: EXACT <baz>(10)
740   10: END(0)
741
742 */
743
744 #define TRIE_DEBUG_CHAR                                                    \
745     DEBUG_TRIE_COMPILE_r({                                                 \
746         SV *tmp;                                                           \
747         if ( UTF ) {                                                       \
748             tmp = newSVpvs( "" );                                          \
749             pv_uni_display( tmp, uc, len, 60, UNI_DISPLAY_REGEX );         \
750         } else {                                                           \
751             tmp = Perl_newSVpvf_nocontext( "%c", (int)uvc );               \
752         }                                                                  \
753         av_push( trie->revcharmap, tmp );                                  \
754     })
755
756 #define TRIE_READ_CHAR STMT_START {                                           \
757     if ( UTF ) {                                                              \
758         if ( folder ) {                                                       \
759             if ( foldlen > 0 ) {                                              \
760                uvc = utf8n_to_uvuni( scan, UTF8_MAXLEN, &len, uniflags );     \
761                foldlen -= len;                                                \
762                scan += len;                                                   \
763                len = 0;                                                       \
764             } else {                                                          \
765                 uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
766                 uvc = to_uni_fold( uvc, foldbuf, &foldlen );                  \
767                 foldlen -= UNISKIP( uvc );                                    \
768                 scan = foldbuf + UNISKIP( uvc );                              \
769             }                                                                 \
770         } else {                                                              \
771             uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
772         }                                                                     \
773     } else {                                                                  \
774         uvc = (U32)*uc;                                                       \
775         len = 1;                                                              \
776     }                                                                         \
777 } STMT_END
778
779
780 #define TRIE_LIST_ITEM(state,idx) (trie->states[state].trans.list)[ idx ]
781 #define TRIE_LIST_CUR(state)  ( TRIE_LIST_ITEM( state, 0 ).forid )
782 #define TRIE_LIST_LEN(state) ( TRIE_LIST_ITEM( state, 0 ).newstate )
783 #define TRIE_LIST_USED(idx)  ( trie->states[state].trans.list ? (TRIE_LIST_CUR( idx ) - 1) : 0 )
784
785 #define TRIE_LIST_PUSH(state,fid,ns) STMT_START {               \
786     if ( TRIE_LIST_CUR( state ) >=TRIE_LIST_LEN( state ) ) {    \
787         TRIE_LIST_LEN( state ) *= 2;                            \
788         Renew( trie->states[ state ].trans.list,                \
789                TRIE_LIST_LEN( state ), reg_trie_trans_le );     \
790     }                                                           \
791     TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).forid = fid;     \
792     TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).newstate = ns;   \
793     TRIE_LIST_CUR( state )++;                                   \
794 } STMT_END
795
796 #define TRIE_LIST_NEW(state) STMT_START {                       \
797     Newxz( trie->states[ state ].trans.list,               \
798         4, reg_trie_trans_le );                                 \
799      TRIE_LIST_CUR( state ) = 1;                                \
800      TRIE_LIST_LEN( state ) = 4;                                \
801 } STMT_END
802
803 STATIC I32
804 S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 flags)
805 {
806     dVAR;
807     /* first pass, loop through and scan words */
808     reg_trie_data *trie;
809     regnode *cur;
810     const U32 uniflags = UTF8_ALLOW_DEFAULT;
811     STRLEN len = 0;
812     UV uvc = 0;
813     U16 curword = 0;
814     U32 next_alloc = 0;
815     /* we just use folder as a flag in utf8 */
816     const U8 * const folder = ( flags == EXACTF
817                        ? PL_fold
818                        : ( flags == EXACTFL
819                            ? PL_fold_locale
820                            : NULL
821                          )
822                      );
823
824     const U32 data_slot = add_data( pRExC_state, 1, "t" );
825     SV *re_trie_maxbuff;
826
827     GET_RE_DEBUG_FLAGS_DECL;
828
829     Newxz( trie, 1, reg_trie_data );
830     trie->refcount = 1;
831     RExC_rx->data->data[ data_slot ] = (void*)trie;
832     Newxz( trie->charmap, 256, U16 );
833     DEBUG_r({
834         trie->words = newAV();
835         trie->revcharmap = newAV();
836     });
837
838
839     re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
840     if (!SvIOK(re_trie_maxbuff)) {
841         sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
842     }
843
844     /*  -- First loop and Setup --
845
846        We first traverse the branches and scan each word to determine if it
847        contains widechars, and how many unique chars there are, this is
848        important as we have to build a table with at least as many columns as we
849        have unique chars.
850
851        We use an array of integers to represent the character codes 0..255
852        (trie->charmap) and we use a an HV* to store unicode characters. We use the
853        native representation of the character value as the key and IV's for the
854        coded index.
855
856        *TODO* If we keep track of how many times each character is used we can
857        remap the columns so that the table compression later on is more
858        efficient in terms of memory by ensuring most common value is in the
859        middle and the least common are on the outside.  IMO this would be better
860        than a most to least common mapping as theres a decent chance the most
861        common letter will share a node with the least common, meaning the node
862        will not be compressable. With a middle is most common approach the worst
863        case is when we have the least common nodes twice.
864
865      */
866
867
868     for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
869         regnode * const noper = NEXTOPER( cur );
870         const U8 *uc = (U8*)STRING( noper );
871         const U8 * const e  = uc + STR_LEN( noper );
872         STRLEN foldlen = 0;
873         U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
874         const U8 *scan = (U8*)NULL;
875
876         for ( ; uc < e ; uc += len ) {
877             trie->charcount++;
878             TRIE_READ_CHAR;
879             if ( uvc < 256 ) {
880                 if ( !trie->charmap[ uvc ] ) {
881                     trie->charmap[ uvc ]=( ++trie->uniquecharcount );
882                     if ( folder )
883                         trie->charmap[ folder[ uvc ] ] = trie->charmap[ uvc ];
884                     TRIE_DEBUG_CHAR;
885                 }
886             } else {
887                 SV** svpp;
888                 if ( !trie->widecharmap )
889                     trie->widecharmap = newHV();
890
891                 svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 1 );
892
893                 if ( !svpp )
894                     Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%"UVXf, uvc );
895
896                 if ( !SvTRUE( *svpp ) ) {
897                     sv_setiv( *svpp, ++trie->uniquecharcount );
898                     TRIE_DEBUG_CHAR;
899                 }
900             }
901         }
902         trie->wordcount++;
903     } /* end first pass */
904     DEBUG_TRIE_COMPILE_r(
905         PerlIO_printf( Perl_debug_log, "TRIE(%s): W:%d C:%d Uq:%d \n",
906                 ( trie->widecharmap ? "UTF8" : "NATIVE" ), trie->wordcount,
907                 (int)trie->charcount, trie->uniquecharcount )
908     );
909
910
911     /*
912         We now know what we are dealing with in terms of unique chars and
913         string sizes so we can calculate how much memory a naive
914         representation using a flat table  will take. If it's over a reasonable
915         limit (as specified by ${^RE_TRIE_MAXBUF}) we use a more memory
916         conservative but potentially much slower representation using an array
917         of lists.
918
919         At the end we convert both representations into the same compressed
920         form that will be used in regexec.c for matching with. The latter
921         is a form that cannot be used to construct with but has memory
922         properties similar to the list form and access properties similar
923         to the table form making it both suitable for fast searches and
924         small enough that its feasable to store for the duration of a program.
925
926         See the comment in the code where the compressed table is produced
927         inplace from the flat tabe representation for an explanation of how
928         the compression works.
929
930     */
931
932
933     if ( (IV)( ( trie->charcount + 1 ) * trie->uniquecharcount + 1) > SvIV(re_trie_maxbuff) ) {
934         /*
935             Second Pass -- Array Of Lists Representation
936
937             Each state will be represented by a list of charid:state records
938             (reg_trie_trans_le) the first such element holds the CUR and LEN
939             points of the allocated array. (See defines above).
940
941             We build the initial structure using the lists, and then convert
942             it into the compressed table form which allows faster lookups
943             (but cant be modified once converted).
944
945
946         */
947
948
949         STRLEN transcount = 1;
950
951         Newxz( trie->states, trie->charcount + 2, reg_trie_state );
952         TRIE_LIST_NEW(1);
953         next_alloc = 2;
954
955         for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
956
957             regnode * const noper = NEXTOPER( cur );
958             U8 *uc           = (U8*)STRING( noper );
959             const U8 * const e = uc + STR_LEN( noper );
960             U32 state        = 1;         /* required init */
961             U16 charid       = 0;         /* sanity init */
962             U8 *scan         = (U8*)NULL; /* sanity init */
963             STRLEN foldlen   = 0;         /* required init */
964             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
965
966             for ( ; uc < e ; uc += len ) {
967
968                 TRIE_READ_CHAR;
969
970                 if ( uvc < 256 ) {
971                     charid = trie->charmap[ uvc ];
972                 } else {
973                     SV** const svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 0);
974                     if ( !svpp ) {
975                         charid = 0;
976                     } else {
977                         charid=(U16)SvIV( *svpp );
978                     }
979                 }
980                 if ( charid ) {
981
982                     U16 check;
983                     U32 newstate = 0;
984
985                     charid--;
986                     if ( !trie->states[ state ].trans.list ) {
987                         TRIE_LIST_NEW( state );
988                     }
989                     for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) {
990                         if ( TRIE_LIST_ITEM( state, check ).forid == charid ) {
991                             newstate = TRIE_LIST_ITEM( state, check ).newstate;
992                             break;
993                         }
994                     }
995                     if ( ! newstate ) {
996                         newstate = next_alloc++;
997                         TRIE_LIST_PUSH( state, charid, newstate );
998                         transcount++;
999                     }
1000                     state = newstate;
1001                 } else {
1002                     Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1003                 }
1004                 /* charid is now 0 if we dont know the char read, or nonzero if we do */
1005             }
1006
1007             if ( !trie->states[ state ].wordnum ) {
1008                 /* we havent inserted this word into the structure yet. */
1009                 trie->states[ state ].wordnum = ++curword;
1010
1011                 DEBUG_r({
1012                     /* store the word for dumping */
1013                     SV* tmp = newSVpvn( STRING( noper ), STR_LEN( noper ) );
1014                     if ( UTF ) SvUTF8_on( tmp );
1015                     av_push( trie->words, tmp );
1016                 });
1017
1018             } else {
1019                 /*EMPTY*/;   /* It's a dupe. So ignore it. */
1020             }
1021
1022         } /* end second pass */
1023
1024         trie->laststate = next_alloc;
1025         Renew( trie->states, next_alloc, reg_trie_state );
1026
1027         DEBUG_TRIE_COMPILE_MORE_r({
1028             U32 state;
1029
1030             /* print out the table precompression.  */
1031
1032             PerlIO_printf( Perl_debug_log, "\nState :Word | Transition Data\n" );
1033             PerlIO_printf( Perl_debug_log,   "------:-----+-----------------" );
1034
1035             for( state=1 ; state < next_alloc ; state ++ ) {
1036                 U16 charid;
1037
1038                 PerlIO_printf( Perl_debug_log, "\n %04"UVXf" :", (UV)state  );
1039                 if ( ! trie->states[ state ].wordnum ) {
1040                     PerlIO_printf( Perl_debug_log, "%5s| ","");
1041                 } else {
1042                     PerlIO_printf( Perl_debug_log, "W%04x| ",
1043                         trie->states[ state ].wordnum
1044                     );
1045                 }
1046                 for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
1047                     SV **tmp = av_fetch( trie->revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0);
1048                     PerlIO_printf( Perl_debug_log, "%s:%3X=%04"UVXf" | ",
1049                         SvPV_nolen_const( *tmp ),
1050                         TRIE_LIST_ITEM(state,charid).forid,
1051                         (UV)TRIE_LIST_ITEM(state,charid).newstate
1052                     );
1053                 }
1054
1055             }
1056             PerlIO_printf( Perl_debug_log, "\n\n" );
1057         });
1058
1059         Newxz( trie->trans, transcount ,reg_trie_trans );
1060         {
1061             U32 state;
1062             U32 tp = 0;
1063             U32 zp = 0;
1064
1065
1066             for( state=1 ; state < next_alloc ; state ++ ) {
1067                 U32 base=0;
1068
1069                 /*
1070                 DEBUG_TRIE_COMPILE_MORE_r(
1071                     PerlIO_printf( Perl_debug_log, "tp: %d zp: %d ",tp,zp)
1072                 );
1073                 */
1074
1075                 if (trie->states[state].trans.list) {
1076                     U16 minid=TRIE_LIST_ITEM( state, 1).forid;
1077                     U16 maxid=minid;
1078                     U16 idx;
1079
1080                     for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1081                         const U16 forid = TRIE_LIST_ITEM( state, idx).forid;
1082                         if ( forid < minid ) {
1083                             minid=forid;
1084                         } else if ( forid > maxid ) {
1085                             maxid=forid;
1086                         }
1087                     }
1088                     if ( transcount < tp + maxid - minid + 1) {
1089                         transcount *= 2;
1090                         Renew( trie->trans, transcount, reg_trie_trans );
1091                         Zero( trie->trans + (transcount / 2), transcount / 2 , reg_trie_trans );
1092                     }
1093                     base = trie->uniquecharcount + tp - minid;
1094                     if ( maxid == minid ) {
1095                         U32 set = 0;
1096                         for ( ; zp < tp ; zp++ ) {
1097                             if ( ! trie->trans[ zp ].next ) {
1098                                 base = trie->uniquecharcount + zp - minid;
1099                                 trie->trans[ zp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1100                                 trie->trans[ zp ].check = state;
1101                                 set = 1;
1102                                 break;
1103                             }
1104                         }
1105                         if ( !set ) {
1106                             trie->trans[ tp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1107                             trie->trans[ tp ].check = state;
1108                             tp++;
1109                             zp = tp;
1110                         }
1111                     } else {
1112                         for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1113                             const U32 tid = base -  trie->uniquecharcount + TRIE_LIST_ITEM( state, idx ).forid;
1114                             trie->trans[ tid ].next = TRIE_LIST_ITEM( state, idx ).newstate;
1115                             trie->trans[ tid ].check = state;
1116                         }
1117                         tp += ( maxid - minid + 1 );
1118                     }
1119                     Safefree(trie->states[ state ].trans.list);
1120                 }
1121                 /*
1122                 DEBUG_TRIE_COMPILE_MORE_r(
1123                     PerlIO_printf( Perl_debug_log, " base: %d\n",base);
1124                 );
1125                 */
1126                 trie->states[ state ].trans.base=base;
1127             }
1128             trie->lasttrans = tp + 1;
1129         }
1130     } else {
1131         /*
1132            Second Pass -- Flat Table Representation.
1133
1134            we dont use the 0 slot of either trans[] or states[] so we add 1 to each.
1135            We know that we will need Charcount+1 trans at most to store the data
1136            (one row per char at worst case) So we preallocate both structures
1137            assuming worst case.
1138
1139            We then construct the trie using only the .next slots of the entry
1140            structs.
1141
1142            We use the .check field of the first entry of the node  temporarily to
1143            make compression both faster and easier by keeping track of how many non
1144            zero fields are in the node.
1145
1146            Since trans are numbered from 1 any 0 pointer in the table is a FAIL
1147            transition.
1148
1149            There are two terms at use here: state as a TRIE_NODEIDX() which is a
1150            number representing the first entry of the node, and state as a
1151            TRIE_NODENUM() which is the trans number. state 1 is TRIE_NODEIDX(1) and
1152            TRIE_NODENUM(1), state 2 is TRIE_NODEIDX(2) and TRIE_NODENUM(3) if there
1153            are 2 entrys per node. eg:
1154
1155              A B       A B
1156           1. 2 4    1. 3 7
1157           2. 0 3    3. 0 5
1158           3. 0 0    5. 0 0
1159           4. 0 0    7. 0 0
1160
1161            The table is internally in the right hand, idx form. However as we also
1162            have to deal with the states array which is indexed by nodenum we have to
1163            use TRIE_NODENUM() to convert.
1164
1165         */
1166
1167         Newxz( trie->trans, ( trie->charcount + 1 ) * trie->uniquecharcount + 1,
1168               reg_trie_trans );
1169         Newxz( trie->states, trie->charcount + 2, reg_trie_state );
1170         next_alloc = trie->uniquecharcount + 1;
1171
1172         for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1173
1174             regnode * const noper   = NEXTOPER( cur );
1175             const U8 *uc     = (U8*)STRING( noper );
1176             const U8 * const e = uc + STR_LEN( noper );
1177
1178             U32 state        = 1;         /* required init */
1179
1180             U16 charid       = 0;         /* sanity init */
1181             U32 accept_state = 0;         /* sanity init */
1182             U8 *scan         = (U8*)NULL; /* sanity init */
1183
1184             STRLEN foldlen   = 0;         /* required init */
1185             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1186
1187
1188             for ( ; uc < e ; uc += len ) {
1189
1190                 TRIE_READ_CHAR;
1191
1192                 if ( uvc < 256 ) {
1193                     charid = trie->charmap[ uvc ];
1194                 } else {
1195                     SV* const * const svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 0);
1196                     charid = svpp ? (U16)SvIV(*svpp) : 0;
1197                 }
1198                 if ( charid ) {
1199                     charid--;
1200                     if ( !trie->trans[ state + charid ].next ) {
1201                         trie->trans[ state + charid ].next = next_alloc;
1202                         trie->trans[ state ].check++;
1203                         next_alloc += trie->uniquecharcount;
1204                     }
1205                     state = trie->trans[ state + charid ].next;
1206                 } else {
1207                     Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1208                 }
1209                 /* charid is now 0 if we dont know the char read, or nonzero if we do */
1210             }
1211
1212             accept_state = TRIE_NODENUM( state );
1213             if ( !trie->states[ accept_state ].wordnum ) {
1214                 /* we havent inserted this word into the structure yet. */
1215                 trie->states[ accept_state ].wordnum = ++curword;
1216
1217                 DEBUG_r({
1218                     /* store the word for dumping */
1219                     SV* tmp = newSVpvn( STRING( noper ), STR_LEN( noper ) );
1220                     if ( UTF ) SvUTF8_on( tmp );
1221                     av_push( trie->words, tmp );
1222                 });
1223
1224             } else {
1225                 /*EMPTY*/;  /* Its a dupe. So ignore it. */
1226             }
1227
1228         } /* end second pass */
1229
1230         DEBUG_TRIE_COMPILE_MORE_r({
1231             /*
1232                print out the table precompression so that we can do a visual check
1233                that they are identical.
1234              */
1235             U32 state;
1236             U16 charid;
1237             PerlIO_printf( Perl_debug_log, "\nChar : " );
1238
1239             for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
1240                 SV **tmp = av_fetch( trie->revcharmap, charid, 0);
1241                 if ( tmp ) {
1242                   PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen_const( *tmp ) );
1243                 }
1244             }
1245
1246             PerlIO_printf( Perl_debug_log, "\nState+-" );
1247
1248             for( charid=0 ; charid < trie->uniquecharcount ; charid++ ) {
1249                 PerlIO_printf( Perl_debug_log, "%4s-", "----" );
1250             }
1251
1252             PerlIO_printf( Perl_debug_log, "\n" );
1253
1254             for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
1255
1256                 PerlIO_printf( Perl_debug_log, "%04"UVXf" : ", (UV)TRIE_NODENUM( state ) );
1257
1258                 for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
1259                     PerlIO_printf( Perl_debug_log, "%04"UVXf" ",
1260                         (UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next ) );
1261                 }
1262                 if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
1263                     PerlIO_printf( Perl_debug_log, " (%04"UVXf")\n", (UV)trie->trans[ state ].check );
1264                 } else {
1265                     PerlIO_printf( Perl_debug_log, " (%04"UVXf") W%04X\n", (UV)trie->trans[ state ].check,
1266                     trie->states[ TRIE_NODENUM( state ) ].wordnum );
1267                 }
1268             }
1269             PerlIO_printf( Perl_debug_log, "\n\n" );
1270         });
1271         {
1272         /*
1273            * Inplace compress the table.*
1274
1275            For sparse data sets the table constructed by the trie algorithm will
1276            be mostly 0/FAIL transitions or to put it another way mostly empty.
1277            (Note that leaf nodes will not contain any transitions.)
1278
1279            This algorithm compresses the tables by eliminating most such
1280            transitions, at the cost of a modest bit of extra work during lookup:
1281
1282            - Each states[] entry contains a .base field which indicates the
1283            index in the state[] array wheres its transition data is stored.
1284
1285            - If .base is 0 there are no  valid transitions from that node.
1286
1287            - If .base is nonzero then charid is added to it to find an entry in
1288            the trans array.
1289
1290            -If trans[states[state].base+charid].check!=state then the
1291            transition is taken to be a 0/Fail transition. Thus if there are fail
1292            transitions at the front of the node then the .base offset will point
1293            somewhere inside the previous nodes data (or maybe even into a node
1294            even earlier), but the .check field determines if the transition is
1295            valid.
1296
1297            The following process inplace converts the table to the compressed
1298            table: We first do not compress the root node 1,and mark its all its
1299            .check pointers as 1 and set its .base pointer as 1 as well. This
1300            allows to do a DFA construction from the compressed table later, and
1301            ensures that any .base pointers we calculate later are greater than
1302            0.
1303
1304            - We set 'pos' to indicate the first entry of the second node.
1305
1306            - We then iterate over the columns of the node, finding the first and
1307            last used entry at l and m. We then copy l..m into pos..(pos+m-l),
1308            and set the .check pointers accordingly, and advance pos
1309            appropriately and repreat for the next node. Note that when we copy
1310            the next pointers we have to convert them from the original
1311            NODEIDX form to NODENUM form as the former is not valid post
1312            compression.
1313
1314            - If a node has no transitions used we mark its base as 0 and do not
1315            advance the pos pointer.
1316
1317            - If a node only has one transition we use a second pointer into the
1318            structure to fill in allocated fail transitions from other states.
1319            This pointer is independent of the main pointer and scans forward
1320            looking for null transitions that are allocated to a state. When it
1321            finds one it writes the single transition into the "hole".  If the
1322            pointer doesnt find one the single transition is appeneded as normal.
1323
1324            - Once compressed we can Renew/realloc the structures to release the
1325            excess space.
1326
1327            See "Table-Compression Methods" in sec 3.9 of the Red Dragon,
1328            specifically Fig 3.47 and the associated pseudocode.
1329
1330            demq
1331         */
1332         const U32 laststate = TRIE_NODENUM( next_alloc );
1333         U32 state, charid;
1334         U32 pos = 0, zp=0;
1335         trie->laststate = laststate;
1336
1337         for ( state = 1 ; state < laststate ; state++ ) {
1338             U8 flag = 0;
1339             const U32 stateidx = TRIE_NODEIDX( state );
1340             const U32 o_used = trie->trans[ stateidx ].check;
1341             U32 used = trie->trans[ stateidx ].check;
1342             trie->trans[ stateidx ].check = 0;
1343
1344             for ( charid = 0 ; used && charid < trie->uniquecharcount ; charid++ ) {
1345                 if ( flag || trie->trans[ stateidx + charid ].next ) {
1346                     if ( trie->trans[ stateidx + charid ].next ) {
1347                         if (o_used == 1) {
1348                             for ( ; zp < pos ; zp++ ) {
1349                                 if ( ! trie->trans[ zp ].next ) {
1350                                     break;
1351                                 }
1352                             }
1353                             trie->states[ state ].trans.base = zp + trie->uniquecharcount - charid ;
1354                             trie->trans[ zp ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1355                             trie->trans[ zp ].check = state;
1356                             if ( ++zp > pos ) pos = zp;
1357                             break;
1358                         }
1359                         used--;
1360                     }
1361                     if ( !flag ) {
1362                         flag = 1;
1363                         trie->states[ state ].trans.base = pos + trie->uniquecharcount - charid ;
1364                     }
1365                     trie->trans[ pos ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1366                     trie->trans[ pos ].check = state;
1367                     pos++;
1368                 }
1369             }
1370         }
1371         trie->lasttrans = pos + 1;
1372         Renew( trie->states, laststate + 1, reg_trie_state);
1373         DEBUG_TRIE_COMPILE_MORE_r(
1374                 PerlIO_printf( Perl_debug_log,
1375                     " Alloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
1376                     (int)( ( trie->charcount + 1 ) * trie->uniquecharcount + 1 ),
1377                     (IV)next_alloc,
1378                     (IV)pos,
1379                     ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
1380             );
1381
1382         } /* end table compress */
1383     }
1384     /* resize the trans array to remove unused space */
1385     Renew( trie->trans, trie->lasttrans, reg_trie_trans);
1386
1387     DEBUG_TRIE_COMPILE_r({
1388         U32 state;
1389         /*
1390            Now we print it out again, in a slightly different form as there is additional
1391            info we want to be able to see when its compressed. They are close enough for
1392            visual comparison though.
1393          */
1394         PerlIO_printf( Perl_debug_log, "\nChar : %-6s%-6s%-4s ","Match","Base","Ofs" );
1395
1396         for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
1397             SV **tmp = av_fetch( trie->revcharmap, state, 0);
1398             if ( tmp ) {
1399               PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen_const( *tmp ) );
1400             }
1401         }
1402         PerlIO_printf( Perl_debug_log, "\n-----:-----------------------");
1403
1404         for( state = 0 ; state < trie->uniquecharcount ; state++ )
1405             PerlIO_printf( Perl_debug_log, "-----");
1406         PerlIO_printf( Perl_debug_log, "\n");
1407
1408         for( state = 1 ; state < trie->laststate ; state++ ) {
1409             const U32 base = trie->states[ state ].trans.base;
1410
1411             PerlIO_printf( Perl_debug_log, "#%04"UVXf" ", (UV)state);
1412
1413             if ( trie->states[ state ].wordnum ) {
1414                 PerlIO_printf( Perl_debug_log, " W%04X", trie->states[ state ].wordnum );
1415             } else {
1416                 PerlIO_printf( Perl_debug_log, "%6s", "" );
1417             }
1418
1419             PerlIO_printf( Perl_debug_log, " @%04"UVXf" ", (UV)base );
1420
1421             if ( base ) {
1422                 U32 ofs = 0;
1423
1424                 while( ( base + ofs  < trie->uniquecharcount ) ||
1425                        ( base + ofs - trie->uniquecharcount < trie->lasttrans
1426                          && trie->trans[ base + ofs - trie->uniquecharcount ].check != state))
1427                         ofs++;
1428
1429                 PerlIO_printf( Perl_debug_log, "+%02"UVXf"[ ", (UV)ofs);
1430
1431                 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
1432                     if ( ( base + ofs >= trie->uniquecharcount ) &&
1433                          ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
1434                          trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
1435                     {
1436                        PerlIO_printf( Perl_debug_log, "%04"UVXf" ",
1437                         (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next );
1438                     } else {
1439                         PerlIO_printf( Perl_debug_log, "%4s ","   0" );
1440                     }
1441                 }
1442
1443                 PerlIO_printf( Perl_debug_log, "]");
1444
1445             }
1446             PerlIO_printf( Perl_debug_log, "\n" );
1447         }
1448     });
1449
1450     {
1451         /* now finally we "stitch in" the new TRIE node
1452            This means we convert either the first branch or the first Exact,
1453            depending on whether the thing following (in 'last') is a branch
1454            or not and whther first is the startbranch (ie is it a sub part of
1455            the alternation or is it the whole thing.)
1456            Assuming its a sub part we conver the EXACT otherwise we convert
1457            the whole branch sequence, including the first.
1458         */
1459         regnode *convert;
1460
1461
1462
1463
1464         if ( first == startbranch && OP( last ) != BRANCH ) {
1465             convert = first;
1466         } else {
1467             convert = NEXTOPER( first );
1468             NEXT_OFF( first ) = (U16)(last - first);
1469         }
1470
1471         OP( convert ) = TRIE + (U8)( flags - EXACT );
1472         NEXT_OFF( convert ) = (U16)(tail - convert);
1473         ARG_SET( convert, data_slot );
1474
1475         /* tells us if we need to handle accept buffers specially */
1476         convert->flags = ( RExC_seen_evals ? 1 : 0 );
1477
1478
1479         /* needed for dumping*/
1480         DEBUG_r({
1481             regnode *optimize = convert + NODE_STEP_REGNODE + regarglen[ TRIE ];
1482             /* We now need to mark all of the space originally used by the
1483                branches as optimized away. This keeps the dumpuntil from
1484                throwing a wobbly as it doesnt use regnext() to traverse the
1485                opcodes.
1486              */
1487             while( optimize < last ) {
1488                 OP( optimize ) = OPTIMIZED;
1489                 optimize++;
1490             }
1491         });
1492     } /* end node insert */
1493     return 1;
1494 }
1495
1496
1497
1498 /*
1499  * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2.
1500  * These need to be revisited when a newer toolchain becomes available.
1501  */
1502 #if defined(__sparc64__) && defined(__GNUC__)
1503 #   if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
1504 #       undef  SPARC64_GCC_WORKAROUND
1505 #       define SPARC64_GCC_WORKAROUND 1
1506 #   endif
1507 #endif
1508
1509 /* REx optimizer.  Converts nodes into quickier variants "in place".
1510    Finds fixed substrings.  */
1511
1512 /* Stops at toplevel WHILEM as well as at "last". At end *scanp is set
1513    to the position after last scanned or to NULL. */
1514
1515
1516 STATIC I32
1517 S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
1518                         regnode *last, scan_data_t *data, U32 flags, U32 depth)
1519                         /* scanp: Start here (read-write). */
1520                         /* deltap: Write maxlen-minlen here. */
1521                         /* last: Stop before this one. */
1522 {
1523     dVAR;
1524     I32 min = 0, pars = 0, code;
1525     regnode *scan = *scanp, *next;
1526     I32 delta = 0;
1527     int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
1528     int is_inf_internal = 0;            /* The studied chunk is infinite */
1529     I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
1530     scan_data_t data_fake;
1531     struct regnode_charclass_class and_with; /* Valid if flags & SCF_DO_STCLASS_OR */
1532     SV *re_trie_maxbuff = NULL;
1533
1534     GET_RE_DEBUG_FLAGS_DECL;
1535
1536     while (scan && OP(scan) != END && scan < last) {
1537         /* Peephole optimizer: */
1538         DEBUG_OPTIMISE_r({
1539           SV * const mysv=sv_newmortal();
1540           regprop(RExC_rx, mysv, scan);
1541           PerlIO_printf(Perl_debug_log, "%*speep: %s (0x%08"UVXf")\n",
1542             (int)depth*2, "", SvPV_nolen_const(mysv), PTR2UV(scan));
1543         });
1544
1545         if (PL_regkind[(U8)OP(scan)] == EXACT) {
1546             /* Merge several consecutive EXACTish nodes into one. */
1547             regnode *n = regnext(scan);
1548             U32 stringok = 1;
1549 #ifdef DEBUGGING
1550             regnode *stop = scan;
1551 #endif
1552
1553             next = scan + NODE_SZ_STR(scan);
1554             /* Skip NOTHING, merge EXACT*. */
1555             while (n &&
1556                    ( PL_regkind[(U8)OP(n)] == NOTHING ||
1557                      (stringok && (OP(n) == OP(scan))))
1558                    && NEXT_OFF(n)
1559                    && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
1560                 if (OP(n) == TAIL || n > next)
1561                     stringok = 0;
1562                 if (PL_regkind[(U8)OP(n)] == NOTHING) {
1563                     NEXT_OFF(scan) += NEXT_OFF(n);
1564                     next = n + NODE_STEP_REGNODE;
1565 #ifdef DEBUGGING
1566                     if (stringok)
1567                         stop = n;
1568 #endif
1569                     n = regnext(n);
1570                 }
1571                 else if (stringok) {
1572                     const int oldl = STR_LEN(scan);
1573                     regnode * const nnext = regnext(n);
1574
1575                     if (oldl + STR_LEN(n) > U8_MAX)
1576                         break;
1577                     NEXT_OFF(scan) += NEXT_OFF(n);
1578                     STR_LEN(scan) += STR_LEN(n);
1579                     next = n + NODE_SZ_STR(n);
1580                     /* Now we can overwrite *n : */
1581                     Move(STRING(n), STRING(scan) + oldl, STR_LEN(n), char);
1582 #ifdef DEBUGGING
1583                     stop = next - 1;
1584 #endif
1585                     n = nnext;
1586                 }
1587             }
1588
1589             if (UTF && ( OP(scan) == EXACTF ) && ( STR_LEN(scan) >= 6 ) ) {
1590 /*
1591   Two problematic code points in Unicode casefolding of EXACT nodes:
1592
1593    U+0390 - GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
1594    U+03B0 - GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
1595
1596    which casefold to
1597
1598    Unicode                      UTF-8
1599
1600    U+03B9 U+0308 U+0301         0xCE 0xB9 0xCC 0x88 0xCC 0x81
1601    U+03C5 U+0308 U+0301         0xCF 0x85 0xCC 0x88 0xCC 0x81
1602
1603    This means that in case-insensitive matching (or "loose matching",
1604    as Unicode calls it), an EXACTF of length six (the UTF-8 encoded byte
1605    length of the above casefolded versions) can match a target string
1606    of length two (the byte length of UTF-8 encoded U+0390 or U+03B0).
1607    This would rather mess up the minimum length computation.
1608
1609    What we'll do is to look for the tail four bytes, and then peek
1610    at the preceding two bytes to see whether we need to decrease
1611    the minimum length by four (six minus two).
1612
1613    Thanks to the design of UTF-8, there cannot be false matches:
1614    A sequence of valid UTF-8 bytes cannot be a subsequence of
1615    another valid sequence of UTF-8 bytes.
1616
1617 */
1618                  char * const s0 = STRING(scan), *s, *t;
1619                  char * const s1 = s0 + STR_LEN(scan) - 1;
1620                  char * const s2 = s1 - 4;
1621                  const char t0[] = "\xcc\x88\xcc\x81";
1622                  const char * const t1 = t0 + 3;
1623
1624                  for (s = s0 + 2;
1625                       s < s2 && (t = ninstr(s, s1, t0, t1));
1626                       s = t + 4) {
1627                       if (((U8)t[-1] == 0xB9 && (U8)t[-2] == 0xCE) ||
1628                           ((U8)t[-1] == 0x85 && (U8)t[-2] == 0xCF))
1629                            min -= 4;
1630                  }
1631             }
1632
1633 #ifdef DEBUGGING
1634             /* Allow dumping */
1635             n = scan + NODE_SZ_STR(scan);
1636             while (n <= stop) {
1637                 if (PL_regkind[(U8)OP(n)] != NOTHING || OP(n) == NOTHING) {
1638                     OP(n) = OPTIMIZED;
1639                     NEXT_OFF(n) = 0;
1640                 }
1641                 n++;
1642             }
1643 #endif
1644         }
1645
1646
1647
1648         /* Follow the next-chain of the current node and optimize
1649            away all the NOTHINGs from it.  */
1650         if (OP(scan) != CURLYX) {
1651             const int max = (reg_off_by_arg[OP(scan)]
1652                        ? I32_MAX
1653                        /* I32 may be smaller than U16 on CRAYs! */
1654                        : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
1655             int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
1656             int noff;
1657             regnode *n = scan;
1658         
1659             /* Skip NOTHING and LONGJMP. */
1660             while ((n = regnext(n))
1661                    && ((PL_regkind[(U8)OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
1662                        || ((OP(n) == LONGJMP) && (noff = ARG(n))))
1663                    && off + noff < max)
1664                 off += noff;
1665             if (reg_off_by_arg[OP(scan)])
1666                 ARG(scan) = off;
1667             else
1668                 NEXT_OFF(scan) = off;
1669         }
1670
1671         /* The principal pseudo-switch.  Cannot be a switch, since we
1672            look into several different things.  */
1673         if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
1674                    || OP(scan) == IFTHEN || OP(scan) == SUSPEND) {
1675             next = regnext(scan);
1676             code = OP(scan);
1677             /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
1678         
1679             if (OP(next) == code || code == IFTHEN || code == SUSPEND) {
1680                 I32 max1 = 0, min1 = I32_MAX, num = 0;
1681                 struct regnode_charclass_class accum;
1682                 regnode * const startbranch=scan;
1683                 
1684                 if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
1685                     scan_commit(pRExC_state, data); /* Cannot merge strings after this. */
1686                 if (flags & SCF_DO_STCLASS)
1687                     cl_init_zero(pRExC_state, &accum);
1688
1689                 while (OP(scan) == code) {
1690                     I32 deltanext, minnext, f = 0, fake;
1691                     struct regnode_charclass_class this_class;
1692
1693                     num++;
1694                     data_fake.flags = 0;
1695                     if (data) {         
1696                         data_fake.whilem_c = data->whilem_c;
1697                         data_fake.last_closep = data->last_closep;
1698                     }
1699                     else
1700                         data_fake.last_closep = &fake;
1701                     next = regnext(scan);
1702                     scan = NEXTOPER(scan);
1703                     if (code != BRANCH)
1704                         scan = NEXTOPER(scan);
1705                     if (flags & SCF_DO_STCLASS) {
1706                         cl_init(pRExC_state, &this_class);
1707                         data_fake.start_class = &this_class;
1708                         f = SCF_DO_STCLASS_AND;
1709                     }           
1710                     if (flags & SCF_WHILEM_VISITED_POS)
1711                         f |= SCF_WHILEM_VISITED_POS;
1712
1713                     /* we suppose the run is continuous, last=next...*/
1714                     minnext = study_chunk(pRExC_state, &scan, &deltanext,
1715                                           next, &data_fake, f,depth+1);
1716                     if (min1 > minnext)
1717                         min1 = minnext;
1718                     if (max1 < minnext + deltanext)
1719                         max1 = minnext + deltanext;
1720                     if (deltanext == I32_MAX)
1721                         is_inf = is_inf_internal = 1;
1722                     scan = next;
1723                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
1724                         pars++;
1725                     if (data && (data_fake.flags & SF_HAS_EVAL))
1726                         data->flags |= SF_HAS_EVAL;
1727                     if (data)
1728                         data->whilem_c = data_fake.whilem_c;
1729                     if (flags & SCF_DO_STCLASS)
1730                         cl_or(pRExC_state, &accum, &this_class);
1731                     if (code == SUSPEND)
1732                         break;
1733                 }
1734                 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
1735                     min1 = 0;
1736                 if ((flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) && !data)
1737                     Perl_croak(aTHX_ "panic: null data in study_chunk");
1738                 if (flags & SCF_DO_SUBSTR) {
1739                     data->pos_min += min1;
1740                     data->pos_delta += max1 - min1;
1741                     if (max1 != min1 || is_inf)
1742                         data->longest = &(data->longest_float);
1743                 }
1744                 min += min1;
1745                 delta += max1 - min1;
1746                 if (flags & SCF_DO_STCLASS_OR) {
1747                     cl_or(pRExC_state, data->start_class, &accum);
1748                     if (min1) {
1749                         cl_and(data->start_class, &and_with);
1750                         flags &= ~SCF_DO_STCLASS;
1751                     }
1752                 }
1753                 else if (flags & SCF_DO_STCLASS_AND) {
1754                     if (min1) {
1755                         cl_and(data->start_class, &accum);
1756                         flags &= ~SCF_DO_STCLASS;
1757                     }
1758                     else {
1759                         /* Switch to OR mode: cache the old value of
1760                          * data->start_class */
1761                         StructCopy(data->start_class, &and_with,
1762                                    struct regnode_charclass_class);
1763                         flags &= ~SCF_DO_STCLASS_AND;
1764                         StructCopy(&accum, data->start_class,
1765                                    struct regnode_charclass_class);
1766                         flags |= SCF_DO_STCLASS_OR;
1767                         data->start_class->flags |= ANYOF_EOS;
1768                     }
1769                 }
1770
1771                 /* demq.
1772
1773                    Assuming this was/is a branch we are dealing with: 'scan' now
1774                    points at the item that follows the branch sequence, whatever
1775                    it is. We now start at the beginning of the sequence and look
1776                    for subsequences of
1777
1778                    BRANCH->EXACT=>X
1779                    BRANCH->EXACT=>X
1780
1781                    which would be constructed from a pattern like /A|LIST|OF|WORDS/
1782
1783                    If we can find such a subseqence we need to turn the first
1784                    element into a trie and then add the subsequent branch exact
1785                    strings to the trie.
1786
1787                    We have two cases
1788
1789                      1. patterns where the whole set of branch can be converted to a trie,
1790
1791                      2. patterns where only a subset of the alternations can be
1792                      converted to a trie.
1793
1794                    In case 1 we can replace the whole set with a single regop
1795                    for the trie. In case 2 we need to keep the start and end
1796                    branchs so
1797
1798                      'BRANCH EXACT; BRANCH EXACT; BRANCH X'
1799                      becomes BRANCH TRIE; BRANCH X;
1800
1801                    Hypthetically when we know the regex isnt anchored we can
1802                    turn a case 1 into a DFA and let it rip... Every time it finds a match
1803                    it would just call its tail, no WHILEM/CURLY needed.
1804
1805                 */
1806                 if (DO_TRIE) {
1807                     if (!re_trie_maxbuff) {
1808                         re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
1809                         if (!SvIOK(re_trie_maxbuff))
1810                             sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
1811                     }
1812                     if ( SvIV(re_trie_maxbuff)>=0 && OP( startbranch )==BRANCH ) {
1813                         regnode *cur;
1814                         regnode *first = (regnode *)NULL;
1815                         regnode *last = (regnode *)NULL;
1816                         regnode *tail = scan;
1817                         U8 optype = 0;
1818                         U32 count=0;
1819
1820 #ifdef DEBUGGING
1821                         SV * const mysv = sv_newmortal();       /* for dumping */
1822 #endif
1823                         /* var tail is used because there may be a TAIL
1824                            regop in the way. Ie, the exacts will point to the
1825                            thing following the TAIL, but the last branch will
1826                            point at the TAIL. So we advance tail. If we
1827                            have nested (?:) we may have to move through several
1828                            tails.
1829                          */
1830
1831                         while ( OP( tail ) == TAIL ) {
1832                             /* this is the TAIL generated by (?:) */
1833                             tail = regnext( tail );
1834                         }
1835
1836                         DEBUG_OPTIMISE_r({
1837                             regprop(RExC_rx, mysv, tail );
1838                             PerlIO_printf( Perl_debug_log, "%*s%s%s%s\n",
1839                                 (int)depth * 2 + 2, "", "Tail node is:", SvPV_nolen_const( mysv ),
1840                                 (RExC_seen_evals) ? "[EVAL]" : ""
1841                             );
1842                         });
1843                         /*
1844
1845                            step through the branches, cur represents each
1846                            branch, noper is the first thing to be matched
1847                            as part of that branch and noper_next is the
1848                            regnext() of that node. if noper is an EXACT
1849                            and noper_next is the same as scan (our current
1850                            position in the regex) then the EXACT branch is
1851                            a possible optimization target. Once we have
1852                            two or more consequetive such branches we can
1853                            create a trie of the EXACT's contents and stich
1854                            it in place. If the sequence represents all of
1855                            the branches we eliminate the whole thing and
1856                            replace it with a single TRIE. If it is a
1857                            subsequence then we need to stitch it in. This
1858                            means the first branch has to remain, and needs
1859                            to be repointed at the item on the branch chain
1860                            following the last branch optimized. This could
1861                            be either a BRANCH, in which case the
1862                            subsequence is internal, or it could be the
1863                            item following the branch sequence in which
1864                            case the subsequence is at the end.
1865
1866                         */
1867
1868                         /* dont use tail as the end marker for this traverse */
1869                         for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) {
1870                             regnode * const noper = NEXTOPER( cur );
1871                             regnode * const noper_next = regnext( noper );
1872
1873                             DEBUG_OPTIMISE_r({
1874                                 regprop(RExC_rx, mysv, cur);
1875                                 PerlIO_printf( Perl_debug_log, "%*s%s",
1876                                    (int)depth * 2 + 2,"  ", SvPV_nolen_const( mysv ) );
1877
1878                                 regprop(RExC_rx, mysv, noper);
1879                                 PerlIO_printf( Perl_debug_log, " -> %s",
1880                                     SvPV_nolen_const(mysv));
1881
1882                                 if ( noper_next ) {
1883                                   regprop(RExC_rx, mysv, noper_next );
1884                                   PerlIO_printf( Perl_debug_log,"\t=> %s\t",
1885                                     SvPV_nolen_const(mysv));
1886                                 }
1887                                 PerlIO_printf( Perl_debug_log, "0x%p,0x%p,0x%p)\n",
1888                                    first, last, cur );
1889                             });
1890                             if ( ( first ? OP( noper ) == optype
1891                                          : PL_regkind[ (U8)OP( noper ) ] == EXACT )
1892                                   && noper_next == tail && count<U16_MAX)
1893                             {
1894                                 count++;
1895                                 if ( !first ) {
1896                                     first = cur;
1897                                     optype = OP( noper );
1898                                 } else {
1899                                     DEBUG_OPTIMISE_r(
1900                                         if (!last ) {
1901                                             regprop(RExC_rx, mysv, first);
1902                                             PerlIO_printf( Perl_debug_log, "%*s%s",
1903                                               (int)depth * 2 + 2, "F:", SvPV_nolen_const( mysv ) );
1904                                             regprop(RExC_rx, mysv, NEXTOPER(first) );
1905                                             PerlIO_printf( Perl_debug_log, " -> %s\n",
1906                                               SvPV_nolen_const( mysv ) );
1907                                         }
1908                                     );
1909                                     last = cur;
1910                                     DEBUG_OPTIMISE_r({
1911                                         regprop(RExC_rx, mysv, cur);
1912                                         PerlIO_printf( Perl_debug_log, "%*s%s",
1913                                           (int)depth * 2 + 2, "N:", SvPV_nolen_const( mysv ) );
1914                                         regprop(RExC_rx, mysv, noper );
1915                                         PerlIO_printf( Perl_debug_log, " -> %s\n",
1916                                           SvPV_nolen_const( mysv ) );
1917                                     });
1918                                 }
1919                             } else {
1920                                 if ( last ) {
1921                                     DEBUG_OPTIMISE_r(
1922                                         PerlIO_printf( Perl_debug_log, "%*s%s\n",
1923                                             (int)depth * 2 + 2, "E:", "**END**" );
1924                                     );
1925                                     make_trie( pRExC_state, startbranch, first, cur, tail, optype );
1926                                 }
1927                                 if ( PL_regkind[ (U8)OP( noper ) ] == EXACT
1928                                      && noper_next == tail )
1929                                 {
1930                                     count = 1;
1931                                     first = cur;
1932                                     optype = OP( noper );
1933                                 } else {
1934                                     count = 0;
1935                                     first = NULL;
1936                                     optype = 0;
1937                                 }
1938                                 last = NULL;
1939                             }
1940                         }
1941                         DEBUG_OPTIMISE_r({
1942                             regprop(RExC_rx, mysv, cur);
1943                             PerlIO_printf( Perl_debug_log,
1944                               "%*s%s\t(0x%p,0x%p,0x%p)\n", (int)depth * 2 + 2,
1945                               "  ", SvPV_nolen_const( mysv ), first, last, cur);
1946
1947                         });
1948                         if ( last ) {
1949                             DEBUG_OPTIMISE_r(
1950                                 PerlIO_printf( Perl_debug_log, "%*s%s\n",
1951                                     (int)depth * 2 + 2, "E:", "==END==" );
1952                             );
1953                             make_trie( pRExC_state, startbranch, first, scan, tail, optype );
1954                         }
1955                     }
1956                 }
1957             }
1958             else if ( code == BRANCHJ ) {  /* single branch is optimized. */
1959                 scan = NEXTOPER(NEXTOPER(scan));
1960             } else                      /* single branch is optimized. */
1961                 scan = NEXTOPER(scan);
1962             continue;
1963         }
1964         else if (OP(scan) == EXACT) {
1965             I32 l = STR_LEN(scan);
1966             UV uc;
1967             if (UTF) {
1968                 const U8 * const s = (U8*)STRING(scan);
1969                 l = utf8_length(s, s + l);
1970                 uc = utf8_to_uvchr(s, NULL);
1971             } else {
1972                 uc = *((U8*)STRING(scan));
1973             }
1974             min += l;
1975             if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
1976                 /* The code below prefers earlier match for fixed
1977                    offset, later match for variable offset.  */
1978                 if (data->last_end == -1) { /* Update the start info. */
1979                     data->last_start_min = data->pos_min;
1980                     data->last_start_max = is_inf
1981                         ? I32_MAX : data->pos_min + data->pos_delta;
1982                 }
1983                 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
1984                 if (UTF)
1985                     SvUTF8_on(data->last_found);
1986                 {
1987                     SV * const sv = data->last_found;
1988                     MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
1989                         mg_find(sv, PERL_MAGIC_utf8) : NULL;
1990                     if (mg && mg->mg_len >= 0)
1991                         mg->mg_len += utf8_length((U8*)STRING(scan),
1992                                                   (U8*)STRING(scan)+STR_LEN(scan));
1993                 }
1994                 data->last_end = data->pos_min + l;
1995                 data->pos_min += l; /* As in the first entry. */
1996                 data->flags &= ~SF_BEFORE_EOL;
1997             }
1998             if (flags & SCF_DO_STCLASS_AND) {
1999                 /* Check whether it is compatible with what we know already! */
2000                 int compat = 1;
2001
2002                 if (uc >= 0x100 ||
2003                     (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
2004                     && !ANYOF_BITMAP_TEST(data->start_class, uc)
2005                     && (!(data->start_class->flags & ANYOF_FOLD)
2006                         || !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
2007                     )
2008                     compat = 0;
2009                 ANYOF_CLASS_ZERO(data->start_class);
2010                 ANYOF_BITMAP_ZERO(data->start_class);
2011                 if (compat)
2012                     ANYOF_BITMAP_SET(data->start_class, uc);
2013                 data->start_class->flags &= ~ANYOF_EOS;
2014                 if (uc < 0x100)
2015                   data->start_class->flags &= ~ANYOF_UNICODE_ALL;
2016             }
2017             else if (flags & SCF_DO_STCLASS_OR) {
2018                 /* false positive possible if the class is case-folded */
2019                 if (uc < 0x100)
2020                     ANYOF_BITMAP_SET(data->start_class, uc);
2021                 else
2022                     data->start_class->flags |= ANYOF_UNICODE_ALL;
2023                 data->start_class->flags &= ~ANYOF_EOS;
2024                 cl_and(data->start_class, &and_with);
2025             }
2026             flags &= ~SCF_DO_STCLASS;
2027         }
2028         else if (PL_regkind[(U8)OP(scan)] == EXACT) { /* But OP != EXACT! */
2029             I32 l = STR_LEN(scan);
2030             UV uc = *((U8*)STRING(scan));
2031
2032             /* Search for fixed substrings supports EXACT only. */
2033             if (flags & SCF_DO_SUBSTR) {
2034                 assert(data);
2035                 scan_commit(pRExC_state, data);
2036             }
2037             if (UTF) {
2038                 const U8 * const s = (U8 *)STRING(scan);
2039                 l = utf8_length(s, s + l);
2040                 uc = utf8_to_uvchr(s, NULL);
2041             }
2042             min += l;
2043             if (flags & SCF_DO_SUBSTR)
2044                 data->pos_min += l;
2045             if (flags & SCF_DO_STCLASS_AND) {
2046                 /* Check whether it is compatible with what we know already! */
2047                 int compat = 1;
2048
2049                 if (uc >= 0x100 ||
2050                     (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
2051                     && !ANYOF_BITMAP_TEST(data->start_class, uc)
2052                      && !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
2053                     compat = 0;
2054                 ANYOF_CLASS_ZERO(data->start_class);
2055                 ANYOF_BITMAP_ZERO(data->start_class);
2056                 if (compat) {
2057                     ANYOF_BITMAP_SET(data->start_class, uc);
2058                     data->start_class->flags &= ~ANYOF_EOS;
2059                     data->start_class->flags |= ANYOF_FOLD;
2060                     if (OP(scan) == EXACTFL)
2061                         data->start_class->flags |= ANYOF_LOCALE;
2062                 }
2063             }
2064             else if (flags & SCF_DO_STCLASS_OR) {
2065                 if (data->start_class->flags & ANYOF_FOLD) {
2066                     /* false positive possible if the class is case-folded.
2067                        Assume that the locale settings are the same... */
2068                     if (uc < 0x100)
2069                         ANYOF_BITMAP_SET(data->start_class, uc);
2070                     data->start_class->flags &= ~ANYOF_EOS;
2071                 }
2072                 cl_and(data->start_class, &and_with);
2073             }
2074             flags &= ~SCF_DO_STCLASS;
2075         }
2076         else if (strchr((const char*)PL_varies,OP(scan))) {
2077             I32 mincount, maxcount, minnext, deltanext, fl = 0;
2078             I32 f = flags, pos_before = 0;
2079             regnode * const oscan = scan;
2080             struct regnode_charclass_class this_class;
2081             struct regnode_charclass_class *oclass = NULL;
2082             I32 next_is_eval = 0;
2083
2084             switch (PL_regkind[(U8)OP(scan)]) {
2085             case WHILEM:                /* End of (?:...)* . */
2086                 scan = NEXTOPER(scan);
2087                 goto finish;
2088             case PLUS:
2089                 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
2090                     next = NEXTOPER(scan);
2091                     if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
2092                         mincount = 1;
2093                         maxcount = REG_INFTY;
2094                         next = regnext(scan);
2095                         scan = NEXTOPER(scan);
2096                         goto do_curly;
2097                     }
2098                 }
2099                 if (flags & SCF_DO_SUBSTR)
2100                     data->pos_min++;
2101                 min++;
2102                 /* Fall through. */
2103             case STAR:
2104                 if (flags & SCF_DO_STCLASS) {
2105                     mincount = 0;
2106                     maxcount = REG_INFTY;
2107                     next = regnext(scan);
2108                     scan = NEXTOPER(scan);
2109                     goto do_curly;
2110                 }
2111                 is_inf = is_inf_internal = 1;
2112                 scan = regnext(scan);
2113                 if (flags & SCF_DO_SUBSTR) {
2114                     scan_commit(pRExC_state, data); /* Cannot extend fixed substrings */
2115                     data->longest = &(data->longest_float);
2116                 }
2117                 goto optimize_curly_tail;
2118             case CURLY:
2119                 mincount = ARG1(scan);
2120                 maxcount = ARG2(scan);
2121                 next = regnext(scan);
2122                 if (OP(scan) == CURLYX) {
2123                     I32 lp = (data ? *(data->last_closep) : 0);
2124                     scan->flags = ((lp <= U8_MAX) ? (U8)lp : U8_MAX);
2125                 }
2126                 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
2127                 next_is_eval = (OP(scan) == EVAL);
2128               do_curly:
2129                 if (flags & SCF_DO_SUBSTR) {
2130                     if (mincount == 0) scan_commit(pRExC_state,data); /* Cannot extend fixed substrings */
2131                     pos_before = data->pos_min;
2132                 }
2133                 if (data) {
2134                     fl = data->flags;
2135                     data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
2136                     if (is_inf)
2137                         data->flags |= SF_IS_INF;
2138                 }
2139                 if (flags & SCF_DO_STCLASS) {
2140                     cl_init(pRExC_state, &this_class);
2141                     oclass = data->start_class;
2142                     data->start_class = &this_class;
2143                     f |= SCF_DO_STCLASS_AND;
2144                     f &= ~SCF_DO_STCLASS_OR;
2145                 }
2146                 /* These are the cases when once a subexpression
2147                    fails at a particular position, it cannot succeed
2148                    even after backtracking at the enclosing scope.
2149                 
2150                    XXXX what if minimal match and we are at the
2151                         initial run of {n,m}? */
2152                 if ((mincount != maxcount - 1) && (maxcount != REG_INFTY))
2153                     f &= ~SCF_WHILEM_VISITED_POS;
2154
2155                 /* This will finish on WHILEM, setting scan, or on NULL: */
2156                 minnext = study_chunk(pRExC_state, &scan, &deltanext, last, data,
2157                                       (mincount == 0
2158                                         ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
2159
2160                 if (flags & SCF_DO_STCLASS)
2161                     data->start_class = oclass;
2162                 if (mincount == 0 || minnext == 0) {
2163                     if (flags & SCF_DO_STCLASS_OR) {
2164                         cl_or(pRExC_state, data->start_class, &this_class);
2165                     }
2166                     else if (flags & SCF_DO_STCLASS_AND) {
2167                         /* Switch to OR mode: cache the old value of
2168                          * data->start_class */
2169                         StructCopy(data->start_class, &and_with,
2170                                    struct regnode_charclass_class);
2171                         flags &= ~SCF_DO_STCLASS_AND;
2172                         StructCopy(&this_class, data->start_class,
2173                                    struct regnode_charclass_class);
2174                         flags |= SCF_DO_STCLASS_OR;
2175                         data->start_class->flags |= ANYOF_EOS;
2176                     }
2177                 } else {                /* Non-zero len */
2178                     if (flags & SCF_DO_STCLASS_OR) {
2179                         cl_or(pRExC_state, data->start_class, &this_class);
2180                         cl_and(data->start_class, &and_with);
2181                     }
2182                     else if (flags & SCF_DO_STCLASS_AND)
2183                         cl_and(data->start_class, &this_class);
2184                     flags &= ~SCF_DO_STCLASS;
2185                 }
2186                 if (!scan)              /* It was not CURLYX, but CURLY. */
2187                     scan = next;
2188                 if ( /* ? quantifier ok, except for (?{ ... }) */
2189                     (next_is_eval || !(mincount == 0 && maxcount == 1))
2190                     && (minnext == 0) && (deltanext == 0)
2191                     && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
2192                     && maxcount <= REG_INFTY/3 /* Complement check for big count */
2193                     && ckWARN(WARN_REGEXP))
2194                 {
2195                     vWARN(RExC_parse,
2196                           "Quantifier unexpected on zero-length expression");
2197                 }
2198
2199                 min += minnext * mincount;
2200                 is_inf_internal |= ((maxcount == REG_INFTY
2201                                      && (minnext + deltanext) > 0)
2202                                     || deltanext == I32_MAX);
2203                 is_inf |= is_inf_internal;
2204                 delta += (minnext + deltanext) * maxcount - minnext * mincount;
2205
2206                 /* Try powerful optimization CURLYX => CURLYN. */
2207                 if (  OP(oscan) == CURLYX && data
2208                       && data->flags & SF_IN_PAR
2209                       && !(data->flags & SF_HAS_EVAL)
2210                       && !deltanext && minnext == 1 ) {
2211                     /* Try to optimize to CURLYN.  */
2212                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
2213                     regnode * const nxt1 = nxt;
2214 #ifdef DEBUGGING
2215                     regnode *nxt2;
2216 #endif
2217
2218                     /* Skip open. */
2219                     nxt = regnext(nxt);
2220                     if (!strchr((const char*)PL_simple,OP(nxt))
2221                         && !(PL_regkind[(U8)OP(nxt)] == EXACT
2222                              && STR_LEN(nxt) == 1))
2223                         goto nogo;
2224 #ifdef DEBUGGING
2225                     nxt2 = nxt;
2226 #endif
2227                     nxt = regnext(nxt);
2228                     if (OP(nxt) != CLOSE)
2229                         goto nogo;
2230                     /* Now we know that nxt2 is the only contents: */
2231                     oscan->flags = (U8)ARG(nxt);
2232                     OP(oscan) = CURLYN;
2233                     OP(nxt1) = NOTHING; /* was OPEN. */
2234 #ifdef DEBUGGING
2235                     OP(nxt1 + 1) = OPTIMIZED; /* was count. */
2236                     NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
2237                     NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */
2238                     OP(nxt) = OPTIMIZED;        /* was CLOSE. */
2239                     OP(nxt + 1) = OPTIMIZED; /* was count. */
2240                     NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
2241 #endif
2242                 }
2243               nogo:
2244
2245                 /* Try optimization CURLYX => CURLYM. */
2246                 if (  OP(oscan) == CURLYX && data
2247                       && !(data->flags & SF_HAS_PAR)
2248                       && !(data->flags & SF_HAS_EVAL)
2249                       && !deltanext     /* atom is fixed width */
2250                       && minnext != 0   /* CURLYM can't handle zero width */
2251                 ) {
2252                     /* XXXX How to optimize if data == 0? */
2253                     /* Optimize to a simpler form.  */
2254                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
2255                     regnode *nxt2;
2256
2257                     OP(oscan) = CURLYM;
2258                     while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
2259                             && (OP(nxt2) != WHILEM))
2260                         nxt = nxt2;
2261                     OP(nxt2)  = SUCCEED; /* Whas WHILEM */
2262                     /* Need to optimize away parenths. */
2263                     if (data->flags & SF_IN_PAR) {
2264                         /* Set the parenth number.  */
2265                         regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
2266
2267                         if (OP(nxt) != CLOSE)
2268                             FAIL("Panic opt close");
2269                         oscan->flags = (U8)ARG(nxt);
2270                         OP(nxt1) = OPTIMIZED;   /* was OPEN. */
2271                         OP(nxt) = OPTIMIZED;    /* was CLOSE. */
2272 #ifdef DEBUGGING
2273                         OP(nxt1 + 1) = OPTIMIZED; /* was count. */
2274                         OP(nxt + 1) = OPTIMIZED; /* was count. */
2275                         NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
2276                         NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
2277 #endif
2278 #if 0
2279                         while ( nxt1 && (OP(nxt1) != WHILEM)) {
2280                             regnode *nnxt = regnext(nxt1);
2281                         
2282                             if (nnxt == nxt) {
2283                                 if (reg_off_by_arg[OP(nxt1)])
2284                                     ARG_SET(nxt1, nxt2 - nxt1);
2285                                 else if (nxt2 - nxt1 < U16_MAX)
2286                                     NEXT_OFF(nxt1) = nxt2 - nxt1;
2287                                 else
2288                                     OP(nxt) = NOTHING;  /* Cannot beautify */
2289                             }
2290                             nxt1 = nnxt;
2291                         }
2292 #endif
2293                         /* Optimize again: */
2294                         study_chunk(pRExC_state, &nxt1, &deltanext, nxt,
2295                                     NULL, 0,depth+1);
2296                     }
2297                     else
2298                         oscan->flags = 0;
2299                 }
2300                 else if ((OP(oscan) == CURLYX)
2301                          && (flags & SCF_WHILEM_VISITED_POS)
2302                          /* See the comment on a similar expression above.
2303                             However, this time it not a subexpression
2304                             we care about, but the expression itself. */
2305                          && (maxcount == REG_INFTY)
2306                          && data && ++data->whilem_c < 16) {
2307                     /* This stays as CURLYX, we can put the count/of pair. */
2308                     /* Find WHILEM (as in regexec.c) */
2309                     regnode *nxt = oscan + NEXT_OFF(oscan);
2310
2311                     if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
2312                         nxt += ARG(nxt);
2313                     PREVOPER(nxt)->flags = (U8)(data->whilem_c
2314                         | (RExC_whilem_seen << 4)); /* On WHILEM */
2315                 }
2316                 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
2317                     pars++;
2318                 if (flags & SCF_DO_SUBSTR) {
2319                     SV *last_str = NULL;
2320                     int counted = mincount != 0;
2321
2322                     if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
2323 #if defined(SPARC64_GCC_WORKAROUND)
2324                         I32 b = 0;
2325                         STRLEN l = 0;
2326                         const char *s = NULL;
2327                         I32 old = 0;
2328
2329                         if (pos_before >= data->last_start_min)
2330                             b = pos_before;
2331                         else
2332                             b = data->last_start_min;
2333
2334                         l = 0;
2335                         s = SvPV_const(data->last_found, l);
2336                         old = b - data->last_start_min;
2337
2338 #else
2339                         I32 b = pos_before >= data->last_start_min
2340                             ? pos_before : data->last_start_min;
2341                         STRLEN l;
2342                         const char * const s = SvPV_const(data->last_found, l);
2343                         I32 old = b - data->last_start_min;
2344 #endif
2345
2346                         if (UTF)
2347                             old = utf8_hop((U8*)s, old) - (U8*)s;
2348                         
2349                         l -= old;
2350                         /* Get the added string: */
2351                         last_str = newSVpvn(s  + old, l);
2352                         if (UTF)
2353                             SvUTF8_on(last_str);
2354                         if (deltanext == 0 && pos_before == b) {
2355                             /* What was added is a constant string */
2356                             if (mincount > 1) {
2357                                 SvGROW(last_str, (mincount * l) + 1);
2358                                 repeatcpy(SvPVX(last_str) + l,
2359                                           SvPVX_const(last_str), l, mincount - 1);
2360                                 SvCUR_set(last_str, SvCUR(last_str) * mincount);
2361                                 /* Add additional parts. */
2362                                 SvCUR_set(data->last_found,
2363                                           SvCUR(data->last_found) - l);
2364                                 sv_catsv(data->last_found, last_str);
2365                                 {
2366                                     SV * sv = data->last_found;
2367                                     MAGIC *mg =
2368                                         SvUTF8(sv) && SvMAGICAL(sv) ?
2369                                         mg_find(sv, PERL_MAGIC_utf8) : NULL;
2370                                     if (mg && mg->mg_len >= 0)
2371                                         mg->mg_len += CHR_SVLEN(last_str);
2372                                 }
2373                                 data->last_end += l * (mincount - 1);
2374                             }
2375                         } else {
2376                             /* start offset must point into the last copy */
2377                             data->last_start_min += minnext * (mincount - 1);
2378                             data->last_start_max += is_inf ? I32_MAX
2379                                 : (maxcount - 1) * (minnext + data->pos_delta);
2380                         }
2381                     }
2382                     /* It is counted once already... */
2383                     data->pos_min += minnext * (mincount - counted);
2384                     data->pos_delta += - counted * deltanext +
2385                         (minnext + deltanext) * maxcount - minnext * mincount;
2386                     if (mincount != maxcount) {
2387                          /* Cannot extend fixed substrings found inside
2388                             the group.  */
2389                         scan_commit(pRExC_state,data);
2390                         if (mincount && last_str) {
2391                             SV * const sv = data->last_found;
2392                             MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
2393                                 mg_find(sv, PERL_MAGIC_utf8) : NULL;
2394
2395                             if (mg)
2396                                 mg->mg_len = -1;
2397                             sv_setsv(sv, last_str);
2398                             data->last_end = data->pos_min;
2399                             data->last_start_min =
2400                                 data->pos_min - CHR_SVLEN(last_str);
2401                             data->last_start_max = is_inf
2402                                 ? I32_MAX
2403                                 : data->pos_min + data->pos_delta
2404                                 - CHR_SVLEN(last_str);
2405                         }
2406                         data->longest = &(data->longest_float);
2407                     }
2408                     SvREFCNT_dec(last_str);
2409                 }
2410                 if (data && (fl & SF_HAS_EVAL))
2411                     data->flags |= SF_HAS_EVAL;
2412               optimize_curly_tail:
2413                 if (OP(oscan) != CURLYX) {
2414                     while (PL_regkind[(U8)OP(next = regnext(oscan))] == NOTHING
2415                            && NEXT_OFF(next))
2416                         NEXT_OFF(oscan) += NEXT_OFF(next);
2417                 }
2418                 continue;
2419             default:                    /* REF and CLUMP only? */
2420                 if (flags & SCF_DO_SUBSTR) {
2421                     scan_commit(pRExC_state,data);      /* Cannot expect anything... */
2422                     data->longest = &(data->longest_float);
2423                 }
2424                 is_inf = is_inf_internal = 1;
2425                 if (flags & SCF_DO_STCLASS_OR)
2426                     cl_anything(pRExC_state, data->start_class);
2427                 flags &= ~SCF_DO_STCLASS;
2428                 break;
2429             }
2430         }
2431         else if (strchr((const char*)PL_simple,OP(scan))) {
2432             int value = 0;
2433
2434             if (flags & SCF_DO_SUBSTR) {
2435                 scan_commit(pRExC_state,data);
2436                 data->pos_min++;
2437             }
2438             min++;
2439             if (flags & SCF_DO_STCLASS) {
2440                 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
2441
2442                 /* Some of the logic below assumes that switching
2443                    locale on will only add false positives. */
2444                 switch (PL_regkind[(U8)OP(scan)]) {
2445                 case SANY:
2446                 default:
2447                   do_default:
2448                     /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
2449                     if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
2450                         cl_anything(pRExC_state, data->start_class);
2451                     break;
2452                 case REG_ANY:
2453                     if (OP(scan) == SANY)
2454                         goto do_default;
2455                     if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
2456                         value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
2457                                  || (data->start_class->flags & ANYOF_CLASS));
2458                         cl_anything(pRExC_state, data->start_class);
2459                     }
2460                     if (flags & SCF_DO_STCLASS_AND || !value)
2461                         ANYOF_BITMAP_CLEAR(data->start_class,'\n');
2462                     break;
2463                 case ANYOF:
2464                     if (flags & SCF_DO_STCLASS_AND)
2465                         cl_and(data->start_class,
2466                                (struct regnode_charclass_class*)scan);
2467                     else
2468                         cl_or(pRExC_state, data->start_class,
2469                               (struct regnode_charclass_class*)scan);
2470                     break;
2471                 case ALNUM:
2472                     if (flags & SCF_DO_STCLASS_AND) {
2473                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
2474                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
2475                             for (value = 0; value < 256; value++)
2476                                 if (!isALNUM(value))
2477                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
2478                         }
2479                     }
2480                     else {
2481                         if (data->start_class->flags & ANYOF_LOCALE)
2482                             ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
2483                         else {
2484                             for (value = 0; value < 256; value++)
2485                                 if (isALNUM(value))
2486                                     ANYOF_BITMAP_SET(data->start_class, value);                 
2487                         }
2488                     }
2489                     break;
2490                 case ALNUML:
2491                     if (flags & SCF_DO_STCLASS_AND) {
2492                         if (data->start_class->flags & ANYOF_LOCALE)
2493                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
2494                     }
2495                     else {
2496                         ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
2497                         data->start_class->flags |= ANYOF_LOCALE;
2498                     }
2499                     break;
2500                 case NALNUM:
2501                     if (flags & SCF_DO_STCLASS_AND) {
2502                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
2503                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
2504                             for (value = 0; value < 256; value++)
2505                                 if (isALNUM(value))
2506                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
2507                         }
2508                     }
2509                     else {
2510                         if (data->start_class->flags & ANYOF_LOCALE)
2511                             ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
2512                         else {
2513                             for (value = 0; value < 256; value++)
2514                                 if (!isALNUM(value))
2515                                     ANYOF_BITMAP_SET(data->start_class, value);                 
2516                         }
2517                     }
2518                     break;
2519                 case NALNUML:
2520                     if (flags & SCF_DO_STCLASS_AND) {
2521                         if (data->start_class->flags & ANYOF_LOCALE)
2522                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
2523                     }
2524                     else {
2525                         data->start_class->flags |= ANYOF_LOCALE;
2526                         ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
2527                     }
2528                     break;
2529                 case SPACE:
2530                     if (flags & SCF_DO_STCLASS_AND) {
2531                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
2532                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
2533                             for (value = 0; value < 256; value++)
2534                                 if (!isSPACE(value))
2535                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
2536                         }
2537                     }
2538                     else {
2539                         if (data->start_class->flags & ANYOF_LOCALE)
2540                             ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
2541                         else {
2542                             for (value = 0; value < 256; value++)
2543                                 if (isSPACE(value))
2544                                     ANYOF_BITMAP_SET(data->start_class, value);                 
2545                         }
2546                     }
2547                     break;
2548                 case SPACEL:
2549                     if (flags & SCF_DO_STCLASS_AND) {
2550                         if (data->start_class->flags & ANYOF_LOCALE)
2551                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
2552                     }
2553                     else {
2554                         data->start_class->flags |= ANYOF_LOCALE;
2555                         ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
2556                     }
2557                     break;
2558                 case NSPACE:
2559                     if (flags & SCF_DO_STCLASS_AND) {
2560                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
2561                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
2562                             for (value = 0; value < 256; value++)
2563                                 if (isSPACE(value))
2564                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
2565                         }
2566                     }
2567                     else {
2568                         if (data->start_class->flags & ANYOF_LOCALE)
2569                             ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
2570                         else {
2571                             for (value = 0; value < 256; value++)
2572                                 if (!isSPACE(value))
2573                                     ANYOF_BITMAP_SET(data->start_class, value);                 
2574                         }
2575                     }
2576                     break;
2577                 case NSPACEL:
2578                     if (flags & SCF_DO_STCLASS_AND) {
2579                         if (data->start_class->flags & ANYOF_LOCALE) {
2580                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
2581                             for (value = 0; value < 256; value++)
2582                                 if (!isSPACE(value))
2583                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
2584                         }
2585                     }
2586                     else {
2587                         data->start_class->flags |= ANYOF_LOCALE;
2588                         ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
2589                     }
2590                     break;
2591                 case DIGIT:
2592                     if (flags & SCF_DO_STCLASS_AND) {
2593                         ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
2594                         for (value = 0; value < 256; value++)
2595                             if (!isDIGIT(value))
2596                                 ANYOF_BITMAP_CLEAR(data->start_class, value);
2597                     }
2598                     else {
2599                         if (data->start_class->flags & ANYOF_LOCALE)
2600                             ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
2601                         else {
2602                             for (value = 0; value < 256; value++)
2603                                 if (isDIGIT(value))
2604                                     ANYOF_BITMAP_SET(data->start_class, value);                 
2605                         }
2606                     }
2607                     break;
2608                 case NDIGIT:
2609                     if (flags & SCF_DO_STCLASS_AND) {
2610                         ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
2611                         for (value = 0; value < 256; value++)
2612                             if (isDIGIT(value))
2613                                 ANYOF_BITMAP_CLEAR(data->start_class, value);
2614                     }
2615                     else {
2616                         if (data->start_class->flags & ANYOF_LOCALE)
2617                             ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
2618                         else {
2619                             for (value = 0; value < 256; value++)
2620                                 if (!isDIGIT(value))
2621                                     ANYOF_BITMAP_SET(data->start_class, value);                 
2622                         }
2623                     }
2624                     break;
2625                 }
2626                 if (flags & SCF_DO_STCLASS_OR)
2627                     cl_and(data->start_class, &and_with);
2628                 flags &= ~SCF_DO_STCLASS;
2629             }
2630         }
2631         else if (PL_regkind[(U8)OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
2632             data->flags |= (OP(scan) == MEOL
2633                             ? SF_BEFORE_MEOL
2634                             : SF_BEFORE_SEOL);
2635         }
2636         else if (  PL_regkind[(U8)OP(scan)] == BRANCHJ
2637                  /* Lookbehind, or need to calculate parens/evals/stclass: */
2638                    && (scan->flags || data || (flags & SCF_DO_STCLASS))
2639                    && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
2640             /* Lookahead/lookbehind */
2641             I32 deltanext, minnext, fake = 0;
2642             regnode *nscan;
2643             struct regnode_charclass_class intrnl;
2644             int f = 0;
2645
2646             data_fake.flags = 0;
2647             if (data) {         
2648                 data_fake.whilem_c = data->whilem_c;
2649                 data_fake.last_closep = data->last_closep;
2650             }
2651             else
2652                 data_fake.last_closep = &fake;
2653             if ( flags & SCF_DO_STCLASS && !scan->flags
2654                  && OP(scan) == IFMATCH ) { /* Lookahead */
2655                 cl_init(pRExC_state, &intrnl);
2656                 data_fake.start_class = &intrnl;
2657                 f |= SCF_DO_STCLASS_AND;
2658             }
2659             if (flags & SCF_WHILEM_VISITED_POS)
2660                 f |= SCF_WHILEM_VISITED_POS;
2661             next = regnext(scan);
2662             nscan = NEXTOPER(NEXTOPER(scan));
2663             minnext = study_chunk(pRExC_state, &nscan, &deltanext, last, &data_fake, f,depth+1);
2664             if (scan->flags) {
2665                 if (deltanext) {
2666                     vFAIL("Variable length lookbehind not implemented");
2667                 }
2668                 else if (minnext > U8_MAX) {
2669                     vFAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
2670                 }
2671                 scan->flags = (U8)minnext;
2672             }
2673             if (data && data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
2674                 pars++;
2675             if (data && (data_fake.flags & SF_HAS_EVAL))
2676                 data->flags |= SF_HAS_EVAL;
2677             if (data)
2678                 data->whilem_c = data_fake.whilem_c;
2679             if (f & SCF_DO_STCLASS_AND) {
2680                 const int was = (data->start_class->flags & ANYOF_EOS);
2681
2682                 cl_and(data->start_class, &intrnl);
2683                 if (was)
2684                     data->start_class->flags |= ANYOF_EOS;
2685             }
2686         }
2687         else if (OP(scan) == OPEN) {
2688             pars++;
2689         }
2690         else if (OP(scan) == CLOSE) {
2691             if ((I32)ARG(scan) == is_par) {
2692                 next = regnext(scan);
2693
2694                 if ( next && (OP(next) != WHILEM) && next < last)
2695                     is_par = 0;         /* Disable optimization */
2696             }
2697             if (data)
2698                 *(data->last_closep) = ARG(scan);
2699         }
2700         else if (OP(scan) == EVAL) {
2701                 if (data)
2702                     data->flags |= SF_HAS_EVAL;
2703         }
2704         else if (OP(scan) == LOGICAL && scan->flags == 2) { /* Embedded follows */
2705                 if (flags & SCF_DO_SUBSTR) {
2706                     scan_commit(pRExC_state,data);
2707                     data->longest = &(data->longest_float);
2708                 }
2709                 is_inf = is_inf_internal = 1;
2710                 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
2711                     cl_anything(pRExC_state, data->start_class);
2712                 flags &= ~SCF_DO_STCLASS;
2713         }
2714         /* Else: zero-length, ignore. */
2715         scan = regnext(scan);
2716     }
2717
2718   finish:
2719     *scanp = scan;
2720     *deltap = is_inf_internal ? I32_MAX : delta;
2721     if (flags & SCF_DO_SUBSTR && is_inf)
2722         data->pos_delta = I32_MAX - data->pos_min;
2723     if (is_par > U8_MAX)
2724         is_par = 0;
2725     if (is_par && pars==1 && data) {
2726         data->flags |= SF_IN_PAR;
2727         data->flags &= ~SF_HAS_PAR;
2728     }
2729     else if (pars && data) {
2730         data->flags |= SF_HAS_PAR;
2731         data->flags &= ~SF_IN_PAR;
2732     }
2733     if (flags & SCF_DO_STCLASS_OR)
2734         cl_and(data->start_class, &and_with);
2735     return min;
2736 }
2737
2738 STATIC I32
2739 S_add_data(RExC_state_t *pRExC_state, I32 n, const char *s)
2740 {
2741     if (RExC_rx->data) {
2742         Renewc(RExC_rx->data,
2743                sizeof(*RExC_rx->data) + sizeof(void*) * (RExC_rx->data->count + n - 1),
2744                char, struct reg_data);
2745         Renew(RExC_rx->data->what, RExC_rx->data->count + n, U8);
2746         RExC_rx->data->count += n;
2747     }
2748     else {
2749         Newxc(RExC_rx->data, sizeof(*RExC_rx->data) + sizeof(void*) * (n - 1),
2750              char, struct reg_data);
2751         Newx(RExC_rx->data->what, n, U8);
2752         RExC_rx->data->count = n;
2753     }
2754     Copy(s, RExC_rx->data->what + RExC_rx->data->count - n, n, U8);
2755     return RExC_rx->data->count - n;
2756 }
2757
2758 void
2759 Perl_reginitcolors(pTHX)
2760 {
2761     dVAR;
2762     const char * const s = PerlEnv_getenv("PERL_RE_COLORS");
2763     if (s) {
2764         char *t = savepv(s);
2765         int i = 0;
2766         PL_colors[0] = t;
2767         while (++i < 6) {
2768             t = strchr(t, '\t');
2769             if (t) {
2770                 *t = '\0';
2771                 PL_colors[i] = ++t;
2772             }
2773             else
2774                 PL_colors[i] = t = (char *)"";
2775         }
2776     } else {
2777         int i = 0;
2778         while (i < 6)
2779             PL_colors[i++] = (char *)"";
2780     }
2781     PL_colorset = 1;
2782 }
2783
2784
2785 /*
2786  - pregcomp - compile a regular expression into internal code
2787  *
2788  * We can't allocate space until we know how big the compiled form will be,
2789  * but we can't compile it (and thus know how big it is) until we've got a
2790  * place to put the code.  So we cheat:  we compile it twice, once with code
2791  * generation turned off and size counting turned on, and once "for real".
2792  * This also means that we don't allocate space until we are sure that the
2793  * thing really will compile successfully, and we never have to move the
2794  * code and thus invalidate pointers into it.  (Note that it has to be in
2795  * one piece because free() must be able to free it all.) [NB: not true in perl]
2796  *
2797  * Beware that the optimization-preparation code in here knows about some
2798  * of the structure of the compiled regexp.  [I'll say.]
2799  */
2800 regexp *
2801 Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
2802 {
2803     dVAR;
2804     register regexp *r;
2805     regnode *scan;
2806     regnode *first;
2807     I32 flags;
2808     I32 minlen = 0;
2809     I32 sawplus = 0;
2810     I32 sawopen = 0;
2811     scan_data_t data;
2812     RExC_state_t RExC_state;
2813     RExC_state_t *pRExC_state = &RExC_state;
2814
2815     GET_RE_DEBUG_FLAGS_DECL;
2816
2817     if (exp == NULL)
2818         FAIL("NULL regexp argument");
2819
2820     RExC_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
2821
2822     RExC_precomp = exp;
2823     DEBUG_r(if (!PL_colorset) reginitcolors());
2824     DEBUG_COMPILE_r({
2825          PerlIO_printf(Perl_debug_log, "%sCompiling REx%s \"%s%*s%s\"\n",
2826                        PL_colors[4],PL_colors[5],PL_colors[0],
2827                        (int)(xend - exp), RExC_precomp, PL_colors[1]);
2828     });
2829     RExC_flags = pm->op_pmflags;
2830     RExC_sawback = 0;
2831
2832     RExC_seen = 0;
2833     RExC_seen_zerolen = *exp == '^' ? -1 : 0;
2834     RExC_seen_evals = 0;
2835     RExC_extralen = 0;
2836
2837     /* First pass: determine size, legality. */
2838     RExC_parse = exp;
2839     RExC_start = exp;
2840     RExC_end = xend;
2841     RExC_naughty = 0;
2842     RExC_npar = 1;
2843     RExC_size = 0L;
2844     RExC_emit = &PL_regdummy;
2845     RExC_whilem_seen = 0;
2846 #if 0 /* REGC() is (currently) a NOP at the first pass.
2847        * Clever compilers notice this and complain. --jhi */
2848     REGC((U8)REG_MAGIC, (char*)RExC_emit);
2849 #endif
2850     if (reg(pRExC_state, 0, &flags) == NULL) {
2851         RExC_precomp = NULL;
2852         return(NULL);
2853     }
2854     DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" ", (IV)RExC_size));
2855
2856     /* Small enough for pointer-storage convention?
2857        If extralen==0, this means that we will not need long jumps. */
2858     if (RExC_size >= 0x10000L && RExC_extralen)
2859         RExC_size += RExC_extralen;
2860     else
2861         RExC_extralen = 0;
2862     if (RExC_whilem_seen > 15)
2863         RExC_whilem_seen = 15;
2864
2865     /* Allocate space and initialize. */
2866     Newxc(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode),
2867          char, regexp);
2868     if (r == NULL)
2869         FAIL("Regexp out of space");
2870
2871 #ifdef DEBUGGING
2872     /* avoid reading uninitialized memory in DEBUGGING code in study_chunk() */
2873     Zero(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode), char);
2874 #endif
2875     r->refcnt = 1;
2876     r->prelen = xend - exp;
2877     r->precomp = savepvn(RExC_precomp, r->prelen);
2878     r->subbeg = NULL;
2879 #ifdef PERL_OLD_COPY_ON_WRITE
2880     r->saved_copy = NULL;
2881 #endif
2882     r->reganch = pm->op_pmflags & PMf_COMPILETIME;
2883     r->nparens = RExC_npar - 1; /* set early to validate backrefs */
2884     r->lastparen = 0;                   /* mg.c reads this.  */
2885
2886     r->substrs = 0;                     /* Useful during FAIL. */
2887     r->startp = 0;                      /* Useful during FAIL. */
2888     r->endp = 0;                        /* Useful during FAIL. */
2889
2890     Newxz(r->offsets, 2*RExC_size+1, U32); /* MJD 20001228 */
2891     if (r->offsets) {
2892         r->offsets[0] = RExC_size;
2893     }
2894     DEBUG_OFFSETS_r(PerlIO_printf(Perl_debug_log,
2895                           "%s %"UVuf" bytes for offset annotations.\n",
2896                           r->offsets ? "Got" : "Couldn't get",
2897                           (UV)((2*RExC_size+1) * sizeof(U32))));
2898
2899     RExC_rx = r;
2900
2901     /* Second pass: emit code. */
2902     RExC_flags = pm->op_pmflags;        /* don't let top level (?i) bleed */
2903     RExC_parse = exp;
2904     RExC_end = xend;
2905     RExC_naughty = 0;
2906     RExC_npar = 1;
2907     RExC_emit_start = r->program;
2908     RExC_emit = r->program;
2909     /* Store the count of eval-groups for security checks: */
2910     RExC_emit->next_off = (U16)((RExC_seen_evals > U16_MAX) ? U16_MAX : RExC_seen_evals);
2911     REGC((U8)REG_MAGIC, (char*) RExC_emit++);
2912     r->data = 0;
2913     if (reg(pRExC_state, 0, &flags) == NULL)
2914         return(NULL);
2915
2916
2917     /* Dig out information for optimizations. */
2918     r->reganch = pm->op_pmflags & PMf_COMPILETIME; /* Again? */
2919     pm->op_pmflags = RExC_flags;
2920     if (UTF)
2921         r->reganch |= ROPT_UTF8;        /* Unicode in it? */
2922     r->regstclass = NULL;
2923     if (RExC_naughty >= 10)     /* Probably an expensive pattern. */
2924         r->reganch |= ROPT_NAUGHTY;
2925     scan = r->program + 1;              /* First BRANCH. */
2926
2927     /* XXXX To minimize changes to RE engine we always allocate
2928        3-units-long substrs field. */
2929     Newxz(r->substrs, 1, struct reg_substr_data);
2930
2931     StructCopy(&zero_scan_data, &data, scan_data_t);
2932     /* XXXX Should not we check for something else?  Usually it is OPEN1... */
2933     if (OP(scan) != BRANCH) {   /* Only one top-level choice. */
2934         I32 fake;
2935         STRLEN longest_float_length, longest_fixed_length;
2936         struct regnode_charclass_class ch_class;
2937         int stclass_flag;
2938         I32 last_close = 0;
2939
2940         first = scan;
2941         /* Skip introductions and multiplicators >= 1. */
2942         while ((OP(first) == OPEN && (sawopen = 1)) ||
2943                /* An OR of *one* alternative - should not happen now. */
2944             (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
2945             (OP(first) == PLUS) ||
2946             (OP(first) == MINMOD) ||
2947                /* An {n,m} with n>0 */
2948             (PL_regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) {
2949                 if (OP(first) == PLUS)
2950                     sawplus = 1;
2951                 else
2952                     first += regarglen[(U8)OP(first)];
2953                 first = NEXTOPER(first);
2954         }
2955
2956         /* Starting-point info. */
2957       again:
2958         if (PL_regkind[(U8)OP(first)] == EXACT) {
2959             if (OP(first) == EXACT)
2960                 /*EMPTY*/;      /* Empty, get anchored substr later. */
2961             else if ((OP(first) == EXACTF || OP(first) == EXACTFL))
2962                 r->regstclass = first;
2963         }
2964         else if (strchr((const char*)PL_simple,OP(first)))
2965             r->regstclass = first;
2966         else if (PL_regkind[(U8)OP(first)] == BOUND ||
2967                  PL_regkind[(U8)OP(first)] == NBOUND)
2968             r->regstclass = first;
2969         else if (PL_regkind[(U8)OP(first)] == BOL) {
2970             r->reganch |= (OP(first) == MBOL
2971                            ? ROPT_ANCH_MBOL
2972                            : (OP(first) == SBOL
2973                               ? ROPT_ANCH_SBOL
2974                               : ROPT_ANCH_BOL));
2975             first = NEXTOPER(first);
2976             goto again;
2977         }
2978         else if (OP(first) == GPOS) {
2979             r->reganch |= ROPT_ANCH_GPOS;
2980             first = NEXTOPER(first);
2981             goto again;
2982         }
2983         else if (!sawopen && (OP(first) == STAR &&
2984             PL_regkind[(U8)OP(NEXTOPER(first))] == REG_ANY) &&
2985             !(r->reganch & ROPT_ANCH) )
2986         {
2987             /* turn .* into ^.* with an implied $*=1 */
2988             const int type =
2989                 (OP(NEXTOPER(first)) == REG_ANY)
2990                     ? ROPT_ANCH_MBOL
2991                     : ROPT_ANCH_SBOL;
2992             r->reganch |= type | ROPT_IMPLICIT;
2993             first = NEXTOPER(first);
2994             goto again;
2995         }
2996         if (sawplus && (!sawopen || !RExC_sawback)
2997             && !(RExC_seen & REG_SEEN_EVAL)) /* May examine pos and $& */
2998             /* x+ must match at the 1st pos of run of x's */
2999             r->reganch |= ROPT_SKIP;
3000
3001         /* Scan is after the zeroth branch, first is atomic matcher. */
3002         DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
3003                               (IV)(first - scan + 1)));
3004         /*
3005         * If there's something expensive in the r.e., find the
3006         * longest literal string that must appear and make it the
3007         * regmust.  Resolve ties in favor of later strings, since
3008         * the regstart check works with the beginning of the r.e.
3009         * and avoiding duplication strengthens checking.  Not a
3010         * strong reason, but sufficient in the absence of others.
3011         * [Now we resolve ties in favor of the earlier string if
3012         * it happens that c_offset_min has been invalidated, since the
3013         * earlier string may buy us something the later one won't.]
3014         */
3015         minlen = 0;
3016
3017         data.longest_fixed = newSVpvs("");
3018         data.longest_float = newSVpvs("");
3019         data.last_found = newSVpvs("");
3020         data.longest = &(data.longest_fixed);
3021         first = scan;
3022         if (!r->regstclass) {
3023             cl_init(pRExC_state, &ch_class);
3024             data.start_class = &ch_class;
3025             stclass_flag = SCF_DO_STCLASS_AND;
3026         } else                          /* XXXX Check for BOUND? */
3027             stclass_flag = 0;
3028         data.last_closep = &last_close;
3029
3030         minlen = study_chunk(pRExC_state, &first, &fake, scan + RExC_size, /* Up to end */
3031                              &data, SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag,0);
3032         if ( RExC_npar == 1 && data.longest == &(data.longest_fixed)
3033              && data.last_start_min == 0 && data.last_end > 0
3034              && !RExC_seen_zerolen
3035              && (!(RExC_seen & REG_SEEN_GPOS) || (r->reganch & ROPT_ANCH_GPOS)))
3036             r->reganch |= ROPT_CHECK_ALL;
3037         scan_commit(pRExC_state, &data);
3038         SvREFCNT_dec(data.last_found);
3039
3040         longest_float_length = CHR_SVLEN(data.longest_float);
3041         if (longest_float_length
3042             || (data.flags & SF_FL_BEFORE_EOL
3043                 && (!(data.flags & SF_FL_BEFORE_MEOL)
3044                     || (RExC_flags & PMf_MULTILINE)))) {
3045             int t;
3046
3047             if (SvCUR(data.longest_fixed)                       /* ok to leave SvCUR */
3048                 && data.offset_fixed == data.offset_float_min
3049                 && SvCUR(data.longest_fixed) == SvCUR(data.longest_float))
3050                     goto remove_float;          /* As in (a)+. */
3051
3052             if (SvUTF8(data.longest_float)) {
3053                 r->float_utf8 = data.longest_float;
3054                 r->float_substr = NULL;
3055             } else {
3056                 r->float_substr = data.longest_float;
3057                 r->float_utf8 = NULL;
3058             }
3059             r->float_min_offset = data.offset_float_min;
3060             r->float_max_offset = data.offset_float_max;
3061             t = (data.flags & SF_FL_BEFORE_EOL /* Can't have SEOL and MULTI */
3062                        && (!(data.flags & SF_FL_BEFORE_MEOL)
3063                            || (RExC_flags & PMf_MULTILINE)));
3064             fbm_compile(data.longest_float, t ? FBMcf_TAIL : 0);
3065         }
3066         else {
3067           remove_float:
3068             r->float_substr = r->float_utf8 = NULL;
3069             SvREFCNT_dec(data.longest_float);
3070             longest_float_length = 0;
3071         }
3072
3073         longest_fixed_length = CHR_SVLEN(data.longest_fixed);
3074         if (longest_fixed_length
3075             || (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
3076                 && (!(data.flags & SF_FIX_BEFORE_MEOL)
3077                     || (RExC_flags & PMf_MULTILINE)))) {
3078             int t;
3079
3080             if (SvUTF8(data.longest_fixed)) {
3081                 r->anchored_utf8 = data.longest_fixed;
3082                 r->anchored_substr = NULL;
3083             } else {
3084                 r->anchored_substr = data.longest_fixed;
3085                 r->anchored_utf8 = NULL;
3086             }
3087             r->anchored_offset = data.offset_fixed;
3088             t = (data.flags & SF_FIX_BEFORE_EOL /* Can't have SEOL and MULTI */
3089                  && (!(data.flags & SF_FIX_BEFORE_MEOL)
3090                      || (RExC_flags & PMf_MULTILINE)));
3091             fbm_compile(data.longest_fixed, t ? FBMcf_TAIL : 0);
3092         }
3093         else {
3094             r->anchored_substr = r->anchored_utf8 = NULL;
3095             SvREFCNT_dec(data.longest_fixed);
3096             longest_fixed_length = 0;
3097         }
3098         if (r->regstclass
3099             && (OP(r->regstclass) == REG_ANY || OP(r->regstclass) == SANY))
3100             r->regstclass = NULL;
3101         if ((!(r->anchored_substr || r->anchored_utf8) || r->anchored_offset)
3102             && stclass_flag
3103             && !(data.start_class->flags & ANYOF_EOS)
3104             && !cl_is_anything(data.start_class))
3105         {
3106             const I32 n = add_data(pRExC_state, 1, "f");
3107
3108             Newx(RExC_rx->data->data[n], 1,
3109                 struct regnode_charclass_class);
3110             StructCopy(data.start_class,
3111                        (struct regnode_charclass_class*)RExC_rx->data->data[n],
3112                        struct regnode_charclass_class);
3113             r->regstclass = (regnode*)RExC_rx->data->data[n];
3114             r->reganch &= ~ROPT_SKIP;   /* Used in find_byclass(). */
3115             DEBUG_COMPILE_r({ SV *sv = sv_newmortal();
3116                       regprop(r, sv, (regnode*)data.start_class);
3117                       PerlIO_printf(Perl_debug_log,
3118                                     "synthetic stclass \"%s\".\n",
3119                                     SvPVX_const(sv));});
3120         }
3121
3122         /* A temporary algorithm prefers floated substr to fixed one to dig more info. */
3123         if (longest_fixed_length > longest_float_length) {
3124             r->check_substr = r->anchored_substr;
3125             r->check_utf8 = r->anchored_utf8;
3126             r->check_offset_min = r->check_offset_max = r->anchored_offset;
3127             if (r->reganch & ROPT_ANCH_SINGLE)
3128                 r->reganch |= ROPT_NOSCAN;
3129         }
3130         else {
3131             r->check_substr = r->float_substr;
3132             r->check_utf8 = r->float_utf8;
3133             r->check_offset_min = data.offset_float_min;
3134             r->check_offset_max = data.offset_float_max;
3135         }
3136         /* XXXX Currently intuiting is not compatible with ANCH_GPOS.
3137            This should be changed ASAP!  */
3138         if ((r->check_substr || r->check_utf8) && !(r->reganch & ROPT_ANCH_GPOS)) {
3139             r->reganch |= RE_USE_INTUIT;
3140             if (SvTAIL(r->check_substr ? r->check_substr : r->check_utf8))
3141                 r->reganch |= RE_INTUIT_TAIL;
3142         }
3143     }
3144     else {
3145         /* Several toplevels. Best we can is to set minlen. */
3146         I32 fake;
3147         struct regnode_charclass_class ch_class;
3148         I32 last_close = 0;
3149         
3150         DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "\n"));
3151         scan = r->program + 1;
3152         cl_init(pRExC_state, &ch_class);
3153         data.start_class = &ch_class;
3154         data.last_closep = &last_close;
3155         minlen = study_chunk(pRExC_state, &scan, &fake, scan + RExC_size, &data, SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS,0);
3156         r->check_substr = r->check_utf8 = r->anchored_substr = r->anchored_utf8
3157                 = r->float_substr = r->float_utf8 = NULL;
3158         if (!(data.start_class->flags & ANYOF_EOS)
3159             && !cl_is_anything(data.start_class))
3160         {
3161             const I32 n = add_data(pRExC_state, 1, "f");
3162
3163             Newx(RExC_rx->data->data[n], 1,
3164                 struct regnode_charclass_class);
3165             StructCopy(data.start_class,
3166                        (struct regnode_charclass_class*)RExC_rx->data->data[n],
3167                        struct regnode_charclass_class);
3168             r->regstclass = (regnode*)RExC_rx->data->data[n];
3169             r->reganch &= ~ROPT_SKIP;   /* Used in find_byclass(). */
3170             DEBUG_COMPILE_r({ SV* sv = sv_newmortal();
3171                       regprop(r, sv, (regnode*)data.start_class);
3172                       PerlIO_printf(Perl_debug_log,
3173                                     "synthetic stclass \"%s\".\n",
3174                                     SvPVX_const(sv));});
3175         }
3176     }
3177
3178     r->minlen = minlen;
3179     if (RExC_seen & REG_SEEN_GPOS)
3180         r->reganch |= ROPT_GPOS_SEEN;
3181     if (RExC_seen & REG_SEEN_LOOKBEHIND)
3182         r->reganch |= ROPT_LOOKBEHIND_SEEN;
3183     if (RExC_seen & REG_SEEN_EVAL)
3184         r->reganch |= ROPT_EVAL_SEEN;
3185     if (RExC_seen & REG_SEEN_CANY)
3186         r->reganch |= ROPT_CANY_SEEN;
3187     Newxz(r->startp, RExC_npar, I32);
3188     Newxz(r->endp, RExC_npar, I32);
3189     DEBUG_COMPILE_r(regdump(r));
3190     return(r);
3191 }
3192
3193 /*
3194  - reg - regular expression, i.e. main body or parenthesized thing
3195  *
3196  * Caller must absorb opening parenthesis.
3197  *
3198  * Combining parenthesis handling with the base level of regular expression
3199  * is a trifle forced, but the need to tie the tails of the branches to what
3200  * follows makes it hard to avoid.
3201  */
3202 STATIC regnode *
3203 S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
3204     /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
3205 {
3206     dVAR;
3207     register regnode *ret;              /* Will be the head of the group. */
3208     register regnode *br;
3209     register regnode *lastbr;
3210     register regnode *ender = NULL;
3211     register I32 parno = 0;
3212     I32 flags;
3213     const I32 oregflags = RExC_flags;
3214     bool have_branch = 0;
3215     bool is_open = 0;
3216
3217     /* for (?g), (?gc), and (?o) warnings; warning
3218        about (?c) will warn about (?g) -- japhy    */
3219
3220 #define WASTED_O  0x01
3221 #define WASTED_G  0x02
3222 #define WASTED_C  0x04
3223 #define WASTED_GC (0x02|0x04)
3224     I32 wastedflags = 0x00;
3225
3226     char * parse_start = RExC_parse; /* MJD */
3227     char * const oregcomp_parse = RExC_parse;
3228
3229     *flagp = 0;                         /* Tentatively. */
3230
3231
3232     /* Make an OPEN node, if parenthesized. */
3233     if (paren) {
3234         if (*RExC_parse == '?') { /* (?...) */
3235             U32 posflags = 0, negflags = 0;
3236             U32 *flagsp = &posflags;
3237             bool is_logical = 0;
3238             const char * const seqstart = RExC_parse;
3239
3240             RExC_parse++;
3241             paren = *RExC_parse++;
3242             ret = NULL;                 /* For look-ahead/behind. */
3243             switch (paren) {
3244             case '<':           /* (?<...) */
3245                 RExC_seen |= REG_SEEN_LOOKBEHIND;
3246                 if (*RExC_parse == '!')
3247                     paren = ',';
3248                 if (*RExC_parse != '=' && *RExC_parse != '!')
3249                     goto unknown;
3250                 RExC_parse++;
3251             case '=':           /* (?=...) */
3252             case '!':           /* (?!...) */
3253                 RExC_seen_zerolen++;
3254             case ':':           /* (?:...) */
3255             case '>':           /* (?>...) */
3256                 break;
3257             case '$':           /* (?$...) */
3258             case '@':           /* (?@...) */
3259                 vFAIL2("Sequence (?%c...) not implemented", (int)paren);
3260                 break;
3261             case '#':           /* (?#...) */
3262                 while (*RExC_parse && *RExC_parse != ')')
3263                     RExC_parse++;
3264                 if (*RExC_parse != ')')
3265                     FAIL("Sequence (?#... not terminated");
3266                 nextchar(pRExC_state);
3267                 *flagp = TRYAGAIN;
3268                 return NULL;
3269             case 'p':           /* (?p...) */
3270                 if (SIZE_ONLY && ckWARN2(WARN_DEPRECATED, WARN_REGEXP))
3271                     vWARNdep(RExC_parse, "(?p{}) is deprecated - use (??{})");
3272                 /* FALL THROUGH*/
3273             case '?':           /* (??...) */
3274                 is_logical = 1;
3275                 if (*RExC_parse != '{')
3276                     goto unknown;
3277                 paren = *RExC_parse++;
3278                 /* FALL THROUGH */
3279             case '{':           /* (?{...}) */
3280             {
3281                 I32 count = 1, n = 0;
3282                 char c;
3283                 char *s = RExC_parse;
3284
3285                 RExC_seen_zerolen++;
3286                 RExC_seen |= REG_SEEN_EVAL;
3287                 while (count && (c = *RExC_parse)) {
3288                     if (c == '\\') {
3289                         if (RExC_parse[1])
3290                             RExC_parse++;
3291                     }
3292                     else if (c == '{')
3293                         count++;
3294                     else if (c == '}')
3295                         count--;
3296                     RExC_parse++;
3297                 }
3298                 if (*RExC_parse != ')') {
3299                     RExC_parse = s;             
3300                     vFAIL("Sequence (?{...}) not terminated or not {}-balanced");
3301                 }
3302                 if (!SIZE_ONLY) {
3303                     PAD *pad;
3304                     OP_4tree *sop, *rop;
3305                     SV * const sv = newSVpvn(s, RExC_parse - 1 - s);
3306
3307                     ENTER;
3308                     Perl_save_re_context(aTHX);
3309                     rop = sv_compile_2op(sv, &sop, "re", &pad);
3310                     sop->op_private |= OPpREFCOUNTED;
3311                     /* re_dup will OpREFCNT_inc */
3312                     OpREFCNT_set(sop, 1);
3313                     LEAVE;
3314
3315                     n = add_data(pRExC_state, 3, "nop");
3316                     RExC_rx->data->data[n] = (void*)rop;
3317                     RExC_rx->data->data[n+1] = (void*)sop;
3318                     RExC_rx->data->data[n+2] = (void*)pad;
3319                     SvREFCNT_dec(sv);
3320                 }
3321                 else {                                          /* First pass */
3322                     if (PL_reginterp_cnt < ++RExC_seen_evals
3323                         && IN_PERL_RUNTIME)
3324                         /* No compiled RE interpolated, has runtime
3325                            components ===> unsafe.  */
3326                         FAIL("Eval-group not allowed at runtime, use re 'eval'");
3327                     if (PL_tainting && PL_tainted)
3328                         FAIL("Eval-group in insecure regular expression");
3329                     if (IN_PERL_COMPILETIME)
3330                         PL_cv_has_eval = 1;
3331                 }
3332
3333                 nextchar(pRExC_state);
3334                 if (is_logical) {
3335                     ret = reg_node(pRExC_state, LOGICAL);
3336                     if (!SIZE_ONLY)
3337                         ret->flags = 2;
3338                     regtail(pRExC_state, ret, reganode(pRExC_state, EVAL, n));
3339                     /* deal with the length of this later - MJD */
3340                     return ret;
3341                 }
3342                 ret = reganode(pRExC_state, EVAL, n);
3343                 Set_Node_Length(ret, RExC_parse - parse_start + 1);
3344                 Set_Node_Offset(ret, parse_start);
3345                 return ret;
3346             }
3347             case '(':           /* (?(?{...})...) and (?(?=...)...) */
3348             {
3349                 if (RExC_parse[0] == '?') {        /* (?(?...)) */
3350                     if (RExC_parse[1] == '=' || RExC_parse[1] == '!'
3351                         || RExC_parse[1] == '<'
3352                         || RExC_parse[1] == '{') { /* Lookahead or eval. */
3353                         I32 flag;
3354                         
3355                         ret = reg_node(pRExC_state, LOGICAL);
3356                         if (!SIZE_ONLY)
3357                             ret->flags = 1;
3358                         regtail(pRExC_state, ret, reg(pRExC_state, 1, &flag));
3359                         goto insert_if;
3360                     }
3361                 }
3362                 else if (RExC_parse[0] >= '1' && RExC_parse[0] <= '9' ) {
3363                     /* (?(1)...) */
3364                     char c;
3365                     parno = atoi(RExC_parse++);
3366
3367                     while (isDIGIT(*RExC_parse))
3368                         RExC_parse++;
3369                     ret = reganode(pRExC_state, GROUPP, parno);
3370
3371                     if ((c = *nextchar(pRExC_state)) != ')')
3372                         vFAIL("Switch condition not recognized");
3373                   insert_if:
3374                     regtail(pRExC_state, ret, reganode(pRExC_state, IFTHEN, 0));
3375                     br = regbranch(pRExC_state, &flags, 1);
3376                     if (br == NULL)
3377                         br = reganode(pRExC_state, LONGJMP, 0);
3378                     else
3379                         regtail(pRExC_state, br, reganode(pRExC_state, LONGJMP, 0));
3380                     c = *nextchar(pRExC_state);
3381                     if (flags&HASWIDTH)
3382                         *flagp |= HASWIDTH;
3383                     if (c == '|') {
3384                         lastbr = reganode(pRExC_state, IFTHEN, 0); /* Fake one for optimizer. */
3385                         regbranch(pRExC_state, &flags, 1);
3386                         regtail(pRExC_state, ret, lastbr);
3387                         if (flags&HASWIDTH)
3388                             *flagp |= HASWIDTH;
3389                         c = *nextchar(pRExC_state);
3390                     }
3391                     else
3392                         lastbr = NULL;
3393                     if (c != ')')
3394                         vFAIL("Switch (?(condition)... contains too many branches");
3395                     ender = reg_node(pRExC_state, TAIL);
3396                     regtail(pRExC_state, br, ender);
3397                     if (lastbr) {
3398                         regtail(pRExC_state, lastbr, ender);
3399                         regtail(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender);
3400                     }
3401                     else
3402                         regtail(pRExC_state, ret, ender);
3403                     return ret;
3404                 }
3405                 else {
3406                     vFAIL2("Unknown switch condition (?(%.2s", RExC_parse);
3407                 }
3408             }
3409             case 0:
3410                 RExC_parse--; /* for vFAIL to print correctly */
3411                 vFAIL("Sequence (? incomplete");
3412                 break;
3413             default:
3414                 --RExC_parse;
3415               parse_flags:      /* (?i) */
3416                 while (*RExC_parse && strchr("iogcmsx", *RExC_parse)) {
3417                     /* (?g), (?gc) and (?o) are useless here
3418                        and must be globally applied -- japhy */
3419
3420                     if (*RExC_parse == 'o' || *RExC_parse == 'g') {
3421                         if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
3422                             const I32 wflagbit = *RExC_parse == 'o' ? WASTED_O : WASTED_G;
3423                             if (! (wastedflags & wflagbit) ) {
3424                                 wastedflags |= wflagbit;
3425                                 vWARN5(
3426                                     RExC_parse + 1,
3427                                     "Useless (%s%c) - %suse /%c modifier",
3428                                     flagsp == &negflags ? "?-" : "?",
3429                                     *RExC_parse,
3430                                     flagsp == &negflags ? "don't " : "",
3431                                     *RExC_parse
3432                                 );
3433                             }
3434                         }
3435                     }
3436                     else if (*RExC_parse == 'c') {
3437                         if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
3438                             if (! (wastedflags & WASTED_C) ) {
3439                                 wastedflags |= WASTED_GC;
3440                                 vWARN3(
3441                                     RExC_parse + 1,
3442                                     "Useless (%sc) - %suse /gc modifier",
3443                                     flagsp == &negflags ? "?-" : "?",
3444                                     flagsp == &negflags ? "don't " : ""
3445                                 );
3446                             }
3447                         }
3448                     }
3449                     else { pmflag(flagsp, *RExC_parse); }
3450
3451                     ++RExC_parse;
3452                 }
3453                 if (*RExC_parse == '-') {
3454                     flagsp = &negflags;
3455                     wastedflags = 0;  /* reset so (?g-c) warns twice */
3456                     ++RExC_parse;
3457                     goto parse_flags;
3458                 }
3459                 RExC_flags |= posflags;
3460                 RExC_flags &= ~negflags;
3461                 if (*RExC_parse == ':') {
3462                     RExC_parse++;
3463                     paren = ':';
3464                     break;
3465                 }               
3466               unknown:
3467                 if (*RExC_parse != ')') {
3468                     RExC_parse++;
3469                     vFAIL3("Sequence (%.*s...) not recognized", RExC_parse-seqstart, seqstart);
3470                 }
3471                 nextchar(pRExC_state);
3472                 *flagp = TRYAGAIN;
3473                 return NULL;
3474             }
3475         }
3476         else {                  /* (...) */
3477             parno = RExC_npar;
3478             RExC_npar++;
3479             ret = reganode(pRExC_state, OPEN, parno);
3480             Set_Node_Length(ret, 1); /* MJD */
3481             Set_Node_Offset(ret, RExC_parse); /* MJD */
3482             is_open = 1;
3483         }
3484     }
3485     else                        /* ! paren */
3486         ret = NULL;
3487
3488     /* Pick up the branches, linking them together. */
3489     parse_start = RExC_parse;   /* MJD */
3490     br = regbranch(pRExC_state, &flags, 1);
3491     /*     branch_len = (paren != 0); */
3492
3493     if (br == NULL)
3494         return(NULL);
3495     if (*RExC_parse == '|') {
3496         if (!SIZE_ONLY && RExC_extralen) {
3497             reginsert(pRExC_state, BRANCHJ, br);
3498         }
3499         else {                  /* MJD */
3500             reginsert(pRExC_state, BRANCH, br);
3501             Set_Node_Length(br, paren != 0);
3502             Set_Node_Offset_To_R(br-RExC_emit_start, parse_start-RExC_start);
3503         }
3504         have_branch = 1;
3505         if (SIZE_ONLY)
3506             RExC_extralen += 1;         /* For BRANCHJ-BRANCH. */
3507     }
3508     else if (paren == ':') {
3509         *flagp |= flags&SIMPLE;
3510     }
3511     if (is_open) {                              /* Starts with OPEN. */
3512         regtail(pRExC_state, ret, br);          /* OPEN -> first. */
3513     }
3514     else if (paren != '?')              /* Not Conditional */
3515         ret = br;
3516     *flagp |= flags & (SPSTART | HASWIDTH);
3517     lastbr = br;
3518     while (*RExC_parse == '|') {
3519         if (!SIZE_ONLY && RExC_extralen) {
3520             ender = reganode(pRExC_state, LONGJMP,0);
3521             regtail(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender); /* Append to the previous. */
3522         }
3523         if (SIZE_ONLY)
3524             RExC_extralen += 2;         /* Account for LONGJMP. */
3525         nextchar(pRExC_state);
3526         br = regbranch(pRExC_state, &flags, 0);
3527
3528         if (br == NULL)
3529             return(NULL);
3530         regtail(pRExC_state, lastbr, br);               /* BRANCH -> BRANCH. */
3531         lastbr = br;
3532         if (flags&HASWIDTH)
3533             *flagp |= HASWIDTH;
3534         *flagp |= flags&SPSTART;
3535     }
3536
3537     if (have_branch || paren != ':') {
3538         /* Make a closing node, and hook it on the end. */
3539         switch (paren) {
3540         case ':':
3541             ender = reg_node(pRExC_state, TAIL);
3542             break;
3543         case 1:
3544             ender = reganode(pRExC_state, CLOSE, parno);
3545             Set_Node_Offset(ender,RExC_parse+1); /* MJD */
3546             Set_Node_Length(ender,1); /* MJD */
3547             break;
3548         case '<':
3549         case ',':
3550         case '=':
3551         case '!':
3552             *flagp &= ~HASWIDTH;
3553             /* FALL THROUGH */
3554         case '>':
3555             ender = reg_node(pRExC_state, SUCCEED);
3556             break;
3557         case 0:
3558             ender = reg_node(pRExC_state, END);
3559             break;
3560         }
3561         regtail(pRExC_state, lastbr, ender);
3562
3563         if (have_branch) {
3564             /* Hook the tails of the branches to the closing node. */
3565             for (br = ret; br != NULL; br = regnext(br)) {
3566                 regoptail(pRExC_state, br, ender);
3567             }
3568         }
3569     }
3570
3571     {
3572         const char *p;
3573         static const char parens[] = "=!<,>";
3574
3575         if (paren && (p = strchr(parens, paren))) {
3576             U8 node = ((p - parens) % 2) ? UNLESSM : IFMATCH;
3577             int flag = (p - parens) > 1;
3578
3579             if (paren == '>')
3580                 node = SUSPEND, flag = 0;
3581             reginsert(pRExC_state, node,ret);
3582             Set_Node_Cur_Length(ret);
3583             Set_Node_Offset(ret, parse_start + 1);
3584             ret->flags = flag;
3585             regtail(pRExC_state, ret, reg_node(pRExC_state, TAIL));
3586         }
3587     }
3588
3589     /* Check for proper termination. */
3590     if (paren) {
3591         RExC_flags = oregflags;
3592         if (RExC_parse >= RExC_end || *nextchar(pRExC_state) != ')') {
3593             RExC_parse = oregcomp_parse;
3594             vFAIL("Unmatched (");
3595         }
3596     }
3597     else if (!paren && RExC_parse < RExC_end) {
3598         if (*RExC_parse == ')') {
3599             RExC_parse++;
3600             vFAIL("Unmatched )");
3601         }
3602         else
3603             FAIL("Junk on end of regexp");      /* "Can't happen". */
3604         /* NOTREACHED */
3605     }
3606
3607     return(ret);
3608 }
3609
3610 /*
3611  - regbranch - one alternative of an | operator
3612  *
3613  * Implements the concatenation operator.
3614  */
3615 STATIC regnode *
3616 S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first)
3617 {
3618     dVAR;
3619     register regnode *ret;
3620     register regnode *chain = NULL;
3621     register regnode *latest;
3622     I32 flags = 0, c = 0;
3623
3624     if (first)
3625         ret = NULL;
3626     else {
3627         if (!SIZE_ONLY && RExC_extralen)
3628             ret = reganode(pRExC_state, BRANCHJ,0);
3629         else {
3630             ret = reg_node(pRExC_state, BRANCH);
3631             Set_Node_Length(ret, 1);
3632         }
3633     }
3634         
3635     if (!first && SIZE_ONLY)
3636         RExC_extralen += 1;                     /* BRANCHJ */
3637
3638     *flagp = WORST;                     /* Tentatively. */
3639
3640     RExC_parse--;
3641     nextchar(pRExC_state);
3642     while (RExC_parse < RExC_end && *RExC_parse != '|' && *RExC_parse != ')') {
3643         flags &= ~TRYAGAIN;
3644         latest = regpiece(pRExC_state, &flags);
3645         if (latest == NULL) {
3646             if (flags & TRYAGAIN)
3647                 continue;
3648             return(NULL);
3649         }
3650         else if (ret == NULL)
3651             ret = latest;
3652         *flagp |= flags&HASWIDTH;
3653         if (chain == NULL)      /* First piece. */
3654             *flagp |= flags&SPSTART;
3655         else {
3656             RExC_naughty++;
3657             regtail(pRExC_state, chain, latest);
3658         }
3659         chain = latest;
3660         c++;
3661     }
3662     if (chain == NULL) {        /* Loop ran zero times. */
3663         chain = reg_node(pRExC_state, NOTHING);
3664         if (ret == NULL)
3665             ret = chain;
3666     }
3667     if (c == 1) {
3668         *flagp |= flags&SIMPLE;
3669     }
3670
3671     return ret;
3672 }
3673
3674 /*
3675  - regpiece - something followed by possible [*+?]
3676  *
3677  * Note that the branching code sequences used for ? and the general cases
3678  * of * and + are somewhat optimized:  they use the same NOTHING node as
3679  * both the endmarker for their branch list and the body of the last branch.
3680  * It might seem that this node could be dispensed with entirely, but the
3681  * endmarker role is not redundant.
3682  */
3683 STATIC regnode *
3684 S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
3685 {
3686     dVAR;
3687     register regnode *ret;
3688     register char op;
3689     register char *next;
3690     I32 flags;
3691     const char * const origparse = RExC_parse;
3692     char *maxpos;
3693     I32 min;
3694     I32 max = REG_INFTY;
3695     char *parse_start;
3696
3697     ret = regatom(pRExC_state, &flags);
3698     if (ret == NULL) {
3699         if (flags & TRYAGAIN)
3700             *flagp |= TRYAGAIN;
3701         return(NULL);
3702     }
3703
3704     op = *RExC_parse;
3705
3706     if (op == '{' && regcurly(RExC_parse)) {
3707         parse_start = RExC_parse; /* MJD */
3708         next = RExC_parse + 1;
3709         maxpos = NULL;
3710         while (isDIGIT(*next) || *next == ',') {
3711             if (*next == ',') {
3712                 if (maxpos)
3713                     break;
3714                 else
3715                     maxpos = next;
3716             }
3717             next++;
3718         }
3719         if (*next == '}') {             /* got one */
3720             if (!maxpos)
3721                 maxpos = next;
3722             RExC_parse++;
3723             min = atoi(RExC_parse);
3724             if (*maxpos == ',')
3725                 maxpos++;
3726             else
3727                 maxpos = RExC_parse;
3728             max = atoi(maxpos);
3729             if (!max && *maxpos != '0')
3730                 max = REG_INFTY;                /* meaning "infinity" */
3731             else if (max >= REG_INFTY)
3732                 vFAIL2("Quantifier in {,} bigger than %d", REG_INFTY - 1);
3733             RExC_parse = next;
3734             nextchar(pRExC_state);
3735
3736         do_curly:
3737             if ((flags&SIMPLE)) {
3738                 RExC_naughty += 2 + RExC_naughty / 2;
3739                 reginsert(pRExC_state, CURLY, ret);
3740                 Set_Node_Offset(ret, parse_start+1); /* MJD */
3741                 Set_Node_Cur_Length(ret);
3742             }
3743             else {
3744                 regnode *w = reg_node(pRExC_state, WHILEM);
3745
3746                 w->flags = 0;
3747                 regtail(pRExC_state, ret, w);
3748                 if (!SIZE_ONLY && RExC_extralen) {
3749                     reginsert(pRExC_state, LONGJMP,ret);
3750                     reginsert(pRExC_state, NOTHING,ret);
3751                     NEXT_OFF(ret) = 3;  /* Go over LONGJMP. */
3752                 }
3753                 reginsert(pRExC_state, CURLYX,ret);
3754                                 /* MJD hk */
3755                 Set_Node_Offset(ret, parse_start+1);
3756                 Set_Node_Length(ret,
3757                                 op == '{' ? (RExC_parse - parse_start) : 1);
3758
3759                 if (!SIZE_ONLY && RExC_extralen)
3760                     NEXT_OFF(ret) = 3;  /* Go over NOTHING to LONGJMP. */
3761                 regtail(pRExC_state, ret, reg_node(pRExC_state, NOTHING));
3762                 if (SIZE_ONLY)
3763                     RExC_whilem_seen++, RExC_extralen += 3;
3764                 RExC_naughty += 4 + RExC_naughty;       /* compound interest */
3765             }
3766             ret->flags = 0;
3767
3768             if (min > 0)
3769                 *flagp = WORST;
3770             if (max > 0)
3771                 *flagp |= HASWIDTH;
3772             if (max && max < min)
3773                 vFAIL("Can't do {n,m} with n > m");
3774             if (!SIZE_ONLY) {
3775                 ARG1_SET(ret, (U16)min);
3776                 ARG2_SET(ret, (U16)max);
3777             }
3778
3779             goto nest_check;
3780         }
3781     }
3782
3783     if (!ISMULT1(op)) {
3784         *flagp = flags;
3785         return(ret);
3786     }
3787
3788 #if 0                           /* Now runtime fix should be reliable. */
3789
3790     /* if this is reinstated, don't forget to put this back into perldiag:
3791
3792             =item Regexp *+ operand could be empty at {#} in regex m/%s/
3793
3794            (F) The part of the regexp subject to either the * or + quantifier
3795            could match an empty string. The {#} shows in the regular
3796            expression about where the problem was discovered.
3797
3798     */
3799
3800     if (!(flags&HASWIDTH) && op != '?')
3801       vFAIL("Regexp *+ operand could be empty");
3802 #endif
3803
3804     parse_start = RExC_parse;
3805     nextchar(pRExC_state);
3806
3807     *flagp = (op != '+') ? (WORST|SPSTART|HASWIDTH) : (WORST|HASWIDTH);
3808
3809     if (op == '*' && (flags&SIMPLE)) {
3810         reginsert(pRExC_state, STAR, ret);
3811         ret->flags = 0;
3812         RExC_naughty += 4;
3813     }
3814     else if (op == '*') {
3815         min = 0;
3816         goto do_curly;
3817     }
3818     else if (op == '+' && (flags&SIMPLE)) {
3819         reginsert(pRExC_state, PLUS, ret);
3820         ret->flags = 0;
3821         RExC_naughty += 3;
3822     }
3823     else if (op == '+') {
3824         min = 1;
3825         goto do_curly;
3826     }
3827     else if (op == '?') {
3828         min = 0; max = 1;
3829         goto do_curly;
3830     }
3831   nest_check:
3832     if (!SIZE_ONLY && !(flags&HASWIDTH) && max > REG_INFTY/3 && ckWARN(WARN_REGEXP)) {
3833         vWARN3(RExC_parse,
3834                "%.*s matches null string many times",
3835                (int)(RExC_parse >= origparse ? RExC_parse - origparse : 0),
3836                origparse);
3837     }
3838
3839     if (*RExC_parse == '?') {
3840         nextchar(pRExC_state);
3841         reginsert(pRExC_state, MINMOD, ret);
3842         regtail(pRExC_state, ret, ret + NODE_STEP_REGNODE);
3843     }
3844     if (ISMULT2(RExC_parse)) {
3845         RExC_parse++;
3846         vFAIL("Nested quantifiers");
3847     }
3848
3849     return(ret);
3850 }
3851
3852 /*
3853  - regatom - the lowest level
3854  *
3855  * Optimization:  gobbles an entire sequence of ordinary characters so that
3856  * it can turn them into a single node, which is smaller to store and
3857  * faster to run.  Backslashed characters are exceptions, each becoming a
3858  * separate node; the code is simpler that way and it's not worth fixing.
3859  *
3860  * [Yes, it is worth fixing, some scripts can run twice the speed.] */
3861 STATIC regnode *
3862 S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
3863 {
3864     dVAR;
3865     register regnode *ret = NULL;
3866     I32 flags;
3867     char *parse_start = RExC_parse;
3868
3869     *flagp = WORST;             /* Tentatively. */
3870
3871 tryagain:
3872     switch (*RExC_parse) {
3873     case '^':
3874         RExC_seen_zerolen++;
3875         nextchar(pRExC_state);
3876         if (RExC_flags & PMf_MULTILINE)
3877             ret = reg_node(pRExC_state, MBOL);
3878         else if (RExC_flags & PMf_SINGLELINE)
3879             ret = reg_node(pRExC_state, SBOL);
3880         else
3881             ret = reg_node(pRExC_state, BOL);
3882         Set_Node_Length(ret, 1); /* MJD */
3883         break;
3884     case '$':
3885         nextchar(pRExC_state);
3886         if (*RExC_parse)
3887             RExC_seen_zerolen++;
3888         if (RExC_flags & PMf_MULTILINE)
3889             ret = reg_node(pRExC_state, MEOL);
3890         else if (RExC_flags & PMf_SINGLELINE)
3891             ret = reg_node(pRExC_state, SEOL);
3892         else
3893             ret = reg_node(pRExC_state, EOL);
3894         Set_Node_Length(ret, 1); /* MJD */
3895         break;
3896     case '.':
3897         nextchar(pRExC_state);
3898         if (RExC_flags & PMf_SINGLELINE)
3899             ret = reg_node(pRExC_state, SANY);
3900         else
3901             ret = reg_node(pRExC_state, REG_ANY);
3902         *flagp |= HASWIDTH|SIMPLE;
3903         RExC_naughty++;
3904         Set_Node_Length(ret, 1); /* MJD */
3905         break;
3906     case '[':
3907     {
3908         char *oregcomp_parse = ++RExC_parse;
3909         ret = regclass(pRExC_state);
3910         if (*RExC_parse != ']') {
3911             RExC_parse = oregcomp_parse;
3912             vFAIL("Unmatched [");
3913         }
3914         nextchar(pRExC_state);
3915         *flagp |= HASWIDTH|SIMPLE;
3916         Set_Node_Length(ret, RExC_parse - oregcomp_parse + 1); /* MJD */
3917         break;
3918     }
3919     case '(':
3920         nextchar(pRExC_state);
3921         ret = reg(pRExC_state, 1, &flags);
3922         if (ret == NULL) {
3923                 if (flags & TRYAGAIN) {
3924                     if (RExC_parse == RExC_end) {
3925                          /* Make parent create an empty node if needed. */
3926                         *flagp |= TRYAGAIN;
3927                         return(NULL);
3928                     }
3929                     goto tryagain;