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