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