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