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