disable non-unicode case insensitive trie matching
[perl.git] / regcomp.c
1 /*    regcomp.c
2  */
3
4 /*
5  * 'A fair jaw-cracker dwarf-language must be.'            --Samwise Gamgee
6  *
7  *     [p.285 of _The Lord of the Rings_, II/iii: "The Ring Goes South"]
8  */
9
10 /* This file contains functions for compiling a regular expression.  See
11  * also regexec.c which funnily enough, contains functions for executing
12  * a regular expression.
13  *
14  * This file is also copied at build time to ext/re/re_comp.c, where
15  * it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
16  * This causes the main functions to be compiled under new names and with
17  * debugging support added, which makes "use re 'debug'" work.
18  */
19
20 /* NOTE: this is derived from Henry Spencer's regexp code, and should not
21  * confused with the original package (see point 3 below).  Thanks, Henry!
22  */
23
24 /* Additional note: this code is very heavily munged from Henry's version
25  * in places.  In some spots I've traded clarity for efficiency, so don't
26  * blame Henry for some of the lack of readability.
27  */
28
29 /* The names of the functions have been changed from regcomp and
30  * regexec to  pregcomp and pregexec in order to avoid conflicts
31  * with the POSIX routines of the same names.
32 */
33
34 #ifdef PERL_EXT_RE_BUILD
35 #include "re_top.h"
36 #endif
37
38 /*
39  * pregcomp and pregexec -- regsub and regerror are not used in perl
40  *
41  *      Copyright (c) 1986 by University of Toronto.
42  *      Written by Henry Spencer.  Not derived from licensed software.
43  *
44  *      Permission is granted to anyone to use this software for any
45  *      purpose on any computer system, and to redistribute it freely,
46  *      subject to the following restrictions:
47  *
48  *      1. The author is not responsible for the consequences of use of
49  *              this software, no matter how awful, even if they arise
50  *              from defects in it.
51  *
52  *      2. The origin of this software must not be misrepresented, either
53  *              by explicit claim or by omission.
54  *
55  *      3. Altered versions must be plainly marked as such, and must not
56  *              be misrepresented as being the original software.
57  *
58  *
59  ****    Alterations to Henry's code are...
60  ****
61  ****    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
62  ****    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
63  ****    by Larry Wall and others
64  ****
65  ****    You may distribute under the terms of either the GNU General Public
66  ****    License or the Artistic License, as specified in the README file.
67
68  *
69  * Beware that some of this code is subtly aware of the way operator
70  * precedence is structured in regular expressions.  Serious changes in
71  * regular-expression syntax might require a total rethink.
72  */
73 #include "EXTERN.h"
74 #define PERL_IN_REGCOMP_C
75 #include "perl.h"
76
77 #ifndef PERL_IN_XSUB_RE
78 #  include "INTERN.h"
79 #endif
80
81 #define REG_COMP_C
82 #ifdef PERL_IN_XSUB_RE
83 #  include "re_comp.h"
84 #else
85 #  include "regcomp.h"
86 #endif
87
88 #ifdef op
89 #undef op
90 #endif /* op */
91
92 #ifdef MSDOS
93 #  if defined(BUGGY_MSC6)
94  /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
95 #    pragma optimize("a",off)
96  /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
97 #    pragma optimize("w",on )
98 #  endif /* BUGGY_MSC6 */
99 #endif /* MSDOS */
100
101 #ifndef STATIC
102 #define STATIC  static
103 #endif
104
105 typedef struct RExC_state_t {
106     U32         flags;                  /* are we folding, multilining? */
107     char        *precomp;               /* uncompiled string. */
108     REGEXP      *rx_sv;                 /* The SV that is the regexp. */
109     regexp      *rx;                    /* perl core regexp structure */
110     regexp_internal     *rxi;           /* internal data for regexp object pprivate field */        
111     char        *start;                 /* Start of input for compile */
112     char        *end;                   /* End of input for compile */
113     char        *parse;                 /* Input-scan pointer. */
114     I32         whilem_seen;            /* number of WHILEM in this expr */
115     regnode     *emit_start;            /* Start of emitted-code area */
116     regnode     *emit_bound;            /* First regnode outside of the allocated space */
117     regnode     *emit;                  /* Code-emit pointer; &regdummy = don't = compiling */
118     I32         naughty;                /* How bad is this pattern? */
119     I32         sawback;                /* Did we see \1, ...? */
120     U32         seen;
121     I32         size;                   /* Code size. */
122     I32         npar;                   /* Capture buffer count, (OPEN). */
123     I32         cpar;                   /* Capture buffer count, (CLOSE). */
124     I32         nestroot;               /* root parens we are in - used by accept */
125     I32         extralen;
126     I32         seen_zerolen;
127     I32         seen_evals;
128     regnode     **open_parens;          /* pointers to open parens */
129     regnode     **close_parens;         /* pointers to close parens */
130     regnode     *opend;                 /* END node in program */
131     I32         utf8;           /* whether the pattern is utf8 or not */
132     I32         orig_utf8;      /* whether the pattern was originally in utf8 */
133                                 /* XXX use this for future optimisation of case
134                                  * where pattern must be upgraded to utf8. */
135     HV          *charnames;             /* cache of named sequences */
136     HV          *paren_names;           /* Paren names */
137     
138     regnode     **recurse;              /* Recurse regops */
139     I32         recurse_count;          /* Number of recurse regops */
140 #if ADD_TO_REGEXEC
141     char        *starttry;              /* -Dr: where regtry was called. */
142 #define RExC_starttry   (pRExC_state->starttry)
143 #endif
144 #ifdef DEBUGGING
145     const char  *lastparse;
146     I32         lastnum;
147     AV          *paren_name_list;       /* idx -> name */
148 #define RExC_lastparse  (pRExC_state->lastparse)
149 #define RExC_lastnum    (pRExC_state->lastnum)
150 #define RExC_paren_name_list    (pRExC_state->paren_name_list)
151 #endif
152 } RExC_state_t;
153
154 #define RExC_flags      (pRExC_state->flags)
155 #define RExC_precomp    (pRExC_state->precomp)
156 #define RExC_rx_sv      (pRExC_state->rx_sv)
157 #define RExC_rx         (pRExC_state->rx)
158 #define RExC_rxi        (pRExC_state->rxi)
159 #define RExC_start      (pRExC_state->start)
160 #define RExC_end        (pRExC_state->end)
161 #define RExC_parse      (pRExC_state->parse)
162 #define RExC_whilem_seen        (pRExC_state->whilem_seen)
163 #ifdef RE_TRACK_PATTERN_OFFSETS
164 #define RExC_offsets    (pRExC_state->rxi->u.offsets) /* I am not like the others */
165 #endif
166 #define RExC_emit       (pRExC_state->emit)
167 #define RExC_emit_start (pRExC_state->emit_start)
168 #define RExC_emit_bound (pRExC_state->emit_bound)
169 #define RExC_naughty    (pRExC_state->naughty)
170 #define RExC_sawback    (pRExC_state->sawback)
171 #define RExC_seen       (pRExC_state->seen)
172 #define RExC_size       (pRExC_state->size)
173 #define RExC_npar       (pRExC_state->npar)
174 #define RExC_nestroot   (pRExC_state->nestroot)
175 #define RExC_extralen   (pRExC_state->extralen)
176 #define RExC_seen_zerolen       (pRExC_state->seen_zerolen)
177 #define RExC_seen_evals (pRExC_state->seen_evals)
178 #define RExC_utf8       (pRExC_state->utf8)
179 #define RExC_orig_utf8  (pRExC_state->orig_utf8)
180 #define RExC_charnames  (pRExC_state->charnames)
181 #define RExC_open_parens        (pRExC_state->open_parens)
182 #define RExC_close_parens       (pRExC_state->close_parens)
183 #define RExC_opend      (pRExC_state->opend)
184 #define RExC_paren_names        (pRExC_state->paren_names)
185 #define RExC_recurse    (pRExC_state->recurse)
186 #define RExC_recurse_count      (pRExC_state->recurse_count)
187
188
189 #define ISMULT1(c)      ((c) == '*' || (c) == '+' || (c) == '?')
190 #define ISMULT2(s)      ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
191         ((*s) == '{' && regcurly(s)))
192
193 #ifdef SPSTART
194 #undef SPSTART          /* dratted cpp namespace... */
195 #endif
196 /*
197  * Flags to be passed up and down.
198  */
199 #define WORST           0       /* Worst case. */
200 #define HASWIDTH        0x01    /* Known to match non-null strings. */
201 #define SIMPLE          0x02    /* Simple enough to be STAR/PLUS operand. */
202 #define SPSTART         0x04    /* Starts with * or +. */
203 #define TRYAGAIN        0x08    /* Weeded out a declaration. */
204 #define POSTPONED       0x10    /* (?1),(?&name), (??{...}) or similar */
205
206 #define REG_NODE_NUM(x) ((x) ? (int)((x)-RExC_emit_start) : -1)
207
208 /* whether trie related optimizations are enabled */
209 #if PERL_ENABLE_EXTENDED_TRIE_OPTIMISATION
210 #define TRIE_STUDY_OPT
211 #define FULL_TRIE_STUDY
212 #define TRIE_STCLASS
213 #endif
214
215
216
217 #define PBYTE(u8str,paren) ((U8*)(u8str))[(paren) >> 3]
218 #define PBITVAL(paren) (1 << ((paren) & 7))
219 #define PAREN_TEST(u8str,paren) ( PBYTE(u8str,paren) & PBITVAL(paren))
220 #define PAREN_SET(u8str,paren) PBYTE(u8str,paren) |= PBITVAL(paren)
221 #define PAREN_UNSET(u8str,paren) PBYTE(u8str,paren) &= (~PBITVAL(paren))
222
223
224 /* About scan_data_t.
225
226   During optimisation we recurse through the regexp program performing
227   various inplace (keyhole style) optimisations. In addition study_chunk
228   and scan_commit populate this data structure with information about
229   what strings MUST appear in the pattern. We look for the longest 
230   string that must appear for at a fixed location, and we look for the
231   longest string that may appear at a floating location. So for instance
232   in the pattern:
233   
234     /FOO[xX]A.*B[xX]BAR/
235     
236   Both 'FOO' and 'A' are fixed strings. Both 'B' and 'BAR' are floating
237   strings (because they follow a .* construct). study_chunk will identify
238   both FOO and BAR as being the longest fixed and floating strings respectively.
239   
240   The strings can be composites, for instance
241   
242      /(f)(o)(o)/
243      
244   will result in a composite fixed substring 'foo'.
245   
246   For each string some basic information is maintained:
247   
248   - offset or min_offset
249     This is the position the string must appear at, or not before.
250     It also implicitly (when combined with minlenp) tells us how many
251     character must match before the string we are searching.
252     Likewise when combined with minlenp and the length of the string
253     tells us how many characters must appear after the string we have 
254     found.
255   
256   - max_offset
257     Only used for floating strings. This is the rightmost point that
258     the string can appear at. Ifset to I32 max it indicates that the
259     string can occur infinitely far to the right.
260   
261   - minlenp
262     A pointer to the minimum length of the pattern that the string 
263     was found inside. This is important as in the case of positive 
264     lookahead or positive lookbehind we can have multiple patterns 
265     involved. Consider
266     
267     /(?=FOO).*F/
268     
269     The minimum length of the pattern overall is 3, the minimum length
270     of the lookahead part is 3, but the minimum length of the part that
271     will actually match is 1. So 'FOO's minimum length is 3, but the 
272     minimum length for the F is 1. This is important as the minimum length
273     is used to determine offsets in front of and behind the string being 
274     looked for.  Since strings can be composites this is the length of the
275     pattern at the time it was commited with a scan_commit. Note that
276     the length is calculated by study_chunk, so that the minimum lengths
277     are not known until the full pattern has been compiled, thus the 
278     pointer to the value.
279   
280   - lookbehind
281   
282     In the case of lookbehind the string being searched for can be
283     offset past the start point of the final matching string. 
284     If this value was just blithely removed from the min_offset it would
285     invalidate some of the calculations for how many chars must match
286     before or after (as they are derived from min_offset and minlen and
287     the length of the string being searched for). 
288     When the final pattern is compiled and the data is moved from the
289     scan_data_t structure into the regexp structure the information
290     about lookbehind is factored in, with the information that would 
291     have been lost precalculated in the end_shift field for the 
292     associated string.
293
294   The fields pos_min and pos_delta are used to store the minimum offset
295   and the delta to the maximum offset at the current point in the pattern.    
296
297 */
298
299 typedef struct scan_data_t {
300     /*I32 len_min;      unused */
301     /*I32 len_delta;    unused */
302     I32 pos_min;
303     I32 pos_delta;
304     SV *last_found;
305     I32 last_end;           /* min value, <0 unless valid. */
306     I32 last_start_min;
307     I32 last_start_max;
308     SV **longest;           /* Either &l_fixed, or &l_float. */
309     SV *longest_fixed;      /* longest fixed string found in pattern */
310     I32 offset_fixed;       /* offset where it starts */
311     I32 *minlen_fixed;      /* pointer to the minlen relevent to the string */
312     I32 lookbehind_fixed;   /* is the position of the string modfied by LB */
313     SV *longest_float;      /* longest floating string found in pattern */
314     I32 offset_float_min;   /* earliest point in string it can appear */
315     I32 offset_float_max;   /* latest point in string it can appear */
316     I32 *minlen_float;      /* pointer to the minlen relevent to the string */
317     I32 lookbehind_float;   /* is the position of the string modified by LB */
318     I32 flags;
319     I32 whilem_c;
320     I32 *last_closep;
321     struct regnode_charclass_class *start_class;
322 } scan_data_t;
323
324 /*
325  * Forward declarations for pregcomp()'s friends.
326  */
327
328 static const scan_data_t zero_scan_data =
329   { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ,0};
330
331 #define SF_BEFORE_EOL           (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
332 #define SF_BEFORE_SEOL          0x0001
333 #define SF_BEFORE_MEOL          0x0002
334 #define SF_FIX_BEFORE_EOL       (SF_FIX_BEFORE_SEOL|SF_FIX_BEFORE_MEOL)
335 #define SF_FL_BEFORE_EOL        (SF_FL_BEFORE_SEOL|SF_FL_BEFORE_MEOL)
336
337 #ifdef NO_UNARY_PLUS
338 #  define SF_FIX_SHIFT_EOL      (0+2)
339 #  define SF_FL_SHIFT_EOL               (0+4)
340 #else
341 #  define SF_FIX_SHIFT_EOL      (+2)
342 #  define SF_FL_SHIFT_EOL               (+4)
343 #endif
344
345 #define SF_FIX_BEFORE_SEOL      (SF_BEFORE_SEOL << SF_FIX_SHIFT_EOL)
346 #define SF_FIX_BEFORE_MEOL      (SF_BEFORE_MEOL << SF_FIX_SHIFT_EOL)
347
348 #define SF_FL_BEFORE_SEOL       (SF_BEFORE_SEOL << SF_FL_SHIFT_EOL)
349 #define SF_FL_BEFORE_MEOL       (SF_BEFORE_MEOL << SF_FL_SHIFT_EOL) /* 0x20 */
350 #define SF_IS_INF               0x0040
351 #define SF_HAS_PAR              0x0080
352 #define SF_IN_PAR               0x0100
353 #define SF_HAS_EVAL             0x0200
354 #define SCF_DO_SUBSTR           0x0400
355 #define SCF_DO_STCLASS_AND      0x0800
356 #define SCF_DO_STCLASS_OR       0x1000
357 #define SCF_DO_STCLASS          (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR)
358 #define SCF_WHILEM_VISITED_POS  0x2000
359
360 #define SCF_TRIE_RESTUDY        0x4000 /* Do restudy? */
361 #define SCF_SEEN_ACCEPT         0x8000 
362
363 #define UTF (RExC_utf8 != 0)
364 #define LOC ((RExC_flags & RXf_PMf_LOCALE) != 0)
365 #define FOLD ((RExC_flags & RXf_PMf_FOLD) != 0)
366
367 #define OOB_UNICODE             12345678
368 #define OOB_NAMEDCLASS          -1
369
370 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
371 #define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
372
373
374 /* length of regex to show in messages that don't mark a position within */
375 #define RegexLengthToShowInErrorMessages 127
376
377 /*
378  * If MARKER[12] are adjusted, be sure to adjust the constants at the top
379  * of t/op/regmesg.t, the tests in t/op/re_tests, and those in
380  * op/pragma/warn/regcomp.
381  */
382 #define MARKER1 "<-- HERE"    /* marker as it appears in the description */
383 #define MARKER2 " <-- HERE "  /* marker as it appears within the regex */
384
385 #define REPORT_LOCATION " in regex; marked by " MARKER1 " in m/%.*s" MARKER2 "%s/"
386
387 /*
388  * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
389  * arg. Show regex, up to a maximum length. If it's too long, chop and add
390  * "...".
391  */
392 #define _FAIL(code) STMT_START {                                        \
393     const char *ellipses = "";                                          \
394     IV len = RExC_end - RExC_precomp;                                   \
395                                                                         \
396     if (!SIZE_ONLY)                                                     \
397         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv);                   \
398     if (len > RegexLengthToShowInErrorMessages) {                       \
399         /* chop 10 shorter than the max, to ensure meaning of "..." */  \
400         len = RegexLengthToShowInErrorMessages - 10;                    \
401         ellipses = "...";                                               \
402     }                                                                   \
403     code;                                                               \
404 } STMT_END
405
406 #define FAIL(msg) _FAIL(                            \
407     Perl_croak(aTHX_ "%s in regex m/%.*s%s/",       \
408             msg, (int)len, RExC_precomp, ellipses))
409
410 #define FAIL2(msg,arg) _FAIL(                       \
411     Perl_croak(aTHX_ msg " in regex m/%.*s%s/",     \
412             arg, (int)len, RExC_precomp, ellipses))
413
414 /*
415  * Simple_vFAIL -- like FAIL, but marks the current location in the scan
416  */
417 #define Simple_vFAIL(m) STMT_START {                                    \
418     const IV offset = RExC_parse - RExC_precomp;                        \
419     Perl_croak(aTHX_ "%s" REPORT_LOCATION,                              \
420             m, (int)offset, RExC_precomp, RExC_precomp + offset);       \
421 } STMT_END
422
423 /*
424  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL()
425  */
426 #define vFAIL(m) STMT_START {                           \
427     if (!SIZE_ONLY)                                     \
428         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv);   \
429     Simple_vFAIL(m);                                    \
430 } STMT_END
431
432 /*
433  * Like Simple_vFAIL(), but accepts two arguments.
434  */
435 #define Simple_vFAIL2(m,a1) STMT_START {                        \
436     const IV offset = RExC_parse - RExC_precomp;                        \
437     S_re_croak2(aTHX_ m, REPORT_LOCATION, a1,                   \
438             (int)offset, RExC_precomp, RExC_precomp + offset);  \
439 } STMT_END
440
441 /*
442  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL2().
443  */
444 #define vFAIL2(m,a1) STMT_START {                       \
445     if (!SIZE_ONLY)                                     \
446         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv);   \
447     Simple_vFAIL2(m, a1);                               \
448 } STMT_END
449
450
451 /*
452  * Like Simple_vFAIL(), but accepts three arguments.
453  */
454 #define Simple_vFAIL3(m, a1, a2) STMT_START {                   \
455     const IV offset = RExC_parse - RExC_precomp;                \
456     S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2,               \
457             (int)offset, RExC_precomp, RExC_precomp + offset);  \
458 } STMT_END
459
460 /*
461  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL3().
462  */
463 #define vFAIL3(m,a1,a2) STMT_START {                    \
464     if (!SIZE_ONLY)                                     \
465         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv);   \
466     Simple_vFAIL3(m, a1, a2);                           \
467 } STMT_END
468
469 /*
470  * Like Simple_vFAIL(), but accepts four arguments.
471  */
472 #define Simple_vFAIL4(m, a1, a2, a3) STMT_START {               \
473     const IV offset = RExC_parse - RExC_precomp;                \
474     S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3,           \
475             (int)offset, RExC_precomp, RExC_precomp + offset);  \
476 } STMT_END
477
478 #define ckWARNreg(loc,m) STMT_START {                                   \
479     const IV offset = loc - RExC_precomp;                               \
480     Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,      \
481             (int)offset, RExC_precomp, RExC_precomp + offset);          \
482 } STMT_END
483
484 #define ckWARNregdep(loc,m) STMT_START {                                \
485     const IV offset = loc - RExC_precomp;                               \
486     Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP),     \
487             m REPORT_LOCATION,                                          \
488             (int)offset, RExC_precomp, RExC_precomp + offset);          \
489 } STMT_END
490
491 #define ckWARN2reg(loc, m, a1) STMT_START {                             \
492     const IV offset = loc - RExC_precomp;                               \
493     Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,      \
494             a1, (int)offset, RExC_precomp, RExC_precomp + offset);      \
495 } STMT_END
496
497 #define vWARN3(loc, m, a1, a2) STMT_START {                             \
498     const IV offset = loc - RExC_precomp;                               \
499     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
500             a1, a2, (int)offset, RExC_precomp, RExC_precomp + offset);  \
501 } STMT_END
502
503 #define ckWARN3reg(loc, m, a1, a2) STMT_START {                         \
504     const IV offset = loc - RExC_precomp;                               \
505     Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,      \
506             a1, a2, (int)offset, RExC_precomp, RExC_precomp + offset);  \
507 } STMT_END
508
509 #define vWARN4(loc, m, a1, a2, a3) STMT_START {                         \
510     const IV offset = loc - RExC_precomp;                               \
511     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
512             a1, a2, a3, (int)offset, RExC_precomp, RExC_precomp + offset); \
513 } STMT_END
514
515 #define ckWARN4reg(loc, m, a1, a2, a3) STMT_START {                     \
516     const IV offset = loc - RExC_precomp;                               \
517     Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,      \
518             a1, a2, a3, (int)offset, RExC_precomp, RExC_precomp + offset); \
519 } STMT_END
520
521 #define vWARN5(loc, m, a1, a2, a3, a4) STMT_START {                     \
522     const IV offset = loc - RExC_precomp;                               \
523     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
524             a1, a2, a3, a4, (int)offset, RExC_precomp, RExC_precomp + offset); \
525 } STMT_END
526
527
528 /* Allow for side effects in s */
529 #define REGC(c,s) STMT_START {                  \
530     if (!SIZE_ONLY) *(s) = (c); else (void)(s); \
531 } STMT_END
532
533 /* Macros for recording node offsets.   20001227 mjd@plover.com 
534  * Nodes are numbered 1, 2, 3, 4.  Node #n's position is recorded in
535  * element 2*n-1 of the array.  Element #2n holds the byte length node #n.
536  * Element 0 holds the number n.
537  * Position is 1 indexed.
538  */
539 #ifndef RE_TRACK_PATTERN_OFFSETS
540 #define Set_Node_Offset_To_R(node,byte)
541 #define Set_Node_Offset(node,byte)
542 #define Set_Cur_Node_Offset
543 #define Set_Node_Length_To_R(node,len)
544 #define Set_Node_Length(node,len)
545 #define Set_Node_Cur_Length(node)
546 #define Node_Offset(n) 
547 #define Node_Length(n) 
548 #define Set_Node_Offset_Length(node,offset,len)
549 #define ProgLen(ri) ri->u.proglen
550 #define SetProgLen(ri,x) ri->u.proglen = x
551 #else
552 #define ProgLen(ri) ri->u.offsets[0]
553 #define SetProgLen(ri,x) ri->u.offsets[0] = x
554 #define Set_Node_Offset_To_R(node,byte) STMT_START {                    \
555     if (! SIZE_ONLY) {                                                  \
556         MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n",         \
557                     __LINE__, (int)(node), (int)(byte)));               \
558         if((node) < 0) {                                                \
559             Perl_croak(aTHX_ "value of node is %d in Offset macro", (int)(node)); \
560         } else {                                                        \
561             RExC_offsets[2*(node)-1] = (byte);                          \
562         }                                                               \
563     }                                                                   \
564 } STMT_END
565
566 #define Set_Node_Offset(node,byte) \
567     Set_Node_Offset_To_R((node)-RExC_emit_start, (byte)-RExC_start)
568 #define Set_Cur_Node_Offset Set_Node_Offset(RExC_emit, RExC_parse)
569
570 #define Set_Node_Length_To_R(node,len) STMT_START {                     \
571     if (! SIZE_ONLY) {                                                  \
572         MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n",           \
573                 __LINE__, (int)(node), (int)(len)));                    \
574         if((node) < 0) {                                                \
575             Perl_croak(aTHX_ "value of node is %d in Length macro", (int)(node)); \
576         } else {                                                        \
577             RExC_offsets[2*(node)] = (len);                             \
578         }                                                               \
579     }                                                                   \
580 } STMT_END
581
582 #define Set_Node_Length(node,len) \
583     Set_Node_Length_To_R((node)-RExC_emit_start, len)
584 #define Set_Cur_Node_Length(len) Set_Node_Length(RExC_emit, len)
585 #define Set_Node_Cur_Length(node) \
586     Set_Node_Length(node, RExC_parse - parse_start)
587
588 /* Get offsets and lengths */
589 #define Node_Offset(n) (RExC_offsets[2*((n)-RExC_emit_start)-1])
590 #define Node_Length(n) (RExC_offsets[2*((n)-RExC_emit_start)])
591
592 #define Set_Node_Offset_Length(node,offset,len) STMT_START {    \
593     Set_Node_Offset_To_R((node)-RExC_emit_start, (offset));     \
594     Set_Node_Length_To_R((node)-RExC_emit_start, (len));        \
595 } STMT_END
596 #endif
597
598 #if PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS
599 #define EXPERIMENTAL_INPLACESCAN
600 #endif /*RE_TRACK_PATTERN_OFFSETS*/
601
602 #define DEBUG_STUDYDATA(str,data,depth)                              \
603 DEBUG_OPTIMISE_MORE_r(if(data){                                      \
604     PerlIO_printf(Perl_debug_log,                                    \
605         "%*s" str "Pos:%"IVdf"/%"IVdf                                \
606         " Flags: 0x%"UVXf" Whilem_c: %"IVdf" Lcp: %"IVdf" %s",       \
607         (int)(depth)*2, "",                                          \
608         (IV)((data)->pos_min),                                       \
609         (IV)((data)->pos_delta),                                     \
610         (UV)((data)->flags),                                         \
611         (IV)((data)->whilem_c),                                      \
612         (IV)((data)->last_closep ? *((data)->last_closep) : -1),     \
613         is_inf ? "INF " : ""                                         \
614     );                                                               \
615     if ((data)->last_found)                                          \
616         PerlIO_printf(Perl_debug_log,                                \
617             "Last:'%s' %"IVdf":%"IVdf"/%"IVdf" %sFixed:'%s' @ %"IVdf \
618             " %sFloat: '%s' @ %"IVdf"/%"IVdf"",                      \
619             SvPVX_const((data)->last_found),                         \
620             (IV)((data)->last_end),                                  \
621             (IV)((data)->last_start_min),                            \
622             (IV)((data)->last_start_max),                            \
623             ((data)->longest &&                                      \
624              (data)->longest==&((data)->longest_fixed)) ? "*" : "",  \
625             SvPVX_const((data)->longest_fixed),                      \
626             (IV)((data)->offset_fixed),                              \
627             ((data)->longest &&                                      \
628              (data)->longest==&((data)->longest_float)) ? "*" : "",  \
629             SvPVX_const((data)->longest_float),                      \
630             (IV)((data)->offset_float_min),                          \
631             (IV)((data)->offset_float_max)                           \
632         );                                                           \
633     PerlIO_printf(Perl_debug_log,"\n");                              \
634 });
635
636 static void clear_re(pTHX_ void *r);
637
638 /* Mark that we cannot extend a found fixed substring at this point.
639    Update the longest found anchored substring and the longest found
640    floating substrings if needed. */
641
642 STATIC void
643 S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, I32 *minlenp, int is_inf)
644 {
645     const STRLEN l = CHR_SVLEN(data->last_found);
646     const STRLEN old_l = CHR_SVLEN(*data->longest);
647     GET_RE_DEBUG_FLAGS_DECL;
648
649     PERL_ARGS_ASSERT_SCAN_COMMIT;
650
651     if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
652         SvSetMagicSV(*data->longest, data->last_found);
653         if (*data->longest == data->longest_fixed) {
654             data->offset_fixed = l ? data->last_start_min : data->pos_min;
655             if (data->flags & SF_BEFORE_EOL)
656                 data->flags
657                     |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL);
658             else
659                 data->flags &= ~SF_FIX_BEFORE_EOL;
660             data->minlen_fixed=minlenp; 
661             data->lookbehind_fixed=0;
662         }
663         else { /* *data->longest == data->longest_float */
664             data->offset_float_min = l ? data->last_start_min : data->pos_min;
665             data->offset_float_max = (l
666                                       ? data->last_start_max
667                                       : data->pos_min + data->pos_delta);
668             if (is_inf || (U32)data->offset_float_max > (U32)I32_MAX)
669                 data->offset_float_max = I32_MAX;
670             if (data->flags & SF_BEFORE_EOL)
671                 data->flags
672                     |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL);
673             else
674                 data->flags &= ~SF_FL_BEFORE_EOL;
675             data->minlen_float=minlenp;
676             data->lookbehind_float=0;
677         }
678     }
679     SvCUR_set(data->last_found, 0);
680     {
681         SV * const sv = data->last_found;
682         if (SvUTF8(sv) && SvMAGICAL(sv)) {
683             MAGIC * const mg = mg_find(sv, PERL_MAGIC_utf8);
684             if (mg)
685                 mg->mg_len = 0;
686         }
687     }
688     data->last_end = -1;
689     data->flags &= ~SF_BEFORE_EOL;
690     DEBUG_STUDYDATA("commit: ",data,0);
691 }
692
693 /* Can match anything (initialization) */
694 STATIC void
695 S_cl_anything(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
696 {
697     PERL_ARGS_ASSERT_CL_ANYTHING;
698
699     ANYOF_CLASS_ZERO(cl);
700     ANYOF_BITMAP_SETALL(cl);
701     cl->flags = ANYOF_EOS|ANYOF_UNICODE_ALL;
702     if (LOC)
703         cl->flags |= ANYOF_LOCALE;
704 }
705
706 /* Can match anything (initialization) */
707 STATIC int
708 S_cl_is_anything(const struct regnode_charclass_class *cl)
709 {
710     int value;
711
712     PERL_ARGS_ASSERT_CL_IS_ANYTHING;
713
714     for (value = 0; value <= ANYOF_MAX; value += 2)
715         if (ANYOF_CLASS_TEST(cl, value) && ANYOF_CLASS_TEST(cl, value + 1))
716             return 1;
717     if (!(cl->flags & ANYOF_UNICODE_ALL))
718         return 0;
719     if (!ANYOF_BITMAP_TESTALLSET((const void*)cl))
720         return 0;
721     return 1;
722 }
723
724 /* Can match anything (initialization) */
725 STATIC void
726 S_cl_init(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
727 {
728     PERL_ARGS_ASSERT_CL_INIT;
729
730     Zero(cl, 1, struct regnode_charclass_class);
731     cl->type = ANYOF;
732     cl_anything(pRExC_state, cl);
733 }
734
735 STATIC void
736 S_cl_init_zero(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
737 {
738     PERL_ARGS_ASSERT_CL_INIT_ZERO;
739
740     Zero(cl, 1, struct regnode_charclass_class);
741     cl->type = ANYOF;
742     cl_anything(pRExC_state, cl);
743     if (LOC)
744         cl->flags |= ANYOF_LOCALE;
745 }
746
747 /* 'And' a given class with another one.  Can create false positives */
748 /* We assume that cl is not inverted */
749 STATIC void
750 S_cl_and(struct regnode_charclass_class *cl,
751         const struct regnode_charclass_class *and_with)
752 {
753     PERL_ARGS_ASSERT_CL_AND;
754
755     assert(and_with->type == ANYOF);
756     if (!(and_with->flags & ANYOF_CLASS)
757         && !(cl->flags & ANYOF_CLASS)
758         && (and_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
759         && !(and_with->flags & ANYOF_FOLD)
760         && !(cl->flags & ANYOF_FOLD)) {
761         int i;
762
763         if (and_with->flags & ANYOF_INVERT)
764             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
765                 cl->bitmap[i] &= ~and_with->bitmap[i];
766         else
767             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
768                 cl->bitmap[i] &= and_with->bitmap[i];
769     } /* XXXX: logic is complicated otherwise, leave it along for a moment. */
770     if (!(and_with->flags & ANYOF_EOS))
771         cl->flags &= ~ANYOF_EOS;
772
773     if (cl->flags & ANYOF_UNICODE_ALL && and_with->flags & ANYOF_UNICODE &&
774         !(and_with->flags & ANYOF_INVERT)) {
775         cl->flags &= ~ANYOF_UNICODE_ALL;
776         cl->flags |= ANYOF_UNICODE;
777         ARG_SET(cl, ARG(and_with));
778     }
779     if (!(and_with->flags & ANYOF_UNICODE_ALL) &&
780         !(and_with->flags & ANYOF_INVERT))
781         cl->flags &= ~ANYOF_UNICODE_ALL;
782     if (!(and_with->flags & (ANYOF_UNICODE|ANYOF_UNICODE_ALL)) &&
783         !(and_with->flags & ANYOF_INVERT))
784         cl->flags &= ~ANYOF_UNICODE;
785 }
786
787 /* 'OR' a given class with another one.  Can create false positives */
788 /* We assume that cl is not inverted */
789 STATIC void
790 S_cl_or(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, const struct regnode_charclass_class *or_with)
791 {
792     PERL_ARGS_ASSERT_CL_OR;
793
794     if (or_with->flags & ANYOF_INVERT) {
795         /* We do not use
796          * (B1 | CL1) | (!B2 & !CL2) = (B1 | !B2 & !CL2) | (CL1 | (!B2 & !CL2))
797          *   <= (B1 | !B2) | (CL1 | !CL2)
798          * which is wasteful if CL2 is small, but we ignore CL2:
799          *   (B1 | CL1) | (!B2 & !CL2) <= (B1 | CL1) | !B2 = (B1 | !B2) | CL1
800          * XXXX Can we handle case-fold?  Unclear:
801          *   (OK1(i) | OK1(i')) | !(OK1(i) | OK1(i')) =
802          *   (OK1(i) | OK1(i')) | (!OK1(i) & !OK1(i'))
803          */
804         if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
805              && !(or_with->flags & ANYOF_FOLD)
806              && !(cl->flags & ANYOF_FOLD) ) {
807             int i;
808
809             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
810                 cl->bitmap[i] |= ~or_with->bitmap[i];
811         } /* XXXX: logic is complicated otherwise */
812         else {
813             cl_anything(pRExC_state, cl);
814         }
815     } else {
816         /* (B1 | CL1) | (B2 | CL2) = (B1 | B2) | (CL1 | CL2)) */
817         if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
818              && (!(or_with->flags & ANYOF_FOLD)
819                  || (cl->flags & ANYOF_FOLD)) ) {
820             int i;
821
822             /* OR char bitmap and class bitmap separately */
823             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
824                 cl->bitmap[i] |= or_with->bitmap[i];
825             if (or_with->flags & ANYOF_CLASS) {
826                 for (i = 0; i < ANYOF_CLASSBITMAP_SIZE; i++)
827                     cl->classflags[i] |= or_with->classflags[i];
828                 cl->flags |= ANYOF_CLASS;
829             }
830         }
831         else { /* XXXX: logic is complicated, leave it along for a moment. */
832             cl_anything(pRExC_state, cl);
833         }
834     }
835     if (or_with->flags & ANYOF_EOS)
836         cl->flags |= ANYOF_EOS;
837
838     if (cl->flags & ANYOF_UNICODE && or_with->flags & ANYOF_UNICODE &&
839         ARG(cl) != ARG(or_with)) {
840         cl->flags |= ANYOF_UNICODE_ALL;
841         cl->flags &= ~ANYOF_UNICODE;
842     }
843     if (or_with->flags & ANYOF_UNICODE_ALL) {
844         cl->flags |= ANYOF_UNICODE_ALL;
845         cl->flags &= ~ANYOF_UNICODE;
846     }
847 }
848
849 #define TRIE_LIST_ITEM(state,idx) (trie->states[state].trans.list)[ idx ]
850 #define TRIE_LIST_CUR(state)  ( TRIE_LIST_ITEM( state, 0 ).forid )
851 #define TRIE_LIST_LEN(state) ( TRIE_LIST_ITEM( state, 0 ).newstate )
852 #define TRIE_LIST_USED(idx)  ( trie->states[state].trans.list ? (TRIE_LIST_CUR( idx ) - 1) : 0 )
853
854
855 #ifdef DEBUGGING
856 /*
857    dump_trie(trie,widecharmap,revcharmap)
858    dump_trie_interim_list(trie,widecharmap,revcharmap,next_alloc)
859    dump_trie_interim_table(trie,widecharmap,revcharmap,next_alloc)
860
861    These routines dump out a trie in a somewhat readable format.
862    The _interim_ variants are used for debugging the interim
863    tables that are used to generate the final compressed
864    representation which is what dump_trie expects.
865
866    Part of the reason for their existance is to provide a form
867    of documentation as to how the different representations function.
868
869 */
870
871 /*
872   Dumps the final compressed table form of the trie to Perl_debug_log.
873   Used for debugging make_trie().
874 */
875  
876 STATIC void
877 S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap,
878             AV *revcharmap, U32 depth)
879 {
880     U32 state;
881     SV *sv=sv_newmortal();
882     int colwidth= widecharmap ? 6 : 4;
883     GET_RE_DEBUG_FLAGS_DECL;
884
885     PERL_ARGS_ASSERT_DUMP_TRIE;
886
887     PerlIO_printf( Perl_debug_log, "%*sChar : %-6s%-6s%-4s ",
888         (int)depth * 2 + 2,"",
889         "Match","Base","Ofs" );
890
891     for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
892         SV ** const tmp = av_fetch( revcharmap, state, 0);
893         if ( tmp ) {
894             PerlIO_printf( Perl_debug_log, "%*s", 
895                 colwidth,
896                 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
897                             PL_colors[0], PL_colors[1],
898                             (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
899                             PERL_PV_ESCAPE_FIRSTCHAR 
900                 ) 
901             );
902         }
903     }
904     PerlIO_printf( Perl_debug_log, "\n%*sState|-----------------------",
905         (int)depth * 2 + 2,"");
906
907     for( state = 0 ; state < trie->uniquecharcount ; state++ )
908         PerlIO_printf( Perl_debug_log, "%.*s", colwidth, "--------");
909     PerlIO_printf( Perl_debug_log, "\n");
910
911     for( state = 1 ; state < trie->statecount ; state++ ) {
912         const U32 base = trie->states[ state ].trans.base;
913
914         PerlIO_printf( Perl_debug_log, "%*s#%4"UVXf"|", (int)depth * 2 + 2,"", (UV)state);
915
916         if ( trie->states[ state ].wordnum ) {
917             PerlIO_printf( Perl_debug_log, " W%4X", trie->states[ state ].wordnum );
918         } else {
919             PerlIO_printf( Perl_debug_log, "%6s", "" );
920         }
921
922         PerlIO_printf( Perl_debug_log, " @%4"UVXf" ", (UV)base );
923
924         if ( base ) {
925             U32 ofs = 0;
926
927             while( ( base + ofs  < trie->uniquecharcount ) ||
928                    ( base + ofs - trie->uniquecharcount < trie->lasttrans
929                      && trie->trans[ base + ofs - trie->uniquecharcount ].check != state))
930                     ofs++;
931
932             PerlIO_printf( Perl_debug_log, "+%2"UVXf"[ ", (UV)ofs);
933
934             for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
935                 if ( ( base + ofs >= trie->uniquecharcount ) &&
936                      ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
937                      trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
938                 {
939                    PerlIO_printf( Perl_debug_log, "%*"UVXf,
940                     colwidth,
941                     (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next );
942                 } else {
943                     PerlIO_printf( Perl_debug_log, "%*s",colwidth,"   ." );
944                 }
945             }
946
947             PerlIO_printf( Perl_debug_log, "]");
948
949         }
950         PerlIO_printf( Perl_debug_log, "\n" );
951     }
952 }    
953 /*
954   Dumps a fully constructed but uncompressed trie in list form.
955   List tries normally only are used for construction when the number of 
956   possible chars (trie->uniquecharcount) is very high.
957   Used for debugging make_trie().
958 */
959 STATIC void
960 S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie,
961                          HV *widecharmap, AV *revcharmap, U32 next_alloc,
962                          U32 depth)
963 {
964     U32 state;
965     SV *sv=sv_newmortal();
966     int colwidth= widecharmap ? 6 : 4;
967     GET_RE_DEBUG_FLAGS_DECL;
968
969     PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_LIST;
970
971     /* print out the table precompression.  */
972     PerlIO_printf( Perl_debug_log, "%*sState :Word | Transition Data\n%*s%s",
973         (int)depth * 2 + 2,"", (int)depth * 2 + 2,"",
974         "------:-----+-----------------\n" );
975     
976     for( state=1 ; state < next_alloc ; state ++ ) {
977         U16 charid;
978     
979         PerlIO_printf( Perl_debug_log, "%*s %4"UVXf" :",
980             (int)depth * 2 + 2,"", (UV)state  );
981         if ( ! trie->states[ state ].wordnum ) {
982             PerlIO_printf( Perl_debug_log, "%5s| ","");
983         } else {
984             PerlIO_printf( Perl_debug_log, "W%4x| ",
985                 trie->states[ state ].wordnum
986             );
987         }
988         for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
989             SV ** const tmp = av_fetch( revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0);
990             if ( tmp ) {
991                 PerlIO_printf( Perl_debug_log, "%*s:%3X=%4"UVXf" | ",
992                     colwidth,
993                     pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
994                             PL_colors[0], PL_colors[1],
995                             (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
996                             PERL_PV_ESCAPE_FIRSTCHAR 
997                     ) ,
998                     TRIE_LIST_ITEM(state,charid).forid,
999                     (UV)TRIE_LIST_ITEM(state,charid).newstate
1000                 );
1001                 if (!(charid % 10)) 
1002                     PerlIO_printf(Perl_debug_log, "\n%*s| ",
1003                         (int)((depth * 2) + 14), "");
1004             }
1005         }
1006         PerlIO_printf( Perl_debug_log, "\n");
1007     }
1008 }    
1009
1010 /*
1011   Dumps a fully constructed but uncompressed trie in table form.
1012   This is the normal DFA style state transition table, with a few 
1013   twists to facilitate compression later. 
1014   Used for debugging make_trie().
1015 */
1016 STATIC void
1017 S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie,
1018                           HV *widecharmap, AV *revcharmap, U32 next_alloc,
1019                           U32 depth)
1020 {
1021     U32 state;
1022     U16 charid;
1023     SV *sv=sv_newmortal();
1024     int colwidth= widecharmap ? 6 : 4;
1025     GET_RE_DEBUG_FLAGS_DECL;
1026
1027     PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_TABLE;
1028     
1029     /*
1030        print out the table precompression so that we can do a visual check
1031        that they are identical.
1032      */
1033     
1034     PerlIO_printf( Perl_debug_log, "%*sChar : ",(int)depth * 2 + 2,"" );
1035
1036     for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
1037         SV ** const tmp = av_fetch( revcharmap, charid, 0);
1038         if ( tmp ) {
1039             PerlIO_printf( Perl_debug_log, "%*s", 
1040                 colwidth,
1041                 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
1042                             PL_colors[0], PL_colors[1],
1043                             (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
1044                             PERL_PV_ESCAPE_FIRSTCHAR 
1045                 ) 
1046             );
1047         }
1048     }
1049
1050     PerlIO_printf( Perl_debug_log, "\n%*sState+-",(int)depth * 2 + 2,"" );
1051
1052     for( charid=0 ; charid < trie->uniquecharcount ; charid++ ) {
1053         PerlIO_printf( Perl_debug_log, "%.*s", colwidth,"--------");
1054     }
1055
1056     PerlIO_printf( Perl_debug_log, "\n" );
1057
1058     for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
1059
1060         PerlIO_printf( Perl_debug_log, "%*s%4"UVXf" : ", 
1061             (int)depth * 2 + 2,"",
1062             (UV)TRIE_NODENUM( state ) );
1063
1064         for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
1065             UV v=(UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next );
1066             if (v)
1067                 PerlIO_printf( Perl_debug_log, "%*"UVXf, colwidth, v );
1068             else
1069                 PerlIO_printf( Perl_debug_log, "%*s", colwidth, "." );
1070         }
1071         if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
1072             PerlIO_printf( Perl_debug_log, " (%4"UVXf")\n", (UV)trie->trans[ state ].check );
1073         } else {
1074             PerlIO_printf( Perl_debug_log, " (%4"UVXf") W%4X\n", (UV)trie->trans[ state ].check,
1075             trie->states[ TRIE_NODENUM( state ) ].wordnum );
1076         }
1077     }
1078 }
1079
1080 #endif
1081
1082 /* make_trie(startbranch,first,last,tail,word_count,flags,depth)
1083   startbranch: the first branch in the whole branch sequence
1084   first      : start branch of sequence of branch-exact nodes.
1085                May be the same as startbranch
1086   last       : Thing following the last branch.
1087                May be the same as tail.
1088   tail       : item following the branch sequence
1089   count      : words in the sequence
1090   flags      : currently the OP() type we will be building one of /EXACT(|F|Fl)/
1091   depth      : indent depth
1092
1093 Inplace optimizes a sequence of 2 or more Branch-Exact nodes into a TRIE node.
1094
1095 A trie is an N'ary tree where the branches are determined by digital
1096 decomposition of the key. IE, at the root node you look up the 1st character and
1097 follow that branch repeat until you find the end of the branches. Nodes can be
1098 marked as "accepting" meaning they represent a complete word. Eg:
1099
1100   /he|she|his|hers/
1101
1102 would convert into the following structure. Numbers represent states, letters
1103 following numbers represent valid transitions on the letter from that state, if
1104 the number is in square brackets it represents an accepting state, otherwise it
1105 will be in parenthesis.
1106
1107       +-h->+-e->[3]-+-r->(8)-+-s->[9]
1108       |    |
1109       |   (2)
1110       |    |
1111      (1)   +-i->(6)-+-s->[7]
1112       |
1113       +-s->(3)-+-h->(4)-+-e->[5]
1114
1115       Accept Word Mapping: 3=>1 (he),5=>2 (she), 7=>3 (his), 9=>4 (hers)
1116
1117 This shows that when matching against the string 'hers' we will begin at state 1
1118 read 'h' and move to state 2, read 'e' and move to state 3 which is accepting,
1119 then read 'r' and go to state 8 followed by 's' which takes us to state 9 which
1120 is also accepting. Thus we know that we can match both 'he' and 'hers' with a
1121 single traverse. We store a mapping from accepting to state to which word was
1122 matched, and then when we have multiple possibilities we try to complete the
1123 rest of the regex in the order in which they occured in the alternation.
1124
1125 The only prior NFA like behaviour that would be changed by the TRIE support is
1126 the silent ignoring of duplicate alternations which are of the form:
1127
1128  / (DUPE|DUPE) X? (?{ ... }) Y /x
1129
1130 Thus EVAL blocks follwing a trie may be called a different number of times with
1131 and without the optimisation. With the optimisations dupes will be silently
1132 ignored. This inconsistant behaviour of EVAL type nodes is well established as
1133 the following demonstrates:
1134
1135  'words'=~/(word|word|word)(?{ print $1 })[xyz]/
1136
1137 which prints out 'word' three times, but
1138
1139  'words'=~/(word|word|word)(?{ print $1 })S/
1140
1141 which doesnt print it out at all. This is due to other optimisations kicking in.
1142
1143 Example of what happens on a structural level:
1144
1145 The regexp /(ac|ad|ab)+/ will produce the folowing debug output:
1146
1147    1: CURLYM[1] {1,32767}(18)
1148    5:   BRANCH(8)
1149    6:     EXACT <ac>(16)
1150    8:   BRANCH(11)
1151    9:     EXACT <ad>(16)
1152   11:   BRANCH(14)
1153   12:     EXACT <ab>(16)
1154   16:   SUCCEED(0)
1155   17:   NOTHING(18)
1156   18: END(0)
1157
1158 This would be optimizable with startbranch=5, first=5, last=16, tail=16
1159 and should turn into:
1160
1161    1: CURLYM[1] {1,32767}(18)
1162    5:   TRIE(16)
1163         [Words:3 Chars Stored:6 Unique Chars:4 States:5 NCP:1]
1164           <ac>
1165           <ad>
1166           <ab>
1167   16:   SUCCEED(0)
1168   17:   NOTHING(18)
1169   18: END(0)
1170
1171 Cases where tail != last would be like /(?foo|bar)baz/:
1172
1173    1: BRANCH(4)
1174    2:   EXACT <foo>(8)
1175    4: BRANCH(7)
1176    5:   EXACT <bar>(8)
1177    7: TAIL(8)
1178    8: EXACT <baz>(10)
1179   10: END(0)
1180
1181 which would be optimizable with startbranch=1, first=1, last=7, tail=8
1182 and would end up looking like:
1183
1184     1: TRIE(8)
1185       [Words:2 Chars Stored:6 Unique Chars:5 States:7 NCP:1]
1186         <foo>
1187         <bar>
1188    7: TAIL(8)
1189    8: EXACT <baz>(10)
1190   10: END(0)
1191
1192     d = uvuni_to_utf8_flags(d, uv, 0);
1193
1194 is the recommended Unicode-aware way of saying
1195
1196     *(d++) = uv;
1197 */
1198
1199 #define TRIE_STORE_REVCHAR                                                 \
1200     STMT_START {                                                           \
1201         if (UTF) {                                                         \
1202             SV *zlopp = newSV(2);                                          \
1203             unsigned char *flrbbbbb = (unsigned char *) SvPVX(zlopp);      \
1204             unsigned const char *const kapow = uvuni_to_utf8(flrbbbbb, uvc & 0xFF); \
1205             SvCUR_set(zlopp, kapow - flrbbbbb);                            \
1206             SvPOK_on(zlopp);                                               \
1207             SvUTF8_on(zlopp);                                              \
1208             av_push(revcharmap, zlopp);                                    \
1209         } else {                                                           \
1210             char ooooff = (char)uvc;                                               \
1211             av_push(revcharmap, newSVpvn(&ooooff, 1));                     \
1212         }                                                                  \
1213         } STMT_END
1214
1215 #define TRIE_READ_CHAR STMT_START {                                           \
1216     wordlen++;                                                                \
1217     if ( UTF ) {                                                              \
1218         if ( folder ) {                                                       \
1219             if ( foldlen > 0 ) {                                              \
1220                uvc = utf8n_to_uvuni( scan, UTF8_MAXLEN, &len, uniflags );     \
1221                foldlen -= len;                                                \
1222                scan += len;                                                   \
1223                len = 0;                                                       \
1224             } else {                                                          \
1225                 uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
1226                 uvc = to_uni_fold( uvc, foldbuf, &foldlen );                  \
1227                 foldlen -= UNISKIP( uvc );                                    \
1228                 scan = foldbuf + UNISKIP( uvc );                              \
1229             }                                                                 \
1230         } else {                                                              \
1231             uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
1232         }                                                                     \
1233     } else {                                                                  \
1234         uvc = (U32)*uc;                                                       \
1235         len = 1;                                                              \
1236     }                                                                         \
1237 } STMT_END
1238
1239
1240
1241 #define TRIE_LIST_PUSH(state,fid,ns) STMT_START {               \
1242     if ( TRIE_LIST_CUR( state ) >=TRIE_LIST_LEN( state ) ) {    \
1243         U32 ging = TRIE_LIST_LEN( state ) *= 2;                 \
1244         Renew( trie->states[ state ].trans.list, ging, reg_trie_trans_le ); \
1245     }                                                           \
1246     TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).forid = fid;     \
1247     TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).newstate = ns;   \
1248     TRIE_LIST_CUR( state )++;                                   \
1249 } STMT_END
1250
1251 #define TRIE_LIST_NEW(state) STMT_START {                       \
1252     Newxz( trie->states[ state ].trans.list,               \
1253         4, reg_trie_trans_le );                                 \
1254      TRIE_LIST_CUR( state ) = 1;                                \
1255      TRIE_LIST_LEN( state ) = 4;                                \
1256 } STMT_END
1257
1258 #define TRIE_HANDLE_WORD(state) STMT_START {                    \
1259     U16 dupe= trie->states[ state ].wordnum;                    \
1260     regnode * const noper_next = regnext( noper );              \
1261                                                                 \
1262     if (trie->wordlen)                                          \
1263         trie->wordlen[ curword ] = wordlen;                     \
1264     DEBUG_r({                                                   \
1265         /* store the word for dumping */                        \
1266         SV* tmp;                                                \
1267         if (OP(noper) != NOTHING)                               \
1268             tmp = newSVpvn_utf8(STRING(noper), STR_LEN(noper), UTF);    \
1269         else                                                    \
1270             tmp = newSVpvn_utf8( "", 0, UTF );                  \
1271         av_push( trie_words, tmp );                             \
1272     });                                                         \
1273                                                                 \
1274     curword++;                                                  \
1275                                                                 \
1276     if ( noper_next < tail ) {                                  \
1277         if (!trie->jump)                                        \
1278             trie->jump = (U16 *) PerlMemShared_calloc( word_count + 1, sizeof(U16) ); \
1279         trie->jump[curword] = (U16)(noper_next - convert);      \
1280         if (!jumper)                                            \
1281             jumper = noper_next;                                \
1282         if (!nextbranch)                                        \
1283             nextbranch= regnext(cur);                           \
1284     }                                                           \
1285                                                                 \
1286     if ( dupe ) {                                               \
1287         /* So it's a dupe. This means we need to maintain a   */\
1288         /* linked-list from the first to the next.            */\
1289         /* we only allocate the nextword buffer when there    */\
1290         /* a dupe, so first time we have to do the allocation */\
1291         if (!trie->nextword)                                    \
1292             trie->nextword = (U16 *)                                    \
1293                 PerlMemShared_calloc( word_count + 1, sizeof(U16));     \
1294         while ( trie->nextword[dupe] )                          \
1295             dupe= trie->nextword[dupe];                         \
1296         trie->nextword[dupe]= curword;                          \
1297     } else {                                                    \
1298         /* we haven't inserted this word yet.                */ \
1299         trie->states[ state ].wordnum = curword;                \
1300     }                                                           \
1301 } STMT_END
1302
1303
1304 #define TRIE_TRANS_STATE(state,base,ucharcount,charid,special)          \
1305      ( ( base + charid >=  ucharcount                                   \
1306          && base + charid < ubound                                      \
1307          && state == trie->trans[ base - ucharcount + charid ].check    \
1308          && trie->trans[ base - ucharcount + charid ].next )            \
1309            ? trie->trans[ base - ucharcount + charid ].next             \
1310            : ( state==1 ? special : 0 )                                 \
1311       )
1312
1313 #define MADE_TRIE       1
1314 #define MADE_JUMP_TRIE  2
1315 #define MADE_EXACT_TRIE 4
1316
1317 STATIC I32
1318 S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 word_count, U32 flags, U32 depth)
1319 {
1320     dVAR;
1321     /* first pass, loop through and scan words */
1322     reg_trie_data *trie;
1323     HV *widecharmap = NULL;
1324     AV *revcharmap = newAV();
1325     regnode *cur;
1326     const U32 uniflags = UTF8_ALLOW_DEFAULT;
1327     STRLEN len = 0;
1328     UV uvc = 0;
1329     U16 curword = 0;
1330     U32 next_alloc = 0;
1331     regnode *jumper = NULL;
1332     regnode *nextbranch = NULL;
1333     regnode *convert = NULL;
1334     /* we just use folder as a flag in utf8 */
1335     const U8 * const folder = ( flags == EXACTF
1336                        ? PL_fold
1337                        : ( flags == EXACTFL
1338                            ? PL_fold_locale
1339                            : NULL
1340                          )
1341                      );
1342
1343 #ifdef DEBUGGING
1344     const U32 data_slot = add_data( pRExC_state, 4, "tuuu" );
1345     AV *trie_words = NULL;
1346     /* along with revcharmap, this only used during construction but both are
1347      * useful during debugging so we store them in the struct when debugging.
1348      */
1349 #else
1350     const U32 data_slot = add_data( pRExC_state, 2, "tu" );
1351     STRLEN trie_charcount=0;
1352 #endif
1353     SV *re_trie_maxbuff;
1354     GET_RE_DEBUG_FLAGS_DECL;
1355
1356     PERL_ARGS_ASSERT_MAKE_TRIE;
1357 #ifndef DEBUGGING
1358     PERL_UNUSED_ARG(depth);
1359 #endif
1360
1361     trie = (reg_trie_data *) PerlMemShared_calloc( 1, sizeof(reg_trie_data) );
1362     trie->refcount = 1;
1363     trie->startstate = 1;
1364     trie->wordcount = word_count;
1365     RExC_rxi->data->data[ data_slot ] = (void*)trie;
1366     trie->charmap = (U16 *) PerlMemShared_calloc( 256, sizeof(U16) );
1367     if (!(UTF && folder))
1368         trie->bitmap = (char *) PerlMemShared_calloc( ANYOF_BITMAP_SIZE, 1 );
1369     DEBUG_r({
1370         trie_words = newAV();
1371     });
1372
1373     re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
1374     if (!SvIOK(re_trie_maxbuff)) {
1375         sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
1376     }
1377     DEBUG_OPTIMISE_r({
1378                 PerlIO_printf( Perl_debug_log,
1379                   "%*smake_trie start==%d, first==%d, last==%d, tail==%d depth=%d\n",
1380                   (int)depth * 2 + 2, "", 
1381                   REG_NODE_NUM(startbranch),REG_NODE_NUM(first), 
1382                   REG_NODE_NUM(last), REG_NODE_NUM(tail),
1383                   (int)depth);
1384     });
1385    
1386    /* Find the node we are going to overwrite */
1387     if ( first == startbranch && OP( last ) != BRANCH ) {
1388         /* whole branch chain */
1389         convert = first;
1390     } else {
1391         /* branch sub-chain */
1392         convert = NEXTOPER( first );
1393     }
1394         
1395     /*  -- First loop and Setup --
1396
1397        We first traverse the branches and scan each word to determine if it
1398        contains widechars, and how many unique chars there are, this is
1399        important as we have to build a table with at least as many columns as we
1400        have unique chars.
1401
1402        We use an array of integers to represent the character codes 0..255
1403        (trie->charmap) and we use a an HV* to store Unicode characters. We use the
1404        native representation of the character value as the key and IV's for the
1405        coded index.
1406
1407        *TODO* If we keep track of how many times each character is used we can
1408        remap the columns so that the table compression later on is more
1409        efficient in terms of memory by ensuring most common value is in the
1410        middle and the least common are on the outside.  IMO this would be better
1411        than a most to least common mapping as theres a decent chance the most
1412        common letter will share a node with the least common, meaning the node
1413        will not be compressable. With a middle is most common approach the worst
1414        case is when we have the least common nodes twice.
1415
1416      */
1417
1418     for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1419         regnode * const noper = NEXTOPER( cur );
1420         const U8 *uc = (U8*)STRING( noper );
1421         const U8 * const e  = uc + STR_LEN( noper );
1422         STRLEN foldlen = 0;
1423         U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1424         const U8 *scan = (U8*)NULL;
1425         U32 wordlen      = 0;         /* required init */
1426         STRLEN chars = 0;
1427         bool set_bit = trie->bitmap ? 1 : 0; /*store the first char in the bitmap?*/
1428
1429         if (OP(noper) == NOTHING) {
1430             trie->minlen= 0;
1431             continue;
1432         }
1433         if ( set_bit ) /* bitmap only alloced when !(UTF&&Folding) */
1434             TRIE_BITMAP_SET(trie,*uc); /* store the raw first byte
1435                                           regardless of encoding */
1436
1437         for ( ; uc < e ; uc += len ) {
1438             TRIE_CHARCOUNT(trie)++;
1439             TRIE_READ_CHAR;
1440             chars++;
1441             if ( uvc < 256 ) {
1442                 if ( !trie->charmap[ uvc ] ) {
1443                     trie->charmap[ uvc ]=( ++trie->uniquecharcount );
1444                     if ( folder )
1445                         trie->charmap[ folder[ uvc ] ] = trie->charmap[ uvc ];
1446                     TRIE_STORE_REVCHAR;
1447                 }
1448                 if ( set_bit ) {
1449                     /* store the codepoint in the bitmap, and if its ascii
1450                        also store its folded equivelent. */
1451                     TRIE_BITMAP_SET(trie,uvc);
1452
1453                     /* store the folded codepoint */
1454                     if ( folder ) TRIE_BITMAP_SET(trie,folder[ uvc ]);
1455
1456                     if ( !UTF ) {
1457                         /* store first byte of utf8 representation of
1458                            codepoints in the 127 < uvc < 256 range */
1459                         if (127 < uvc && uvc < 192) {
1460                             TRIE_BITMAP_SET(trie,194);
1461                         } else if (191 < uvc ) {
1462                             TRIE_BITMAP_SET(trie,195);
1463                         /* && uvc < 256 -- we know uvc is < 256 already */
1464                         }
1465                     }
1466                     set_bit = 0; /* We've done our bit :-) */
1467                 }
1468             } else {
1469                 SV** svpp;
1470                 if ( !widecharmap )
1471                     widecharmap = newHV();
1472
1473                 svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 1 );
1474
1475                 if ( !svpp )
1476                     Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%"UVXf, uvc );
1477
1478                 if ( !SvTRUE( *svpp ) ) {
1479                     sv_setiv( *svpp, ++trie->uniquecharcount );
1480                     TRIE_STORE_REVCHAR;
1481                 }
1482             }
1483         }
1484         if( cur == first ) {
1485             trie->minlen=chars;
1486             trie->maxlen=chars;
1487         } else if (chars < trie->minlen) {
1488             trie->minlen=chars;
1489         } else if (chars > trie->maxlen) {
1490             trie->maxlen=chars;
1491         }
1492
1493     } /* end first pass */
1494     DEBUG_TRIE_COMPILE_r(
1495         PerlIO_printf( Perl_debug_log, "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
1496                 (int)depth * 2 + 2,"",
1497                 ( widecharmap ? "UTF8" : "NATIVE" ), (int)word_count,
1498                 (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount,
1499                 (int)trie->minlen, (int)trie->maxlen )
1500     );
1501     trie->wordlen = (U32 *) PerlMemShared_calloc( word_count, sizeof(U32) );
1502
1503     /*
1504         We now know what we are dealing with in terms of unique chars and
1505         string sizes so we can calculate how much memory a naive
1506         representation using a flat table  will take. If it's over a reasonable
1507         limit (as specified by ${^RE_TRIE_MAXBUF}) we use a more memory
1508         conservative but potentially much slower representation using an array
1509         of lists.
1510
1511         At the end we convert both representations into the same compressed
1512         form that will be used in regexec.c for matching with. The latter
1513         is a form that cannot be used to construct with but has memory
1514         properties similar to the list form and access properties similar
1515         to the table form making it both suitable for fast searches and
1516         small enough that its feasable to store for the duration of a program.
1517
1518         See the comment in the code where the compressed table is produced
1519         inplace from the flat tabe representation for an explanation of how
1520         the compression works.
1521
1522     */
1523
1524
1525     if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1) > SvIV(re_trie_maxbuff) ) {
1526         /*
1527             Second Pass -- Array Of Lists Representation
1528
1529             Each state will be represented by a list of charid:state records
1530             (reg_trie_trans_le) the first such element holds the CUR and LEN
1531             points of the allocated array. (See defines above).
1532
1533             We build the initial structure using the lists, and then convert
1534             it into the compressed table form which allows faster lookups
1535             (but cant be modified once converted).
1536         */
1537
1538         STRLEN transcount = 1;
1539
1540         DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log, 
1541             "%*sCompiling trie using list compiler\n",
1542             (int)depth * 2 + 2, ""));
1543         
1544         trie->states = (reg_trie_state *)
1545             PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
1546                                   sizeof(reg_trie_state) );
1547         TRIE_LIST_NEW(1);
1548         next_alloc = 2;
1549
1550         for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1551
1552             regnode * const noper = NEXTOPER( cur );
1553             U8 *uc           = (U8*)STRING( noper );
1554             const U8 * const e = uc + STR_LEN( noper );
1555             U32 state        = 1;         /* required init */
1556             U16 charid       = 0;         /* sanity init */
1557             U8 *scan         = (U8*)NULL; /* sanity init */
1558             STRLEN foldlen   = 0;         /* required init */
1559             U32 wordlen      = 0;         /* required init */
1560             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1561
1562             if (OP(noper) != NOTHING) {
1563                 for ( ; uc < e ; uc += len ) {
1564
1565                     TRIE_READ_CHAR;
1566
1567                     if ( uvc < 256 ) {
1568                         charid = trie->charmap[ uvc ];
1569                     } else {
1570                         SV** const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
1571                         if ( !svpp ) {
1572                             charid = 0;
1573                         } else {
1574                             charid=(U16)SvIV( *svpp );
1575                         }
1576                     }
1577                     /* charid is now 0 if we dont know the char read, or nonzero if we do */
1578                     if ( charid ) {
1579
1580                         U16 check;
1581                         U32 newstate = 0;
1582
1583                         charid--;
1584                         if ( !trie->states[ state ].trans.list ) {
1585                             TRIE_LIST_NEW( state );
1586                         }
1587                         for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) {
1588                             if ( TRIE_LIST_ITEM( state, check ).forid == charid ) {
1589                                 newstate = TRIE_LIST_ITEM( state, check ).newstate;
1590                                 break;
1591                             }
1592                         }
1593                         if ( ! newstate ) {
1594                             newstate = next_alloc++;
1595                             TRIE_LIST_PUSH( state, charid, newstate );
1596                             transcount++;
1597                         }
1598                         state = newstate;
1599                     } else {
1600                         Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1601                     }
1602                 }
1603             }
1604             TRIE_HANDLE_WORD(state);
1605
1606         } /* end second pass */
1607
1608         /* next alloc is the NEXT state to be allocated */
1609         trie->statecount = next_alloc; 
1610         trie->states = (reg_trie_state *)
1611             PerlMemShared_realloc( trie->states,
1612                                    next_alloc
1613                                    * sizeof(reg_trie_state) );
1614
1615         /* and now dump it out before we compress it */
1616         DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_list(trie, widecharmap,
1617                                                          revcharmap, next_alloc,
1618                                                          depth+1)
1619         );
1620
1621         trie->trans = (reg_trie_trans *)
1622             PerlMemShared_calloc( transcount, sizeof(reg_trie_trans) );
1623         {
1624             U32 state;
1625             U32 tp = 0;
1626             U32 zp = 0;
1627
1628
1629             for( state=1 ; state < next_alloc ; state ++ ) {
1630                 U32 base=0;
1631
1632                 /*
1633                 DEBUG_TRIE_COMPILE_MORE_r(
1634                     PerlIO_printf( Perl_debug_log, "tp: %d zp: %d ",tp,zp)
1635                 );
1636                 */
1637
1638                 if (trie->states[state].trans.list) {
1639                     U16 minid=TRIE_LIST_ITEM( state, 1).forid;
1640                     U16 maxid=minid;
1641                     U16 idx;
1642
1643                     for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1644                         const U16 forid = TRIE_LIST_ITEM( state, idx).forid;
1645                         if ( forid < minid ) {
1646                             minid=forid;
1647                         } else if ( forid > maxid ) {
1648                             maxid=forid;
1649                         }
1650                     }
1651                     if ( transcount < tp + maxid - minid + 1) {
1652                         transcount *= 2;
1653                         trie->trans = (reg_trie_trans *)
1654                             PerlMemShared_realloc( trie->trans,
1655                                                      transcount
1656                                                      * sizeof(reg_trie_trans) );
1657                         Zero( trie->trans + (transcount / 2), transcount / 2 , reg_trie_trans );
1658                     }
1659                     base = trie->uniquecharcount + tp - minid;
1660                     if ( maxid == minid ) {
1661                         U32 set = 0;
1662                         for ( ; zp < tp ; zp++ ) {
1663                             if ( ! trie->trans[ zp ].next ) {
1664                                 base = trie->uniquecharcount + zp - minid;
1665                                 trie->trans[ zp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1666                                 trie->trans[ zp ].check = state;
1667                                 set = 1;
1668                                 break;
1669                             }
1670                         }
1671                         if ( !set ) {
1672                             trie->trans[ tp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1673                             trie->trans[ tp ].check = state;
1674                             tp++;
1675                             zp = tp;
1676                         }
1677                     } else {
1678                         for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1679                             const U32 tid = base -  trie->uniquecharcount + TRIE_LIST_ITEM( state, idx ).forid;
1680                             trie->trans[ tid ].next = TRIE_LIST_ITEM( state, idx ).newstate;
1681                             trie->trans[ tid ].check = state;
1682                         }
1683                         tp += ( maxid - minid + 1 );
1684                     }
1685                     Safefree(trie->states[ state ].trans.list);
1686                 }
1687                 /*
1688                 DEBUG_TRIE_COMPILE_MORE_r(
1689                     PerlIO_printf( Perl_debug_log, " base: %d\n",base);
1690                 );
1691                 */
1692                 trie->states[ state ].trans.base=base;
1693             }
1694             trie->lasttrans = tp + 1;
1695         }
1696     } else {
1697         /*
1698            Second Pass -- Flat Table Representation.
1699
1700            we dont use the 0 slot of either trans[] or states[] so we add 1 to each.
1701            We know that we will need Charcount+1 trans at most to store the data
1702            (one row per char at worst case) So we preallocate both structures
1703            assuming worst case.
1704
1705            We then construct the trie using only the .next slots of the entry
1706            structs.
1707
1708            We use the .check field of the first entry of the node  temporarily to
1709            make compression both faster and easier by keeping track of how many non
1710            zero fields are in the node.
1711
1712            Since trans are numbered from 1 any 0 pointer in the table is a FAIL
1713            transition.
1714
1715            There are two terms at use here: state as a TRIE_NODEIDX() which is a
1716            number representing the first entry of the node, and state as a
1717            TRIE_NODENUM() which is the trans number. state 1 is TRIE_NODEIDX(1) and
1718            TRIE_NODENUM(1), state 2 is TRIE_NODEIDX(2) and TRIE_NODENUM(3) if there
1719            are 2 entrys per node. eg:
1720
1721              A B       A B
1722           1. 2 4    1. 3 7
1723           2. 0 3    3. 0 5
1724           3. 0 0    5. 0 0
1725           4. 0 0    7. 0 0
1726
1727            The table is internally in the right hand, idx form. However as we also
1728            have to deal with the states array which is indexed by nodenum we have to
1729            use TRIE_NODENUM() to convert.
1730
1731         */
1732         DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log, 
1733             "%*sCompiling trie using table compiler\n",
1734             (int)depth * 2 + 2, ""));
1735
1736         trie->trans = (reg_trie_trans *)
1737             PerlMemShared_calloc( ( TRIE_CHARCOUNT(trie) + 1 )
1738                                   * trie->uniquecharcount + 1,
1739                                   sizeof(reg_trie_trans) );
1740         trie->states = (reg_trie_state *)
1741             PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
1742                                   sizeof(reg_trie_state) );
1743         next_alloc = trie->uniquecharcount + 1;
1744
1745
1746         for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1747
1748             regnode * const noper   = NEXTOPER( cur );
1749             const U8 *uc     = (U8*)STRING( noper );
1750             const U8 * const e = uc + STR_LEN( noper );
1751
1752             U32 state        = 1;         /* required init */
1753
1754             U16 charid       = 0;         /* sanity init */
1755             U32 accept_state = 0;         /* sanity init */
1756             U8 *scan         = (U8*)NULL; /* sanity init */
1757
1758             STRLEN foldlen   = 0;         /* required init */
1759             U32 wordlen      = 0;         /* required init */
1760             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1761
1762             if ( OP(noper) != NOTHING ) {
1763                 for ( ; uc < e ; uc += len ) {
1764
1765                     TRIE_READ_CHAR;
1766
1767                     if ( uvc < 256 ) {
1768                         charid = trie->charmap[ uvc ];
1769                     } else {
1770                         SV* const * const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
1771                         charid = svpp ? (U16)SvIV(*svpp) : 0;
1772                     }
1773                     if ( charid ) {
1774                         charid--;
1775                         if ( !trie->trans[ state + charid ].next ) {
1776                             trie->trans[ state + charid ].next = next_alloc;
1777                             trie->trans[ state ].check++;
1778                             next_alloc += trie->uniquecharcount;
1779                         }
1780                         state = trie->trans[ state + charid ].next;
1781                     } else {
1782                         Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1783                     }
1784                     /* charid is now 0 if we dont know the char read, or nonzero if we do */
1785                 }
1786             }
1787             accept_state = TRIE_NODENUM( state );
1788             TRIE_HANDLE_WORD(accept_state);
1789
1790         } /* end second pass */
1791
1792         /* and now dump it out before we compress it */
1793         DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_table(trie, widecharmap,
1794                                                           revcharmap,
1795                                                           next_alloc, depth+1));
1796
1797         {
1798         /*
1799            * Inplace compress the table.*
1800
1801            For sparse data sets the table constructed by the trie algorithm will
1802            be mostly 0/FAIL transitions or to put it another way mostly empty.
1803            (Note that leaf nodes will not contain any transitions.)
1804
1805            This algorithm compresses the tables by eliminating most such
1806            transitions, at the cost of a modest bit of extra work during lookup:
1807
1808            - Each states[] entry contains a .base field which indicates the
1809            index in the state[] array wheres its transition data is stored.
1810
1811            - If .base is 0 there are no  valid transitions from that node.
1812
1813            - If .base is nonzero then charid is added to it to find an entry in
1814            the trans array.
1815
1816            -If trans[states[state].base+charid].check!=state then the
1817            transition is taken to be a 0/Fail transition. Thus if there are fail
1818            transitions at the front of the node then the .base offset will point
1819            somewhere inside the previous nodes data (or maybe even into a node
1820            even earlier), but the .check field determines if the transition is
1821            valid.
1822
1823            XXX - wrong maybe?
1824            The following process inplace converts the table to the compressed
1825            table: We first do not compress the root node 1,and mark its all its
1826            .check pointers as 1 and set its .base pointer as 1 as well. This
1827            allows to do a DFA construction from the compressed table later, and
1828            ensures that any .base pointers we calculate later are greater than
1829            0.
1830
1831            - We set 'pos' to indicate the first entry of the second node.
1832
1833            - We then iterate over the columns of the node, finding the first and
1834            last used entry at l and m. We then copy l..m into pos..(pos+m-l),
1835            and set the .check pointers accordingly, and advance pos
1836            appropriately and repreat for the next node. Note that when we copy
1837            the next pointers we have to convert them from the original
1838            NODEIDX form to NODENUM form as the former is not valid post
1839            compression.
1840
1841            - If a node has no transitions used we mark its base as 0 and do not
1842            advance the pos pointer.
1843
1844            - If a node only has one transition we use a second pointer into the
1845            structure to fill in allocated fail transitions from other states.
1846            This pointer is independent of the main pointer and scans forward
1847            looking for null transitions that are allocated to a state. When it
1848            finds one it writes the single transition into the "hole".  If the
1849            pointer doesnt find one the single transition is appended as normal.
1850
1851            - Once compressed we can Renew/realloc the structures to release the
1852            excess space.
1853
1854            See "Table-Compression Methods" in sec 3.9 of the Red Dragon,
1855            specifically Fig 3.47 and the associated pseudocode.
1856
1857            demq
1858         */
1859         const U32 laststate = TRIE_NODENUM( next_alloc );
1860         U32 state, charid;
1861         U32 pos = 0, zp=0;
1862         trie->statecount = laststate;
1863
1864         for ( state = 1 ; state < laststate ; state++ ) {
1865             U8 flag = 0;
1866             const U32 stateidx = TRIE_NODEIDX( state );
1867             const U32 o_used = trie->trans[ stateidx ].check;
1868             U32 used = trie->trans[ stateidx ].check;
1869             trie->trans[ stateidx ].check = 0;
1870
1871             for ( charid = 0 ; used && charid < trie->uniquecharcount ; charid++ ) {
1872                 if ( flag || trie->trans[ stateidx + charid ].next ) {
1873                     if ( trie->trans[ stateidx + charid ].next ) {
1874                         if (o_used == 1) {
1875                             for ( ; zp < pos ; zp++ ) {
1876                                 if ( ! trie->trans[ zp ].next ) {
1877                                     break;
1878                                 }
1879                             }
1880                             trie->states[ state ].trans.base = zp + trie->uniquecharcount - charid ;
1881                             trie->trans[ zp ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1882                             trie->trans[ zp ].check = state;
1883                             if ( ++zp > pos ) pos = zp;
1884                             break;
1885                         }
1886                         used--;
1887                     }
1888                     if ( !flag ) {
1889                         flag = 1;
1890                         trie->states[ state ].trans.base = pos + trie->uniquecharcount - charid ;
1891                     }
1892                     trie->trans[ pos ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1893                     trie->trans[ pos ].check = state;
1894                     pos++;
1895                 }
1896             }
1897         }
1898         trie->lasttrans = pos + 1;
1899         trie->states = (reg_trie_state *)
1900             PerlMemShared_realloc( trie->states, laststate
1901                                    * sizeof(reg_trie_state) );
1902         DEBUG_TRIE_COMPILE_MORE_r(
1903                 PerlIO_printf( Perl_debug_log,
1904                     "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
1905                     (int)depth * 2 + 2,"",
1906                     (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1 ),
1907                     (IV)next_alloc,
1908                     (IV)pos,
1909                     ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
1910             );
1911
1912         } /* end table compress */
1913     }
1914     DEBUG_TRIE_COMPILE_MORE_r(
1915             PerlIO_printf(Perl_debug_log, "%*sStatecount:%"UVxf" Lasttrans:%"UVxf"\n",
1916                 (int)depth * 2 + 2, "",
1917                 (UV)trie->statecount,
1918                 (UV)trie->lasttrans)
1919     );
1920     /* resize the trans array to remove unused space */
1921     trie->trans = (reg_trie_trans *)
1922         PerlMemShared_realloc( trie->trans, trie->lasttrans
1923                                * sizeof(reg_trie_trans) );
1924
1925     /* and now dump out the compressed format */
1926     DEBUG_TRIE_COMPILE_r(dump_trie(trie, widecharmap, revcharmap, depth+1));
1927
1928     {   /* Modify the program and insert the new TRIE node*/ 
1929         U8 nodetype =(U8)(flags & 0xFF);
1930         char *str=NULL;
1931         
1932 #ifdef DEBUGGING
1933         regnode *optimize = NULL;
1934 #ifdef RE_TRACK_PATTERN_OFFSETS
1935
1936         U32 mjd_offset = 0;
1937         U32 mjd_nodelen = 0;
1938 #endif /* RE_TRACK_PATTERN_OFFSETS */
1939 #endif /* DEBUGGING */
1940         /*
1941            This means we convert either the first branch or the first Exact,
1942            depending on whether the thing following (in 'last') is a branch
1943            or not and whther first is the startbranch (ie is it a sub part of
1944            the alternation or is it the whole thing.)
1945            Assuming its a sub part we conver the EXACT otherwise we convert
1946            the whole branch sequence, including the first.
1947          */
1948         /* Find the node we are going to overwrite */
1949         if ( first != startbranch || OP( last ) == BRANCH ) {
1950             /* branch sub-chain */
1951             NEXT_OFF( first ) = (U16)(last - first);
1952 #ifdef RE_TRACK_PATTERN_OFFSETS
1953             DEBUG_r({
1954                 mjd_offset= Node_Offset((convert));
1955                 mjd_nodelen= Node_Length((convert));
1956             });
1957 #endif
1958             /* whole branch chain */
1959         }
1960 #ifdef RE_TRACK_PATTERN_OFFSETS
1961         else {
1962             DEBUG_r({
1963                 const  regnode *nop = NEXTOPER( convert );
1964                 mjd_offset= Node_Offset((nop));
1965                 mjd_nodelen= Node_Length((nop));
1966             });
1967         }
1968         DEBUG_OPTIMISE_r(
1969             PerlIO_printf(Perl_debug_log, "%*sMJD offset:%"UVuf" MJD length:%"UVuf"\n",
1970                 (int)depth * 2 + 2, "",
1971                 (UV)mjd_offset, (UV)mjd_nodelen)
1972         );
1973 #endif
1974         /* But first we check to see if there is a common prefix we can 
1975            split out as an EXACT and put in front of the TRIE node.  */
1976         trie->startstate= 1;
1977         if ( trie->bitmap && !widecharmap && !trie->jump  ) {
1978             U32 state;
1979             for ( state = 1 ; state < trie->statecount-1 ; state++ ) {
1980                 U32 ofs = 0;
1981                 I32 idx = -1;
1982                 U32 count = 0;
1983                 const U32 base = trie->states[ state ].trans.base;
1984
1985                 if ( trie->states[state].wordnum )
1986                         count = 1;
1987
1988                 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
1989                     if ( ( base + ofs >= trie->uniquecharcount ) &&
1990                          ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
1991                          trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
1992                     {
1993                         if ( ++count > 1 ) {
1994                             SV **tmp = av_fetch( revcharmap, ofs, 0);
1995                             const U8 *ch = (U8*)SvPV_nolen_const( *tmp );
1996                             if ( state == 1 ) break;
1997                             if ( count == 2 ) {
1998                                 Zero(trie->bitmap, ANYOF_BITMAP_SIZE, char);
1999                                 DEBUG_OPTIMISE_r(
2000                                     PerlIO_printf(Perl_debug_log,
2001                                         "%*sNew Start State=%"UVuf" Class: [",
2002                                         (int)depth * 2 + 2, "",
2003                                         (UV)state));
2004                                 if (idx >= 0) {
2005                                     SV ** const tmp = av_fetch( revcharmap, idx, 0);
2006                                     const U8 * const ch = (U8*)SvPV_nolen_const( *tmp );
2007
2008                                     TRIE_BITMAP_SET(trie,*ch);
2009                                     if ( folder )
2010                                         TRIE_BITMAP_SET(trie, folder[ *ch ]);
2011                                     DEBUG_OPTIMISE_r(
2012                                         PerlIO_printf(Perl_debug_log, "%s", (char*)ch)
2013                                     );
2014                                 }
2015                             }
2016                             TRIE_BITMAP_SET(trie,*ch);
2017                             if ( folder )
2018                                 TRIE_BITMAP_SET(trie,folder[ *ch ]);
2019                             DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"%s", ch));
2020                         }
2021                         idx = ofs;
2022                     }
2023                 }
2024                 if ( count == 1 ) {
2025                     SV **tmp = av_fetch( revcharmap, idx, 0);
2026                     STRLEN len;
2027                     char *ch = SvPV( *tmp, len );
2028                     DEBUG_OPTIMISE_r({
2029                         SV *sv=sv_newmortal();
2030                         PerlIO_printf( Perl_debug_log,
2031                             "%*sPrefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
2032                             (int)depth * 2 + 2, "",
2033                             (UV)state, (UV)idx, 
2034                             pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6, 
2035                                 PL_colors[0], PL_colors[1],
2036                                 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
2037                                 PERL_PV_ESCAPE_FIRSTCHAR 
2038                             )
2039                         );
2040                     });
2041                     if ( state==1 ) {
2042                         OP( convert ) = nodetype;
2043                         str=STRING(convert);
2044                         STR_LEN(convert)=0;
2045                     }
2046                     STR_LEN(convert) += len;
2047                     while (len--)
2048                         *str++ = *ch++;
2049                 } else {
2050 #ifdef DEBUGGING            
2051                     if (state>1)
2052                         DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"]\n"));
2053 #endif
2054                     break;
2055                 }
2056             }
2057             if (str) {
2058                 regnode *n = convert+NODE_SZ_STR(convert);
2059                 NEXT_OFF(convert) = NODE_SZ_STR(convert);
2060                 trie->startstate = state;
2061                 trie->minlen -= (state - 1);
2062                 trie->maxlen -= (state - 1);
2063 #ifdef DEBUGGING
2064                /* At least the UNICOS C compiler choked on this
2065                 * being argument to DEBUG_r(), so let's just have
2066                 * it right here. */
2067                if (
2068 #ifdef PERL_EXT_RE_BUILD
2069                    1
2070 #else
2071                    DEBUG_r_TEST
2072 #endif
2073                    ) {
2074                    regnode *fix = convert;
2075                    U32 word = trie->wordcount;
2076                    mjd_nodelen++;
2077                    Set_Node_Offset_Length(convert, mjd_offset, state - 1);
2078                    while( ++fix < n ) {
2079                        Set_Node_Offset_Length(fix, 0, 0);
2080                    }
2081                    while (word--) {
2082                        SV ** const tmp = av_fetch( trie_words, word, 0 );
2083                        if (tmp) {
2084                            if ( STR_LEN(convert) <= SvCUR(*tmp) )
2085                                sv_chop(*tmp, SvPV_nolen(*tmp) + STR_LEN(convert));
2086                            else
2087                                sv_chop(*tmp, SvPV_nolen(*tmp) + SvCUR(*tmp));
2088                        }
2089                    }
2090                }
2091 #endif
2092                 if (trie->maxlen) {
2093                     convert = n;
2094                 } else {
2095                     NEXT_OFF(convert) = (U16)(tail - convert);
2096                     DEBUG_r(optimize= n);
2097                 }
2098             }
2099         }
2100         if (!jumper) 
2101             jumper = last; 
2102         if ( trie->maxlen ) {
2103             NEXT_OFF( convert ) = (U16)(tail - convert);
2104             ARG_SET( convert, data_slot );
2105             /* Store the offset to the first unabsorbed branch in 
2106                jump[0], which is otherwise unused by the jump logic. 
2107                We use this when dumping a trie and during optimisation. */
2108             if (trie->jump) 
2109                 trie->jump[0] = (U16)(nextbranch - convert);
2110             
2111             /* XXXX */
2112             if ( !trie->states[trie->startstate].wordnum && trie->bitmap && 
2113                  ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) )
2114             {
2115                 OP( convert ) = TRIEC;
2116                 Copy(trie->bitmap, ((struct regnode_charclass *)convert)->bitmap, ANYOF_BITMAP_SIZE, char);
2117                 PerlMemShared_free(trie->bitmap);
2118                 trie->bitmap= NULL;
2119             } else 
2120                 OP( convert ) = TRIE;
2121
2122             /* store the type in the flags */
2123             convert->flags = nodetype;
2124             DEBUG_r({
2125             optimize = convert 
2126                       + NODE_STEP_REGNODE 
2127                       + regarglen[ OP( convert ) ];
2128             });
2129             /* XXX We really should free up the resource in trie now, 
2130                    as we won't use them - (which resources?) dmq */
2131         }
2132         /* needed for dumping*/
2133         DEBUG_r(if (optimize) {
2134             regnode *opt = convert;
2135
2136             while ( ++opt < optimize) {
2137                 Set_Node_Offset_Length(opt,0,0);
2138             }
2139             /* 
2140                 Try to clean up some of the debris left after the 
2141                 optimisation.
2142              */
2143             while( optimize < jumper ) {
2144                 mjd_nodelen += Node_Length((optimize));
2145                 OP( optimize ) = OPTIMIZED;
2146                 Set_Node_Offset_Length(optimize,0,0);
2147                 optimize++;
2148             }
2149             Set_Node_Offset_Length(convert,mjd_offset,mjd_nodelen);
2150         });
2151     } /* end node insert */
2152     RExC_rxi->data->data[ data_slot + 1 ] = (void*)widecharmap;
2153 #ifdef DEBUGGING
2154     RExC_rxi->data->data[ data_slot + TRIE_WORDS_OFFSET ] = (void*)trie_words;
2155     RExC_rxi->data->data[ data_slot + 3 ] = (void*)revcharmap;
2156 #else
2157     SvREFCNT_dec(revcharmap);
2158 #endif
2159     return trie->jump 
2160            ? MADE_JUMP_TRIE 
2161            : trie->startstate>1 
2162              ? MADE_EXACT_TRIE 
2163              : MADE_TRIE;
2164 }
2165
2166 STATIC void
2167 S_make_trie_failtable(pTHX_ RExC_state_t *pRExC_state, regnode *source,  regnode *stclass, U32 depth)
2168 {
2169 /* The Trie is constructed and compressed now so we can build a fail array now if its needed
2170
2171    This is basically the Aho-Corasick algorithm. Its from exercise 3.31 and 3.32 in the
2172    "Red Dragon" -- Compilers, principles, techniques, and tools. Aho, Sethi, Ullman 1985/88
2173    ISBN 0-201-10088-6
2174
2175    We find the fail state for each state in the trie, this state is the longest proper
2176    suffix of the current states 'word' that is also a proper prefix of another word in our
2177    trie. State 1 represents the word '' and is the thus the default fail state. This allows
2178    the DFA not to have to restart after its tried and failed a word at a given point, it
2179    simply continues as though it had been matching the other word in the first place.
2180    Consider
2181       'abcdgu'=~/abcdefg|cdgu/
2182    When we get to 'd' we are still matching the first word, we would encounter 'g' which would
2183    fail, which would bring use to the state representing 'd' in the second word where we would
2184    try 'g' and succeed, prodceding to match 'cdgu'.
2185  */
2186  /* add a fail transition */
2187     const U32 trie_offset = ARG(source);
2188     reg_trie_data *trie=(reg_trie_data *)RExC_rxi->data->data[trie_offset];
2189     U32 *q;
2190     const U32 ucharcount = trie->uniquecharcount;
2191     const U32 numstates = trie->statecount;
2192     const U32 ubound = trie->lasttrans + ucharcount;
2193     U32 q_read = 0;
2194     U32 q_write = 0;
2195     U32 charid;
2196     U32 base = trie->states[ 1 ].trans.base;
2197     U32 *fail;
2198     reg_ac_data *aho;
2199     const U32 data_slot = add_data( pRExC_state, 1, "T" );
2200     GET_RE_DEBUG_FLAGS_DECL;
2201
2202     PERL_ARGS_ASSERT_MAKE_TRIE_FAILTABLE;
2203 #ifndef DEBUGGING
2204     PERL_UNUSED_ARG(depth);
2205 #endif
2206
2207
2208     ARG_SET( stclass, data_slot );
2209     aho = (reg_ac_data *) PerlMemShared_calloc( 1, sizeof(reg_ac_data) );
2210     RExC_rxi->data->data[ data_slot ] = (void*)aho;
2211     aho->trie=trie_offset;
2212     aho->states=(reg_trie_state *)PerlMemShared_malloc( numstates * sizeof(reg_trie_state) );
2213     Copy( trie->states, aho->states, numstates, reg_trie_state );
2214     Newxz( q, numstates, U32);
2215     aho->fail = (U32 *) PerlMemShared_calloc( numstates, sizeof(U32) );
2216     aho->refcount = 1;
2217     fail = aho->fail;
2218     /* initialize fail[0..1] to be 1 so that we always have
2219        a valid final fail state */
2220     fail[ 0 ] = fail[ 1 ] = 1;
2221
2222     for ( charid = 0; charid < ucharcount ; charid++ ) {
2223         const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 );
2224         if ( newstate ) {
2225             q[ q_write ] = newstate;
2226             /* set to point at the root */
2227             fail[ q[ q_write++ ] ]=1;
2228         }
2229     }
2230     while ( q_read < q_write) {
2231         const U32 cur = q[ q_read++ % numstates ];
2232         base = trie->states[ cur ].trans.base;
2233
2234         for ( charid = 0 ; charid < ucharcount ; charid++ ) {
2235             const U32 ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 );
2236             if (ch_state) {
2237                 U32 fail_state = cur;
2238                 U32 fail_base;
2239                 do {
2240                     fail_state = fail[ fail_state ];
2241                     fail_base = aho->states[ fail_state ].trans.base;
2242                 } while ( !TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 ) );
2243
2244                 fail_state = TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 );
2245                 fail[ ch_state ] = fail_state;
2246                 if ( !aho->states[ ch_state ].wordnum && aho->states[ fail_state ].wordnum )
2247                 {
2248                         aho->states[ ch_state ].wordnum =  aho->states[ fail_state ].wordnum;
2249                 }
2250                 q[ q_write++ % numstates] = ch_state;
2251             }
2252         }
2253     }
2254     /* restore fail[0..1] to 0 so that we "fall out" of the AC loop
2255        when we fail in state 1, this allows us to use the
2256        charclass scan to find a valid start char. This is based on the principle
2257        that theres a good chance the string being searched contains lots of stuff
2258        that cant be a start char.
2259      */
2260     fail[ 0 ] = fail[ 1 ] = 0;
2261     DEBUG_TRIE_COMPILE_r({
2262         PerlIO_printf(Perl_debug_log,
2263                       "%*sStclass Failtable (%"UVuf" states): 0", 
2264                       (int)(depth * 2), "", (UV)numstates
2265         );
2266         for( q_read=1; q_read<numstates; q_read++ ) {
2267             PerlIO_printf(Perl_debug_log, ", %"UVuf, (UV)fail[q_read]);
2268         }
2269         PerlIO_printf(Perl_debug_log, "\n");
2270     });
2271     Safefree(q);
2272     /*RExC_seen |= REG_SEEN_TRIEDFA;*/
2273 }
2274
2275
2276 /*
2277  * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2.
2278  * These need to be revisited when a newer toolchain becomes available.
2279  */
2280 #if defined(__sparc64__) && defined(__GNUC__)
2281 #   if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
2282 #       undef  SPARC64_GCC_WORKAROUND
2283 #       define SPARC64_GCC_WORKAROUND 1
2284 #   endif
2285 #endif
2286
2287 #define DEBUG_PEEP(str,scan,depth) \
2288     DEBUG_OPTIMISE_r({if (scan){ \
2289        SV * const mysv=sv_newmortal(); \
2290        regnode *Next = regnext(scan); \
2291        regprop(RExC_rx, mysv, scan); \
2292        PerlIO_printf(Perl_debug_log, "%*s" str ">%3d: %s (%d)\n", \
2293        (int)depth*2, "", REG_NODE_NUM(scan), SvPV_nolen_const(mysv),\
2294        Next ? (REG_NODE_NUM(Next)) : 0 ); \
2295    }});
2296
2297
2298
2299
2300
2301 #define JOIN_EXACT(scan,min,flags) \
2302     if (PL_regkind[OP(scan)] == EXACT) \
2303         join_exact(pRExC_state,(scan),(min),(flags),NULL,depth+1)
2304
2305 STATIC U32
2306 S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, I32 *min, U32 flags,regnode *val, U32 depth) {
2307     /* Merge several consecutive EXACTish nodes into one. */
2308     regnode *n = regnext(scan);
2309     U32 stringok = 1;
2310     regnode *next = scan + NODE_SZ_STR(scan);
2311     U32 merged = 0;
2312     U32 stopnow = 0;
2313 #ifdef DEBUGGING
2314     regnode *stop = scan;
2315     GET_RE_DEBUG_FLAGS_DECL;
2316 #else
2317     PERL_UNUSED_ARG(depth);
2318 #endif
2319
2320     PERL_ARGS_ASSERT_JOIN_EXACT;
2321 #ifndef EXPERIMENTAL_INPLACESCAN
2322     PERL_UNUSED_ARG(flags);
2323     PERL_UNUSED_ARG(val);
2324 #endif
2325     DEBUG_PEEP("join",scan,depth);
2326     
2327     /* Skip NOTHING, merge EXACT*. */
2328     while (n &&
2329            ( PL_regkind[OP(n)] == NOTHING ||
2330              (stringok && (OP(n) == OP(scan))))
2331            && NEXT_OFF(n)
2332            && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
2333         
2334         if (OP(n) == TAIL || n > next)
2335             stringok = 0;
2336         if (PL_regkind[OP(n)] == NOTHING) {
2337             DEBUG_PEEP("skip:",n,depth);
2338             NEXT_OFF(scan) += NEXT_OFF(n);
2339             next = n + NODE_STEP_REGNODE;
2340 #ifdef DEBUGGING
2341             if (stringok)
2342                 stop = n;
2343 #endif
2344             n = regnext(n);
2345         }
2346         else if (stringok) {
2347             const unsigned int oldl = STR_LEN(scan);
2348             regnode * const nnext = regnext(n);
2349             
2350             DEBUG_PEEP("merg",n,depth);
2351             
2352             merged++;
2353             if (oldl + STR_LEN(n) > U8_MAX)
2354                 break;
2355             NEXT_OFF(scan) += NEXT_OFF(n);
2356             STR_LEN(scan) += STR_LEN(n);
2357             next = n + NODE_SZ_STR(n);
2358             /* Now we can overwrite *n : */
2359             Move(STRING(n), STRING(scan) + oldl, STR_LEN(n), char);
2360 #ifdef DEBUGGING
2361             stop = next - 1;
2362 #endif
2363             n = nnext;
2364             if (stopnow) break;
2365         }
2366
2367 #ifdef EXPERIMENTAL_INPLACESCAN
2368         if (flags && !NEXT_OFF(n)) {
2369             DEBUG_PEEP("atch", val, depth);
2370             if (reg_off_by_arg[OP(n)]) {
2371                 ARG_SET(n, val - n);
2372             }
2373             else {
2374                 NEXT_OFF(n) = val - n;
2375             }
2376             stopnow = 1;
2377         }
2378 #endif
2379     }
2380     
2381     if (UTF && ( OP(scan) == EXACTF ) && ( STR_LEN(scan) >= 6 ) ) {
2382     /*
2383     Two problematic code points in Unicode casefolding of EXACT nodes:
2384     
2385     U+0390 - GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
2386     U+03B0 - GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
2387     
2388     which casefold to
2389     
2390     Unicode                      UTF-8
2391     
2392     U+03B9 U+0308 U+0301         0xCE 0xB9 0xCC 0x88 0xCC 0x81
2393     U+03C5 U+0308 U+0301         0xCF 0x85 0xCC 0x88 0xCC 0x81
2394     
2395     This means that in case-insensitive matching (or "loose matching",
2396     as Unicode calls it), an EXACTF of length six (the UTF-8 encoded byte
2397     length of the above casefolded versions) can match a target string
2398     of length two (the byte length of UTF-8 encoded U+0390 or U+03B0).
2399     This would rather mess up the minimum length computation.
2400     
2401     What we'll do is to look for the tail four bytes, and then peek
2402     at the preceding two bytes to see whether we need to decrease
2403     the minimum length by four (six minus two).
2404     
2405     Thanks to the design of UTF-8, there cannot be false matches:
2406     A sequence of valid UTF-8 bytes cannot be a subsequence of
2407     another valid sequence of UTF-8 bytes.
2408     
2409     */
2410          char * const s0 = STRING(scan), *s, *t;
2411          char * const s1 = s0 + STR_LEN(scan) - 1;
2412          char * const s2 = s1 - 4;
2413 #ifdef EBCDIC /* RD tunifold greek 0390 and 03B0 */
2414          const char t0[] = "\xaf\x49\xaf\x42";
2415 #else
2416          const char t0[] = "\xcc\x88\xcc\x81";
2417 #endif
2418          const char * const t1 = t0 + 3;
2419     
2420          for (s = s0 + 2;
2421               s < s2 && (t = ninstr(s, s1, t0, t1));
2422               s = t + 4) {
2423 #ifdef EBCDIC
2424               if (((U8)t[-1] == 0x68 && (U8)t[-2] == 0xB4) ||
2425                   ((U8)t[-1] == 0x46 && (U8)t[-2] == 0xB5))
2426 #else
2427               if (((U8)t[-1] == 0xB9 && (U8)t[-2] == 0xCE) ||
2428                   ((U8)t[-1] == 0x85 && (U8)t[-2] == 0xCF))
2429 #endif
2430                    *min -= 4;
2431          }
2432     }
2433     
2434 #ifdef DEBUGGING
2435     /* Allow dumping */
2436     n = scan + NODE_SZ_STR(scan);
2437     while (n <= stop) {
2438         if (PL_regkind[OP(n)] != NOTHING || OP(n) == NOTHING) {
2439             OP(n) = OPTIMIZED;
2440             NEXT_OFF(n) = 0;
2441         }
2442         n++;
2443     }
2444 #endif
2445     DEBUG_OPTIMISE_r(if (merged){DEBUG_PEEP("finl",scan,depth)});
2446     return stopnow;
2447 }
2448
2449 /* REx optimizer.  Converts nodes into quickier variants "in place".
2450    Finds fixed substrings.  */
2451
2452 /* Stops at toplevel WHILEM as well as at "last". At end *scanp is set
2453    to the position after last scanned or to NULL. */
2454
2455 #define INIT_AND_WITHP \
2456     assert(!and_withp); \
2457     Newx(and_withp,1,struct regnode_charclass_class); \
2458     SAVEFREEPV(and_withp)
2459
2460 /* this is a chain of data about sub patterns we are processing that
2461    need to be handled seperately/specially in study_chunk. Its so
2462    we can simulate recursion without losing state.  */
2463 struct scan_frame;
2464 typedef struct scan_frame {
2465     regnode *last;  /* last node to process in this frame */
2466     regnode *next;  /* next node to process when last is reached */
2467     struct scan_frame *prev; /*previous frame*/
2468     I32 stop; /* what stopparen do we use */
2469 } scan_frame;
2470
2471
2472 #define SCAN_COMMIT(s, data, m) scan_commit(s, data, m, is_inf)
2473
2474 #define CASE_SYNST_FNC(nAmE)                                       \
2475 case nAmE:                                                         \
2476     if (flags & SCF_DO_STCLASS_AND) {                              \
2477             for (value = 0; value < 256; value++)                  \
2478                 if (!is_ ## nAmE ## _cp(value))                       \
2479                     ANYOF_BITMAP_CLEAR(data->start_class, value);  \
2480     }                                                              \
2481     else {                                                         \
2482             for (value = 0; value < 256; value++)                  \
2483                 if (is_ ## nAmE ## _cp(value))                        \
2484                     ANYOF_BITMAP_SET(data->start_class, value);    \
2485     }                                                              \
2486     break;                                                         \
2487 case N ## nAmE:                                                    \
2488     if (flags & SCF_DO_STCLASS_AND) {                              \
2489             for (value = 0; value < 256; value++)                   \
2490                 if (is_ ## nAmE ## _cp(value))                         \
2491                     ANYOF_BITMAP_CLEAR(data->start_class, value);   \
2492     }                                                               \
2493     else {                                                          \
2494             for (value = 0; value < 256; value++)                   \
2495                 if (!is_ ## nAmE ## _cp(value))                        \
2496                     ANYOF_BITMAP_SET(data->start_class, value);     \
2497     }                                                               \
2498     break
2499
2500
2501
2502 STATIC I32
2503 S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
2504                         I32 *minlenp, I32 *deltap,
2505                         regnode *last,
2506                         scan_data_t *data,
2507                         I32 stopparen,
2508                         U8* recursed,
2509                         struct regnode_charclass_class *and_withp,
2510                         U32 flags, U32 depth)
2511                         /* scanp: Start here (read-write). */
2512                         /* deltap: Write maxlen-minlen here. */
2513                         /* last: Stop before this one. */
2514                         /* data: string data about the pattern */
2515                         /* stopparen: treat close N as END */
2516                         /* recursed: which subroutines have we recursed into */
2517                         /* and_withp: Valid if flags & SCF_DO_STCLASS_OR */
2518 {
2519     dVAR;
2520     I32 min = 0, pars = 0, code;
2521     regnode *scan = *scanp, *next;
2522     I32 delta = 0;
2523     int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
2524     int is_inf_internal = 0;            /* The studied chunk is infinite */
2525     I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
2526     scan_data_t data_fake;
2527     SV *re_trie_maxbuff = NULL;
2528     regnode *first_non_open = scan;
2529     I32 stopmin = I32_MAX;
2530     scan_frame *frame = NULL;
2531     GET_RE_DEBUG_FLAGS_DECL;
2532
2533     PERL_ARGS_ASSERT_STUDY_CHUNK;
2534
2535 #ifdef DEBUGGING
2536     StructCopy(&zero_scan_data, &data_fake, scan_data_t);
2537 #endif
2538
2539     if ( depth == 0 ) {
2540         while (first_non_open && OP(first_non_open) == OPEN)
2541             first_non_open=regnext(first_non_open);
2542     }
2543
2544
2545   fake_study_recurse:
2546     while ( scan && OP(scan) != END && scan < last ){
2547         /* Peephole optimizer: */
2548         DEBUG_STUDYDATA("Peep:", data,depth);
2549         DEBUG_PEEP("Peep",scan,depth);
2550         JOIN_EXACT(scan,&min,0);
2551
2552         /* Follow the next-chain of the current node and optimize
2553            away all the NOTHINGs from it.  */
2554         if (OP(scan) != CURLYX) {
2555             const int max = (reg_off_by_arg[OP(scan)]
2556                        ? I32_MAX
2557                        /* I32 may be smaller than U16 on CRAYs! */
2558                        : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
2559             int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
2560             int noff;
2561             regnode *n = scan;
2562         
2563             /* Skip NOTHING and LONGJMP. */
2564             while ((n = regnext(n))
2565                    && ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
2566                        || ((OP(n) == LONGJMP) && (noff = ARG(n))))
2567                    && off + noff < max)
2568                 off += noff;
2569             if (reg_off_by_arg[OP(scan)])
2570                 ARG(scan) = off;
2571             else
2572                 NEXT_OFF(scan) = off;
2573         }
2574
2575
2576
2577         /* The principal pseudo-switch.  Cannot be a switch, since we
2578            look into several different things.  */
2579         if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
2580                    || OP(scan) == IFTHEN) {
2581             next = regnext(scan);
2582             code = OP(scan);
2583             /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
2584         
2585             if (OP(next) == code || code == IFTHEN) {
2586                 /* NOTE - There is similar code to this block below for handling
2587                    TRIE nodes on a re-study.  If you change stuff here check there
2588                    too. */
2589                 I32 max1 = 0, min1 = I32_MAX, num = 0;
2590                 struct regnode_charclass_class accum;
2591                 regnode * const startbranch=scan;
2592                 
2593                 if (flags & SCF_DO_SUBSTR)
2594                     SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot merge strings after this. */
2595                 if (flags & SCF_DO_STCLASS)
2596                     cl_init_zero(pRExC_state, &accum);
2597
2598                 while (OP(scan) == code) {
2599                     I32 deltanext, minnext, f = 0, fake;
2600                     struct regnode_charclass_class this_class;
2601
2602                     num++;
2603                     data_fake.flags = 0;
2604                     if (data) {
2605                         data_fake.whilem_c = data->whilem_c;
2606                         data_fake.last_closep = data->last_closep;
2607                     }
2608                     else
2609                         data_fake.last_closep = &fake;
2610
2611                     data_fake.pos_delta = delta;
2612                     next = regnext(scan);
2613                     scan = NEXTOPER(scan);
2614                     if (code != BRANCH)
2615                         scan = NEXTOPER(scan);
2616                     if (flags & SCF_DO_STCLASS) {
2617                         cl_init(pRExC_state, &this_class);
2618                         data_fake.start_class = &this_class;
2619                         f = SCF_DO_STCLASS_AND;
2620                     }
2621                     if (flags & SCF_WHILEM_VISITED_POS)
2622                         f |= SCF_WHILEM_VISITED_POS;
2623
2624                     /* we suppose the run is continuous, last=next...*/
2625                     minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
2626                                           next, &data_fake,
2627                                           stopparen, recursed, NULL, f,depth+1);
2628                     if (min1 > minnext)
2629                         min1 = minnext;
2630                     if (max1 < minnext + deltanext)
2631                         max1 = minnext + deltanext;
2632                     if (deltanext == I32_MAX)
2633                         is_inf = is_inf_internal = 1;
2634                     scan = next;
2635                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
2636                         pars++;
2637                     if (data_fake.flags & SCF_SEEN_ACCEPT) {
2638                         if ( stopmin > minnext) 
2639                             stopmin = min + min1;
2640                         flags &= ~SCF_DO_SUBSTR;
2641                         if (data)
2642                             data->flags |= SCF_SEEN_ACCEPT;
2643                     }
2644                     if (data) {
2645                         if (data_fake.flags & SF_HAS_EVAL)
2646                             data->flags |= SF_HAS_EVAL;
2647                         data->whilem_c = data_fake.whilem_c;
2648                     }
2649                     if (flags & SCF_DO_STCLASS)
2650                         cl_or(pRExC_state, &accum, &this_class);
2651                 }
2652                 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
2653                     min1 = 0;
2654                 if (flags & SCF_DO_SUBSTR) {
2655                     data->pos_min += min1;
2656                     data->pos_delta += max1 - min1;
2657                     if (max1 != min1 || is_inf)
2658                         data->longest = &(data->longest_float);
2659                 }
2660                 min += min1;
2661                 delta += max1 - min1;
2662                 if (flags & SCF_DO_STCLASS_OR) {
2663                     cl_or(pRExC_state, data->start_class, &accum);
2664                     if (min1) {
2665                         cl_and(data->start_class, and_withp);
2666                         flags &= ~SCF_DO_STCLASS;
2667                     }
2668                 }
2669                 else if (flags & SCF_DO_STCLASS_AND) {
2670                     if (min1) {
2671                         cl_and(data->start_class, &accum);
2672                         flags &= ~SCF_DO_STCLASS;
2673                     }
2674                     else {
2675                         /* Switch to OR mode: cache the old value of
2676                          * data->start_class */
2677                         INIT_AND_WITHP;
2678                         StructCopy(data->start_class, and_withp,
2679                                    struct regnode_charclass_class);
2680                         flags &= ~SCF_DO_STCLASS_AND;
2681                         StructCopy(&accum, data->start_class,
2682                                    struct regnode_charclass_class);
2683                         flags |= SCF_DO_STCLASS_OR;
2684                         data->start_class->flags |= ANYOF_EOS;
2685                     }
2686                 }
2687
2688                 if (PERL_ENABLE_TRIE_OPTIMISATION && OP( startbranch ) == BRANCH ) {
2689                 /* demq.
2690
2691                    Assuming this was/is a branch we are dealing with: 'scan' now
2692                    points at the item that follows the branch sequence, whatever
2693                    it is. We now start at the beginning of the sequence and look
2694                    for subsequences of
2695
2696                    BRANCH->EXACT=>x1
2697                    BRANCH->EXACT=>x2
2698                    tail
2699
2700                    which would be constructed from a pattern like /A|LIST|OF|WORDS/
2701
2702                    If we can find such a subseqence we need to turn the first
2703                    element into a trie and then add the subsequent branch exact
2704                    strings to the trie.
2705
2706                    We have two cases
2707
2708                      1. patterns where the whole set of branch can be converted. 
2709
2710                      2. patterns where only a subset can be converted.
2711
2712                    In case 1 we can replace the whole set with a single regop
2713                    for the trie. In case 2 we need to keep the start and end
2714                    branchs so
2715
2716                      'BRANCH EXACT; BRANCH EXACT; BRANCH X'
2717                      becomes BRANCH TRIE; BRANCH X;
2718
2719                   There is an additional case, that being where there is a 
2720                   common prefix, which gets split out into an EXACT like node
2721                   preceding the TRIE node.
2722
2723                   If x(1..n)==tail then we can do a simple trie, if not we make
2724                   a "jump" trie, such that when we match the appropriate word
2725                   we "jump" to the appopriate tail node. Essentailly we turn
2726                   a nested if into a case structure of sorts.
2727
2728                 */
2729                 
2730                     int made=0;
2731                     if (!re_trie_maxbuff) {
2732                         re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
2733                         if (!SvIOK(re_trie_maxbuff))
2734                             sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
2735                     }
2736                     if ( SvIV(re_trie_maxbuff)>=0  ) {
2737                         regnode *cur;
2738                         regnode *first = (regnode *)NULL;
2739                         regnode *last = (regnode *)NULL;
2740                         regnode *tail = scan;
2741                         U8 optype = 0;
2742                         U32 count=0;
2743
2744 #ifdef DEBUGGING
2745                         SV * const mysv = sv_newmortal();       /* for dumping */
2746 #endif
2747                         /* var tail is used because there may be a TAIL
2748                            regop in the way. Ie, the exacts will point to the
2749                            thing following the TAIL, but the last branch will
2750                            point at the TAIL. So we advance tail. If we
2751                            have nested (?:) we may have to move through several
2752                            tails.
2753                          */
2754
2755                         while ( OP( tail ) == TAIL ) {
2756                             /* this is the TAIL generated by (?:) */
2757                             tail = regnext( tail );
2758                         }
2759
2760                         
2761                         DEBUG_OPTIMISE_r({
2762                             regprop(RExC_rx, mysv, tail );
2763                             PerlIO_printf( Perl_debug_log, "%*s%s%s\n",
2764                                 (int)depth * 2 + 2, "", 
2765                                 "Looking for TRIE'able sequences. Tail node is: ", 
2766                                 SvPV_nolen_const( mysv )
2767                             );
2768                         });
2769                         
2770                         /*
2771
2772                            step through the branches, cur represents each
2773                            branch, noper is the first thing to be matched
2774                            as part of that branch and noper_next is the
2775                            regnext() of that node. if noper is an EXACT
2776                            and noper_next is the same as scan (our current
2777                            position in the regex) then the EXACT branch is
2778                            a possible optimization target. Once we have
2779                            two or more consequetive such branches we can
2780                            create a trie of the EXACT's contents and stich
2781                            it in place. If the sequence represents all of
2782                            the branches we eliminate the whole thing and
2783                            replace it with a single TRIE. If it is a
2784                            subsequence then we need to stitch it in. This
2785                            means the first branch has to remain, and needs
2786                            to be repointed at the item on the branch chain
2787                            following the last branch optimized. This could
2788                            be either a BRANCH, in which case the
2789                            subsequence is internal, or it could be the
2790                            item following the branch sequence in which
2791                            case the subsequence is at the end.
2792
2793                         */
2794
2795                         /* dont use tail as the end marker for this traverse */
2796                         for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) {
2797                             regnode * const noper = NEXTOPER( cur );
2798 #if defined(DEBUGGING) || defined(NOJUMPTRIE)
2799                             regnode * const noper_next = regnext( noper );
2800 #endif
2801
2802                             DEBUG_OPTIMISE_r({
2803                                 regprop(RExC_rx, mysv, cur);
2804                                 PerlIO_printf( Perl_debug_log, "%*s- %s (%d)",
2805                                    (int)depth * 2 + 2,"", SvPV_nolen_const( mysv ), REG_NODE_NUM(cur) );
2806
2807                                 regprop(RExC_rx, mysv, noper);
2808                                 PerlIO_printf( Perl_debug_log, " -> %s",
2809                                     SvPV_nolen_const(mysv));
2810
2811                                 if ( noper_next ) {
2812                                   regprop(RExC_rx, mysv, noper_next );
2813                                   PerlIO_printf( Perl_debug_log,"\t=> %s\t",
2814                                     SvPV_nolen_const(mysv));
2815                                 }
2816                                 PerlIO_printf( Perl_debug_log, "(First==%d,Last==%d,Cur==%d)\n",
2817                                    REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur) );
2818                             });
2819                             if ( (((first && optype!=NOTHING) ? OP( noper ) == optype
2820                                          : PL_regkind[ OP( noper ) ] == EXACT )
2821                                   || OP(noper) == NOTHING )
2822 #ifdef NOJUMPTRIE
2823                                   && noper_next == tail
2824 #endif
2825                                   && count < U16_MAX)
2826                             {
2827                                 count++;
2828                                 if ( !first || optype == NOTHING ) {
2829                                     if (!first) first = cur;
2830                                     optype = OP( noper );
2831                                 } else {
2832                                     last = cur;
2833                                 }
2834                             } else {
2835 /* 
2836     Currently we do not believe that the trie logic can
2837     handle case insensitive matching properly when the
2838     pattern is not unicode (thus forcing unicode semantics).
2839
2840     If/when this is fixed the following define can be swapped
2841     in below to fully enable trie logic.
2842
2843 #define TRIE_TYPE_IS_SAFE 1
2844
2845 */
2846 #define TRIE_TYPE_IS_SAFE (UTF || optype==EXACT)
2847
2848                                 if ( last && TRIE_TYPE_IS_SAFE ) {
2849                                     make_trie( pRExC_state, 
2850                                             startbranch, first, cur, tail, count, 
2851                                             optype, depth+1 );
2852                                 }
2853                                 if ( PL_regkind[ OP( noper ) ] == EXACT
2854 #ifdef NOJUMPTRIE
2855                                      && noper_next == tail
2856 #endif
2857                                 ){
2858                                     count = 1;
2859                                     first = cur;
2860                                     optype = OP( noper );
2861                                 } else {
2862                                     count = 0;
2863                                     first = NULL;
2864                                     optype = 0;
2865                                 }
2866                                 last = NULL;
2867                             }
2868                         }
2869                         DEBUG_OPTIMISE_r({
2870                             regprop(RExC_rx, mysv, cur);
2871                             PerlIO_printf( Perl_debug_log,
2872                               "%*s- %s (%d) <SCAN FINISHED>\n", (int)depth * 2 + 2,
2873                               "", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
2874
2875                         });
2876                         
2877                         if ( last && TRIE_TYPE_IS_SAFE ) {
2878                             made= make_trie( pRExC_state, startbranch, first, scan, tail, count, optype, depth+1 );
2879 #ifdef TRIE_STUDY_OPT   
2880                             if ( ((made == MADE_EXACT_TRIE && 
2881                                  startbranch == first) 
2882                                  || ( first_non_open == first )) && 
2883                                  depth==0 ) {
2884                                 flags |= SCF_TRIE_RESTUDY;
2885                                 if ( startbranch == first 
2886                                      && scan == tail ) 
2887                                 {
2888                                     RExC_seen &=~REG_TOP_LEVEL_BRANCHES;
2889                                 }
2890                             }
2891 #endif
2892                         }
2893                     }
2894                     
2895                 } /* do trie */
2896                 
2897             }
2898             else if ( code == BRANCHJ ) {  /* single branch is optimized. */
2899                 scan = NEXTOPER(NEXTOPER(scan));
2900             } else                      /* single branch is optimized. */
2901                 scan = NEXTOPER(scan);
2902             continue;
2903         } else if (OP(scan) == SUSPEND || OP(scan) == GOSUB || OP(scan) == GOSTART) {
2904             scan_frame *newframe = NULL;
2905             I32 paren;
2906             regnode *start;
2907             regnode *end;
2908
2909             if (OP(scan) != SUSPEND) {
2910             /* set the pointer */
2911                 if (OP(scan) == GOSUB) {
2912                     paren = ARG(scan);
2913                     RExC_recurse[ARG2L(scan)] = scan;
2914                     start = RExC_open_parens[paren-1];
2915                     end   = RExC_close_parens[paren-1];
2916                 } else {
2917                     paren = 0;
2918                     start = RExC_rxi->program + 1;
2919                     end   = RExC_opend;
2920                 }
2921                 if (!recursed) {
2922                     Newxz(recursed, (((RExC_npar)>>3) +1), U8);
2923                     SAVEFREEPV(recursed);
2924                 }
2925                 if (!PAREN_TEST(recursed,paren+1)) {
2926                     PAREN_SET(recursed,paren+1);
2927                     Newx(newframe,1,scan_frame);
2928                 } else {
2929                     if (flags & SCF_DO_SUBSTR) {
2930                         SCAN_COMMIT(pRExC_state,data,minlenp);
2931                         data->longest = &(data->longest_float);
2932                     }
2933                     is_inf = is_inf_internal = 1;
2934                     if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
2935                         cl_anything(pRExC_state, data->start_class);
2936                     flags &= ~SCF_DO_STCLASS;
2937                 }
2938             } else {
2939                 Newx(newframe,1,scan_frame);
2940                 paren = stopparen;
2941                 start = scan+2;
2942                 end = regnext(scan);
2943             }
2944             if (newframe) {
2945                 assert(start);
2946                 assert(end);
2947                 SAVEFREEPV(newframe);
2948                 newframe->next = regnext(scan);
2949                 newframe->last = last;
2950                 newframe->stop = stopparen;
2951                 newframe->prev = frame;
2952
2953                 frame = newframe;
2954                 scan =  start;
2955                 stopparen = paren;
2956                 last = end;
2957
2958                 continue;
2959             }
2960         }
2961         else if (OP(scan) == EXACT) {
2962             I32 l = STR_LEN(scan);
2963             UV uc;
2964             if (UTF) {
2965                 const U8 * const s = (U8*)STRING(scan);
2966                 l = utf8_length(s, s + l);
2967                 uc = utf8_to_uvchr(s, NULL);
2968             } else {
2969                 uc = *((U8*)STRING(scan));
2970             }
2971             min += l;
2972             if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
2973                 /* The code below prefers earlier match for fixed
2974                    offset, later match for variable offset.  */
2975                 if (data->last_end == -1) { /* Update the start info. */
2976                     data->last_start_min = data->pos_min;
2977                     data->last_start_max = is_inf
2978                         ? I32_MAX : data->pos_min + data->pos_delta;
2979                 }
2980                 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
2981                 if (UTF)
2982                     SvUTF8_on(data->last_found);
2983                 {
2984                     SV * const sv = data->last_found;
2985                     MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
2986                         mg_find(sv, PERL_MAGIC_utf8) : NULL;
2987                     if (mg && mg->mg_len >= 0)
2988                         mg->mg_len += utf8_length((U8*)STRING(scan),
2989                                                   (U8*)STRING(scan)+STR_LEN(scan));
2990                 }
2991                 data->last_end = data->pos_min + l;
2992                 data->pos_min += l; /* As in the first entry. */
2993                 data->flags &= ~SF_BEFORE_EOL;
2994             }
2995             if (flags & SCF_DO_STCLASS_AND) {
2996                 /* Check whether it is compatible with what we know already! */
2997                 int compat = 1;
2998
2999                 if (uc >= 0x100 ||
3000                     (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
3001                     && !ANYOF_BITMAP_TEST(data->start_class, uc)
3002                     && (!(data->start_class->flags & ANYOF_FOLD)
3003                         || !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
3004                     )
3005                     compat = 0;
3006                 ANYOF_CLASS_ZERO(data->start_class);
3007                 ANYOF_BITMAP_ZERO(data->start_class);
3008                 if (compat)
3009                     ANYOF_BITMAP_SET(data->start_class, uc);
3010                 data->start_class->flags &= ~ANYOF_EOS;
3011                 if (uc < 0x100)
3012                   data->start_class->flags &= ~ANYOF_UNICODE_ALL;
3013             }
3014             else if (flags & SCF_DO_STCLASS_OR) {
3015                 /* false positive possible if the class is case-folded */
3016                 if (uc < 0x100)
3017                     ANYOF_BITMAP_SET(data->start_class, uc);
3018                 else
3019                     data->start_class->flags |= ANYOF_UNICODE_ALL;
3020                 data->start_class->flags &= ~ANYOF_EOS;
3021                 cl_and(data->start_class, and_withp);
3022             }
3023             flags &= ~SCF_DO_STCLASS;
3024         }
3025         else if (PL_regkind[OP(scan)] == EXACT) { /* But OP != EXACT! */
3026             I32 l = STR_LEN(scan);
3027             UV uc = *((U8*)STRING(scan));
3028
3029             /* Search for fixed substrings supports EXACT only. */
3030             if (flags & SCF_DO_SUBSTR) {
3031                 assert(data);
3032                 SCAN_COMMIT(pRExC_state, data, minlenp);
3033             }
3034             if (UTF) {
3035                 const U8 * const s = (U8 *)STRING(scan);
3036                 l = utf8_length(s, s + l);
3037                 uc = utf8_to_uvchr(s, NULL);
3038             }
3039             min += l;
3040             if (flags & SCF_DO_SUBSTR)
3041                 data->pos_min += l;
3042             if (flags & SCF_DO_STCLASS_AND) {
3043                 /* Check whether it is compatible with what we know already! */
3044                 int compat = 1;
3045
3046                 if (uc >= 0x100 ||
3047                     (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
3048                     && !ANYOF_BITMAP_TEST(data->start_class, uc)
3049                      && !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
3050                     compat = 0;
3051                 ANYOF_CLASS_ZERO(data->start_class);
3052                 ANYOF_BITMAP_ZERO(data->start_class);
3053                 if (compat) {
3054                     ANYOF_BITMAP_SET(data->start_class, uc);
3055                     data->start_class->flags &= ~ANYOF_EOS;
3056                     data->start_class->flags |= ANYOF_FOLD;
3057                     if (OP(scan) == EXACTFL)
3058                         data->start_class->flags |= ANYOF_LOCALE;
3059                 }
3060             }
3061             else if (flags & SCF_DO_STCLASS_OR) {
3062                 if (data->start_class->flags & ANYOF_FOLD) {
3063                     /* false positive possible if the class is case-folded.
3064                        Assume that the locale settings are the same... */
3065                     if (uc < 0x100)
3066                         ANYOF_BITMAP_SET(data->start_class, uc);
3067                     data->start_class->flags &= ~ANYOF_EOS;
3068                 }
3069                 cl_and(data->start_class, and_withp);
3070             }
3071             flags &= ~SCF_DO_STCLASS;
3072         }
3073         else if (strchr((const char*)PL_varies,OP(scan))) {
3074             I32 mincount, maxcount, minnext, deltanext, fl = 0;
3075             I32 f = flags, pos_before = 0;
3076             regnode * const oscan = scan;
3077             struct regnode_charclass_class this_class;
3078             struct regnode_charclass_class *oclass = NULL;
3079             I32 next_is_eval = 0;
3080
3081             switch (PL_regkind[OP(scan)]) {
3082             case WHILEM:                /* End of (?:...)* . */
3083                 scan = NEXTOPER(scan);
3084                 goto finish;
3085             case PLUS:
3086                 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
3087                     next = NEXTOPER(scan);
3088                     if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
3089                         mincount = 1;
3090                         maxcount = REG_INFTY;
3091                         next = regnext(scan);
3092                         scan = NEXTOPER(scan);
3093                         goto do_curly;
3094                     }
3095                 }
3096                 if (flags & SCF_DO_SUBSTR)
3097                     data->pos_min++;
3098                 min++;
3099                 /* Fall through. */
3100             case STAR:
3101                 if (flags & SCF_DO_STCLASS) {
3102                     mincount = 0;
3103                     maxcount = REG_INFTY;
3104                     next = regnext(scan);
3105                     scan = NEXTOPER(scan);
3106                     goto do_curly;
3107                 }
3108                 is_inf = is_inf_internal = 1;
3109                 scan = regnext(scan);
3110                 if (flags & SCF_DO_SUBSTR) {
3111                     SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot extend fixed substrings */
3112                     data->longest = &(data->longest_float);
3113                 }
3114                 goto optimize_curly_tail;
3115             case CURLY:
3116                 if (stopparen>0 && (OP(scan)==CURLYN || OP(scan)==CURLYM)
3117                     && (scan->flags == stopparen))
3118                 {
3119                     mincount = 1;
3120                     maxcount = 1;
3121                 } else {
3122                     mincount = ARG1(scan);
3123                     maxcount = ARG2(scan);
3124                 }
3125                 next = regnext(scan);
3126                 if (OP(scan) == CURLYX) {
3127                     I32 lp = (data ? *(data->last_closep) : 0);
3128                     scan->flags = ((lp <= (I32)U8_MAX) ? (U8)lp : U8_MAX);
3129                 }
3130                 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3131                 next_is_eval = (OP(scan) == EVAL);
3132               do_curly:
3133                 if (flags & SCF_DO_SUBSTR) {
3134                     if (mincount == 0) SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot extend fixed substrings */
3135                     pos_before = data->pos_min;
3136                 }
3137                 if (data) {
3138                     fl = data->flags;
3139                     data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
3140                     if (is_inf)
3141                         data->flags |= SF_IS_INF;
3142                 }
3143                 if (flags & SCF_DO_STCLASS) {
3144                     cl_init(pRExC_state, &this_class);
3145                     oclass = data->start_class;
3146                     data->start_class = &this_class;
3147                     f |= SCF_DO_STCLASS_AND;
3148                     f &= ~SCF_DO_STCLASS_OR;
3149                 }
3150                 /* These are the cases when once a subexpression
3151                    fails at a particular position, it cannot succeed
3152                    even after backtracking at the enclosing scope.
3153                 
3154                    XXXX what if minimal match and we are at the
3155                         initial run of {n,m}? */
3156                 if ((mincount != maxcount - 1) && (maxcount != REG_INFTY))
3157                     f &= ~SCF_WHILEM_VISITED_POS;
3158
3159                 /* This will finish on WHILEM, setting scan, or on NULL: */
3160                 minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext, 
3161                                       last, data, stopparen, recursed, NULL,
3162                                       (mincount == 0
3163                                         ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
3164
3165                 if (flags & SCF_DO_STCLASS)
3166                     data->start_class = oclass;
3167                 if (mincount == 0 || minnext == 0) {
3168                     if (flags & SCF_DO_STCLASS_OR) {
3169                         cl_or(pRExC_state, data->start_class, &this_class);
3170                     }
3171                     else if (flags & SCF_DO_STCLASS_AND) {
3172                         /* Switch to OR mode: cache the old value of
3173                          * data->start_class */
3174                         INIT_AND_WITHP;
3175                         StructCopy(data->start_class, and_withp,
3176                                    struct regnode_charclass_class);
3177                         flags &= ~SCF_DO_STCLASS_AND;
3178                         StructCopy(&this_class, data->start_class,
3179                                    struct regnode_charclass_class);
3180                         flags |= SCF_DO_STCLASS_OR;
3181                         data->start_class->flags |= ANYOF_EOS;
3182                     }
3183                 } else {                /* Non-zero len */
3184                     if (flags & SCF_DO_STCLASS_OR) {
3185                         cl_or(pRExC_state, data->start_class, &this_class);
3186                         cl_and(data->start_class, and_withp);
3187                     }
3188                     else if (flags & SCF_DO_STCLASS_AND)
3189                         cl_and(data->start_class, &this_class);
3190                     flags &= ~SCF_DO_STCLASS;
3191                 }
3192                 if (!scan)              /* It was not CURLYX, but CURLY. */
3193                     scan = next;
3194                 if ( /* ? quantifier ok, except for (?{ ... }) */
3195                     (next_is_eval || !(mincount == 0 && maxcount == 1))
3196                     && (minnext == 0) && (deltanext == 0)
3197                     && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
3198                     && maxcount <= REG_INFTY/3) /* Complement check for big count */
3199                 {
3200                     ckWARNreg(RExC_parse,
3201                               "Quantifier unexpected on zero-length expression");
3202                 }
3203
3204                 min += minnext * mincount;
3205                 is_inf_internal |= ((maxcount == REG_INFTY
3206                                      && (minnext + deltanext) > 0)
3207                                     || deltanext == I32_MAX);
3208                 is_inf |= is_inf_internal;
3209                 delta += (minnext + deltanext) * maxcount - minnext * mincount;
3210
3211                 /* Try powerful optimization CURLYX => CURLYN. */
3212                 if (  OP(oscan) == CURLYX && data
3213                       && data->flags & SF_IN_PAR
3214                       && !(data->flags & SF_HAS_EVAL)
3215                       && !deltanext && minnext == 1 ) {
3216                     /* Try to optimize to CURLYN.  */
3217                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
3218                     regnode * const nxt1 = nxt;
3219 #ifdef DEBUGGING
3220                     regnode *nxt2;
3221 #endif
3222
3223                     /* Skip open. */
3224                     nxt = regnext(nxt);
3225                     if (!strchr((const char*)PL_simple,OP(nxt))
3226                         && !(PL_regkind[OP(nxt)] == EXACT
3227                              && STR_LEN(nxt) == 1))
3228                         goto nogo;
3229 #ifdef DEBUGGING
3230                     nxt2 = nxt;
3231 #endif
3232                     nxt = regnext(nxt);
3233                     if (OP(nxt) != CLOSE)
3234                         goto nogo;
3235                     if (RExC_open_parens) {
3236                         RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
3237                         RExC_close_parens[ARG(nxt1)-1]=nxt+2; /*close->while*/
3238                     }
3239                     /* Now we know that nxt2 is the only contents: */
3240                     oscan->flags = (U8)ARG(nxt);
3241                     OP(oscan) = CURLYN;
3242                     OP(nxt1) = NOTHING; /* was OPEN. */
3243
3244 #ifdef DEBUGGING
3245                     OP(nxt1 + 1) = OPTIMIZED; /* was count. */
3246                     NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
3247                     NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */
3248                     OP(nxt) = OPTIMIZED;        /* was CLOSE. */
3249                     OP(nxt + 1) = OPTIMIZED; /* was count. */
3250                     NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
3251 #endif
3252                 }
3253               nogo:
3254
3255                 /* Try optimization CURLYX => CURLYM. */
3256                 if (  OP(oscan) == CURLYX && data
3257                       && !(data->flags & SF_HAS_PAR)
3258                       && !(data->flags & SF_HAS_EVAL)
3259                       && !deltanext     /* atom is fixed width */
3260                       && minnext != 0   /* CURLYM can't handle zero width */
3261                 ) {
3262                     /* XXXX How to optimize if data == 0? */
3263                     /* Optimize to a simpler form.  */
3264                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
3265                     regnode *nxt2;
3266
3267                     OP(oscan) = CURLYM;
3268                     while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
3269                             && (OP(nxt2) != WHILEM))
3270                         nxt = nxt2;
3271                     OP(nxt2)  = SUCCEED; /* Whas WHILEM */
3272                     /* Need to optimize away parenths. */
3273                     if (data->flags & SF_IN_PAR) {
3274                         /* Set the parenth number.  */
3275                         regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
3276
3277                         if (OP(nxt) != CLOSE)
3278                             FAIL("Panic opt close");
3279                         oscan->flags = (U8)ARG(nxt);
3280                         if (RExC_open_parens) {
3281                             RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
3282                             RExC_close_parens[ARG(nxt1)-1]=nxt2+1; /*close->NOTHING*/
3283                         }
3284                         OP(nxt1) = OPTIMIZED;   /* was OPEN. */
3285                         OP(nxt) = OPTIMIZED;    /* was CLOSE. */
3286
3287 #ifdef DEBUGGING
3288                         OP(nxt1 + 1) = OPTIMIZED; /* was count. */
3289                         OP(nxt + 1) = OPTIMIZED; /* was count. */
3290                         NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
3291                         NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
3292 #endif
3293 #if 0
3294                         while ( nxt1 && (OP(nxt1) != WHILEM)) {
3295                             regnode *nnxt = regnext(nxt1);
3296                         
3297                             if (nnxt == nxt) {
3298                                 if (reg_off_by_arg[OP(nxt1)])
3299                                     ARG_SET(nxt1, nxt2 - nxt1);
3300                                 else if (nxt2 - nxt1 < U16_MAX)
3301                                     NEXT_OFF(nxt1) = nxt2 - nxt1;
3302                                 else
3303                                     OP(nxt) = NOTHING;  /* Cannot beautify */
3304                             }
3305                             nxt1 = nnxt;
3306                         }
3307 #endif
3308                         /* Optimize again: */
3309                         study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt,
3310                                     NULL, stopparen, recursed, NULL, 0,depth+1);
3311                     }
3312                     else
3313                         oscan->flags = 0;
3314                 }
3315                 else if ((OP(oscan) == CURLYX)
3316                          && (flags & SCF_WHILEM_VISITED_POS)
3317                          /* See the comment on a similar expression above.
3318                             However, this time it not a subexpression
3319                             we care about, but the expression itself. */
3320                          && (maxcount == REG_INFTY)
3321                          && data && ++data->whilem_c < 16) {
3322                     /* This stays as CURLYX, we can put the count/of pair. */
3323                     /* Find WHILEM (as in regexec.c) */
3324                     regnode *nxt = oscan + NEXT_OFF(oscan);
3325
3326                     if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
3327                         nxt += ARG(nxt);
3328                     PREVOPER(nxt)->flags = (U8)(data->whilem_c
3329                         | (RExC_whilem_seen << 4)); /* On WHILEM */
3330                 }
3331                 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
3332                     pars++;
3333                 if (flags & SCF_DO_SUBSTR) {
3334                     SV *last_str = NULL;
3335                     int counted = mincount != 0;
3336
3337                     if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
3338 #if defined(SPARC64_GCC_WORKAROUND)
3339                         I32 b = 0;
3340                         STRLEN l = 0;
3341                         const char *s = NULL;
3342                         I32 old = 0;
3343
3344                         if (pos_before >= data->last_start_min)
3345                             b = pos_before;
3346                         else
3347                             b = data->last_start_min;
3348
3349                         l = 0;
3350                         s = SvPV_const(data->last_found, l);
3351                         old = b - data->last_start_min;
3352
3353 #else
3354                         I32 b = pos_before >= data->last_start_min
3355                             ? pos_before : data->last_start_min;
3356                         STRLEN l;
3357                         const char * const s = SvPV_const(data->last_found, l);
3358                         I32 old = b - data->last_start_min;
3359 #endif
3360
3361                         if (UTF)
3362                             old = utf8_hop((U8*)s, old) - (U8*)s;
3363                         
3364                         l -= old;
3365                         /* Get the added string: */
3366                         last_str = newSVpvn_utf8(s  + old, l, UTF);
3367                         if (deltanext == 0 && pos_before == b) {
3368                             /* What was added is a constant string */
3369                             if (mincount > 1) {
3370                                 SvGROW(last_str, (mincount * l) + 1);
3371                                 repeatcpy(SvPVX(last_str) + l,
3372                                           SvPVX_const(last_str), l, mincount - 1);
3373                                 SvCUR_set(last_str, SvCUR(last_str) * mincount);
3374                                 /* Add additional parts. */
3375                                 SvCUR_set(data->last_found,
3376                                           SvCUR(data->last_found) - l);
3377                                 sv_catsv(data->last_found, last_str);
3378                                 {
3379                                     SV * sv = data->last_found;
3380                                     MAGIC *mg =
3381                                         SvUTF8(sv) && SvMAGICAL(sv) ?
3382                                         mg_find(sv, PERL_MAGIC_utf8) : NULL;
3383                                     if (mg && mg->mg_len >= 0)
3384                                         mg->mg_len += CHR_SVLEN(last_str) - l;
3385                                 }
3386                                 data->last_end += l * (mincount - 1);
3387                             }
3388                         } else {
3389                             /* start offset must point into the last copy */
3390                             data->last_start_min += minnext * (mincount - 1);
3391                             data->last_start_max += is_inf ? I32_MAX
3392                                 : (maxcount - 1) * (minnext + data->pos_delta);
3393                         }
3394                     }
3395                     /* It is counted once already... */
3396                     data->pos_min += minnext * (mincount - counted);
3397                     data->pos_delta += - counted * deltanext +
3398                         (minnext + deltanext) * maxcount - minnext * mincount;
3399                     if (mincount != maxcount) {
3400                          /* Cannot extend fixed substrings found inside
3401                             the group.  */
3402                         SCAN_COMMIT(pRExC_state,data,minlenp);
3403                         if (mincount && last_str) {
3404                             SV * const sv = data->last_found;
3405                             MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
3406                                 mg_find(sv, PERL_MAGIC_utf8) : NULL;
3407
3408                             if (mg)
3409                                 mg->mg_len = -1;
3410                             sv_setsv(sv, last_str);
3411                             data->last_end = data->pos_min;
3412                             data->last_start_min =
3413                                 data->pos_min - CHR_SVLEN(last_str);
3414                             data->last_start_max = is_inf
3415                                 ? I32_MAX
3416                                 : data->pos_min + data->pos_delta
3417                                 - CHR_SVLEN(last_str);
3418                         }
3419                         data->longest = &(data->longest_float);
3420                     }
3421                     SvREFCNT_dec(last_str);
3422                 }
3423                 if (data && (fl & SF_HAS_EVAL))
3424                     data->flags |= SF_HAS_EVAL;
3425               optimize_curly_tail:
3426                 if (OP(oscan) != CURLYX) {
3427                     while (PL_regkind[OP(next = regnext(oscan))] == NOTHING
3428                            && NEXT_OFF(next))
3429                         NEXT_OFF(oscan) += NEXT_OFF(next);
3430                 }
3431                 continue;
3432             default:                    /* REF and CLUMP only? */
3433                 if (flags & SCF_DO_SUBSTR) {
3434                     SCAN_COMMIT(pRExC_state,data,minlenp);      /* Cannot expect anything... */
3435                     data->longest = &(data->longest_float);
3436                 }
3437                 is_inf = is_inf_internal = 1;
3438                 if (flags & SCF_DO_STCLASS_OR)
3439                     cl_anything(pRExC_state, data->start_class);
3440                 flags &= ~SCF_DO_STCLASS;
3441                 break;
3442             }
3443         }
3444         else if (OP(scan) == LNBREAK) {
3445             if (flags & SCF_DO_STCLASS) {
3446                 int value = 0;
3447                 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
3448                 if (flags & SCF_DO_STCLASS_AND) {
3449                     for (value = 0; value < 256; value++)
3450                         if (!is_VERTWS_cp(value))
3451                             ANYOF_BITMAP_CLEAR(data->start_class, value);  
3452                 }                                                              
3453                 else {                                                         
3454                     for (value = 0; value < 256; value++)
3455                         if (is_VERTWS_cp(value))
3456                             ANYOF_BITMAP_SET(data->start_class, value);    
3457                 }                                                              
3458                 if (flags & SCF_DO_STCLASS_OR)
3459                     cl_and(data->start_class, and_withp);
3460                 flags &= ~SCF_DO_STCLASS;
3461             }
3462             min += 1;
3463             delta += 1;
3464             if (flags & SCF_DO_SUBSTR) {
3465                 SCAN_COMMIT(pRExC_state,data,minlenp);  /* Cannot expect anything... */
3466                 data->pos_min += 1;
3467                 data->pos_delta += 1;
3468                 data->longest = &(data->longest_float);
3469             }
3470             
3471         }
3472         else if (OP(scan) == FOLDCHAR) {
3473             int d = ARG(scan)==0xDF ? 1 : 2;
3474             flags &= ~SCF_DO_STCLASS;
3475             min += 1;
3476             delta += d;
3477             if (flags & SCF_DO_SUBSTR) {
3478                 SCAN_COMMIT(pRExC_state,data,minlenp);  /* Cannot expect anything... */
3479                 data->pos_min += 1;
3480                 data->pos_delta += d;
3481                 data->longest = &(data->longest_float);
3482             }
3483         }
3484         else if (strchr((const char*)PL_simple,OP(scan))) {
3485             int value = 0;
3486
3487             if (flags & SCF_DO_SUBSTR) {
3488                 SCAN_COMMIT(pRExC_state,data,minlenp);
3489                 data->pos_min++;
3490             }
3491             min++;
3492             if (flags & SCF_DO_STCLASS) {
3493                 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
3494
3495                 /* Some of the logic below assumes that switching
3496                    locale on will only add false positives. */
3497                 switch (PL_regkind[OP(scan)]) {
3498                 case SANY:
3499                 default:
3500                   do_default:
3501                     /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
3502                     if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3503                         cl_anything(pRExC_state, data->start_class);
3504                     break;
3505                 case REG_ANY:
3506                     if (OP(scan) == SANY)
3507                         goto do_default;
3508                     if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
3509                         value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
3510                                  || (data->start_class->flags & ANYOF_CLASS));
3511                         cl_anything(pRExC_state, data->start_class);
3512                     }
3513                     if (flags & SCF_DO_STCLASS_AND || !value)
3514                         ANYOF_BITMAP_CLEAR(data->start_class,'\n');
3515                     break;
3516                 case ANYOF:
3517                     if (flags & SCF_DO_STCLASS_AND)
3518                         cl_and(data->start_class,
3519                                (struct regnode_charclass_class*)scan);
3520                     else
3521                         cl_or(pRExC_state, data->start_class,
3522                               (struct regnode_charclass_class*)scan);
3523                     break;
3524                 case ALNUM:
3525                     if (flags & SCF_DO_STCLASS_AND) {
3526                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
3527                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
3528                             for (value = 0; value < 256; value++)
3529                                 if (!isALNUM(value))
3530                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3531                         }
3532                     }
3533                     else {
3534                         if (data->start_class->flags & ANYOF_LOCALE)
3535                             ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
3536                         else {
3537                             for (value = 0; value < 256; value++)
3538                                 if (isALNUM(value))
3539                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3540                         }
3541                     }
3542                     break;
3543                 case ALNUML:
3544                     if (flags & SCF_DO_STCLASS_AND) {
3545                         if (data->start_class->flags & ANYOF_LOCALE)
3546                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
3547                     }
3548                     else {
3549                         ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
3550                         data->start_class->flags |= ANYOF_LOCALE;
3551                     }
3552                     break;
3553                 case NALNUM:
3554                     if (flags & SCF_DO_STCLASS_AND) {
3555                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
3556                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
3557                             for (value = 0; value < 256; value++)
3558                                 if (isALNUM(value))
3559                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3560                         }
3561                     }
3562                     else {
3563                         if (data->start_class->flags & ANYOF_LOCALE)
3564                             ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
3565                         else {
3566                             for (value = 0; value < 256; value++)
3567                                 if (!isALNUM(value))
3568                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3569                         }
3570                     }
3571                     break;
3572                 case NALNUML:
3573                     if (flags & SCF_DO_STCLASS_AND) {
3574                         if (data->start_class->flags & ANYOF_LOCALE)
3575                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
3576                     }
3577                     else {
3578                         data->start_class->flags |= ANYOF_LOCALE;
3579                         ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
3580                     }
3581                     break;
3582                 case SPACE:
3583                     if (flags & SCF_DO_STCLASS_AND) {
3584                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
3585                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
3586                             for (value = 0; value < 256; value++)
3587                                 if (!isSPACE(value))
3588                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3589                         }
3590                     }
3591                     else {
3592                         if (data->start_class->flags & ANYOF_LOCALE)
3593                             ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
3594                         else {
3595                             for (value = 0; value < 256; value++)
3596                                 if (isSPACE(value))
3597                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3598                         }
3599                     }
3600                     break;
3601                 case SPACEL:
3602                     if (flags & SCF_DO_STCLASS_AND) {
3603                         if (data->start_class->flags & ANYOF_LOCALE)
3604                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
3605                     }
3606                     else {
3607                         data->start_class->flags |= ANYOF_LOCALE;
3608                         ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
3609                     }
3610                     break;
3611                 case NSPACE:
3612                     if (flags & SCF_DO_STCLASS_AND) {
3613                         if (!(data->start_class->flags & ANYOF_LOCALE)) {
3614                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3615                             for (value = 0; value < 256; value++)
3616                                 if (isSPACE(value))
3617                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3618                         }
3619                     }
3620                     else {
3621                         if (data->start_class->flags & ANYOF_LOCALE)
3622                             ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3623                         else {
3624                             for (value = 0; value < 256; value++)
3625                                 if (!isSPACE(value))
3626                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3627                         }
3628                     }
3629                     break;
3630                 case NSPACEL:
3631                     if (flags & SCF_DO_STCLASS_AND) {
3632                         if (data->start_class->flags & ANYOF_LOCALE) {
3633                             ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3634                             for (value = 0; value < 256; value++)
3635                                 if (!isSPACE(value))
3636                                     ANYOF_BITMAP_CLEAR(data->start_class, value);
3637                         }
3638                     }
3639                     else {
3640                         data->start_class->flags |= ANYOF_LOCALE;
3641                         ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3642                     }
3643                     break;
3644                 case DIGIT:
3645                     if (flags & SCF_DO_STCLASS_AND) {
3646                         ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
3647                         for (value = 0; value < 256; value++)
3648                             if (!isDIGIT(value))
3649                                 ANYOF_BITMAP_CLEAR(data->start_class, value);
3650                     }
3651                     else {
3652                         if (data->start_class->flags & ANYOF_LOCALE)
3653                             ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
3654                         else {
3655                             for (value = 0; value < 256; value++)
3656                                 if (isDIGIT(value))
3657                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3658                         }
3659                     }
3660                     break;
3661                 case NDIGIT:
3662                     if (flags & SCF_DO_STCLASS_AND) {
3663                         ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
3664                         for (value = 0; value < 256; value++)
3665                             if (isDIGIT(value))
3666                                 ANYOF_BITMAP_CLEAR(data->start_class, value);
3667                     }
3668                     else {
3669                         if (data->start_class->flags & ANYOF_LOCALE)
3670                             ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
3671                         else {
3672                             for (value = 0; value < 256; value++)
3673                                 if (!isDIGIT(value))
3674                                     ANYOF_BITMAP_SET(data->start_class, value);                 
3675                         }
3676                     }
3677                     break;
3678                 CASE_SYNST_FNC(VERTWS);
3679                 CASE_SYNST_FNC(HORIZWS);
3680                 
3681                 }
3682                 if (flags & SCF_DO_STCLASS_OR)
3683                     cl_and(data->start_class, and_withp);
3684                 flags &= ~SCF_DO_STCLASS;
3685             }
3686         }
3687         else if (PL_regkind[OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
3688             data->flags |= (OP(scan) == MEOL
3689                             ? SF_BEFORE_MEOL
3690                             : SF_BEFORE_SEOL);
3691         }
3692         else if (  PL_regkind[OP(scan)] == BRANCHJ
3693                  /* Lookbehind, or need to calculate parens/evals/stclass: */
3694                    && (scan->flags || data || (flags & SCF_DO_STCLASS))
3695                    && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
3696             if ( !PERL_ENABLE_POSITIVE_ASSERTION_STUDY 
3697                 || OP(scan) == UNLESSM )
3698             {
3699                 /* Negative Lookahead/lookbehind
3700                    In this case we can't do fixed string optimisation.
3701                 */
3702
3703                 I32 deltanext, minnext, fake = 0;
3704                 regnode *nscan;
3705                 struct regnode_charclass_class intrnl;
3706                 int f = 0;
3707
3708                 data_fake.flags = 0;
3709                 if (data) {
3710                     data_fake.whilem_c = data->whilem_c;
3711                     data_fake.last_closep = data->last_closep;
3712                 }
3713                 else
3714                     data_fake.last_closep = &fake;
3715                 data_fake.pos_delta = delta;
3716                 if ( flags & SCF_DO_STCLASS && !scan->flags
3717                      && OP(scan) == IFMATCH ) { /* Lookahead */
3718                     cl_init(pRExC_state, &intrnl);
3719                     data_fake.start_class = &intrnl;
3720                     f |= SCF_DO_STCLASS_AND;
3721                 }
3722                 if (flags & SCF_WHILEM_VISITED_POS)
3723                     f |= SCF_WHILEM_VISITED_POS;
3724                 next = regnext(scan);
3725                 nscan = NEXTOPER(NEXTOPER(scan));
3726                 minnext = study_chunk(pRExC_state, &nscan, minlenp, &deltanext, 
3727                     last, &data_fake, stopparen, recursed, NULL, f, depth+1);
3728                 if (scan->flags) {
3729                     if (deltanext) {
3730                         FAIL("Variable length lookbehind not implemented");
3731                     }
3732                     else if (minnext > (I32)U8_MAX) {
3733                         FAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
3734                     }
3735                     scan->flags = (U8)minnext;
3736                 }
3737                 if (data) {
3738                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3739                         pars++;
3740                     if (data_fake.flags & SF_HAS_EVAL)
3741                         data->flags |= SF_HAS_EVAL;
3742                     data->whilem_c = data_fake.whilem_c;
3743                 }
3744                 if (f & SCF_DO_STCLASS_AND) {
3745                     if (flags & SCF_DO_STCLASS_OR) {
3746                         /* OR before, AND after: ideally we would recurse with
3747                          * data_fake to get the AND applied by study of the
3748                          * remainder of the pattern, and then derecurse;
3749                          * *** HACK *** for now just treat as "no information".
3750                          * See [perl #56690].
3751                          */
3752                         cl_init(pRExC_state, data->start_class);
3753                     }  else {
3754                         /* AND before and after: combine and continue */
3755                         const int was = (data->start_class->flags & ANYOF_EOS);
3756
3757                         cl_and(data->start_class, &intrnl);
3758                         if (was)
3759                             data->start_class->flags |= ANYOF_EOS;
3760                     }
3761                 }
3762             }
3763 #if PERL_ENABLE_POSITIVE_ASSERTION_STUDY
3764             else {
3765                 /* Positive Lookahead/lookbehind
3766                    In this case we can do fixed string optimisation,
3767                    but we must be careful about it. Note in the case of
3768                    lookbehind the positions will be offset by the minimum
3769                    length of the pattern, something we won't know about
3770                    until after the recurse.
3771                 */
3772                 I32 deltanext, fake = 0;
3773                 regnode *nscan;
3774                 struct regnode_charclass_class intrnl;
3775                 int f = 0;
3776                 /* We use SAVEFREEPV so that when the full compile 
3777                     is finished perl will clean up the allocated 
3778                     minlens when its all done. This was we don't
3779                     have to worry about freeing them when we know
3780                     they wont be used, which would be a pain.
3781                  */
3782                 I32 *minnextp;
3783                 Newx( minnextp, 1, I32 );
3784                 SAVEFREEPV(minnextp);
3785
3786                 if (data) {
3787                     StructCopy(data, &data_fake, scan_data_t);
3788                     if ((flags & SCF_DO_SUBSTR) && data->last_found) {
3789                         f |= SCF_DO_SUBSTR;
3790                         if (scan->flags) 
3791                             SCAN_COMMIT(pRExC_state, &data_fake,minlenp);
3792                         data_fake.last_found=newSVsv(data->last_found);
3793                     }
3794                 }
3795                 else
3796                     data_fake.last_closep = &fake;
3797                 data_fake.flags = 0;
3798                 data_fake.pos_delta = delta;
3799                 if (is_inf)
3800                     data_fake.flags |= SF_IS_INF;
3801                 if ( flags & SCF_DO_STCLASS && !scan->flags
3802                      && OP(scan) == IFMATCH ) { /* Lookahead */
3803                     cl_init(pRExC_state, &intrnl);
3804                     data_fake.start_class = &intrnl;
3805                     f |= SCF_DO_STCLASS_AND;
3806                 }
3807                 if (flags & SCF_WHILEM_VISITED_POS)
3808                     f |= SCF_WHILEM_VISITED_POS;
3809                 next = regnext(scan);
3810                 nscan = NEXTOPER(NEXTOPER(scan));
3811
3812                 *minnextp = study_chunk(pRExC_state, &nscan, minnextp, &deltanext, 
3813                     last, &data_fake, stopparen, recursed, NULL, f,depth+1);
3814                 if (scan->flags) {
3815                     if (deltanext) {
3816                         FAIL("Variable length lookbehind not implemented");
3817                     }
3818                     else if (*minnextp > (I32)U8_MAX) {
3819                         FAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
3820                     }
3821                     scan->flags = (U8)*minnextp;
3822                 }
3823
3824                 *minnextp += min;
3825
3826                 if (f & SCF_DO_STCLASS_AND) {
3827                     const int was = (data->start_class->flags & ANYOF_EOS);
3828
3829                     cl_and(data->start_class, &intrnl);
3830                     if (was)
3831                         data->start_class->flags |= ANYOF_EOS;
3832                 }
3833                 if (data) {
3834                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3835                         pars++;
3836                     if (data_fake.flags & SF_HAS_EVAL)
3837                         data->flags |= SF_HAS_EVAL;
3838                     data->whilem_c = data_fake.whilem_c;
3839                     if ((flags & SCF_DO_SUBSTR) && data_fake.last_found) {
3840                         if (RExC_rx->minlen<*minnextp)
3841                             RExC_rx->minlen=*minnextp;
3842                         SCAN_COMMIT(pRExC_state, &data_fake, minnextp);
3843                         SvREFCNT_dec(data_fake.last_found);
3844                         
3845                         if ( data_fake.minlen_fixed != minlenp ) 
3846                         {
3847                             data->offset_fixed= data_fake.offset_fixed;
3848                             data->minlen_fixed= data_fake.minlen_fixed;
3849                             data->lookbehind_fixed+= scan->flags;
3850                         }
3851                         if ( data_fake.minlen_float != minlenp )
3852                         {
3853                             data->minlen_float= data_fake.minlen_float;
3854                             data->offset_float_min=data_fake.offset_float_min;
3855                             data->offset_float_max=data_fake.offset_float_max;
3856                             data->lookbehind_float+= scan->flags;
3857                         }
3858                     }
3859                 }
3860
3861
3862             }
3863 #endif
3864         }
3865         else if (OP(scan) == OPEN) {
3866             if (stopparen != (I32)ARG(scan))
3867                 pars++;
3868         }
3869         else if (OP(scan) == CLOSE) {
3870             if (stopparen == (I32)ARG(scan)) {
3871                 break;
3872             }
3873             if ((I32)ARG(scan) == is_par) {
3874                 next = regnext(scan);
3875
3876                 if ( next && (OP(next) != WHILEM) && next < last)
3877                     is_par = 0;         /* Disable optimization */
3878             }
3879             if (data)
3880                 *(data->last_closep) = ARG(scan);
3881         }
3882         else if (OP(scan) == EVAL) {
3883                 if (data)
3884                     data->flags |= SF_HAS_EVAL;
3885         }
3886         else if ( PL_regkind[OP(scan)] == ENDLIKE ) {
3887             if (flags & SCF_DO_SUBSTR) {
3888                 SCAN_COMMIT(pRExC_state,data,minlenp);
3889                 flags &= ~SCF_DO_SUBSTR;
3890             }
3891             if (data && OP(scan)==ACCEPT) {
3892                 data->flags |= SCF_SEEN_ACCEPT;
3893                 if (stopmin > min)
3894                     stopmin = min;
3895             }
3896         }
3897         else if (OP(scan) == LOGICAL && scan->flags == 2) /* Embedded follows */
3898         {
3899                 if (flags & SCF_DO_SUBSTR) {
3900                     SCAN_COMMIT(pRExC_state,data,minlenp);
3901                     data->longest = &(data->longest_float);
3902                 }
3903                 is_inf = is_inf_internal = 1;
3904                 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3905                     cl_anything(pRExC_state, data->start_class);
3906                 flags &= ~SCF_DO_STCLASS;
3907         }
3908         else if (OP(scan) == GPOS) {
3909             if (!(RExC_rx->extflags & RXf_GPOS_FLOAT) &&
3910                 !(delta || is_inf || (data && data->pos_delta))) 
3911             {
3912                 if (!(RExC_rx->extflags & RXf_ANCH) && (flags & SCF_DO_SUBSTR))
3913                     RExC_rx->extflags |= RXf_ANCH_GPOS;
3914                 if (RExC_rx->gofs < (U32)min)
3915                     RExC_rx->gofs = min;
3916             } else {
3917                 RExC_rx->extflags |= RXf_GPOS_FLOAT;
3918                 RExC_rx->gofs = 0;
3919             }       
3920         }
3921 #ifdef TRIE_STUDY_OPT
3922 #ifdef FULL_TRIE_STUDY
3923         else if (PL_regkind[OP(scan)] == TRIE) {
3924             /* NOTE - There is similar code to this block above for handling
3925                BRANCH nodes on the initial study.  If you change stuff here
3926                check there too. */
3927             regnode *trie_node= scan;
3928             regnode *tail= regnext(scan);
3929             reg_trie_data *trie = (reg_trie_data*)RExC_rxi->data->data[ ARG(scan) ];
3930             I32 max1 = 0, min1 = I32_MAX;
3931             struct regnode_charclass_class accum;
3932
3933             if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
3934                 SCAN_COMMIT(pRExC_state, data,minlenp); /* Cannot merge strings after this. */
3935             if (flags & SCF_DO_STCLASS)
3936                 cl_init_zero(pRExC_state, &accum);
3937                 
3938             if (!trie->jump) {
3939                 min1= trie->minlen;
3940                 max1= trie->maxlen;
3941             } else {
3942                 const regnode *nextbranch= NULL;
3943                 U32 word;
3944                 
3945                 for ( word=1 ; word <= trie->wordcount ; word++) 
3946                 {
3947                     I32 deltanext=0, minnext=0, f = 0, fake;
3948                     struct regnode_charclass_class this_class;
3949                     
3950                     data_fake.flags = 0;
3951                     if (data) {
3952                         data_fake.whilem_c = data->whilem_c;
3953                         data_fake.last_closep = data->last_closep;
3954                     }
3955                     else
3956                         data_fake.last_closep = &fake;
3957                     data_fake.pos_delta = delta;
3958                     if (flags & SCF_DO_STCLASS) {
3959                         cl_init(pRExC_state, &this_class);
3960                         data_fake.start_class = &this_class;
3961                         f = SCF_DO_STCLASS_AND;
3962                     }
3963                     if (flags & SCF_WHILEM_VISITED_POS)
3964                         f |= SCF_WHILEM_VISITED_POS;
3965     
3966                     if (trie->jump[word]) {
3967                         if (!nextbranch)
3968                             nextbranch = trie_node + trie->jump[0];
3969                         scan= trie_node + trie->jump[word];
3970                         /* We go from the jump point to the branch that follows
3971                            it. Note this means we need the vestigal unused branches
3972                            even though they arent otherwise used.
3973                          */
3974                         minnext = study_chunk(pRExC_state, &scan, minlenp, 
3975                             &deltanext, (regnode *)nextbranch, &data_fake, 
3976                             stopparen, recursed, NULL, f,depth+1);
3977                     }
3978                     if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH)
3979                         nextbranch= regnext((regnode*)nextbranch);
3980                     
3981                     if (min1 > (I32)(minnext + trie->minlen))
3982                         min1 = minnext + trie->minlen;
3983                     if (max1 < (I32)(minnext + deltanext + trie->maxlen))
3984                         max1 = minnext + deltanext + trie->maxlen;
3985                     if (deltanext == I32_MAX)
3986                         is_inf = is_inf_internal = 1;
3987                     
3988                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3989                         pars++;
3990                     if (data_fake.flags & SCF_SEEN_ACCEPT) {
3991                         if ( stopmin > min + min1) 
3992                             stopmin = min + min1;
3993                         flags &= ~SCF_DO_SUBSTR;
3994                         if (data)
3995                             data->flags |= SCF_SEEN_ACCEPT;
3996                     }
3997                     if (data) {
3998                         if (data_fake.flags & SF_HAS_EVAL)
3999                             data->flags |= SF_HAS_EVAL;
4000                         data->whilem_c = data_fake.whilem_c;
4001                     }
4002                     if (flags & SCF_DO_STCLASS)
4003                         cl_or(pRExC_state, &accum, &this_class);
4004                 }
4005             }
4006             if (flags & SCF_DO_SUBSTR) {
4007                 data->pos_min += min1;
4008                 data->pos_delta += max1 - min1;
4009                 if (max1 != min1 || is_inf)
4010                     data->longest = &(data->longest_float);
4011             }
4012             min += min1;
4013             delta += max1 - min1;
4014             if (flags & SCF_DO_STCLASS_OR) {
4015                 cl_or(pRExC_state, data->start_class, &accum);
4016                 if (min1) {
4017                     cl_and(data->start_class, and_withp);
4018                     flags &= ~SCF_DO_STCLASS;
4019                 }
4020             }
4021             else if (flags & SCF_DO_STCLASS_AND) {
4022                 if (min1) {
4023                     cl_and(data->start_class, &accum);
4024                     flags &= ~SCF_DO_STCLASS;
4025                 }
4026                 else {
4027                     /* Switch to OR mode: cache the old value of
4028                      * data->start_class */
4029                     INIT_AND_WITHP;
4030                     StructCopy(data->start_class, and_withp,
4031                                struct regnode_charclass_class);
4032                     flags &= ~SCF_DO_STCLASS_AND;
4033                     StructCopy(&accum, data->start_class,
4034                                struct regnode_charclass_class);
4035                     flags |= SCF_DO_STCLASS_OR;
4036                     data->start_class->flags |= ANYOF_EOS;
4037                 }
4038             }
4039             scan= tail;
4040             continue;
4041         }
4042 #else
4043         else if (PL_regkind[OP(scan)] == TRIE) {
4044             reg_trie_data *trie = (reg_trie_data*)RExC_rxi->data->data[ ARG(scan) ];
4045             U8*bang=NULL;
4046             
4047             min += trie->minlen;
4048             delta += (trie->maxlen - trie->minlen);
4049             flags &= ~SCF_DO_STCLASS; /* xxx */
4050             if (flags & SCF_DO_SUBSTR) {
4051                 SCAN_COMMIT(pRExC_state,data,minlenp);  /* Cannot expect anything... */
4052                 data->pos_min += trie->minlen;
4053                 data->pos_delta += (trie->maxlen - trie->minlen);
4054                 if (trie->maxlen != trie->minlen)
4055                     data->longest = &(data->longest_float);
4056             }
4057             if (trie->jump) /* no more substrings -- for now /grr*/
4058                 flags &= ~SCF_DO_SUBSTR; 
4059         }
4060 #endif /* old or new */
4061 #endif /* TRIE_STUDY_OPT */     
4062
4063         /* Else: zero-length, ignore. */
4064         scan = regnext(scan);
4065     }
4066     if (frame) {
4067         last = frame->last;
4068         scan = frame->next;
4069         stopparen = frame->stop;
4070         frame = frame->prev;
4071         goto fake_study_recurse;
4072     }
4073
4074   finish:
4075     assert(!frame);
4076     DEBUG_STUDYDATA("pre-fin:",data,depth);
4077
4078     *scanp = scan;
4079     *deltap = is_inf_internal ? I32_MAX : delta;
4080     if (flags & SCF_DO_SUBSTR && is_inf)
4081         data->pos_delta = I32_MAX - data->pos_min;
4082     if (is_par > (I32)U8_MAX)
4083         is_par = 0;
4084     if (is_par && pars==1 && data) {
4085         data->flags |= SF_IN_PAR;
4086         data->flags &= ~SF_HAS_PAR;
4087     }
4088     else if (pars && data) {
4089         data->flags |= SF_HAS_PAR;
4090         data->flags &= ~SF_IN_PAR;
4091     }
4092     if (flags & SCF_DO_STCLASS_OR)
4093         cl_and(data->start_class, and_withp);
4094     if (flags & SCF_TRIE_RESTUDY)
4095         data->flags |=  SCF_TRIE_RESTUDY;
4096     
4097     DEBUG_STUDYDATA("post-fin:",data,depth);
4098     
4099     return min < stopmin ? min : stopmin;
4100 }
4101
4102 STATIC U32
4103 S_add_data(RExC_state_t *pRExC_state, U32 n, const char *s)
4104 {
4105     U32 count = RExC_rxi->data ? RExC_rxi->data->count : 0;
4106
4107     PERL_ARGS_ASSERT_ADD_DATA;
4108
4109     Renewc(RExC_rxi->data,
4110            sizeof(*RExC_rxi->data) + sizeof(void*) * (count + n - 1),
4111            char, struct reg_data);
4112     if(count)
4113         Renew(RExC_rxi->data->what, count + n, U8);
4114     else
4115         Newx(RExC_rxi->data->what, n, U8);
4116     RExC_rxi->data->count = count + n;
4117     Copy(s, RExC_rxi->data->what + count, n, U8);
4118     return count;
4119 }
4120
4121 /*XXX: todo make this not included in a non debugging perl */
4122 #ifndef PERL_IN_XSUB_RE
4123 void
4124 Perl_reginitcolors(pTHX)
4125 {
4126     dVAR;
4127     const char * const s = PerlEnv_getenv("PERL_RE_COLORS");
4128     if (s) {
4129         char *t = savepv(s);
4130         int i = 0;
4131         PL_colors[0] = t;
4132         while (++i < 6) {
4133             t = strchr(t, '\t');
4134             if (t) {
4135                 *t = '\0';
4136                 PL_colors[i] = ++t;
4137             }
4138             else
4139                 PL_colors[i] = t = (char *)"";
4140         }
4141     } else {
4142         int i = 0;
4143         while (i < 6)
4144             PL_colors[i++] = (char *)"";
4145     }
4146     PL_colorset = 1;
4147 }
4148 #endif
4149
4150
4151 #ifdef TRIE_STUDY_OPT
4152 #define CHECK_RESTUDY_GOTO                                  \
4153         if (                                                \
4154               (data.flags & SCF_TRIE_RESTUDY)               \
4155               && ! restudied++                              \
4156         )     goto reStudy
4157 #else
4158 #define CHECK_RESTUDY_GOTO
4159 #endif        
4160
4161 /*
4162  - pregcomp - compile a regular expression into internal code
4163  *
4164  * We can't allocate space until we know how big the compiled form will be,
4165  * but we can't compile it (and thus know how big it is) until we've got a
4166  * place to put the code.  So we cheat:  we compile it twice, once with code
4167  * generation turned off and size counting turned on, and once "for real".
4168  * This also means that we don't allocate space until we are sure that the
4169  * thing really will compile successfully, and we never have to move the
4170  * code and thus invalidate pointers into it.  (Note that it has to be in
4171  * one piece because free() must be able to free it all.) [NB: not true in perl]
4172  *
4173  * Beware that the optimization-preparation code in here knows about some
4174  * of the structure of the compiled regexp.  [I'll say.]
4175  */
4176
4177
4178
4179 #ifndef PERL_IN_XSUB_RE
4180 #define RE_ENGINE_PTR &PL_core_reg_engine
4181 #else
4182 extern const struct regexp_engine my_reg_engine;
4183 #define RE_ENGINE_PTR &my_reg_engine
4184 #endif
4185
4186 #ifndef PERL_IN_XSUB_RE 
4187 REGEXP *
4188 Perl_pregcomp(pTHX_ SV * const pattern, const U32 flags)
4189 {
4190     dVAR;
4191     HV * const table = GvHV(PL_hintgv);
4192
4193     PERL_ARGS_ASSERT_PREGCOMP;
4194
4195     /* Dispatch a request to compile a regexp to correct 
4196        regexp engine. */
4197     if (table) {
4198         SV **ptr= hv_fetchs(table, "regcomp", FALSE);
4199         GET_RE_DEBUG_FLAGS_DECL;
4200         if (ptr && SvIOK(*ptr) && SvIV(*ptr)) {
4201             const regexp_engine *eng=INT2PTR(regexp_engine*,SvIV(*ptr));
4202             DEBUG_COMPILE_r({
4203                 PerlIO_printf(Perl_debug_log, "Using engine %"UVxf"\n",
4204                     SvIV(*ptr));
4205             });            
4206             return CALLREGCOMP_ENG(eng, pattern, flags);
4207         } 
4208     }
4209     return Perl_re_compile(aTHX_ pattern, flags);
4210 }
4211 #endif
4212
4213 REGEXP *
4214 Perl_re_compile(pTHX_ SV * const pattern, U32 pm_flags)
4215 {
4216     dVAR;
4217     REGEXP *rx;
4218     struct regexp *r;
4219     register regexp_internal *ri;
4220     STRLEN plen;
4221     char  *exp = SvPV(pattern, plen);
4222     char* xend = exp + plen;
4223     regnode *scan;
4224     I32 flags;
4225     I32 minlen = 0;
4226     I32 sawplus = 0;
4227     I32 sawopen = 0;
4228     scan_data_t data;
4229     RExC_state_t RExC_state;
4230     RExC_state_t * const pRExC_state = &RExC_state;
4231 #ifdef TRIE_STUDY_OPT    
4232     int restudied= 0;
4233     RExC_state_t copyRExC_state;
4234 #endif    
4235     GET_RE_DEBUG_FLAGS_DECL;
4236
4237     PERL_ARGS_ASSERT_RE_COMPILE;
4238
4239     DEBUG_r(if (!PL_colorset) reginitcolors());
4240
4241     RExC_utf8 = RExC_orig_utf8 = SvUTF8(pattern);
4242
4243     DEBUG_COMPILE_r({
4244         SV *dsv= sv_newmortal();
4245         RE_PV_QUOTED_DECL(s, RExC_utf8,
4246             dsv, exp, plen, 60);
4247         PerlIO_printf(Perl_debug_log, "%sCompiling REx%s %s\n",
4248                        PL_colors[4],PL_colors[5],s);
4249     });
4250
4251 redo_first_pass:
4252     RExC_precomp = exp;
4253     RExC_flags = pm_flags;
4254     RExC_sawback = 0;
4255
4256     RExC_seen = 0;
4257     RExC_seen_zerolen = *exp == '^' ? -1 : 0;
4258     RExC_seen_evals = 0;
4259     RExC_extralen = 0;
4260
4261     /* First pass: determine size, legality. */
4262     RExC_parse = exp;
4263     RExC_start = exp;
4264     RExC_end = xend;
4265     RExC_naughty = 0;
4266     RExC_npar = 1;
4267     RExC_nestroot = 0;
4268     RExC_size = 0L;
4269     RExC_emit = &PL_regdummy;
4270     RExC_whilem_seen = 0;
4271     RExC_charnames = NULL;
4272     RExC_open_parens = NULL;
4273     RExC_close_parens = NULL;
4274     RExC_opend = NULL;
4275     RExC_paren_names = NULL;
4276 #ifdef DEBUGGING
4277     RExC_paren_name_list = NULL;
4278 #endif
4279     RExC_recurse = NULL;
4280     RExC_recurse_count = 0;
4281
4282 #if 0 /* REGC() is (currently) a NOP at the first pass.
4283        * Clever compilers notice this and complain. --jhi */
4284     REGC((U8)REG_MAGIC, (char*)RExC_emit);
4285 #endif
4286     DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "Starting first pass (sizing)\n"));
4287     if (reg(pRExC_state, 0, &flags,1) == NULL) {
4288         RExC_precomp = NULL;
4289         return(NULL);
4290     }
4291     if (RExC_utf8 && !RExC_orig_utf8) {
4292         /* It's possible to write a regexp in ascii that represents Unicode
4293         codepoints outside of the byte range, such as via \x{100}. If we
4294         detect such a sequence we have to convert the entire pattern to utf8
4295         and then recompile, as our sizing calculation will have been based
4296         on 1 byte == 1 character, but we will need to use utf8 to encode
4297         at least some part of the pattern, and therefore must convert the whole
4298         thing.
4299         XXX: somehow figure out how to make this less expensive...
4300         -- dmq */
4301         STRLEN len = plen;
4302         DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log,
4303             "UTF8 mismatch! Converting to utf8 for resizing and compile\n"));
4304         exp = (char*)Perl_bytes_to_utf8(aTHX_ (U8*)exp, &len);
4305         xend = exp + len;
4306         RExC_orig_utf8 = RExC_utf8;
4307         SAVEFREEPV(exp);
4308         goto redo_first_pass;
4309     }
4310     DEBUG_PARSE_r({
4311         PerlIO_printf(Perl_debug_log, 
4312             "Required size %"IVdf" nodes\n"
4313             "Starting second pass (creation)\n", 
4314             (IV)RExC_size);
4315         RExC_lastnum=0; 
4316         RExC_lastparse=NULL; 
4317     });
4318     /* Small enough for pointer-storage convention?
4319        If extralen==0, this means that we will not need long jumps. */
4320     if (RExC_size >= 0x10000L && RExC_extralen)
4321         RExC_size += RExC_extralen;
4322     else
4323         RExC_extralen = 0;
4324     if (RExC_whilem_seen > 15)
4325         RExC_whilem_seen = 15;
4326
4327     /* Allocate space and zero-initialize. Note, the two step process 
4328        of zeroing when in debug mode, thus anything assigned has to 
4329        happen after that */
4330     rx = (REGEXP*) newSV_type(SVt_REGEXP);
4331     r = (struct regexp*)SvANY(rx);
4332     Newxc(ri, sizeof(regexp_internal) + (unsigned)RExC_size * sizeof(regnode),
4333          char, regexp_internal);
4334     if ( r == NULL || ri == NULL )
4335         FAIL("Regexp out of space");
4336 #ifdef DEBUGGING
4337     /* avoid reading uninitialized memory in DEBUGGING code in study_chunk() */
4338     Zero(ri, sizeof(regexp_internal) + (unsigned)RExC_size * sizeof(regnode), char);
4339 #else 
4340     /* bulk initialize base fields with 0. */
4341     Zero(ri, sizeof(regexp_internal), char);        
4342 #endif
4343
4344     /* non-zero initialization begins here */
4345     RXi_SET( r, ri );
4346     r->engine= RE_ENGINE_PTR;
4347     r->extflags = pm_flags;
4348     {
4349         bool has_p     = ((r->extflags & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY);
4350         bool has_minus = ((r->extflags & RXf_PMf_STD_PMMOD) != RXf_PMf_STD_PMMOD);
4351         bool has_runon = ((RExC_seen & REG_SEEN_RUN_ON_COMMENT)==REG_SEEN_RUN_ON_COMMENT);
4352         U16 reganch = (U16)((r->extflags & RXf_PMf_STD_PMMOD)
4353                             >> RXf_PMf_STD_PMMOD_SHIFT);
4354         const char *fptr = STD_PAT_MODS;        /*"msix"*/
4355         char *p;
4356         const STRLEN wraplen = plen + has_minus + has_p + has_runon
4357             + (sizeof(STD_PAT_MODS) - 1)
4358             + (sizeof("(?:)") - 1);
4359
4360         p = sv_grow(MUTABLE_SV(rx), wraplen + 1);
4361         SvCUR_set(rx, wraplen);
4362         SvPOK_on(rx);
4363         SvFLAGS(rx) |= SvUTF8(pattern);
4364         *p++='('; *p++='?';
4365         if (has_p)
4366             *p++ = KEEPCOPY_PAT_MOD; /*'p'*/
4367         {
4368             char *r = p + (sizeof(STD_PAT_MODS) - 1) + has_minus - 1;
4369             char *colon = r + 1;
4370             char ch;
4371
4372             while((ch = *fptr++)) {
4373                 if(reganch & 1)
4374                     *p++ = ch;
4375                 else
4376                     *r-- = ch;
4377                 reganch >>= 1;
4378             }
4379             if(has_minus) {
4380                 *r = '-';
4381                 p = colon;
4382             }
4383         }
4384
4385         *p++ = ':';
4386         Copy(RExC_precomp, p, plen, char);
4387         assert ((RX_WRAPPED(rx) - p) < 16);
4388         r->pre_prefix = p - RX_WRAPPED(rx);
4389         p += plen;
4390         if (has_runon)
4391             *p++ = '\n';
4392         *p++ = ')';
4393         *p = 0;
4394     }
4395
4396     r->intflags = 0;
4397     r->nparens = RExC_npar - 1; /* set early to validate backrefs */
4398     
4399     if (RExC_seen & REG_SEEN_RECURSE) {
4400         Newxz(RExC_open_parens, RExC_npar,regnode *);
4401         SAVEFREEPV(RExC_open_parens);
4402         Newxz(RExC_close_parens,RExC_npar,regnode *);
4403         SAVEFREEPV(RExC_close_parens);
4404     }
4405
4406     /* Useful during FAIL. */
4407 #ifdef RE_TRACK_PATTERN_OFFSETS
4408     Newxz(ri->u.offsets, 2*RExC_size+1, U32); /* MJD 20001228 */
4409     DEBUG_OFFSETS_r(PerlIO_printf(Perl_debug_log,
4410                           "%s %"UVuf" bytes for offset annotations.\n",
4411                           ri->u.offsets ? "Got" : "Couldn't get",
4412                           (UV)((2*RExC_size+1) * sizeof(U32))));
4413 #endif
4414     SetProgLen(ri,RExC_size);
4415     RExC_rx_sv = rx;
4416     RExC_rx = r;
4417     RExC_rxi = ri;
4418
4419     /* Second pass: emit code. */
4420     RExC_flags = pm_flags;      /* don't let top level (?i) bleed */
4421     RExC_parse = exp;
4422     RExC_end = xend;
4423     RExC_naughty = 0;
4424     RExC_npar = 1;
4425     RExC_emit_start = ri->program;
4426     RExC_emit = ri->program;
4427     RExC_emit_bound = ri->program + RExC_size + 1;
4428
4429     /* Store the count of eval-groups for security checks: */
4430     RExC_rx->seen_evals = RExC_seen_evals;
4431     REGC((U8)REG_MAGIC, (char*) RExC_emit++);
4432     if (reg(pRExC_state, 0, &flags,1) == NULL) {
4433         ReREFCNT_dec(rx);   
4434         return(NULL);
4435     }
4436     /* XXXX To minimize changes to RE engine we always allocate
4437        3-units-long substrs field. */
4438     Newx(r->substrs, 1, struct reg_substr_data);
4439     if (RExC_recurse_count) {
4440         Newxz(RExC_recurse,RExC_recurse_count,regnode *);
4441         SAVEFREEPV(RExC_recurse);
4442     }
4443
4444 reStudy:
4445     r->minlen = minlen = sawplus = sawopen = 0;
4446     Zero(r->substrs, 1, struct reg_substr_data);
4447
4448 #ifdef TRIE_STUDY_OPT
4449     if (!restudied) {
4450         StructCopy(&zero_scan_data, &data, scan_data_t);
4451         copyRExC_state = RExC_state;
4452     } else {
4453         U32 seen=RExC_seen;
4454         DEBUG_OPTIMISE_r(PerlIO_printf(Perl_debug_log,"Restudying\n"));
4455         
4456         RExC_state = copyRExC_state;
4457         if (seen & REG_TOP_LEVEL_BRANCHES) 
4458             RExC_seen |= REG_TOP_LEVEL_BRANCHES;
4459         else
4460             RExC_seen &= ~REG_TOP_LEVEL_BRANCHES;
4461         if (data.last_found) {
4462             SvREFCNT_dec(data.longest_fixed);
4463             SvREFCNT_dec(data.longest_float);
4464             SvREFCNT_dec(data.last_found);
4465         }
4466         StructCopy(&zero_scan_data, &data, scan_data_t);
4467     }
4468 #else
4469     StructCopy(&zero_scan_data, &data, scan_data_t);
4470 #endif    
4471
4472     /* Dig out information for optimizations. */
4473     r->extflags = RExC_flags; /* was pm_op */
4474     /*dmq: removed as part of de-PMOP: pm->op_pmflags = RExC_flags; */
4475  
4476     if (UTF)
4477         SvUTF8_on(rx);  /* Unicode in it? */
4478     ri->regstclass = NULL;
4479     if (RExC_naughty >= 10)     /* Probably an expensive pattern. */
4480         r->intflags |= PREGf_NAUGHTY;
4481     scan = ri->program + 1;             /* First BRANCH. */
4482
4483     /* testing for BRANCH here tells us whether there is "must appear"
4484        data in the pattern. If there is then we can use it for optimisations */
4485     if (!(RExC_seen & REG_TOP_LEVEL_BRANCHES)) { /*  Only one top-level choice. */
4486         I32 fake;
4487         STRLEN longest_float_length, longest_fixed_length;
4488         struct regnode_charclass_class ch_class; /* pointed to by data */
4489         int stclass_flag;
4490         I32 last_close = 0; /* pointed to by data */
4491         regnode *first= scan;
4492         regnode *first_next= regnext(first);
4493         
4494         /*
4495          * Skip introductions and multiplicators >= 1
4496          * so that we can extract the 'meat' of the pattern that must 
4497          * match in the large if() sequence following.
4498          * NOTE that EXACT is NOT covered here, as it is normally
4499          * picked up by the optimiser separately. 
4500          *
4501          * This is unfortunate as the optimiser isnt handling lookahead
4502          * properly currently.
4503          *
4504          */
4505         while ((OP(first) == OPEN && (sawopen = 1)) ||
4506                /* An OR of *one* alternative - should not happen now. */
4507             (OP(first) == BRANCH && OP(first_next) != BRANCH) ||
4508             /* for now we can't handle lookbehind IFMATCH*/
4509             (OP(first) == IFMATCH && !first->flags) || 
4510             (OP(first) == PLUS) ||
4511             (OP(first) == MINMOD) ||
4512                /* An {n,m} with n>0 */
4513             (PL_regkind[OP(first)] == CURLY && ARG1(first) > 0) ||
4514             (OP(first) == NOTHING && PL_regkind[OP(first_next)] != END ))
4515         {
4516                 /* 
4517                  * the only op that could be a regnode is PLUS, all the rest
4518                  * will be regnode_1 or regnode_2.
4519                  *
4520                  */
4521                 if (OP(first) == PLUS)
4522                     sawplus = 1;
4523                 else
4524                     first += regarglen[OP(first)];
4525                 
4526                 first = NEXTOPER(first);
4527                 first_next= regnext(first);
4528         }
4529
4530         /* Starting-point info. */
4531       again:
4532         DEBUG_PEEP("first:",first,0);
4533         /* Ignore EXACT as we deal with it later. */
4534         if (PL_regkind[OP(first)] == EXACT) {
4535             if (OP(first) == EXACT)
4536                 NOOP;   /* Empty, get anchored substr later. */
4537             else if ((OP(first) == EXACTF || OP(first) == EXACTFL))
4538                 ri->regstclass = first;
4539         }
4540 #ifdef TRIE_STCLASS     
4541         else if (PL_regkind[OP(first)] == TRIE &&
4542                 ((reg_trie_data *)ri->data->data[ ARG(first) ])->minlen>0) 
4543         {
4544             regnode *trie_op;
4545             /* this can happen only on restudy */
4546             if ( OP(first) == TRIE ) {
4547                 struct regnode_1 *trieop = (struct regnode_1 *)
4548                     PerlMemShared_calloc(1, sizeof(struct regnode_1));
4549                 StructCopy(first,trieop,struct regnode_1);
4550                 trie_op=(regnode *)trieop;
4551             } else {
4552                 struct regnode_charclass *trieop = (struct regnode_charclass *)
4553                     PerlMemShared_calloc(1, sizeof(struct regnode_charclass));
4554                 StructCopy(first,trieop,struct regnode_charclass);
4555                 trie_op=(regnode *)trieop;
4556             }
4557             OP(trie_op)+=2;
4558             make_trie_failtable(pRExC_state, (regnode *)first, trie_op, 0);
4559             ri->regstclass = trie_op;
4560         }
4561 #endif  
4562         else if (strchr((const char*)PL_simple,OP(first)))
4563             ri->regstclass = first;
4564         else if (PL_regkind[OP(first)] == BOUND ||
4565                  PL_regkind[OP(first)] == NBOUND)
4566             ri->regstclass = first;
4567         else if (PL_regkind[OP(first)] == BOL) {
4568             r->extflags |= (OP(first) == MBOL
4569                            ? RXf_ANCH_MBOL
4570                            : (OP(first) == SBOL
4571                               ? RXf_ANCH_SBOL
4572                               : RXf_ANCH_BOL));
4573             first = NEXTOPER(first);
4574             goto again;
4575         }
4576         else if (OP(first) == GPOS) {
4577             r->extflags |= RXf_ANCH_GPOS;
4578             first = NEXTOPER(first);
4579             goto again;
4580         }
4581         else if ((!sawopen || !RExC_sawback) &&
4582             (OP(first) == STAR &&
4583             PL_regkind[OP(NEXTOPER(first))] == REG_ANY) &&
4584             !(r->extflags & RXf_ANCH) && !(RExC_seen & REG_SEEN_EVAL))
4585         {
4586             /* turn .* into ^.* with an implied $*=1 */
4587             const int type =
4588                 (OP(NEXTOPER(first)) == REG_ANY)
4589                     ? RXf_ANCH_MBOL
4590                     : RXf_ANCH_SBOL;
4591             r->extflags |= type;
4592             r->intflags |= PREGf_IMPLICIT;
4593             first = NEXTOPER(first);
4594             goto again;
4595         }
4596         if (sawplus && (!sawopen || !RExC_sawback)
4597             && !(RExC_seen & REG_SEEN_EVAL)) /* May examine pos and $& */
4598             /* x+ must match at the 1st pos of run of x's */
4599             r->intflags |= PREGf_SKIP;
4600
4601         /* Scan is after the zeroth branch, first is atomic matcher. */
4602 #ifdef TRIE_STUDY_OPT
4603         DEBUG_PARSE_r(
4604             if (!restudied)
4605                 PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
4606                               (IV)(first - scan + 1))
4607         );
4608 #else
4609         DEBUG_PARSE_r(
4610             PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
4611                 (IV)(first - scan + 1))
4612         );
4613 #endif
4614
4615
4616         /*
4617         * If there's something expensive in the r.e., find the
4618         * longest literal string that must appear and make it the
4619         * regmust.  Resolve ties in favor of later strings, since
4620         * the regstart check works with the beginning of the r.e.
4621         * and avoiding duplication strengthens checking.  Not a
4622         * strong reason, but sufficient in the absence of others.
4623         * [Now we resolve ties in favor of the earlier string if
4624         * it happens that c_offset_min has been invalidated, since the
4625         * earlier string may buy us something the later one won't.]
4626         */
4627         
4628         data.longest_fixed = newSVpvs("");
4629         data.longest_float = newSVpvs("");
4630         data.last_found = newSVpvs("");
4631         data.longest = &(data.longest_fixed);
4632         first = scan;
4633         if (!ri->regstclass) {
4634             cl_init(pRExC_state, &ch_class);
4635             data.start_class = &ch_class;
4636             stclass_flag = SCF_DO_STCLASS_AND;
4637         } else                          /* XXXX Check for BOUND? */
4638             stclass_flag = 0;
4639         data.last_closep = &last_close;
4640         
4641         minlen = study_chunk(pRExC_state, &first, &minlen, &fake, scan + RExC_size, /* Up to end */
4642             &data, -1, NULL, NULL,
4643             SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag,0);
4644
4645         
4646         CHECK_RESTUDY_GOTO;
4647
4648
4649         if ( RExC_npar == 1 && data.longest == &(data.longest_fixed)
4650              && data.last_start_min == 0 && data.last_end > 0
4651              && !RExC_seen_zerolen
4652              && !(RExC_seen & REG_SEEN_VERBARG)
4653              && (!(RExC_seen & REG_SEEN_GPOS) || (r->extflags & RXf_ANCH_GPOS)))
4654             r->extflags |= RXf_CHECK_ALL;
4655         scan_commit(pRExC_state, &data,&minlen,0);
4656         SvREFCNT_dec(data.last_found);
4657
4658         /* Note that code very similar to this but for anchored string 
4659            follows immediately below, changes may need to be made to both. 
4660            Be careful. 
4661          */
4662         longest_float_length = CHR_SVLEN(data.longest_float);
4663         if (longest_float_length
4664             || (data.flags & SF_FL_BEFORE_EOL
4665                 && (!(data.flags & SF_FL_BEFORE_MEOL)
4666                     || (RExC_flags & RXf_PMf_MULTILINE)))) 
4667         {
4668             I32 t,ml;
4669
4670             if (SvCUR(data.longest_fixed)  /* ok to leave SvCUR */
4671                 && data.offset_fixed == data.offset_float_min
4672                 && SvCUR(data.longest_fixed) == SvCUR(data.longest_float))
4673                     goto remove_float;          /* As in (a)+. */
4674
4675             /* copy the information about the longest float from the reg_scan_data
4676                over to the program. */
4677             if (SvUTF8(data.longest_float)) {
4678                 r->float_utf8 = data.longest_float;
4679                 r->float_substr = NULL;
4680             } else {
4681                 r->float_substr = data.longest_float;
4682                 r->float_utf8 = NULL;
4683             }
4684             /* float_end_shift is how many chars that must be matched that 
4685                follow this item. We calculate it ahead of time as once the
4686                lookbehind offset is added in we lose the ability to correctly
4687                calculate it.*/
4688             ml = data.minlen_float ? *(data.minlen_float) 
4689                                    : (I32)longest_float_length;
4690             r->float_end_shift = ml - data.offset_float_min
4691                 - longest_float_length + (SvTAIL(data.longest_float) != 0)
4692                 + data.lookbehind_float;
4693             r->float_min_offset = data.offset_float_min - data.lookbehind_float;
4694             r->float_max_offset = data.offset_float_max;
4695             if (data.offset_float_max < I32_MAX) /* Don't offset infinity */
4696                 r->float_max_offset -= data.lookbehind_float;
4697             
4698             t = (data.flags & SF_FL_BEFORE_EOL /* Can't have SEOL and MULTI */
4699                        && (!(data.flags & SF_FL_BEFORE_MEOL)
4700                            || (RExC_flags & RXf_PMf_MULTILINE)));
4701             fbm_compile(data.longest_float, t ? FBMcf_TAIL : 0);
4702         }
4703         else {
4704           remove_float:
4705             r->float_substr = r->float_utf8 = NULL;
4706             SvREFCNT_dec(data.longest_float);
4707             longest_float_length = 0;
4708         }
4709
4710         /* Note that code very similar to this but for floating string 
4711            is immediately above, changes may need to be made to both. 
4712            Be careful. 
4713          */
4714         longest_fixed_length = CHR_SVLEN(data.longest_fixed);
4715         if (longest_fixed_length
4716             || (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
4717                 && (!(data.flags & SF_FIX_BEFORE_MEOL)
4718                     || (RExC_flags & RXf_PMf_MULTILINE)))) 
4719         {
4720             I32 t,ml;
4721
4722             /* copy the information about the longest fixed 
4723                from the reg_scan_data over to the program. */
4724             if (SvUTF8(data.longest_fixed)) {
4725                 r->anchored_utf8 = data.longest_fixed;
4726                 r->anchored_substr = NULL;
4727             } else {
4728                 r->anchored_substr = data.longest_fixed;
4729                 r->anchored_utf8 = NULL;
4730             }
4731             /* fixed_end_shift is how many chars that must be matched that 
4732                follow this item. We calculate it ahead of time as once the
4733                lookbehind offset is added in we lose the ability to correctly
4734                calculate it.*/
4735             ml = data.minlen_fixed ? *(data.minlen_fixed) 
4736                                    : (I32)longest_fixed_length;
4737             r->anchored_end_shift = ml - data.offset_fixed
4738                 - longest_fixed_length + (SvTAIL(data.longest_fixed) != 0)
4739                 + data.lookbehind_fixed;
4740             r->anchored_offset = data.offset_fixed - data.lookbehind_fixed;
4741
4742             t = (data.flags & SF_FIX_BEFORE_EOL /* Can't have SEOL and MULTI */
4743                  && (!(data.flags & SF_FIX_BEFORE_MEOL)
4744                      || (RExC_flags & RXf_PMf_MULTILINE)));
4745             fbm_compile(data.longest_fixed, t ? FBMcf_TAIL : 0);
4746         }
4747         else {
4748             r->anchored_substr = r->anchored_utf8 = NULL;
4749             SvREFCNT_dec(data.longest_fixed);
4750             longest_fixed_length = 0;
4751         }
4752         if (ri->regstclass
4753             && (OP(ri->regstclass) == REG_ANY || OP(ri->regstclass) == SANY))
4754             ri->regstclass = NULL;
4755         if ((!(r->anchored_substr || r->anchored_utf8) || r->anchored_offset)
4756             && stclass_flag
4757             && !(data.start_class->flags & ANYOF_EOS)
4758             && !cl_is_anything(data.start_class))
4759         {
4760             const U32 n = add_data(pRExC_state, 1, "f");
4761
4762             Newx(RExC_rxi->data->data[n], 1,
4763                 struct regnode_charclass_class);
4764             StructCopy(data.start_class,
4765                        (struct regnode_charclass_class*)RExC_rxi->data->data[n],
4766                        struct regnode_charclass_class);
4767             ri->regstclass = (regnode*)RExC_rxi->data->data[n];
4768             r->intflags &= ~PREGf_SKIP; /* Used in find_byclass(). */
4769             DEBUG_COMPILE_r({ SV *sv = sv_newmortal();
4770                       regprop(r, sv, (regnode*)data.start_class);
4771                       PerlIO_printf(Perl_debug_log,
4772                                     "synthetic stclass \"%s\".\n",
4773                                     SvPVX_const(sv));});
4774         }
4775
4776         /* A temporary algorithm prefers floated substr to fixed one to dig more info. */
4777         if (longest_fixed_length > longest_float_length) {
4778             r->check_end_shift = r->anchored_end_shift;
4779             r->check_substr = r->anchored_substr;
4780             r->check_utf8 = r->anchored_utf8;
4781             r->check_offset_min = r->check_offset_max = r->anchored_offset;
4782             if (r->extflags & RXf_ANCH_SINGLE)
4783                 r->extflags |= RXf_NOSCAN;
4784         }
4785         else {
4786             r->check_end_shift = r->float_end_shift;
4787             r->check_substr = r->float_substr;
4788             r->check_utf8 = r->float_utf8;
4789             r->check_offset_min = r->float_min_offset;
4790             r->check_offset_max = r->float_max_offset;
4791         }
4792         /* XXXX Currently intuiting is not compatible with ANCH_GPOS.
4793            This should be changed ASAP!  */
4794         if ((r->check_substr || r->check_utf8) && !(r->extflags & RXf_ANCH_GPOS)) {
4795             r->extflags |= RXf_USE_INTUIT;
4796             if (SvTAIL(r->check_substr ? r->check_substr : r->check_utf8))
4797                 r->extflags |= RXf_INTUIT_TAIL;
4798         }
4799         /* XXX Unneeded? dmq (shouldn't as this is handled elsewhere)
4800         if ( (STRLEN)minlen < longest_float_length )
4801             minlen= longest_float_length;
4802         if ( (STRLEN)minlen < longest_fixed_length )
4803             minlen= longest_fixed_length;     
4804         */
4805     }
4806     else {
4807         /* Several toplevels. Best we can is to set minlen. */
4808         I32 fake;
4809         struct regnode_charclass_class ch_class;
4810         I32 last_close = 0;
4811         
4812         DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "\nMulti Top Level\n"));
4813
4814         scan = ri->program + 1;
4815         cl_init(pRExC_state, &ch_class);
4816         data.start_class = &ch_class;
4817         data.last_closep = &last_close;
4818
4819         
4820         minlen = study_chunk(pRExC_state, &scan, &minlen, &fake, scan + RExC_size,
4821             &data, -1, NULL, NULL, SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS,0);
4822         
4823         CHECK_RESTUDY_GOTO;
4824
4825         r->check_substr = r->check_utf8 = r->anchored_substr = r->anchored_utf8
4826                 = r->float_substr = r->float_utf8 = NULL;
4827         if (!(data.start_class->flags & ANYOF_EOS)
4828             && !cl_is_anything(data.start_class))
4829         {
4830             const U32 n = add_data(pRExC_state, 1, "f");
4831
4832             Newx(RExC_rxi->data->data[n], 1,
4833                 struct regnode_charclass_class);
4834             StructCopy(data.start_class,
4835                        (struct regnode_charclass_class*)RExC_rxi->data->data[n],
4836                        struct regnode_charclass_class);
4837             ri->regstclass = (regnode*)RExC_rxi->data->data[n];
4838             r->intflags &= ~PREGf_SKIP; /* Used in find_byclass(). */
4839             DEBUG_COMPILE_r({ SV* sv = sv_newmortal();
4840                       regprop(r, sv, (regnode*)data.start_class);
4841                       PerlIO_printf(Perl_debug_log,
4842                                     "synthetic stclass \"%s\".\n",
4843                                     SvPVX_const(sv));});
4844         }
4845     }
4846
4847     /* Guard against an embedded (?=) or (?<=) with a longer minlen than
4848        the "real" pattern. */
4849     DEBUG_OPTIMISE_r({
4850         PerlIO_printf(Perl_debug_log,"minlen: %"IVdf" r->minlen:%"IVdf"\n",
4851                       (IV)minlen, (IV)r->minlen);
4852     });
4853     r->minlenret = minlen;
4854     if (r->minlen < minlen) 
4855         r->minlen = minlen;
4856     
4857     if (RExC_seen & REG_SEEN_GPOS)
4858         r->extflags |= RXf_GPOS_SEEN;
4859     if (RExC_seen & REG_SEEN_LOOKBEHIND)
4860         r->extflags |= RXf_LOOKBEHIND_SEEN;
4861     if (RExC_seen & REG_SEEN_EVAL)
4862         r->extflags |= RXf_EVAL_SEEN;
4863     if (RExC_seen & REG_SEEN_CANY)
4864         r->extflags |= RXf_CANY_SEEN;
4865     if (RExC_seen & REG_SEEN_VERBARG)
4866         r->intflags |= PREGf_VERBARG_SEEN;
4867     if (RExC_seen & REG_SEEN_CUTGROUP)
4868         r->intflags |= PREGf_CUTGROUP_SEEN;
4869     if (RExC_paren_names)
4870         RXp_PAREN_NAMES(r) = MUTABLE_HV(SvREFCNT_inc(RExC_paren_names));
4871     else
4872         RXp_PAREN_NAMES(r) = NULL;
4873
4874 #ifdef STUPID_PATTERN_CHECKS            
4875     if (RX_PRELEN(rx) == 0)
4876         r->extflags |= RXf_NULL;
4877     if (r->extflags & RXf_SPLIT && RX_PRELEN(rx) == 1 && RX_PRECOMP(rx)[0] == ' ')
4878         /* XXX: this should happen BEFORE we compile */
4879         r->extflags |= (RXf_SKIPWHITE|RXf_WHITE); 
4880     else if (RX_PRELEN(rx) == 3 && memEQ("\\s+", RX_PRECOMP(rx), 3))
4881         r->extflags |= RXf_WHITE;
4882     else if (RX_PRELEN(rx) == 1 && RXp_PRECOMP(rx)[0] == '^')
4883         r->extflags |= RXf_START_ONLY;
4884 #else
4885     if (r->extflags & RXf_SPLIT && RX_PRELEN(rx) == 1 && RX_PRECOMP(rx)[0] == ' ')
4886             /* XXX: this should happen BEFORE we compile */
4887             r->extflags |= (RXf_SKIPWHITE|RXf_WHITE); 
4888     else {
4889         regnode *first = ri->program + 1;
4890         U8 fop = OP(first);
4891         U8 nop = OP(NEXTOPER(first));
4892         
4893         if (PL_regkind[fop] == NOTHING && nop == END)
4894             r->extflags |= RXf_NULL;
4895         else if (PL_regkind[fop] == BOL && nop == END)
4896             r->extflags |= RXf_START_ONLY;
4897         else if (fop == PLUS && nop ==SPACE && OP(regnext(first))==END)
4898             r->extflags |= RXf_WHITE;    
4899     }
4900 #endif
4901 #ifdef DEBUGGING
4902     if (RExC_paren_names) {
4903         ri->name_list_idx = add_data( pRExC_state, 1, "p" );
4904         ri->data->data[ri->name_list_idx] = (void*)SvREFCNT_inc(RExC_paren_name_list);
4905     } else
4906 #endif
4907         ri->name_list_idx = 0;
4908
4909     if (RExC_recurse_count) {
4910         for ( ; RExC_recurse_count ; RExC_recurse_count-- ) {
4911             const regnode *scan = RExC_recurse[RExC_recurse_count-1];
4912             ARG2L_SET( scan, RExC_open_parens[ARG(scan)-1] - scan );
4913         }
4914     }
4915     Newxz(r->offs, RExC_npar, regexp_paren_pair);
4916     /* assume we don't need to swap parens around before we match */
4917
4918     DEBUG_DUMP_r({
4919         PerlIO_printf(Perl_debug_log,"Final program:\n");
4920         regdump(r);
4921     });
4922 #ifdef RE_TRACK_PATTERN_OFFSETS
4923     DEBUG_OFFSETS_r(if (ri->u.offsets) {
4924         const U32 len = ri->u.offsets[0];
4925         U32 i;
4926         GET_RE_DEBUG_FLAGS_DECL;
4927         PerlIO_printf(Perl_debug_log, "Offsets: [%"UVuf"]\n\t", (UV)ri->u.offsets[0]);
4928         for (i = 1; i <= len; i++) {
4929             if (ri->u.offsets[i*2-1] || ri->u.offsets[i*2])
4930                 PerlIO_printf(Perl_debug_log, "%"UVuf":%"UVuf"[%"UVuf"] ",
4931                 (UV)i, (UV)ri->u.offsets[i*2-1], (UV)ri->u.offsets[i*2]);
4932             }
4933         PerlIO_printf(Perl_debug_log, "\n");
4934     });
4935 #endif
4936     return rx;
4937 }
4938
4939 #undef RE_ENGINE_PTR
4940
4941
4942 SV*
4943 Perl_reg_named_buff(pTHX_ REGEXP * const rx, SV * const key, SV * const value,
4944                     const U32 flags)
4945 {
4946     PERL_ARGS_ASSERT_REG_NAMED_BUFF;
4947
4948     PERL_UNUSED_ARG(value);
4949
4950     if (flags & RXapif_FETCH) {
4951         return reg_named_buff_fetch(rx, key, flags);
4952     } else if (flags & (RXapif_STORE | RXapif_DELETE | RXapif_CLEAR)) {
4953         Perl_croak(aTHX_ "%s", PL_no_modify);
4954         return NULL;
4955     } else if (flags & RXapif_EXISTS) {
4956         return reg_named_buff_exists(rx, key, flags)
4957             ? &PL_sv_yes
4958             : &PL_sv_no;
4959     } else if (flags & RXapif_REGNAMES) {
4960         return reg_named_buff_all(rx, flags);
4961     } else if (flags & (RXapif_SCALAR | RXapif_REGNAMES_COUNT)) {
4962         return reg_named_buff_scalar(rx, flags);
4963     } else {
4964         Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff", (int)flags);
4965         return NULL;
4966     }
4967 }
4968
4969 SV*
4970 Perl_reg_named_buff_iter(pTHX_ REGEXP * const rx, const SV * const lastkey,
4971                          const U32 flags)
4972 {
4973     PERL_ARGS_ASSERT_REG_NAMED_BUFF_ITER;
4974     PERL_UNUSED_ARG(lastkey);
4975
4976     if (flags & RXapif_FIRSTKEY)
4977         return reg_named_buff_firstkey(rx, flags);
4978     else if (flags & RXapif_NEXTKEY)
4979         return reg_named_buff_nextkey(rx, flags);
4980     else {
4981         Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_iter", (int)flags);
4982         return NULL;
4983     }
4984 }
4985
4986 SV*
4987 Perl_reg_named_buff_fetch(pTHX_ REGEXP * const r, SV * const namesv,
4988                           const U32 flags)
4989 {
4990     AV *retarray = NULL;
4991     SV *ret;
4992     struct regexp *const rx = (struct regexp *)SvANY(r);
4993
4994     PERL_ARGS_ASSERT_REG_NAMED_BUFF_FETCH;
4995
4996     if (flags & RXapif_ALL)
4997         retarray=newAV();
4998
4999     if (rx && RXp_PAREN_NAMES(rx)) {
5000         HE *he_str = hv_fetch_ent( RXp_PAREN_NAMES(rx), namesv, 0, 0 );
5001         if (he_str) {
5002             IV i;
5003             SV* sv_dat=HeVAL(he_str);
5004             I32 *nums=(I32*)SvPVX(sv_dat);
5005             for ( i=0; i<SvIVX(sv_dat); i++ ) {
5006                 if ((I32)(rx->nparens) >= nums[i]
5007                     && rx->offs[nums[i]].start != -1
5008                     && rx->offs[nums[i]].end != -1)
5009                 {
5010                     ret = newSVpvs("");
5011                     CALLREG_NUMBUF_FETCH(r,nums[i],ret);
5012                     if (!retarray)
5013                         return ret;
5014                 } else {
5015                     ret = newSVsv(&PL_sv_undef);
5016                 }
5017                 if (retarray)
5018                     av_push(retarray, ret);
5019             }
5020             if (retarray)
5021                 return newRV_noinc(MUTABLE_SV(retarray));
5022         }
5023     }
5024     return NULL;
5025 }
5026
5027 bool
5028 Perl_reg_named_buff_exists(pTHX_ REGEXP * const r, SV * const key,
5029                            const U32 flags)
5030 {
5031     struct regexp *const rx = (struct regexp *)SvANY(r);
5032
5033     PERL_ARGS_ASSERT_REG_NAMED_BUFF_EXISTS;
5034
5035     if (rx && RXp_PAREN_NAMES(rx)) {
5036         if (flags & RXapif_ALL) {
5037             return hv_exists_ent(RXp_PAREN_NAMES(rx), key, 0);
5038         } else {
5039             SV *sv = CALLREG_NAMED_BUFF_FETCH(r, key, flags);
5040             if (sv) {
5041                 SvREFCNT_dec(sv);
5042                 return TRUE;
5043             } else {
5044                 return FALSE;
5045             }
5046         }
5047     } else {
5048         return FALSE;
5049     }
5050 }
5051
5052 SV*
5053 Perl_reg_named_buff_firstkey(pTHX_ REGEXP * const r, const U32 flags)
5054 {
5055     struct regexp *const rx = (struct regexp *)SvANY(r);
5056
5057     PERL_ARGS_ASSERT_REG_NAMED_BUFF_FIRSTKEY;
5058
5059     if ( rx && RXp_PAREN_NAMES(rx) ) {
5060         (void)hv_iterinit(RXp_PAREN_NAMES(rx));
5061
5062         return CALLREG_NAMED_BUFF_NEXTKEY(r, NULL, flags & ~RXapif_FIRSTKEY);
5063     } else {
5064         return FALSE;
5065     }
5066 }
5067
5068 SV*
5069 Perl_reg_named_buff_nextkey(pTHX_ REGEXP * const r, const U32 flags)
5070 {
5071     struct regexp *const rx = (struct regexp *)SvANY(r);
5072     GET_RE_DEBUG_FLAGS_DECL;
5073
5074     PERL_ARGS_ASSERT_REG_NAMED_BUFF_NEXTKEY;
5075
5076     if (rx && RXp_PAREN_NAMES(rx)) {
5077         HV *hv = RXp_PAREN_NAMES(rx);
5078         HE *temphe;
5079         while ( (temphe = hv_iternext_flags(hv,0)) ) {
5080             IV i;
5081             IV parno = 0;
5082             SV* sv_dat = HeVAL(temphe);
5083             I32 *nums = (I32*)SvPVX(sv_dat);
5084             for ( i = 0; i < SvIVX(sv_dat); i++ ) {
5085                 if ((I32)(rx->lastparen) >= nums[i] &&
5086                     rx->offs[nums[i]].start != -1 &&
5087                     rx->offs[nums[i]].end != -1)
5088                 {
5089                     parno = nums[i];
5090                     break;
5091                 }
5092             }
5093             if (parno || flags & RXapif_ALL) {
5094                 return newSVhek(HeKEY_hek(temphe));
5095             }
5096         }
5097     }
5098     return NULL;
5099 }
5100
5101 SV*
5102 Perl_reg_named_buff_scalar(pTHX_ REGEXP * const r, const U32 flags)
5103 {
5104     SV *ret;
5105     AV *av;
5106     I32 length;
5107     struct regexp *const rx = (struct regexp *)SvANY(r);
5108
5109     PERL_ARGS_ASSERT_REG_NAMED_BUFF_SCALAR;
5110
5111     if (rx && RXp_PAREN_NAMES(rx)) {
5112         if (flags & (RXapif_ALL | RXapif_REGNAMES_COUNT)) {
5113             return newSViv(HvTOTALKEYS(RXp_PAREN_NAMES(rx)));
5114         } else if (flags & RXapif_ONE) {
5115             ret = CALLREG_NAMED_BUFF_ALL(r, (flags | RXapif_REGNAMES));
5116             av = MUTABLE_AV(SvRV(ret));
5117             length = av_len(av);
5118             SvREFCNT_dec(ret);
5119             return newSViv(length + 1);
5120         } else {
5121             Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_scalar", (int)flags);
5122             return NULL;
5123         }
5124     }
5125     return &PL_sv_undef;
5126 }
5127
5128 SV*
5129 Perl_reg_named_buff_all(pTHX_ REGEXP * const r, const U32 flags)
5130 {
5131     struct regexp *const rx = (struct regexp *)SvANY(r);
5132     AV *av = newAV();
5133
5134     PERL_ARGS_ASSERT_REG_NAMED_BUFF_ALL;
5135
5136     if (rx && RXp_PAREN_NAMES(rx)) {
5137         HV *hv= RXp_PAREN_NAMES(rx);
5138         HE *temphe;
5139         (void)hv_iterinit(hv);
5140         while ( (temphe = hv_iternext_flags(hv,0)) ) {
5141             IV i;
5142             IV parno = 0;
5143             SV* sv_dat = HeVAL(temphe);
5144             I32 *nums = (I32*)SvPVX(sv_dat);
5145             for ( i = 0; i < SvIVX(sv_dat); i++ ) {
5146                 if ((I32)(rx->lastparen) >= nums[i] &&
5147                     rx->offs[nums[i]].start != -1 &&
5148                     rx->offs[nums[i]].end != -1)
5149                 {
5150                     parno = nums[i];
5151                     break;
5152                 }
5153             }
5154             if (parno || flags & RXapif_ALL) {
5155                 av_push(av, newSVhek(HeKEY_hek(temphe)));
5156             }
5157         }
5158     }
5159
5160     return newRV_noinc(MUTABLE_SV(av));
5161 }
5162
5163 void
5164 Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren,
5165                              SV * const sv)
5166 {
5167     struct regexp *const rx = (struct regexp *)SvANY(r);
5168     char *s = NULL;
5169     I32 i = 0;
5170     I32 s1, t1;
5171
5172     PERL_ARGS_ASSERT_REG_NUMBERED_BUFF_FETCH;
5173         
5174     if (!rx->subbeg) {
5175         sv_setsv(sv,&PL_sv_undef);
5176         return;
5177     } 
5178     else               
5179     if (paren == RX_BUFF_IDX_PREMATCH && rx->offs[0].start != -1) {
5180         /* $` */
5181         i = rx->offs[0].start;
5182         s = rx->subbeg;
5183     }
5184     else 
5185     if (paren == RX_BUFF_IDX_POSTMATCH && rx->offs[0].end != -1) {
5186         /* $' */
5187         s = rx->subbeg + rx->offs[0].end;
5188         i = rx->sublen - rx->offs[0].end;
5189     } 
5190     else
5191     if ( 0 <= paren && paren <= (I32)rx->nparens &&
5192         (s1 = rx->offs[paren].start) != -1 &&
5193         (t1 = rx->offs[paren].end) != -1)
5194     {
5195         /* $& $1 ... */
5196         i = t1 - s1;
5197         s = rx->subbeg + s1;
5198     } else {
5199         sv_setsv(sv,&PL_sv_undef);
5200         return;
5201     }          
5202     assert(rx->sublen >= (s - rx->subbeg) + i );
5203     if (i >= 0) {
5204         const int oldtainted = PL_tainted;
5205         TAINT_NOT;
5206         sv_setpvn(sv, s, i);
5207         PL_tainted = oldtainted;
5208         if ( (rx->extflags & RXf_CANY_SEEN)
5209             ? (RXp_MATCH_UTF8(rx)
5210                         && (!i || is_utf8_string((U8*)s, i)))
5211             : (RXp_MATCH_UTF8(rx)) )
5212         {
5213             SvUTF8_on(sv);
5214         }
5215         else
5216             SvUTF8_off(sv);
5217         if (PL_tainting) {
5218             if (RXp_MATCH_TAINTED(rx)) {
5219                 if (SvTYPE(sv) >= SVt_PVMG) {
5220                     MAGIC* const mg = SvMAGIC(sv);
5221                     MAGIC* mgt;
5222                     PL_tainted = 1;
5223                     SvMAGIC_set(sv, mg->mg_moremagic);
5224                     SvTAINT(sv);
5225                     if ((mgt = SvMAGIC(sv))) {
5226                         mg->mg_moremagic = mgt;
5227                         SvMAGIC_set(sv, mg);
5228                     }
5229                 } else {
5230                     PL_tainted = 1;
5231                     SvTAINT(sv);
5232                 }
5233             } else 
5234                 SvTAINTED_off(sv);
5235         }
5236     } else {
5237         sv_setsv(sv,&PL_sv_undef);
5238         return;
5239     }
5240 }
5241
5242 void
5243 Perl_reg_numbered_buff_store(pTHX_ REGEXP * const rx, const I32 paren,
5244                                                          SV const * const value)
5245 {
5246     PERL_ARGS_ASSERT_REG_NUMBERED_BUFF_STORE;
5247
5248     PERL_UNUSED_ARG(rx);
5249     PERL_UNUSED_ARG(paren);
5250     PERL_UNUSED_ARG(value);
5251
5252     if (!PL_localizing)
5253         Perl_croak(aTHX_ "%s", PL_no_modify);
5254 }
5255
5256 I32
5257 Perl_reg_numbered_buff_length(pTHX_ REGEXP * const r, const SV * const sv,
5258                               const I32 paren)
5259 {
5260     struct regexp *const rx = (struct regexp *)SvANY(r);
5261     I32 i;
5262     I32 s1, t1;
5263
5264     PERL_ARGS_ASSERT_REG_NUMBERED_BUFF_LENGTH;
5265
5266     /* Some of this code was originally in C<Perl_magic_len> in F<mg.c> */
5267         switch (paren) {
5268       /* $` / ${^PREMATCH} */
5269       case RX_BUFF_IDX_PREMATCH:
5270         if (rx->offs[0].start != -1) {
5271                         i = rx->offs[0].start;
5272                         if (i > 0) {
5273                                 s1 = 0;
5274                                 t1 = i;
5275                                 goto getlen;
5276                         }
5277             }
5278         return 0;
5279       /* $' / ${^POSTMATCH} */
5280       case RX_BUFF_IDX_POSTMATCH:
5281             if (rx->offs[0].end != -1) {
5282                         i = rx->sublen - rx->offs[0].end;
5283                         if (i > 0) {
5284                                 s1 = rx->offs[0].end;
5285                                 t1 = rx->sublen;
5286                                 goto getlen;
5287                         }
5288             }
5289         return 0;
5290       /* $& / ${^MATCH}, $1, $2