XS::Typemap: Fix tests with -Dusemorebits
[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 #include "dquote_static.c"
89
90 #ifdef op
91 #undef op
92 #endif /* op */
93
94 #ifdef MSDOS
95 #  if defined(BUGGY_MSC6)
96  /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
97 #    pragma optimize("a",off)
98  /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
99 #    pragma optimize("w",on )
100 #  endif /* BUGGY_MSC6 */
101 #endif /* MSDOS */
102
103 #ifndef STATIC
104 #define STATIC  static
105 #endif
106
107 typedef struct RExC_state_t {
108     U32         flags;                  /* are we folding, multilining? */
109     char        *precomp;               /* uncompiled string. */
110     REGEXP      *rx_sv;                 /* The SV that is the regexp. */
111     regexp      *rx;                    /* perl core regexp structure */
112     regexp_internal     *rxi;           /* internal data for regexp object pprivate field */        
113     char        *start;                 /* Start of input for compile */
114     char        *end;                   /* End of input for compile */
115     char        *parse;                 /* Input-scan pointer. */
116     I32         whilem_seen;            /* number of WHILEM in this expr */
117     regnode     *emit_start;            /* Start of emitted-code area */
118     regnode     *emit_bound;            /* First regnode outside of the allocated space */
119     regnode     *emit;                  /* Code-emit pointer; &regdummy = don't = compiling */
120     I32         naughty;                /* How bad is this pattern? */
121     I32         sawback;                /* Did we see \1, ...? */
122     U32         seen;
123     I32         size;                   /* Code size. */
124     I32         npar;                   /* Capture buffer count, (OPEN). */
125     I32         cpar;                   /* Capture buffer count, (CLOSE). */
126     I32         nestroot;               /* root parens we are in - used by accept */
127     I32         extralen;
128     I32         seen_zerolen;
129     I32         seen_evals;
130     regnode     **open_parens;          /* pointers to open parens */
131     regnode     **close_parens;         /* pointers to close parens */
132     regnode     *opend;                 /* END node in program */
133     I32         utf8;           /* whether the pattern is utf8 or not */
134     I32         orig_utf8;      /* whether the pattern was originally in utf8 */
135                                 /* XXX use this for future optimisation of case
136                                  * where pattern must be upgraded to utf8. */
137     I32         uni_semantics;  /* If a d charset modifier should use unicode
138                                    rules, even if the pattern is not in
139                                    utf8 */
140     HV          *paren_names;           /* Paren names */
141     
142     regnode     **recurse;              /* Recurse regops */
143     I32         recurse_count;          /* Number of recurse regops */
144     I32         in_lookbehind;
145     I32         contains_locale;
146     I32         override_recoding;
147 #if ADD_TO_REGEXEC
148     char        *starttry;              /* -Dr: where regtry was called. */
149 #define RExC_starttry   (pRExC_state->starttry)
150 #endif
151 #ifdef DEBUGGING
152     const char  *lastparse;
153     I32         lastnum;
154     AV          *paren_name_list;       /* idx -> name */
155 #define RExC_lastparse  (pRExC_state->lastparse)
156 #define RExC_lastnum    (pRExC_state->lastnum)
157 #define RExC_paren_name_list    (pRExC_state->paren_name_list)
158 #endif
159 } RExC_state_t;
160
161 #define RExC_flags      (pRExC_state->flags)
162 #define RExC_precomp    (pRExC_state->precomp)
163 #define RExC_rx_sv      (pRExC_state->rx_sv)
164 #define RExC_rx         (pRExC_state->rx)
165 #define RExC_rxi        (pRExC_state->rxi)
166 #define RExC_start      (pRExC_state->start)
167 #define RExC_end        (pRExC_state->end)
168 #define RExC_parse      (pRExC_state->parse)
169 #define RExC_whilem_seen        (pRExC_state->whilem_seen)
170 #ifdef RE_TRACK_PATTERN_OFFSETS
171 #define RExC_offsets    (pRExC_state->rxi->u.offsets) /* I am not like the others */
172 #endif
173 #define RExC_emit       (pRExC_state->emit)
174 #define RExC_emit_start (pRExC_state->emit_start)
175 #define RExC_emit_bound (pRExC_state->emit_bound)
176 #define RExC_naughty    (pRExC_state->naughty)
177 #define RExC_sawback    (pRExC_state->sawback)
178 #define RExC_seen       (pRExC_state->seen)
179 #define RExC_size       (pRExC_state->size)
180 #define RExC_npar       (pRExC_state->npar)
181 #define RExC_nestroot   (pRExC_state->nestroot)
182 #define RExC_extralen   (pRExC_state->extralen)
183 #define RExC_seen_zerolen       (pRExC_state->seen_zerolen)
184 #define RExC_seen_evals (pRExC_state->seen_evals)
185 #define RExC_utf8       (pRExC_state->utf8)
186 #define RExC_uni_semantics      (pRExC_state->uni_semantics)
187 #define RExC_orig_utf8  (pRExC_state->orig_utf8)
188 #define RExC_open_parens        (pRExC_state->open_parens)
189 #define RExC_close_parens       (pRExC_state->close_parens)
190 #define RExC_opend      (pRExC_state->opend)
191 #define RExC_paren_names        (pRExC_state->paren_names)
192 #define RExC_recurse    (pRExC_state->recurse)
193 #define RExC_recurse_count      (pRExC_state->recurse_count)
194 #define RExC_in_lookbehind      (pRExC_state->in_lookbehind)
195 #define RExC_contains_locale    (pRExC_state->contains_locale)
196 #define RExC_override_recoding  (pRExC_state->override_recoding)
197
198
199 #define ISMULT1(c)      ((c) == '*' || (c) == '+' || (c) == '?')
200 #define ISMULT2(s)      ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
201         ((*s) == '{' && regcurly(s)))
202
203 #ifdef SPSTART
204 #undef SPSTART          /* dratted cpp namespace... */
205 #endif
206 /*
207  * Flags to be passed up and down.
208  */
209 #define WORST           0       /* Worst case. */
210 #define HASWIDTH        0x01    /* Known to match non-null strings. */
211
212 /* Simple enough to be STAR/PLUS operand, in an EXACT node must be a single
213  * character, and if utf8, must be invariant.  Note that this is not the same thing as REGNODE_SIMPLE */
214 #define SIMPLE          0x02
215 #define SPSTART         0x04    /* Starts with * or +. */
216 #define TRYAGAIN        0x08    /* Weeded out a declaration. */
217 #define POSTPONED       0x10    /* (?1),(?&name), (??{...}) or similar */
218
219 #define REG_NODE_NUM(x) ((x) ? (int)((x)-RExC_emit_start) : -1)
220
221 /* whether trie related optimizations are enabled */
222 #if PERL_ENABLE_EXTENDED_TRIE_OPTIMISATION
223 #define TRIE_STUDY_OPT
224 #define FULL_TRIE_STUDY
225 #define TRIE_STCLASS
226 #endif
227
228
229
230 #define PBYTE(u8str,paren) ((U8*)(u8str))[(paren) >> 3]
231 #define PBITVAL(paren) (1 << ((paren) & 7))
232 #define PAREN_TEST(u8str,paren) ( PBYTE(u8str,paren) & PBITVAL(paren))
233 #define PAREN_SET(u8str,paren) PBYTE(u8str,paren) |= PBITVAL(paren)
234 #define PAREN_UNSET(u8str,paren) PBYTE(u8str,paren) &= (~PBITVAL(paren))
235
236 /* If not already in utf8, do a longjmp back to the beginning */
237 #define UTF8_LONGJMP 42 /* Choose a value not likely to ever conflict */
238 #define REQUIRE_UTF8    STMT_START {                                       \
239                                      if (! UTF) JMPENV_JUMP(UTF8_LONGJMP); \
240                         } STMT_END
241
242 /* About scan_data_t.
243
244   During optimisation we recurse through the regexp program performing
245   various inplace (keyhole style) optimisations. In addition study_chunk
246   and scan_commit populate this data structure with information about
247   what strings MUST appear in the pattern. We look for the longest 
248   string that must appear at a fixed location, and we look for the
249   longest string that may appear at a floating location. So for instance
250   in the pattern:
251   
252     /FOO[xX]A.*B[xX]BAR/
253     
254   Both 'FOO' and 'A' are fixed strings. Both 'B' and 'BAR' are floating
255   strings (because they follow a .* construct). study_chunk will identify
256   both FOO and BAR as being the longest fixed and floating strings respectively.
257   
258   The strings can be composites, for instance
259   
260      /(f)(o)(o)/
261      
262   will result in a composite fixed substring 'foo'.
263   
264   For each string some basic information is maintained:
265   
266   - offset or min_offset
267     This is the position the string must appear at, or not before.
268     It also implicitly (when combined with minlenp) tells us how many
269     characters must match before the string we are searching for.
270     Likewise when combined with minlenp and the length of the string it
271     tells us how many characters must appear after the string we have 
272     found.
273   
274   - max_offset
275     Only used for floating strings. This is the rightmost point that
276     the string can appear at. If set to I32 max it indicates that the
277     string can occur infinitely far to the right.
278   
279   - minlenp
280     A pointer to the minimum length of the pattern that the string 
281     was found inside. This is important as in the case of positive 
282     lookahead or positive lookbehind we can have multiple patterns 
283     involved. Consider
284     
285     /(?=FOO).*F/
286     
287     The minimum length of the pattern overall is 3, the minimum length
288     of the lookahead part is 3, but the minimum length of the part that
289     will actually match is 1. So 'FOO's minimum length is 3, but the 
290     minimum length for the F is 1. This is important as the minimum length
291     is used to determine offsets in front of and behind the string being 
292     looked for.  Since strings can be composites this is the length of the
293     pattern at the time it was committed with a scan_commit. Note that
294     the length is calculated by study_chunk, so that the minimum lengths
295     are not known until the full pattern has been compiled, thus the 
296     pointer to the value.
297   
298   - lookbehind
299   
300     In the case of lookbehind the string being searched for can be
301     offset past the start point of the final matching string. 
302     If this value was just blithely removed from the min_offset it would
303     invalidate some of the calculations for how many chars must match
304     before or after (as they are derived from min_offset and minlen and
305     the length of the string being searched for). 
306     When the final pattern is compiled and the data is moved from the
307     scan_data_t structure into the regexp structure the information
308     about lookbehind is factored in, with the information that would 
309     have been lost precalculated in the end_shift field for the 
310     associated string.
311
312   The fields pos_min and pos_delta are used to store the minimum offset
313   and the delta to the maximum offset at the current point in the pattern.    
314
315 */
316
317 typedef struct scan_data_t {
318     /*I32 len_min;      unused */
319     /*I32 len_delta;    unused */
320     I32 pos_min;
321     I32 pos_delta;
322     SV *last_found;
323     I32 last_end;           /* min value, <0 unless valid. */
324     I32 last_start_min;
325     I32 last_start_max;
326     SV **longest;           /* Either &l_fixed, or &l_float. */
327     SV *longest_fixed;      /* longest fixed string found in pattern */
328     I32 offset_fixed;       /* offset where it starts */
329     I32 *minlen_fixed;      /* pointer to the minlen relevant to the string */
330     I32 lookbehind_fixed;   /* is the position of the string modfied by LB */
331     SV *longest_float;      /* longest floating string found in pattern */
332     I32 offset_float_min;   /* earliest point in string it can appear */
333     I32 offset_float_max;   /* latest point in string it can appear */
334     I32 *minlen_float;      /* pointer to the minlen relevant to the string */
335     I32 lookbehind_float;   /* is the position of the string modified by LB */
336     I32 flags;
337     I32 whilem_c;
338     I32 *last_closep;
339     struct regnode_charclass_class *start_class;
340 } scan_data_t;
341
342 /*
343  * Forward declarations for pregcomp()'s friends.
344  */
345
346 static const scan_data_t zero_scan_data =
347   { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ,0};
348
349 #define SF_BEFORE_EOL           (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
350 #define SF_BEFORE_SEOL          0x0001
351 #define SF_BEFORE_MEOL          0x0002
352 #define SF_FIX_BEFORE_EOL       (SF_FIX_BEFORE_SEOL|SF_FIX_BEFORE_MEOL)
353 #define SF_FL_BEFORE_EOL        (SF_FL_BEFORE_SEOL|SF_FL_BEFORE_MEOL)
354
355 #ifdef NO_UNARY_PLUS
356 #  define SF_FIX_SHIFT_EOL      (0+2)
357 #  define SF_FL_SHIFT_EOL               (0+4)
358 #else
359 #  define SF_FIX_SHIFT_EOL      (+2)
360 #  define SF_FL_SHIFT_EOL               (+4)
361 #endif
362
363 #define SF_FIX_BEFORE_SEOL      (SF_BEFORE_SEOL << SF_FIX_SHIFT_EOL)
364 #define SF_FIX_BEFORE_MEOL      (SF_BEFORE_MEOL << SF_FIX_SHIFT_EOL)
365
366 #define SF_FL_BEFORE_SEOL       (SF_BEFORE_SEOL << SF_FL_SHIFT_EOL)
367 #define SF_FL_BEFORE_MEOL       (SF_BEFORE_MEOL << SF_FL_SHIFT_EOL) /* 0x20 */
368 #define SF_IS_INF               0x0040
369 #define SF_HAS_PAR              0x0080
370 #define SF_IN_PAR               0x0100
371 #define SF_HAS_EVAL             0x0200
372 #define SCF_DO_SUBSTR           0x0400
373 #define SCF_DO_STCLASS_AND      0x0800
374 #define SCF_DO_STCLASS_OR       0x1000
375 #define SCF_DO_STCLASS          (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR)
376 #define SCF_WHILEM_VISITED_POS  0x2000
377
378 #define SCF_TRIE_RESTUDY        0x4000 /* Do restudy? */
379 #define SCF_SEEN_ACCEPT         0x8000 
380
381 #define UTF cBOOL(RExC_utf8)
382 #define LOC (get_regex_charset(RExC_flags) == REGEX_LOCALE_CHARSET)
383 #define UNI_SEMANTICS (get_regex_charset(RExC_flags) == REGEX_UNICODE_CHARSET)
384 #define DEPENDS_SEMANTICS (get_regex_charset(RExC_flags) == REGEX_DEPENDS_CHARSET)
385 #define AT_LEAST_UNI_SEMANTICS (get_regex_charset(RExC_flags) >= REGEX_UNICODE_CHARSET)
386 #define ASCII_RESTRICTED (get_regex_charset(RExC_flags) == REGEX_ASCII_RESTRICTED_CHARSET)
387 #define MORE_ASCII_RESTRICTED (get_regex_charset(RExC_flags) == REGEX_ASCII_MORE_RESTRICTED_CHARSET)
388 #define AT_LEAST_ASCII_RESTRICTED (get_regex_charset(RExC_flags) >= REGEX_ASCII_RESTRICTED_CHARSET)
389
390 #define FOLD cBOOL(RExC_flags & RXf_PMf_FOLD)
391
392 #define OOB_UNICODE             12345678
393 #define OOB_NAMEDCLASS          -1
394
395 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
396 #define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
397
398
399 /* length of regex to show in messages that don't mark a position within */
400 #define RegexLengthToShowInErrorMessages 127
401
402 /*
403  * If MARKER[12] are adjusted, be sure to adjust the constants at the top
404  * of t/op/regmesg.t, the tests in t/op/re_tests, and those in
405  * op/pragma/warn/regcomp.
406  */
407 #define MARKER1 "<-- HERE"    /* marker as it appears in the description */
408 #define MARKER2 " <-- HERE "  /* marker as it appears within the regex */
409
410 #define REPORT_LOCATION " in regex; marked by " MARKER1 " in m/%.*s" MARKER2 "%s/"
411
412 /*
413  * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
414  * arg. Show regex, up to a maximum length. If it's too long, chop and add
415  * "...".
416  */
417 #define _FAIL(code) STMT_START {                                        \
418     const char *ellipses = "";                                          \
419     IV len = RExC_end - RExC_precomp;                                   \
420                                                                         \
421     if (!SIZE_ONLY)                                                     \
422         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv);                   \
423     if (len > RegexLengthToShowInErrorMessages) {                       \
424         /* chop 10 shorter than the max, to ensure meaning of "..." */  \
425         len = RegexLengthToShowInErrorMessages - 10;                    \
426         ellipses = "...";                                               \
427     }                                                                   \
428     code;                                                               \
429 } STMT_END
430
431 #define FAIL(msg) _FAIL(                            \
432     Perl_croak(aTHX_ "%s in regex m/%.*s%s/",       \
433             msg, (int)len, RExC_precomp, ellipses))
434
435 #define FAIL2(msg,arg) _FAIL(                       \
436     Perl_croak(aTHX_ msg " in regex m/%.*s%s/",     \
437             arg, (int)len, RExC_precomp, ellipses))
438
439 /*
440  * Simple_vFAIL -- like FAIL, but marks the current location in the scan
441  */
442 #define Simple_vFAIL(m) STMT_START {                                    \
443     const IV offset = RExC_parse - RExC_precomp;                        \
444     Perl_croak(aTHX_ "%s" REPORT_LOCATION,                              \
445             m, (int)offset, RExC_precomp, RExC_precomp + offset);       \
446 } STMT_END
447
448 /*
449  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL()
450  */
451 #define vFAIL(m) STMT_START {                           \
452     if (!SIZE_ONLY)                                     \
453         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv);   \
454     Simple_vFAIL(m);                                    \
455 } STMT_END
456
457 /*
458  * Like Simple_vFAIL(), but accepts two arguments.
459  */
460 #define Simple_vFAIL2(m,a1) STMT_START {                        \
461     const IV offset = RExC_parse - RExC_precomp;                        \
462     S_re_croak2(aTHX_ m, REPORT_LOCATION, a1,                   \
463             (int)offset, RExC_precomp, RExC_precomp + offset);  \
464 } STMT_END
465
466 /*
467  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL2().
468  */
469 #define vFAIL2(m,a1) STMT_START {                       \
470     if (!SIZE_ONLY)                                     \
471         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv);   \
472     Simple_vFAIL2(m, a1);                               \
473 } STMT_END
474
475
476 /*
477  * Like Simple_vFAIL(), but accepts three arguments.
478  */
479 #define Simple_vFAIL3(m, a1, a2) STMT_START {                   \
480     const IV offset = RExC_parse - RExC_precomp;                \
481     S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2,               \
482             (int)offset, RExC_precomp, RExC_precomp + offset);  \
483 } STMT_END
484
485 /*
486  * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL3().
487  */
488 #define vFAIL3(m,a1,a2) STMT_START {                    \
489     if (!SIZE_ONLY)                                     \
490         SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv);   \
491     Simple_vFAIL3(m, a1, a2);                           \
492 } STMT_END
493
494 /*
495  * Like Simple_vFAIL(), but accepts four arguments.
496  */
497 #define Simple_vFAIL4(m, a1, a2, a3) STMT_START {               \
498     const IV offset = RExC_parse - RExC_precomp;                \
499     S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3,           \
500             (int)offset, RExC_precomp, RExC_precomp + offset);  \
501 } STMT_END
502
503 #define ckWARNreg(loc,m) STMT_START {                                   \
504     const IV offset = loc - RExC_precomp;                               \
505     Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,      \
506             (int)offset, RExC_precomp, RExC_precomp + offset);          \
507 } STMT_END
508
509 #define ckWARNregdep(loc,m) STMT_START {                                \
510     const IV offset = loc - RExC_precomp;                               \
511     Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP),     \
512             m REPORT_LOCATION,                                          \
513             (int)offset, RExC_precomp, RExC_precomp + offset);          \
514 } STMT_END
515
516 #define ckWARN2regdep(loc,m, a1) STMT_START {                           \
517     const IV offset = loc - RExC_precomp;                               \
518     Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP),     \
519             m REPORT_LOCATION,                                          \
520             a1, (int)offset, RExC_precomp, RExC_precomp + offset);      \
521 } STMT_END
522
523 #define ckWARN2reg(loc, m, a1) STMT_START {                             \
524     const IV offset = loc - RExC_precomp;                               \
525     Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,      \
526             a1, (int)offset, RExC_precomp, RExC_precomp + offset);      \
527 } STMT_END
528
529 #define vWARN3(loc, m, a1, a2) STMT_START {                             \
530     const IV offset = loc - RExC_precomp;                               \
531     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
532             a1, a2, (int)offset, RExC_precomp, RExC_precomp + offset);  \
533 } STMT_END
534
535 #define ckWARN3reg(loc, m, a1, a2) STMT_START {                         \
536     const IV offset = loc - RExC_precomp;                               \
537     Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,      \
538             a1, a2, (int)offset, RExC_precomp, RExC_precomp + offset);  \
539 } STMT_END
540
541 #define vWARN4(loc, m, a1, a2, a3) STMT_START {                         \
542     const IV offset = loc - RExC_precomp;                               \
543     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
544             a1, a2, a3, (int)offset, RExC_precomp, RExC_precomp + offset); \
545 } STMT_END
546
547 #define ckWARN4reg(loc, m, a1, a2, a3) STMT_START {                     \
548     const IV offset = loc - RExC_precomp;                               \
549     Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,      \
550             a1, a2, a3, (int)offset, RExC_precomp, RExC_precomp + offset); \
551 } STMT_END
552
553 #define vWARN5(loc, m, a1, a2, a3, a4) STMT_START {                     \
554     const IV offset = loc - RExC_precomp;                               \
555     Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION,         \
556             a1, a2, a3, a4, (int)offset, RExC_precomp, RExC_precomp + offset); \
557 } STMT_END
558
559
560 /* Allow for side effects in s */
561 #define REGC(c,s) STMT_START {                  \
562     if (!SIZE_ONLY) *(s) = (c); else (void)(s); \
563 } STMT_END
564
565 /* Macros for recording node offsets.   20001227 mjd@plover.com 
566  * Nodes are numbered 1, 2, 3, 4.  Node #n's position is recorded in
567  * element 2*n-1 of the array.  Element #2n holds the byte length node #n.
568  * Element 0 holds the number n.
569  * Position is 1 indexed.
570  */
571 #ifndef RE_TRACK_PATTERN_OFFSETS
572 #define Set_Node_Offset_To_R(node,byte)
573 #define Set_Node_Offset(node,byte)
574 #define Set_Cur_Node_Offset
575 #define Set_Node_Length_To_R(node,len)
576 #define Set_Node_Length(node,len)
577 #define Set_Node_Cur_Length(node)
578 #define Node_Offset(n) 
579 #define Node_Length(n) 
580 #define Set_Node_Offset_Length(node,offset,len)
581 #define ProgLen(ri) ri->u.proglen
582 #define SetProgLen(ri,x) ri->u.proglen = x
583 #else
584 #define ProgLen(ri) ri->u.offsets[0]
585 #define SetProgLen(ri,x) ri->u.offsets[0] = x
586 #define Set_Node_Offset_To_R(node,byte) STMT_START {                    \
587     if (! SIZE_ONLY) {                                                  \
588         MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n",         \
589                     __LINE__, (int)(node), (int)(byte)));               \
590         if((node) < 0) {                                                \
591             Perl_croak(aTHX_ "value of node is %d in Offset macro", (int)(node)); \
592         } else {                                                        \
593             RExC_offsets[2*(node)-1] = (byte);                          \
594         }                                                               \
595     }                                                                   \
596 } STMT_END
597
598 #define Set_Node_Offset(node,byte) \
599     Set_Node_Offset_To_R((node)-RExC_emit_start, (byte)-RExC_start)
600 #define Set_Cur_Node_Offset Set_Node_Offset(RExC_emit, RExC_parse)
601
602 #define Set_Node_Length_To_R(node,len) STMT_START {                     \
603     if (! SIZE_ONLY) {                                                  \
604         MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n",           \
605                 __LINE__, (int)(node), (int)(len)));                    \
606         if((node) < 0) {                                                \
607             Perl_croak(aTHX_ "value of node is %d in Length macro", (int)(node)); \
608         } else {                                                        \
609             RExC_offsets[2*(node)] = (len);                             \
610         }                                                               \
611     }                                                                   \
612 } STMT_END
613
614 #define Set_Node_Length(node,len) \
615     Set_Node_Length_To_R((node)-RExC_emit_start, len)
616 #define Set_Cur_Node_Length(len) Set_Node_Length(RExC_emit, len)
617 #define Set_Node_Cur_Length(node) \
618     Set_Node_Length(node, RExC_parse - parse_start)
619
620 /* Get offsets and lengths */
621 #define Node_Offset(n) (RExC_offsets[2*((n)-RExC_emit_start)-1])
622 #define Node_Length(n) (RExC_offsets[2*((n)-RExC_emit_start)])
623
624 #define Set_Node_Offset_Length(node,offset,len) STMT_START {    \
625     Set_Node_Offset_To_R((node)-RExC_emit_start, (offset));     \
626     Set_Node_Length_To_R((node)-RExC_emit_start, (len));        \
627 } STMT_END
628 #endif
629
630 #if PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS
631 #define EXPERIMENTAL_INPLACESCAN
632 #endif /*PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS*/
633
634 #define DEBUG_STUDYDATA(str,data,depth)                              \
635 DEBUG_OPTIMISE_MORE_r(if(data){                                      \
636     PerlIO_printf(Perl_debug_log,                                    \
637         "%*s" str "Pos:%"IVdf"/%"IVdf                                \
638         " Flags: 0x%"UVXf" Whilem_c: %"IVdf" Lcp: %"IVdf" %s",       \
639         (int)(depth)*2, "",                                          \
640         (IV)((data)->pos_min),                                       \
641         (IV)((data)->pos_delta),                                     \
642         (UV)((data)->flags),                                         \
643         (IV)((data)->whilem_c),                                      \
644         (IV)((data)->last_closep ? *((data)->last_closep) : -1),     \
645         is_inf ? "INF " : ""                                         \
646     );                                                               \
647     if ((data)->last_found)                                          \
648         PerlIO_printf(Perl_debug_log,                                \
649             "Last:'%s' %"IVdf":%"IVdf"/%"IVdf" %sFixed:'%s' @ %"IVdf \
650             " %sFloat: '%s' @ %"IVdf"/%"IVdf"",                      \
651             SvPVX_const((data)->last_found),                         \
652             (IV)((data)->last_end),                                  \
653             (IV)((data)->last_start_min),                            \
654             (IV)((data)->last_start_max),                            \
655             ((data)->longest &&                                      \
656              (data)->longest==&((data)->longest_fixed)) ? "*" : "",  \
657             SvPVX_const((data)->longest_fixed),                      \
658             (IV)((data)->offset_fixed),                              \
659             ((data)->longest &&                                      \
660              (data)->longest==&((data)->longest_float)) ? "*" : "",  \
661             SvPVX_const((data)->longest_float),                      \
662             (IV)((data)->offset_float_min),                          \
663             (IV)((data)->offset_float_max)                           \
664         );                                                           \
665     PerlIO_printf(Perl_debug_log,"\n");                              \
666 });
667
668 static void clear_re(pTHX_ void *r);
669
670 /* Mark that we cannot extend a found fixed substring at this point.
671    Update the longest found anchored substring and the longest found
672    floating substrings if needed. */
673
674 STATIC void
675 S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, I32 *minlenp, int is_inf)
676 {
677     const STRLEN l = CHR_SVLEN(data->last_found);
678     const STRLEN old_l = CHR_SVLEN(*data->longest);
679     GET_RE_DEBUG_FLAGS_DECL;
680
681     PERL_ARGS_ASSERT_SCAN_COMMIT;
682
683     if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
684         SvSetMagicSV(*data->longest, data->last_found);
685         if (*data->longest == data->longest_fixed) {
686             data->offset_fixed = l ? data->last_start_min : data->pos_min;
687             if (data->flags & SF_BEFORE_EOL)
688                 data->flags
689                     |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL);
690             else
691                 data->flags &= ~SF_FIX_BEFORE_EOL;
692             data->minlen_fixed=minlenp;
693             data->lookbehind_fixed=0;
694         }
695         else { /* *data->longest == data->longest_float */
696             data->offset_float_min = l ? data->last_start_min : data->pos_min;
697             data->offset_float_max = (l
698                                       ? data->last_start_max
699                                       : data->pos_min + data->pos_delta);
700             if (is_inf || (U32)data->offset_float_max > (U32)I32_MAX)
701                 data->offset_float_max = I32_MAX;
702             if (data->flags & SF_BEFORE_EOL)
703                 data->flags
704                     |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL);
705             else
706                 data->flags &= ~SF_FL_BEFORE_EOL;
707             data->minlen_float=minlenp;
708             data->lookbehind_float=0;
709         }
710     }
711     SvCUR_set(data->last_found, 0);
712     {
713         SV * const sv = data->last_found;
714         if (SvUTF8(sv) && SvMAGICAL(sv)) {
715             MAGIC * const mg = mg_find(sv, PERL_MAGIC_utf8);
716             if (mg)
717                 mg->mg_len = 0;
718         }
719     }
720     data->last_end = -1;
721     data->flags &= ~SF_BEFORE_EOL;
722     DEBUG_STUDYDATA("commit: ",data,0);
723 }
724
725 /* Can match anything (initialization) */
726 STATIC void
727 S_cl_anything(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
728 {
729     PERL_ARGS_ASSERT_CL_ANYTHING;
730
731     ANYOF_BITMAP_SETALL(cl);
732     cl->flags = ANYOF_CLASS|ANYOF_EOS|ANYOF_UNICODE_ALL
733                 |ANYOF_LOC_NONBITMAP_FOLD|ANYOF_NON_UTF8_LATIN1_ALL;
734
735     /* If any portion of the regex is to operate under locale rules,
736      * initialization includes it.  The reason this isn't done for all regexes
737      * is that the optimizer was written under the assumption that locale was
738      * all-or-nothing.  Given the complexity and lack of documentation in the
739      * optimizer, and that there are inadequate test cases for locale, so many
740      * parts of it may not work properly, it is safest to avoid locale unless
741      * necessary. */
742     if (RExC_contains_locale) {
743         ANYOF_CLASS_SETALL(cl);     /* /l uses class */
744         cl->flags |= ANYOF_LOCALE;
745     }
746     else {
747         ANYOF_CLASS_ZERO(cl);       /* Only /l uses class now */
748     }
749 }
750
751 /* Can match anything (initialization) */
752 STATIC int
753 S_cl_is_anything(const struct regnode_charclass_class *cl)
754 {
755     int value;
756
757     PERL_ARGS_ASSERT_CL_IS_ANYTHING;
758
759     for (value = 0; value <= ANYOF_MAX; value += 2)
760         if (ANYOF_CLASS_TEST(cl, value) && ANYOF_CLASS_TEST(cl, value + 1))
761             return 1;
762     if (!(cl->flags & ANYOF_UNICODE_ALL))
763         return 0;
764     if (!ANYOF_BITMAP_TESTALLSET((const void*)cl))
765         return 0;
766     return 1;
767 }
768
769 /* Can match anything (initialization) */
770 STATIC void
771 S_cl_init(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
772 {
773     PERL_ARGS_ASSERT_CL_INIT;
774
775     Zero(cl, 1, struct regnode_charclass_class);
776     cl->type = ANYOF;
777     cl_anything(pRExC_state, cl);
778     ARG_SET(cl, ANYOF_NONBITMAP_EMPTY);
779 }
780
781 /* These two functions currently do the exact same thing */
782 #define cl_init_zero            S_cl_init
783
784 /* 'AND' a given class with another one.  Can create false positives.  'cl'
785  * should not be inverted.  'and_with->flags & ANYOF_CLASS' should be 0 if
786  * 'and_with' is a regnode_charclass instead of a regnode_charclass_class. */
787 STATIC void
788 S_cl_and(struct regnode_charclass_class *cl,
789         const struct regnode_charclass_class *and_with)
790 {
791     PERL_ARGS_ASSERT_CL_AND;
792
793     assert(and_with->type == ANYOF);
794
795     /* I (khw) am not sure all these restrictions are necessary XXX */
796     if (!(ANYOF_CLASS_TEST_ANY_SET(and_with))
797         && !(ANYOF_CLASS_TEST_ANY_SET(cl))
798         && (and_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
799         && !(and_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
800         && !(cl->flags & ANYOF_LOC_NONBITMAP_FOLD)) {
801         int i;
802
803         if (and_with->flags & ANYOF_INVERT)
804             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
805                 cl->bitmap[i] &= ~and_with->bitmap[i];
806         else
807             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
808                 cl->bitmap[i] &= and_with->bitmap[i];
809     } /* XXXX: logic is complicated otherwise, leave it along for a moment. */
810
811     if (and_with->flags & ANYOF_INVERT) {
812
813         /* Here, the and'ed node is inverted.  Get the AND of the flags that
814          * aren't affected by the inversion.  Those that are affected are
815          * handled individually below */
816         U8 affected_flags = cl->flags & ~INVERSION_UNAFFECTED_FLAGS;
817         cl->flags &= (and_with->flags & INVERSION_UNAFFECTED_FLAGS);
818         cl->flags |= affected_flags;
819
820         /* We currently don't know how to deal with things that aren't in the
821          * bitmap, but we know that the intersection is no greater than what
822          * is already in cl, so let there be false positives that get sorted
823          * out after the synthetic start class succeeds, and the node is
824          * matched for real. */
825
826         /* The inversion of these two flags indicate that the resulting
827          * intersection doesn't have them */
828         if (and_with->flags & ANYOF_UNICODE_ALL) {
829             cl->flags &= ~ANYOF_UNICODE_ALL;
830         }
831         if (and_with->flags & ANYOF_NON_UTF8_LATIN1_ALL) {
832             cl->flags &= ~ANYOF_NON_UTF8_LATIN1_ALL;
833         }
834     }
835     else {   /* and'd node is not inverted */
836         U8 outside_bitmap_but_not_utf8; /* Temp variable */
837
838         if (! ANYOF_NONBITMAP(and_with)) {
839
840             /* Here 'and_with' doesn't match anything outside the bitmap
841              * (except possibly ANYOF_UNICODE_ALL), which means the
842              * intersection can't either, except for ANYOF_UNICODE_ALL, in
843              * which case we don't know what the intersection is, but it's no
844              * greater than what cl already has, so can just leave it alone,
845              * with possible false positives */
846             if (! (and_with->flags & ANYOF_UNICODE_ALL)) {
847                 ARG_SET(cl, ANYOF_NONBITMAP_EMPTY);
848                 cl->flags &= ~ANYOF_NONBITMAP_NON_UTF8;
849             }
850         }
851         else if (! ANYOF_NONBITMAP(cl)) {
852
853             /* Here, 'and_with' does match something outside the bitmap, and cl
854              * doesn't have a list of things to match outside the bitmap.  If
855              * cl can match all code points above 255, the intersection will
856              * be those above-255 code points that 'and_with' matches.  If cl
857              * can't match all Unicode code points, it means that it can't
858              * match anything outside the bitmap (since the 'if' that got us
859              * into this block tested for that), so we leave the bitmap empty.
860              */
861             if (cl->flags & ANYOF_UNICODE_ALL) {
862                 ARG_SET(cl, ARG(and_with));
863
864                 /* and_with's ARG may match things that don't require UTF8.
865                  * And now cl's will too, in spite of this being an 'and'.  See
866                  * the comments below about the kludge */
867                 cl->flags |= and_with->flags & ANYOF_NONBITMAP_NON_UTF8;
868             }
869         }
870         else {
871             /* Here, both 'and_with' and cl match something outside the
872              * bitmap.  Currently we do not do the intersection, so just match
873              * whatever cl had at the beginning.  */
874         }
875
876
877         /* Take the intersection of the two sets of flags.  However, the
878          * ANYOF_NONBITMAP_NON_UTF8 flag is treated as an 'or'.  This is a
879          * kludge around the fact that this flag is not treated like the others
880          * which are initialized in cl_anything().  The way the optimizer works
881          * is that the synthetic start class (SSC) is initialized to match
882          * anything, and then the first time a real node is encountered, its
883          * values are AND'd with the SSC's with the result being the values of
884          * the real node.  However, there are paths through the optimizer where
885          * the AND never gets called, so those initialized bits are set
886          * inappropriately, which is not usually a big deal, as they just cause
887          * false positives in the SSC, which will just mean a probably
888          * imperceptible slow down in execution.  However this bit has a
889          * higher false positive consequence in that it can cause utf8.pm,
890          * utf8_heavy.pl ... to be loaded when not necessary, which is a much
891          * bigger slowdown and also causes significant extra memory to be used.
892          * In order to prevent this, the code now takes a different tack.  The
893          * bit isn't set unless some part of the regular expression needs it,
894          * but once set it won't get cleared.  This means that these extra
895          * modules won't get loaded unless there was some path through the
896          * pattern that would have required them anyway, and  so any false
897          * positives that occur by not ANDing them out when they could be
898          * aren't as severe as they would be if we treated this bit like all
899          * the others */
900         outside_bitmap_but_not_utf8 = (cl->flags | and_with->flags)
901                                       & ANYOF_NONBITMAP_NON_UTF8;
902         cl->flags &= and_with->flags;
903         cl->flags |= outside_bitmap_but_not_utf8;
904     }
905 }
906
907 /* 'OR' a given class with another one.  Can create false positives.  'cl'
908  * should not be inverted.  'or_with->flags & ANYOF_CLASS' should be 0 if
909  * 'or_with' is a regnode_charclass instead of a regnode_charclass_class. */
910 STATIC void
911 S_cl_or(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, const struct regnode_charclass_class *or_with)
912 {
913     PERL_ARGS_ASSERT_CL_OR;
914
915     if (or_with->flags & ANYOF_INVERT) {
916
917         /* Here, the or'd node is to be inverted.  This means we take the
918          * complement of everything not in the bitmap, but currently we don't
919          * know what that is, so give up and match anything */
920         if (ANYOF_NONBITMAP(or_with)) {
921             cl_anything(pRExC_state, cl);
922         }
923         /* We do not use
924          * (B1 | CL1) | (!B2 & !CL2) = (B1 | !B2 & !CL2) | (CL1 | (!B2 & !CL2))
925          *   <= (B1 | !B2) | (CL1 | !CL2)
926          * which is wasteful if CL2 is small, but we ignore CL2:
927          *   (B1 | CL1) | (!B2 & !CL2) <= (B1 | CL1) | !B2 = (B1 | !B2) | CL1
928          * XXXX Can we handle case-fold?  Unclear:
929          *   (OK1(i) | OK1(i')) | !(OK1(i) | OK1(i')) =
930          *   (OK1(i) | OK1(i')) | (!OK1(i) & !OK1(i'))
931          */
932         else if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
933              && !(or_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
934              && !(cl->flags & ANYOF_LOC_NONBITMAP_FOLD) ) {
935             int i;
936
937             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
938                 cl->bitmap[i] |= ~or_with->bitmap[i];
939         } /* XXXX: logic is complicated otherwise */
940         else {
941             cl_anything(pRExC_state, cl);
942         }
943
944         /* And, we can just take the union of the flags that aren't affected
945          * by the inversion */
946         cl->flags |= or_with->flags & INVERSION_UNAFFECTED_FLAGS;
947
948         /* For the remaining flags:
949             ANYOF_UNICODE_ALL and inverted means to not match anything above
950                     255, which means that the union with cl should just be
951                     what cl has in it, so can ignore this flag
952             ANYOF_NON_UTF8_LATIN1_ALL and inverted means if not utf8 and ord
953                     is 127-255 to match them, but then invert that, so the
954                     union with cl should just be what cl has in it, so can
955                     ignore this flag
956          */
957     } else {    /* 'or_with' is not inverted */
958         /* (B1 | CL1) | (B2 | CL2) = (B1 | B2) | (CL1 | CL2)) */
959         if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
960              && (!(or_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
961                  || (cl->flags & ANYOF_LOC_NONBITMAP_FOLD)) ) {
962             int i;
963
964             /* OR char bitmap and class bitmap separately */
965             for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
966                 cl->bitmap[i] |= or_with->bitmap[i];
967             if (ANYOF_CLASS_TEST_ANY_SET(or_with)) {
968                 for (i = 0; i < ANYOF_CLASSBITMAP_SIZE; i++)
969                     cl->classflags[i] |= or_with->classflags[i];
970                 cl->flags |= ANYOF_CLASS;
971             }
972         }
973         else { /* XXXX: logic is complicated, leave it along for a moment. */
974             cl_anything(pRExC_state, cl);
975         }
976
977         if (ANYOF_NONBITMAP(or_with)) {
978
979             /* Use the added node's outside-the-bit-map match if there isn't a
980              * conflict.  If there is a conflict (both nodes match something
981              * outside the bitmap, but what they match outside is not the same
982              * pointer, and hence not easily compared until XXX we extend
983              * inversion lists this far), give up and allow the start class to
984              * match everything outside the bitmap.  If that stuff is all above
985              * 255, can just set UNICODE_ALL, otherwise caould be anything. */
986             if (! ANYOF_NONBITMAP(cl)) {
987                 ARG_SET(cl, ARG(or_with));
988             }
989             else if (ARG(cl) != ARG(or_with)) {
990
991                 if ((or_with->flags & ANYOF_NONBITMAP_NON_UTF8)) {
992                     cl_anything(pRExC_state, cl);
993                 }
994                 else {
995                     cl->flags |= ANYOF_UNICODE_ALL;
996                 }
997             }
998         }
999
1000         /* Take the union */
1001         cl->flags |= or_with->flags;
1002     }
1003 }
1004
1005 #define TRIE_LIST_ITEM(state,idx) (trie->states[state].trans.list)[ idx ]
1006 #define TRIE_LIST_CUR(state)  ( TRIE_LIST_ITEM( state, 0 ).forid )
1007 #define TRIE_LIST_LEN(state) ( TRIE_LIST_ITEM( state, 0 ).newstate )
1008 #define TRIE_LIST_USED(idx)  ( trie->states[state].trans.list ? (TRIE_LIST_CUR( idx ) - 1) : 0 )
1009
1010
1011 #ifdef DEBUGGING
1012 /*
1013    dump_trie(trie,widecharmap,revcharmap)
1014    dump_trie_interim_list(trie,widecharmap,revcharmap,next_alloc)
1015    dump_trie_interim_table(trie,widecharmap,revcharmap,next_alloc)
1016
1017    These routines dump out a trie in a somewhat readable format.
1018    The _interim_ variants are used for debugging the interim
1019    tables that are used to generate the final compressed
1020    representation which is what dump_trie expects.
1021
1022    Part of the reason for their existence is to provide a form
1023    of documentation as to how the different representations function.
1024
1025 */
1026
1027 /*
1028   Dumps the final compressed table form of the trie to Perl_debug_log.
1029   Used for debugging make_trie().
1030 */
1031
1032 STATIC void
1033 S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap,
1034             AV *revcharmap, U32 depth)
1035 {
1036     U32 state;
1037     SV *sv=sv_newmortal();
1038     int colwidth= widecharmap ? 6 : 4;
1039     U16 word;
1040     GET_RE_DEBUG_FLAGS_DECL;
1041
1042     PERL_ARGS_ASSERT_DUMP_TRIE;
1043
1044     PerlIO_printf( Perl_debug_log, "%*sChar : %-6s%-6s%-4s ",
1045         (int)depth * 2 + 2,"",
1046         "Match","Base","Ofs" );
1047
1048     for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
1049         SV ** const tmp = av_fetch( revcharmap, state, 0);
1050         if ( tmp ) {
1051             PerlIO_printf( Perl_debug_log, "%*s", 
1052                 colwidth,
1053                 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
1054                             PL_colors[0], PL_colors[1],
1055                             (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
1056                             PERL_PV_ESCAPE_FIRSTCHAR 
1057                 ) 
1058             );
1059         }
1060     }
1061     PerlIO_printf( Perl_debug_log, "\n%*sState|-----------------------",
1062         (int)depth * 2 + 2,"");
1063
1064     for( state = 0 ; state < trie->uniquecharcount ; state++ )
1065         PerlIO_printf( Perl_debug_log, "%.*s", colwidth, "--------");
1066     PerlIO_printf( Perl_debug_log, "\n");
1067
1068     for( state = 1 ; state < trie->statecount ; state++ ) {
1069         const U32 base = trie->states[ state ].trans.base;
1070
1071         PerlIO_printf( Perl_debug_log, "%*s#%4"UVXf"|", (int)depth * 2 + 2,"", (UV)state);
1072
1073         if ( trie->states[ state ].wordnum ) {
1074             PerlIO_printf( Perl_debug_log, " W%4X", trie->states[ state ].wordnum );
1075         } else {
1076             PerlIO_printf( Perl_debug_log, "%6s", "" );
1077         }
1078
1079         PerlIO_printf( Perl_debug_log, " @%4"UVXf" ", (UV)base );
1080
1081         if ( base ) {
1082             U32 ofs = 0;
1083
1084             while( ( base + ofs  < trie->uniquecharcount ) ||
1085                    ( base + ofs - trie->uniquecharcount < trie->lasttrans
1086                      && trie->trans[ base + ofs - trie->uniquecharcount ].check != state))
1087                     ofs++;
1088
1089             PerlIO_printf( Perl_debug_log, "+%2"UVXf"[ ", (UV)ofs);
1090
1091             for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
1092                 if ( ( base + ofs >= trie->uniquecharcount ) &&
1093                      ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
1094                      trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
1095                 {
1096                    PerlIO_printf( Perl_debug_log, "%*"UVXf,
1097                     colwidth,
1098                     (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next );
1099                 } else {
1100                     PerlIO_printf( Perl_debug_log, "%*s",colwidth,"   ." );
1101                 }
1102             }
1103
1104             PerlIO_printf( Perl_debug_log, "]");
1105
1106         }
1107         PerlIO_printf( Perl_debug_log, "\n" );
1108     }
1109     PerlIO_printf(Perl_debug_log, "%*sword_info N:(prev,len)=", (int)depth*2, "");
1110     for (word=1; word <= trie->wordcount; word++) {
1111         PerlIO_printf(Perl_debug_log, " %d:(%d,%d)",
1112             (int)word, (int)(trie->wordinfo[word].prev),
1113             (int)(trie->wordinfo[word].len));
1114     }
1115     PerlIO_printf(Perl_debug_log, "\n" );
1116 }    
1117 /*
1118   Dumps a fully constructed but uncompressed trie in list form.
1119   List tries normally only are used for construction when the number of 
1120   possible chars (trie->uniquecharcount) is very high.
1121   Used for debugging make_trie().
1122 */
1123 STATIC void
1124 S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie,
1125                          HV *widecharmap, AV *revcharmap, U32 next_alloc,
1126                          U32 depth)
1127 {
1128     U32 state;
1129     SV *sv=sv_newmortal();
1130     int colwidth= widecharmap ? 6 : 4;
1131     GET_RE_DEBUG_FLAGS_DECL;
1132
1133     PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_LIST;
1134
1135     /* print out the table precompression.  */
1136     PerlIO_printf( Perl_debug_log, "%*sState :Word | Transition Data\n%*s%s",
1137         (int)depth * 2 + 2,"", (int)depth * 2 + 2,"",
1138         "------:-----+-----------------\n" );
1139     
1140     for( state=1 ; state < next_alloc ; state ++ ) {
1141         U16 charid;
1142     
1143         PerlIO_printf( Perl_debug_log, "%*s %4"UVXf" :",
1144             (int)depth * 2 + 2,"", (UV)state  );
1145         if ( ! trie->states[ state ].wordnum ) {
1146             PerlIO_printf( Perl_debug_log, "%5s| ","");
1147         } else {
1148             PerlIO_printf( Perl_debug_log, "W%4x| ",
1149                 trie->states[ state ].wordnum
1150             );
1151         }
1152         for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
1153             SV ** const tmp = av_fetch( revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0);
1154             if ( tmp ) {
1155                 PerlIO_printf( Perl_debug_log, "%*s:%3X=%4"UVXf" | ",
1156                     colwidth,
1157                     pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
1158                             PL_colors[0], PL_colors[1],
1159                             (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
1160                             PERL_PV_ESCAPE_FIRSTCHAR 
1161                     ) ,
1162                     TRIE_LIST_ITEM(state,charid).forid,
1163                     (UV)TRIE_LIST_ITEM(state,charid).newstate
1164                 );
1165                 if (!(charid % 10)) 
1166                     PerlIO_printf(Perl_debug_log, "\n%*s| ",
1167                         (int)((depth * 2) + 14), "");
1168             }
1169         }
1170         PerlIO_printf( Perl_debug_log, "\n");
1171     }
1172 }    
1173
1174 /*
1175   Dumps a fully constructed but uncompressed trie in table form.
1176   This is the normal DFA style state transition table, with a few 
1177   twists to facilitate compression later. 
1178   Used for debugging make_trie().
1179 */
1180 STATIC void
1181 S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie,
1182                           HV *widecharmap, AV *revcharmap, U32 next_alloc,
1183                           U32 depth)
1184 {
1185     U32 state;
1186     U16 charid;
1187     SV *sv=sv_newmortal();
1188     int colwidth= widecharmap ? 6 : 4;
1189     GET_RE_DEBUG_FLAGS_DECL;
1190
1191     PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_TABLE;
1192     
1193     /*
1194        print out the table precompression so that we can do a visual check
1195        that they are identical.
1196      */
1197     
1198     PerlIO_printf( Perl_debug_log, "%*sChar : ",(int)depth * 2 + 2,"" );
1199
1200     for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
1201         SV ** const tmp = av_fetch( revcharmap, charid, 0);
1202         if ( tmp ) {
1203             PerlIO_printf( Perl_debug_log, "%*s", 
1204                 colwidth,
1205                 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
1206                             PL_colors[0], PL_colors[1],
1207                             (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
1208                             PERL_PV_ESCAPE_FIRSTCHAR 
1209                 ) 
1210             );
1211         }
1212     }
1213
1214     PerlIO_printf( Perl_debug_log, "\n%*sState+-",(int)depth * 2 + 2,"" );
1215
1216     for( charid=0 ; charid < trie->uniquecharcount ; charid++ ) {
1217         PerlIO_printf( Perl_debug_log, "%.*s", colwidth,"--------");
1218     }
1219
1220     PerlIO_printf( Perl_debug_log, "\n" );
1221
1222     for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
1223
1224         PerlIO_printf( Perl_debug_log, "%*s%4"UVXf" : ", 
1225             (int)depth * 2 + 2,"",
1226             (UV)TRIE_NODENUM( state ) );
1227
1228         for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
1229             UV v=(UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next );
1230             if (v)
1231                 PerlIO_printf( Perl_debug_log, "%*"UVXf, colwidth, v );
1232             else
1233                 PerlIO_printf( Perl_debug_log, "%*s", colwidth, "." );
1234         }
1235         if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
1236             PerlIO_printf( Perl_debug_log, " (%4"UVXf")\n", (UV)trie->trans[ state ].check );
1237         } else {
1238             PerlIO_printf( Perl_debug_log, " (%4"UVXf") W%4X\n", (UV)trie->trans[ state ].check,
1239             trie->states[ TRIE_NODENUM( state ) ].wordnum );
1240         }
1241     }
1242 }
1243
1244 #endif
1245
1246
1247 /* make_trie(startbranch,first,last,tail,word_count,flags,depth)
1248   startbranch: the first branch in the whole branch sequence
1249   first      : start branch of sequence of branch-exact nodes.
1250                May be the same as startbranch
1251   last       : Thing following the last branch.
1252                May be the same as tail.
1253   tail       : item following the branch sequence
1254   count      : words in the sequence
1255   flags      : currently the OP() type we will be building one of /EXACT(|F|Fl)/
1256   depth      : indent depth
1257
1258 Inplace optimizes a sequence of 2 or more Branch-Exact nodes into a TRIE node.
1259
1260 A trie is an N'ary tree where the branches are determined by digital
1261 decomposition of the key. IE, at the root node you look up the 1st character and
1262 follow that branch repeat until you find the end of the branches. Nodes can be
1263 marked as "accepting" meaning they represent a complete word. Eg:
1264
1265   /he|she|his|hers/
1266
1267 would convert into the following structure. Numbers represent states, letters
1268 following numbers represent valid transitions on the letter from that state, if
1269 the number is in square brackets it represents an accepting state, otherwise it
1270 will be in parenthesis.
1271
1272       +-h->+-e->[3]-+-r->(8)-+-s->[9]
1273       |    |
1274       |   (2)
1275       |    |
1276      (1)   +-i->(6)-+-s->[7]
1277       |
1278       +-s->(3)-+-h->(4)-+-e->[5]
1279
1280       Accept Word Mapping: 3=>1 (he),5=>2 (she), 7=>3 (his), 9=>4 (hers)
1281
1282 This shows that when matching against the string 'hers' we will begin at state 1
1283 read 'h' and move to state 2, read 'e' and move to state 3 which is accepting,
1284 then read 'r' and go to state 8 followed by 's' which takes us to state 9 which
1285 is also accepting. Thus we know that we can match both 'he' and 'hers' with a
1286 single traverse. We store a mapping from accepting to state to which word was
1287 matched, and then when we have multiple possibilities we try to complete the
1288 rest of the regex in the order in which they occured in the alternation.
1289
1290 The only prior NFA like behaviour that would be changed by the TRIE support is
1291 the silent ignoring of duplicate alternations which are of the form:
1292
1293  / (DUPE|DUPE) X? (?{ ... }) Y /x
1294
1295 Thus EVAL blocks following a trie may be called a different number of times with
1296 and without the optimisation. With the optimisations dupes will be silently
1297 ignored. This inconsistent behaviour of EVAL type nodes is well established as
1298 the following demonstrates:
1299
1300  'words'=~/(word|word|word)(?{ print $1 })[xyz]/
1301
1302 which prints out 'word' three times, but
1303
1304  'words'=~/(word|word|word)(?{ print $1 })S/
1305
1306 which doesnt print it out at all. This is due to other optimisations kicking in.
1307
1308 Example of what happens on a structural level:
1309
1310 The regexp /(ac|ad|ab)+/ will produce the following debug output:
1311
1312    1: CURLYM[1] {1,32767}(18)
1313    5:   BRANCH(8)
1314    6:     EXACT <ac>(16)
1315    8:   BRANCH(11)
1316    9:     EXACT <ad>(16)
1317   11:   BRANCH(14)
1318   12:     EXACT <ab>(16)
1319   16:   SUCCEED(0)
1320   17:   NOTHING(18)
1321   18: END(0)
1322
1323 This would be optimizable with startbranch=5, first=5, last=16, tail=16
1324 and should turn into:
1325
1326    1: CURLYM[1] {1,32767}(18)
1327    5:   TRIE(16)
1328         [Words:3 Chars Stored:6 Unique Chars:4 States:5 NCP:1]
1329           <ac>
1330           <ad>
1331           <ab>
1332   16:   SUCCEED(0)
1333   17:   NOTHING(18)
1334   18: END(0)
1335
1336 Cases where tail != last would be like /(?foo|bar)baz/:
1337
1338    1: BRANCH(4)
1339    2:   EXACT <foo>(8)
1340    4: BRANCH(7)
1341    5:   EXACT <bar>(8)
1342    7: TAIL(8)
1343    8: EXACT <baz>(10)
1344   10: END(0)
1345
1346 which would be optimizable with startbranch=1, first=1, last=7, tail=8
1347 and would end up looking like:
1348
1349     1: TRIE(8)
1350       [Words:2 Chars Stored:6 Unique Chars:5 States:7 NCP:1]
1351         <foo>
1352         <bar>
1353    7: TAIL(8)
1354    8: EXACT <baz>(10)
1355   10: END(0)
1356
1357     d = uvuni_to_utf8_flags(d, uv, 0);
1358
1359 is the recommended Unicode-aware way of saying
1360
1361     *(d++) = uv;
1362 */
1363
1364 #define TRIE_STORE_REVCHAR                                                 \
1365     STMT_START {                                                           \
1366         if (UTF) {                                                         \
1367             SV *zlopp = newSV(2);                                          \
1368             unsigned char *flrbbbbb = (unsigned char *) SvPVX(zlopp);      \
1369             unsigned const char *const kapow = uvuni_to_utf8(flrbbbbb, uvc & 0xFF); \
1370             SvCUR_set(zlopp, kapow - flrbbbbb);                            \
1371             SvPOK_on(zlopp);                                               \
1372             SvUTF8_on(zlopp);                                              \
1373             av_push(revcharmap, zlopp);                                    \
1374         } else {                                                           \
1375             char ooooff = (char)uvc;                                               \
1376             av_push(revcharmap, newSVpvn(&ooooff, 1));                     \
1377         }                                                                  \
1378         } STMT_END
1379
1380 #define TRIE_READ_CHAR STMT_START {                                           \
1381     wordlen++;                                                                \
1382     if ( UTF ) {                                                              \
1383         if ( folder ) {                                                       \
1384             if ( foldlen > 0 ) {                                              \
1385                uvc = utf8n_to_uvuni( scan, UTF8_MAXLEN, &len, uniflags );     \
1386                foldlen -= len;                                                \
1387                scan += len;                                                   \
1388                len = 0;                                                       \
1389             } else {                                                          \
1390                 len = UTF8SKIP(uc);\
1391                 uvc = to_utf8_fold( uc, foldbuf, &foldlen);                   \
1392                 foldlen -= UNISKIP( uvc );                                    \
1393                 scan = foldbuf + UNISKIP( uvc );                              \
1394             }                                                                 \
1395         } else {                                                              \
1396             uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
1397         }                                                                     \
1398     } else {                                                                  \
1399         uvc = (U32)*uc;                                                       \
1400         len = 1;                                                              \
1401     }                                                                         \
1402 } STMT_END
1403
1404
1405
1406 #define TRIE_LIST_PUSH(state,fid,ns) STMT_START {               \
1407     if ( TRIE_LIST_CUR( state ) >=TRIE_LIST_LEN( state ) ) {    \
1408         U32 ging = TRIE_LIST_LEN( state ) *= 2;                 \
1409         Renew( trie->states[ state ].trans.list, ging, reg_trie_trans_le ); \
1410     }                                                           \
1411     TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).forid = fid;     \
1412     TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).newstate = ns;   \
1413     TRIE_LIST_CUR( state )++;                                   \
1414 } STMT_END
1415
1416 #define TRIE_LIST_NEW(state) STMT_START {                       \
1417     Newxz( trie->states[ state ].trans.list,               \
1418         4, reg_trie_trans_le );                                 \
1419      TRIE_LIST_CUR( state ) = 1;                                \
1420      TRIE_LIST_LEN( state ) = 4;                                \
1421 } STMT_END
1422
1423 #define TRIE_HANDLE_WORD(state) STMT_START {                    \
1424     U16 dupe= trie->states[ state ].wordnum;                    \
1425     regnode * const noper_next = regnext( noper );              \
1426                                                                 \
1427     DEBUG_r({                                                   \
1428         /* store the word for dumping */                        \
1429         SV* tmp;                                                \
1430         if (OP(noper) != NOTHING)                               \
1431             tmp = newSVpvn_utf8(STRING(noper), STR_LEN(noper), UTF);    \
1432         else                                                    \
1433             tmp = newSVpvn_utf8( "", 0, UTF );                  \
1434         av_push( trie_words, tmp );                             \
1435     });                                                         \
1436                                                                 \
1437     curword++;                                                  \
1438     trie->wordinfo[curword].prev   = 0;                         \
1439     trie->wordinfo[curword].len    = wordlen;                   \
1440     trie->wordinfo[curword].accept = state;                     \
1441                                                                 \
1442     if ( noper_next < tail ) {                                  \
1443         if (!trie->jump)                                        \
1444             trie->jump = (U16 *) PerlMemShared_calloc( word_count + 1, sizeof(U16) ); \
1445         trie->jump[curword] = (U16)(noper_next - convert);      \
1446         if (!jumper)                                            \
1447             jumper = noper_next;                                \
1448         if (!nextbranch)                                        \
1449             nextbranch= regnext(cur);                           \
1450     }                                                           \
1451                                                                 \
1452     if ( dupe ) {                                               \
1453         /* It's a dupe. Pre-insert into the wordinfo[].prev   */\
1454         /* chain, so that when the bits of chain are later    */\
1455         /* linked together, the dups appear in the chain      */\
1456         trie->wordinfo[curword].prev = trie->wordinfo[dupe].prev; \
1457         trie->wordinfo[dupe].prev = curword;                    \
1458     } else {                                                    \
1459         /* we haven't inserted this word yet.                */ \
1460         trie->states[ state ].wordnum = curword;                \
1461     }                                                           \
1462 } STMT_END
1463
1464
1465 #define TRIE_TRANS_STATE(state,base,ucharcount,charid,special)          \
1466      ( ( base + charid >=  ucharcount                                   \
1467          && base + charid < ubound                                      \
1468          && state == trie->trans[ base - ucharcount + charid ].check    \
1469          && trie->trans[ base - ucharcount + charid ].next )            \
1470            ? trie->trans[ base - ucharcount + charid ].next             \
1471            : ( state==1 ? special : 0 )                                 \
1472       )
1473
1474 #define MADE_TRIE       1
1475 #define MADE_JUMP_TRIE  2
1476 #define MADE_EXACT_TRIE 4
1477
1478 STATIC I32
1479 S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 word_count, U32 flags, U32 depth)
1480 {
1481     dVAR;
1482     /* first pass, loop through and scan words */
1483     reg_trie_data *trie;
1484     HV *widecharmap = NULL;
1485     AV *revcharmap = newAV();
1486     regnode *cur;
1487     const U32 uniflags = UTF8_ALLOW_DEFAULT;
1488     STRLEN len = 0;
1489     UV uvc = 0;
1490     U16 curword = 0;
1491     U32 next_alloc = 0;
1492     regnode *jumper = NULL;
1493     regnode *nextbranch = NULL;
1494     regnode *convert = NULL;
1495     U32 *prev_states; /* temp array mapping each state to previous one */
1496     /* we just use folder as a flag in utf8 */
1497     const U8 * folder = NULL;
1498
1499 #ifdef DEBUGGING
1500     const U32 data_slot = add_data( pRExC_state, 4, "tuuu" );
1501     AV *trie_words = NULL;
1502     /* along with revcharmap, this only used during construction but both are
1503      * useful during debugging so we store them in the struct when debugging.
1504      */
1505 #else
1506     const U32 data_slot = add_data( pRExC_state, 2, "tu" );
1507     STRLEN trie_charcount=0;
1508 #endif
1509     SV *re_trie_maxbuff;
1510     GET_RE_DEBUG_FLAGS_DECL;
1511
1512     PERL_ARGS_ASSERT_MAKE_TRIE;
1513 #ifndef DEBUGGING
1514     PERL_UNUSED_ARG(depth);
1515 #endif
1516
1517     switch (flags) {
1518         case EXACT: break;
1519         case EXACTFA:
1520         case EXACTFU: folder = PL_fold_latin1; break;
1521         case EXACTF:  folder = PL_fold; break;
1522         case EXACTFL: folder = PL_fold_locale; break;
1523         default: Perl_croak( aTHX_ "panic! In trie construction, unknown node type %u", (unsigned) flags );
1524     }
1525
1526     trie = (reg_trie_data *) PerlMemShared_calloc( 1, sizeof(reg_trie_data) );
1527     trie->refcount = 1;
1528     trie->startstate = 1;
1529     trie->wordcount = word_count;
1530     RExC_rxi->data->data[ data_slot ] = (void*)trie;
1531     trie->charmap = (U16 *) PerlMemShared_calloc( 256, sizeof(U16) );
1532     if (!(UTF && folder))
1533         trie->bitmap = (char *) PerlMemShared_calloc( ANYOF_BITMAP_SIZE, 1 );
1534     trie->wordinfo = (reg_trie_wordinfo *) PerlMemShared_calloc(
1535                        trie->wordcount+1, sizeof(reg_trie_wordinfo));
1536
1537     DEBUG_r({
1538         trie_words = newAV();
1539     });
1540
1541     re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
1542     if (!SvIOK(re_trie_maxbuff)) {
1543         sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
1544     }
1545     DEBUG_OPTIMISE_r({
1546                 PerlIO_printf( Perl_debug_log,
1547                   "%*smake_trie start==%d, first==%d, last==%d, tail==%d depth=%d\n",
1548                   (int)depth * 2 + 2, "", 
1549                   REG_NODE_NUM(startbranch),REG_NODE_NUM(first), 
1550                   REG_NODE_NUM(last), REG_NODE_NUM(tail),
1551                   (int)depth);
1552     });
1553    
1554    /* Find the node we are going to overwrite */
1555     if ( first == startbranch && OP( last ) != BRANCH ) {
1556         /* whole branch chain */
1557         convert = first;
1558     } else {
1559         /* branch sub-chain */
1560         convert = NEXTOPER( first );
1561     }
1562         
1563     /*  -- First loop and Setup --
1564
1565        We first traverse the branches and scan each word to determine if it
1566        contains widechars, and how many unique chars there are, this is
1567        important as we have to build a table with at least as many columns as we
1568        have unique chars.
1569
1570        We use an array of integers to represent the character codes 0..255
1571        (trie->charmap) and we use a an HV* to store Unicode characters. We use the
1572        native representation of the character value as the key and IV's for the
1573        coded index.
1574
1575        *TODO* If we keep track of how many times each character is used we can
1576        remap the columns so that the table compression later on is more
1577        efficient in terms of memory by ensuring the most common value is in the
1578        middle and the least common are on the outside.  IMO this would be better
1579        than a most to least common mapping as theres a decent chance the most
1580        common letter will share a node with the least common, meaning the node
1581        will not be compressible. With a middle is most common approach the worst
1582        case is when we have the least common nodes twice.
1583
1584      */
1585
1586     for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1587         regnode * const noper = NEXTOPER( cur );
1588         const U8 *uc = (U8*)STRING( noper );
1589         const U8 * const e  = uc + STR_LEN( noper );
1590         STRLEN foldlen = 0;
1591         U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1592         const U8 *scan = (U8*)NULL;
1593         U32 wordlen      = 0;         /* required init */
1594         STRLEN chars = 0;
1595         bool set_bit = trie->bitmap ? 1 : 0; /*store the first char in the bitmap?*/
1596
1597         if (OP(noper) == NOTHING) {
1598             trie->minlen= 0;
1599             continue;
1600         }
1601         if ( set_bit ) /* bitmap only alloced when !(UTF&&Folding) */
1602             TRIE_BITMAP_SET(trie,*uc); /* store the raw first byte
1603                                           regardless of encoding */
1604
1605         for ( ; uc < e ; uc += len ) {
1606             TRIE_CHARCOUNT(trie)++;
1607             TRIE_READ_CHAR;
1608             chars++;
1609             if ( uvc < 256 ) {
1610                 if ( !trie->charmap[ uvc ] ) {
1611                     trie->charmap[ uvc ]=( ++trie->uniquecharcount );
1612                     if ( folder )
1613                         trie->charmap[ folder[ uvc ] ] = trie->charmap[ uvc ];
1614                     TRIE_STORE_REVCHAR;
1615                 }
1616                 if ( set_bit ) {
1617                     /* store the codepoint in the bitmap, and its folded
1618                      * equivalent. */
1619                     TRIE_BITMAP_SET(trie,uvc);
1620
1621                     /* store the folded codepoint */
1622                     if ( folder ) TRIE_BITMAP_SET(trie,folder[ uvc ]);
1623
1624                     if ( !UTF ) {
1625                         /* store first byte of utf8 representation of
1626                            variant codepoints */
1627                         if (! UNI_IS_INVARIANT(uvc)) {
1628                             TRIE_BITMAP_SET(trie, UTF8_TWO_BYTE_HI(uvc));
1629                         }
1630                     }
1631                     set_bit = 0; /* We've done our bit :-) */
1632                 }
1633             } else {
1634                 SV** svpp;
1635                 if ( !widecharmap )
1636                     widecharmap = newHV();
1637
1638                 svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 1 );
1639
1640                 if ( !svpp )
1641                     Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%"UVXf, uvc );
1642
1643                 if ( !SvTRUE( *svpp ) ) {
1644                     sv_setiv( *svpp, ++trie->uniquecharcount );
1645                     TRIE_STORE_REVCHAR;
1646                 }
1647             }
1648         }
1649         if( cur == first ) {
1650             trie->minlen=chars;
1651             trie->maxlen=chars;
1652         } else if (chars < trie->minlen) {
1653             trie->minlen=chars;
1654         } else if (chars > trie->maxlen) {
1655             trie->maxlen=chars;
1656         }
1657
1658     } /* end first pass */
1659     DEBUG_TRIE_COMPILE_r(
1660         PerlIO_printf( Perl_debug_log, "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
1661                 (int)depth * 2 + 2,"",
1662                 ( widecharmap ? "UTF8" : "NATIVE" ), (int)word_count,
1663                 (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount,
1664                 (int)trie->minlen, (int)trie->maxlen )
1665     );
1666
1667     /*
1668         We now know what we are dealing with in terms of unique chars and
1669         string sizes so we can calculate how much memory a naive
1670         representation using a flat table  will take. If it's over a reasonable
1671         limit (as specified by ${^RE_TRIE_MAXBUF}) we use a more memory
1672         conservative but potentially much slower representation using an array
1673         of lists.
1674
1675         At the end we convert both representations into the same compressed
1676         form that will be used in regexec.c for matching with. The latter
1677         is a form that cannot be used to construct with but has memory
1678         properties similar to the list form and access properties similar
1679         to the table form making it both suitable for fast searches and
1680         small enough that its feasable to store for the duration of a program.
1681
1682         See the comment in the code where the compressed table is produced
1683         inplace from the flat tabe representation for an explanation of how
1684         the compression works.
1685
1686     */
1687
1688
1689     Newx(prev_states, TRIE_CHARCOUNT(trie) + 2, U32);
1690     prev_states[1] = 0;
1691
1692     if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1) > SvIV(re_trie_maxbuff) ) {
1693         /*
1694             Second Pass -- Array Of Lists Representation
1695
1696             Each state will be represented by a list of charid:state records
1697             (reg_trie_trans_le) the first such element holds the CUR and LEN
1698             points of the allocated array. (See defines above).
1699
1700             We build the initial structure using the lists, and then convert
1701             it into the compressed table form which allows faster lookups
1702             (but cant be modified once converted).
1703         */
1704
1705         STRLEN transcount = 1;
1706
1707         DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log, 
1708             "%*sCompiling trie using list compiler\n",
1709             (int)depth * 2 + 2, ""));
1710
1711         trie->states = (reg_trie_state *)
1712             PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
1713                                   sizeof(reg_trie_state) );
1714         TRIE_LIST_NEW(1);
1715         next_alloc = 2;
1716
1717         for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1718
1719             regnode * const noper = NEXTOPER( cur );
1720             U8 *uc           = (U8*)STRING( noper );
1721             const U8 * const e = uc + STR_LEN( noper );
1722             U32 state        = 1;         /* required init */
1723             U16 charid       = 0;         /* sanity init */
1724             U8 *scan         = (U8*)NULL; /* sanity init */
1725             STRLEN foldlen   = 0;         /* required init */
1726             U32 wordlen      = 0;         /* required init */
1727             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1728
1729             if (OP(noper) != NOTHING) {
1730                 for ( ; uc < e ; uc += len ) {
1731
1732                     TRIE_READ_CHAR;
1733
1734                     if ( uvc < 256 ) {
1735                         charid = trie->charmap[ uvc ];
1736                     } else {
1737                         SV** const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
1738                         if ( !svpp ) {
1739                             charid = 0;
1740                         } else {
1741                             charid=(U16)SvIV( *svpp );
1742                         }
1743                     }
1744                     /* charid is now 0 if we dont know the char read, or nonzero if we do */
1745                     if ( charid ) {
1746
1747                         U16 check;
1748                         U32 newstate = 0;
1749
1750                         charid--;
1751                         if ( !trie->states[ state ].trans.list ) {
1752                             TRIE_LIST_NEW( state );
1753                         }
1754                         for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) {
1755                             if ( TRIE_LIST_ITEM( state, check ).forid == charid ) {
1756                                 newstate = TRIE_LIST_ITEM( state, check ).newstate;
1757                                 break;
1758                             }
1759                         }
1760                         if ( ! newstate ) {
1761                             newstate = next_alloc++;
1762                             prev_states[newstate] = state;
1763                             TRIE_LIST_PUSH( state, charid, newstate );
1764                             transcount++;
1765                         }
1766                         state = newstate;
1767                     } else {
1768                         Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1769                     }
1770                 }
1771             }
1772             TRIE_HANDLE_WORD(state);
1773
1774         } /* end second pass */
1775
1776         /* next alloc is the NEXT state to be allocated */
1777         trie->statecount = next_alloc; 
1778         trie->states = (reg_trie_state *)
1779             PerlMemShared_realloc( trie->states,
1780                                    next_alloc
1781                                    * sizeof(reg_trie_state) );
1782
1783         /* and now dump it out before we compress it */
1784         DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_list(trie, widecharmap,
1785                                                          revcharmap, next_alloc,
1786                                                          depth+1)
1787         );
1788
1789         trie->trans = (reg_trie_trans *)
1790             PerlMemShared_calloc( transcount, sizeof(reg_trie_trans) );
1791         {
1792             U32 state;
1793             U32 tp = 0;
1794             U32 zp = 0;
1795
1796
1797             for( state=1 ; state < next_alloc ; state ++ ) {
1798                 U32 base=0;
1799
1800                 /*
1801                 DEBUG_TRIE_COMPILE_MORE_r(
1802                     PerlIO_printf( Perl_debug_log, "tp: %d zp: %d ",tp,zp)
1803                 );
1804                 */
1805
1806                 if (trie->states[state].trans.list) {
1807                     U16 minid=TRIE_LIST_ITEM( state, 1).forid;
1808                     U16 maxid=minid;
1809                     U16 idx;
1810
1811                     for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1812                         const U16 forid = TRIE_LIST_ITEM( state, idx).forid;
1813                         if ( forid < minid ) {
1814                             minid=forid;
1815                         } else if ( forid > maxid ) {
1816                             maxid=forid;
1817                         }
1818                     }
1819                     if ( transcount < tp + maxid - minid + 1) {
1820                         transcount *= 2;
1821                         trie->trans = (reg_trie_trans *)
1822                             PerlMemShared_realloc( trie->trans,
1823                                                      transcount
1824                                                      * sizeof(reg_trie_trans) );
1825                         Zero( trie->trans + (transcount / 2), transcount / 2 , reg_trie_trans );
1826                     }
1827                     base = trie->uniquecharcount + tp - minid;
1828                     if ( maxid == minid ) {
1829                         U32 set = 0;
1830                         for ( ; zp < tp ; zp++ ) {
1831                             if ( ! trie->trans[ zp ].next ) {
1832                                 base = trie->uniquecharcount + zp - minid;
1833                                 trie->trans[ zp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1834                                 trie->trans[ zp ].check = state;
1835                                 set = 1;
1836                                 break;
1837                             }
1838                         }
1839                         if ( !set ) {
1840                             trie->trans[ tp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1841                             trie->trans[ tp ].check = state;
1842                             tp++;
1843                             zp = tp;
1844                         }
1845                     } else {
1846                         for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1847                             const U32 tid = base -  trie->uniquecharcount + TRIE_LIST_ITEM( state, idx ).forid;
1848                             trie->trans[ tid ].next = TRIE_LIST_ITEM( state, idx ).newstate;
1849                             trie->trans[ tid ].check = state;
1850                         }
1851                         tp += ( maxid - minid + 1 );
1852                     }
1853                     Safefree(trie->states[ state ].trans.list);
1854                 }
1855                 /*
1856                 DEBUG_TRIE_COMPILE_MORE_r(
1857                     PerlIO_printf( Perl_debug_log, " base: %d\n",base);
1858                 );
1859                 */
1860                 trie->states[ state ].trans.base=base;
1861             }
1862             trie->lasttrans = tp + 1;
1863         }
1864     } else {
1865         /*
1866            Second Pass -- Flat Table Representation.
1867
1868            we dont use the 0 slot of either trans[] or states[] so we add 1 to each.
1869            We know that we will need Charcount+1 trans at most to store the data
1870            (one row per char at worst case) So we preallocate both structures
1871            assuming worst case.
1872
1873            We then construct the trie using only the .next slots of the entry
1874            structs.
1875
1876            We use the .check field of the first entry of the node temporarily to
1877            make compression both faster and easier by keeping track of how many non
1878            zero fields are in the node.
1879
1880            Since trans are numbered from 1 any 0 pointer in the table is a FAIL
1881            transition.
1882
1883            There are two terms at use here: state as a TRIE_NODEIDX() which is a
1884            number representing the first entry of the node, and state as a
1885            TRIE_NODENUM() which is the trans number. state 1 is TRIE_NODEIDX(1) and
1886            TRIE_NODENUM(1), state 2 is TRIE_NODEIDX(2) and TRIE_NODENUM(3) if there
1887            are 2 entrys per node. eg:
1888
1889              A B       A B
1890           1. 2 4    1. 3 7
1891           2. 0 3    3. 0 5
1892           3. 0 0    5. 0 0
1893           4. 0 0    7. 0 0
1894
1895            The table is internally in the right hand, idx form. However as we also
1896            have to deal with the states array which is indexed by nodenum we have to
1897            use TRIE_NODENUM() to convert.
1898
1899         */
1900         DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log, 
1901             "%*sCompiling trie using table compiler\n",
1902             (int)depth * 2 + 2, ""));
1903
1904         trie->trans = (reg_trie_trans *)
1905             PerlMemShared_calloc( ( TRIE_CHARCOUNT(trie) + 1 )
1906                                   * trie->uniquecharcount + 1,
1907                                   sizeof(reg_trie_trans) );
1908         trie->states = (reg_trie_state *)
1909             PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
1910                                   sizeof(reg_trie_state) );
1911         next_alloc = trie->uniquecharcount + 1;
1912
1913
1914         for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1915
1916             regnode * const noper   = NEXTOPER( cur );
1917             const U8 *uc     = (U8*)STRING( noper );
1918             const U8 * const e = uc + STR_LEN( noper );
1919
1920             U32 state        = 1;         /* required init */
1921
1922             U16 charid       = 0;         /* sanity init */
1923             U32 accept_state = 0;         /* sanity init */
1924             U8 *scan         = (U8*)NULL; /* sanity init */
1925
1926             STRLEN foldlen   = 0;         /* required init */
1927             U32 wordlen      = 0;         /* required init */
1928             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1929
1930             if ( OP(noper) != NOTHING ) {
1931                 for ( ; uc < e ; uc += len ) {
1932
1933                     TRIE_READ_CHAR;
1934
1935                     if ( uvc < 256 ) {
1936                         charid = trie->charmap[ uvc ];
1937                     } else {
1938                         SV* const * const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
1939                         charid = svpp ? (U16)SvIV(*svpp) : 0;
1940                     }
1941                     if ( charid ) {
1942                         charid--;
1943                         if ( !trie->trans[ state + charid ].next ) {
1944                             trie->trans[ state + charid ].next = next_alloc;
1945                             trie->trans[ state ].check++;
1946                             prev_states[TRIE_NODENUM(next_alloc)]
1947                                     = TRIE_NODENUM(state);
1948                             next_alloc += trie->uniquecharcount;
1949                         }
1950                         state = trie->trans[ state + charid ].next;
1951                     } else {
1952                         Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1953                     }
1954                     /* charid is now 0 if we dont know the char read, or nonzero if we do */
1955                 }
1956             }
1957             accept_state = TRIE_NODENUM( state );
1958             TRIE_HANDLE_WORD(accept_state);
1959
1960         } /* end second pass */
1961
1962         /* and now dump it out before we compress it */
1963         DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_table(trie, widecharmap,
1964                                                           revcharmap,
1965                                                           next_alloc, depth+1));
1966
1967         {
1968         /*
1969            * Inplace compress the table.*
1970
1971            For sparse data sets the table constructed by the trie algorithm will
1972            be mostly 0/FAIL transitions or to put it another way mostly empty.
1973            (Note that leaf nodes will not contain any transitions.)
1974
1975            This algorithm compresses the tables by eliminating most such
1976            transitions, at the cost of a modest bit of extra work during lookup:
1977
1978            - Each states[] entry contains a .base field which indicates the
1979            index in the state[] array wheres its transition data is stored.
1980
1981            - If .base is 0 there are no valid transitions from that node.
1982
1983            - If .base is nonzero then charid is added to it to find an entry in
1984            the trans array.
1985
1986            -If trans[states[state].base+charid].check!=state then the
1987            transition is taken to be a 0/Fail transition. Thus if there are fail
1988            transitions at the front of the node then the .base offset will point
1989            somewhere inside the previous nodes data (or maybe even into a node
1990            even earlier), but the .check field determines if the transition is
1991            valid.
1992
1993            XXX - wrong maybe?
1994            The following process inplace converts the table to the compressed
1995            table: We first do not compress the root node 1,and mark all its
1996            .check pointers as 1 and set its .base pointer as 1 as well. This
1997            allows us to do a DFA construction from the compressed table later,
1998            and ensures that any .base pointers we calculate later are greater
1999            than 0.
2000
2001            - We set 'pos' to indicate the first entry of the second node.
2002
2003            - We then iterate over the columns of the node, finding the first and
2004            last used entry at l and m. We then copy l..m into pos..(pos+m-l),
2005            and set the .check pointers accordingly, and advance pos
2006            appropriately and repreat for the next node. Note that when we copy
2007            the next pointers we have to convert them from the original
2008            NODEIDX form to NODENUM form as the former is not valid post
2009            compression.
2010
2011            - If a node has no transitions used we mark its base as 0 and do not
2012            advance the pos pointer.
2013
2014            - If a node only has one transition we use a second pointer into the
2015            structure to fill in allocated fail transitions from other states.
2016            This pointer is independent of the main pointer and scans forward
2017            looking for null transitions that are allocated to a state. When it
2018            finds one it writes the single transition into the "hole".  If the
2019            pointer doesnt find one the single transition is appended as normal.
2020
2021            - Once compressed we can Renew/realloc the structures to release the
2022            excess space.
2023
2024            See "Table-Compression Methods" in sec 3.9 of the Red Dragon,
2025            specifically Fig 3.47 and the associated pseudocode.
2026
2027            demq
2028         */
2029         const U32 laststate = TRIE_NODENUM( next_alloc );
2030         U32 state, charid;
2031         U32 pos = 0, zp=0;
2032         trie->statecount = laststate;
2033
2034         for ( state = 1 ; state < laststate ; state++ ) {
2035             U8 flag = 0;
2036             const U32 stateidx = TRIE_NODEIDX( state );
2037             const U32 o_used = trie->trans[ stateidx ].check;
2038             U32 used = trie->trans[ stateidx ].check;
2039             trie->trans[ stateidx ].check = 0;
2040
2041             for ( charid = 0 ; used && charid < trie->uniquecharcount ; charid++ ) {
2042                 if ( flag || trie->trans[ stateidx + charid ].next ) {
2043                     if ( trie->trans[ stateidx + charid ].next ) {
2044                         if (o_used == 1) {
2045                             for ( ; zp < pos ; zp++ ) {
2046                                 if ( ! trie->trans[ zp ].next ) {
2047                                     break;
2048                                 }
2049                             }
2050                             trie->states[ state ].trans.base = zp + trie->uniquecharcount - charid ;
2051                             trie->trans[ zp ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
2052                             trie->trans[ zp ].check = state;
2053                             if ( ++zp > pos ) pos = zp;
2054                             break;
2055                         }
2056                         used--;
2057                     }
2058                     if ( !flag ) {
2059                         flag = 1;
2060                         trie->states[ state ].trans.base = pos + trie->uniquecharcount - charid ;
2061                     }
2062                     trie->trans[ pos ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
2063                     trie->trans[ pos ].check = state;
2064                     pos++;
2065                 }
2066             }
2067         }
2068         trie->lasttrans = pos + 1;
2069         trie->states = (reg_trie_state *)
2070             PerlMemShared_realloc( trie->states, laststate
2071                                    * sizeof(reg_trie_state) );
2072         DEBUG_TRIE_COMPILE_MORE_r(
2073                 PerlIO_printf( Perl_debug_log,
2074                     "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
2075                     (int)depth * 2 + 2,"",
2076                     (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1 ),
2077                     (IV)next_alloc,
2078                     (IV)pos,
2079                     ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
2080             );
2081
2082         } /* end table compress */
2083     }
2084     DEBUG_TRIE_COMPILE_MORE_r(
2085             PerlIO_printf(Perl_debug_log, "%*sStatecount:%"UVxf" Lasttrans:%"UVxf"\n",
2086                 (int)depth * 2 + 2, "",
2087                 (UV)trie->statecount,
2088                 (UV)trie->lasttrans)
2089     );
2090     /* resize the trans array to remove unused space */
2091     trie->trans = (reg_trie_trans *)
2092         PerlMemShared_realloc( trie->trans, trie->lasttrans
2093                                * sizeof(reg_trie_trans) );
2094
2095     {   /* Modify the program and insert the new TRIE node */ 
2096         U8 nodetype =(U8)(flags & 0xFF);
2097         char *str=NULL;
2098         
2099 #ifdef DEBUGGING
2100         regnode *optimize = NULL;
2101 #ifdef RE_TRACK_PATTERN_OFFSETS
2102
2103         U32 mjd_offset = 0;
2104         U32 mjd_nodelen = 0;
2105 #endif /* RE_TRACK_PATTERN_OFFSETS */
2106 #endif /* DEBUGGING */
2107         /*
2108            This means we convert either the first branch or the first Exact,
2109            depending on whether the thing following (in 'last') is a branch
2110            or not and whther first is the startbranch (ie is it a sub part of
2111            the alternation or is it the whole thing.)
2112            Assuming its a sub part we convert the EXACT otherwise we convert
2113            the whole branch sequence, including the first.
2114          */
2115         /* Find the node we are going to overwrite */
2116         if ( first != startbranch || OP( last ) == BRANCH ) {
2117             /* branch sub-chain */
2118             NEXT_OFF( first ) = (U16)(last - first);
2119 #ifdef RE_TRACK_PATTERN_OFFSETS
2120             DEBUG_r({
2121                 mjd_offset= Node_Offset((convert));
2122                 mjd_nodelen= Node_Length((convert));
2123             });
2124 #endif
2125             /* whole branch chain */
2126         }
2127 #ifdef RE_TRACK_PATTERN_OFFSETS
2128         else {
2129             DEBUG_r({
2130                 const  regnode *nop = NEXTOPER( convert );
2131                 mjd_offset= Node_Offset((nop));
2132                 mjd_nodelen= Node_Length((nop));
2133             });
2134         }
2135         DEBUG_OPTIMISE_r(
2136             PerlIO_printf(Perl_debug_log, "%*sMJD offset:%"UVuf" MJD length:%"UVuf"\n",
2137                 (int)depth * 2 + 2, "",
2138                 (UV)mjd_offset, (UV)mjd_nodelen)
2139         );
2140 #endif
2141         /* But first we check to see if there is a common prefix we can 
2142            split out as an EXACT and put in front of the TRIE node.  */
2143         trie->startstate= 1;
2144         if ( trie->bitmap && !widecharmap && !trie->jump  ) {
2145             U32 state;
2146             for ( state = 1 ; state < trie->statecount-1 ; state++ ) {
2147                 U32 ofs = 0;
2148                 I32 idx = -1;
2149                 U32 count = 0;
2150                 const U32 base = trie->states[ state ].trans.base;
2151
2152                 if ( trie->states[state].wordnum )
2153                         count = 1;
2154
2155                 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
2156                     if ( ( base + ofs >= trie->uniquecharcount ) &&
2157                          ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
2158                          trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
2159                     {
2160                         if ( ++count > 1 ) {
2161                             SV **tmp = av_fetch( revcharmap, ofs, 0);
2162                             const U8 *ch = (U8*)SvPV_nolen_const( *tmp );
2163                             if ( state == 1 ) break;
2164                             if ( count == 2 ) {
2165                                 Zero(trie->bitmap, ANYOF_BITMAP_SIZE, char);
2166                                 DEBUG_OPTIMISE_r(
2167                                     PerlIO_printf(Perl_debug_log,
2168                                         "%*sNew Start State=%"UVuf" Class: [",
2169                                         (int)depth * 2 + 2, "",
2170                                         (UV)state));
2171                                 if (idx >= 0) {
2172                                     SV ** const tmp = av_fetch( revcharmap, idx, 0);
2173                                     const U8 * const ch = (U8*)SvPV_nolen_const( *tmp );
2174
2175                                     TRIE_BITMAP_SET(trie,*ch);
2176                                     if ( folder )
2177                                         TRIE_BITMAP_SET(trie, folder[ *ch ]);
2178                                     DEBUG_OPTIMISE_r(
2179                                         PerlIO_printf(Perl_debug_log, "%s", (char*)ch)
2180                                     );
2181                                 }
2182                             }
2183                             TRIE_BITMAP_SET(trie,*ch);
2184                             if ( folder )
2185                                 TRIE_BITMAP_SET(trie,folder[ *ch ]);
2186                             DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"%s", ch));
2187                         }
2188                         idx = ofs;
2189                     }
2190                 }
2191                 if ( count == 1 ) {
2192                     SV **tmp = av_fetch( revcharmap, idx, 0);
2193                     STRLEN len;
2194                     char *ch = SvPV( *tmp, len );
2195                     DEBUG_OPTIMISE_r({
2196                         SV *sv=sv_newmortal();
2197                         PerlIO_printf( Perl_debug_log,
2198                             "%*sPrefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
2199                             (int)depth * 2 + 2, "",
2200                             (UV)state, (UV)idx, 
2201                             pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6, 
2202                                 PL_colors[0], PL_colors[1],
2203                                 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
2204                                 PERL_PV_ESCAPE_FIRSTCHAR 
2205                             )
2206                         );
2207                     });
2208                     if ( state==1 ) {
2209                         OP( convert ) = nodetype;
2210                         str=STRING(convert);
2211                         STR_LEN(convert)=0;
2212                     }
2213                     STR_LEN(convert) += len;
2214                     while (len--)
2215                         *str++ = *ch++;
2216                 } else {
2217 #ifdef DEBUGGING            
2218                     if (state>1)
2219                         DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"]\n"));
2220 #endif
2221                     break;
2222                 }
2223             }
2224             trie->prefixlen = (state-1);
2225             if (str) {
2226                 regnode *n = convert+NODE_SZ_STR(convert);
2227                 NEXT_OFF(convert) = NODE_SZ_STR(convert);
2228                 trie->startstate = state;
2229                 trie->minlen -= (state - 1);
2230                 trie->maxlen -= (state - 1);
2231 #ifdef DEBUGGING
2232                /* At least the UNICOS C compiler choked on this
2233                 * being argument to DEBUG_r(), so let's just have
2234                 * it right here. */
2235                if (
2236 #ifdef PERL_EXT_RE_BUILD
2237                    1
2238 #else
2239                    DEBUG_r_TEST
2240 #endif
2241                    ) {
2242                    regnode *fix = convert;
2243                    U32 word = trie->wordcount;
2244                    mjd_nodelen++;
2245                    Set_Node_Offset_Length(convert, mjd_offset, state - 1);
2246                    while( ++fix < n ) {
2247                        Set_Node_Offset_Length(fix, 0, 0);
2248                    }
2249                    while (word--) {
2250                        SV ** const tmp = av_fetch( trie_words, word, 0 );
2251                        if (tmp) {
2252                            if ( STR_LEN(convert) <= SvCUR(*tmp) )
2253                                sv_chop(*tmp, SvPV_nolen(*tmp) + STR_LEN(convert));
2254                            else
2255                                sv_chop(*tmp, SvPV_nolen(*tmp) + SvCUR(*tmp));
2256                        }
2257                    }
2258                }
2259 #endif
2260                 if (trie->maxlen) {
2261                     convert = n;
2262                 } else {
2263                     NEXT_OFF(convert) = (U16)(tail - convert);
2264                     DEBUG_r(optimize= n);
2265                 }
2266             }
2267         }
2268         if (!jumper) 
2269             jumper = last; 
2270         if ( trie->maxlen ) {
2271             NEXT_OFF( convert ) = (U16)(tail - convert);
2272             ARG_SET( convert, data_slot );
2273             /* Store the offset to the first unabsorbed branch in 
2274                jump[0], which is otherwise unused by the jump logic. 
2275                We use this when dumping a trie and during optimisation. */
2276             if (trie->jump) 
2277                 trie->jump[0] = (U16)(nextbranch - convert);
2278             
2279             /* If the start state is not accepting (meaning there is no empty string/NOTHING)
2280              *   and there is a bitmap
2281              *   and the first "jump target" node we found leaves enough room
2282              * then convert the TRIE node into a TRIEC node, with the bitmap
2283              * embedded inline in the opcode - this is hypothetically faster.
2284              */
2285             if ( !trie->states[trie->startstate].wordnum
2286                  && trie->bitmap
2287                  && ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) )
2288             {
2289                 OP( convert ) = TRIEC;
2290                 Copy(trie->bitmap, ((struct regnode_charclass *)convert)->bitmap, ANYOF_BITMAP_SIZE, char);
2291                 PerlMemShared_free(trie->bitmap);
2292                 trie->bitmap= NULL;
2293             } else 
2294                 OP( convert ) = TRIE;
2295
2296             /* store the type in the flags */
2297             convert->flags = nodetype;
2298             DEBUG_r({
2299             optimize = convert 
2300                       + NODE_STEP_REGNODE 
2301                       + regarglen[ OP( convert ) ];
2302             });
2303             /* XXX We really should free up the resource in trie now, 
2304                    as we won't use them - (which resources?) dmq */
2305         }
2306         /* needed for dumping*/
2307         DEBUG_r(if (optimize) {
2308             regnode *opt = convert;
2309
2310             while ( ++opt < optimize) {
2311                 Set_Node_Offset_Length(opt,0,0);
2312             }
2313             /* 
2314                 Try to clean up some of the debris left after the 
2315                 optimisation.
2316              */
2317             while( optimize < jumper ) {
2318                 mjd_nodelen += Node_Length((optimize));
2319                 OP( optimize ) = OPTIMIZED;
2320                 Set_Node_Offset_Length(optimize,0,0);
2321                 optimize++;
2322             }
2323             Set_Node_Offset_Length(convert,mjd_offset,mjd_nodelen);
2324         });
2325     } /* end node insert */
2326
2327     /*  Finish populating the prev field of the wordinfo array.  Walk back
2328      *  from each accept state until we find another accept state, and if
2329      *  so, point the first word's .prev field at the second word. If the
2330      *  second already has a .prev field set, stop now. This will be the
2331      *  case either if we've already processed that word's accept state,
2332      *  or that state had multiple words, and the overspill words were
2333      *  already linked up earlier.
2334      */
2335     {
2336         U16 word;
2337         U32 state;
2338         U16 prev;
2339
2340         for (word=1; word <= trie->wordcount; word++) {
2341             prev = 0;
2342             if (trie->wordinfo[word].prev)
2343                 continue;
2344             state = trie->wordinfo[word].accept;
2345             while (state) {
2346                 state = prev_states[state];
2347                 if (!state)
2348                     break;
2349                 prev = trie->states[state].wordnum;
2350                 if (prev)
2351                     break;
2352             }
2353             trie->wordinfo[word].prev = prev;
2354         }
2355         Safefree(prev_states);
2356     }
2357
2358
2359     /* and now dump out the compressed format */
2360     DEBUG_TRIE_COMPILE_r(dump_trie(trie, widecharmap, revcharmap, depth+1));
2361
2362     RExC_rxi->data->data[ data_slot + 1 ] = (void*)widecharmap;
2363 #ifdef DEBUGGING
2364     RExC_rxi->data->data[ data_slot + TRIE_WORDS_OFFSET ] = (void*)trie_words;
2365     RExC_rxi->data->data[ data_slot + 3 ] = (void*)revcharmap;
2366 #else
2367     SvREFCNT_dec(revcharmap);
2368 #endif
2369     return trie->jump 
2370            ? MADE_JUMP_TRIE 
2371            : trie->startstate>1 
2372              ? MADE_EXACT_TRIE 
2373              : MADE_TRIE;
2374 }
2375
2376 STATIC void
2377 S_make_trie_failtable(pTHX_ RExC_state_t *pRExC_state, regnode *source,  regnode *stclass, U32 depth)
2378 {
2379 /* The Trie is constructed and compressed now so we can build a fail array if it's needed
2380
2381    This is basically the Aho-Corasick algorithm. Its from exercise 3.31 and 3.32 in the
2382    "Red Dragon" -- Compilers, principles, techniques, and tools. Aho, Sethi, Ullman 1985/88
2383    ISBN 0-201-10088-6
2384
2385    We find the fail state for each state in the trie, this state is the longest proper
2386    suffix of the current state's 'word' that is also a proper prefix of another word in our
2387    trie. State 1 represents the word '' and is thus the default fail state. This allows
2388    the DFA not to have to restart after its tried and failed a word at a given point, it
2389    simply continues as though it had been matching the other word in the first place.
2390    Consider
2391       'abcdgu'=~/abcdefg|cdgu/
2392    When we get to 'd' we are still matching the first word, we would encounter 'g' which would
2393    fail, which would bring us to the state representing 'd' in the second word where we would
2394    try 'g' and succeed, proceeding to match 'cdgu'.
2395  */
2396  /* add a fail transition */
2397     const U32 trie_offset = ARG(source);
2398     reg_trie_data *trie=(reg_trie_data *)RExC_rxi->data->data[trie_offset];
2399     U32 *q;
2400     const U32 ucharcount = trie->uniquecharcount;
2401     const U32 numstates = trie->statecount;
2402     const U32 ubound = trie->lasttrans + ucharcount;
2403     U32 q_read = 0;
2404     U32 q_write = 0;
2405     U32 charid;
2406     U32 base = trie->states[ 1 ].trans.base;
2407     U32 *fail;
2408     reg_ac_data *aho;
2409     const U32 data_slot = add_data( pRExC_state, 1, "T" );
2410     GET_RE_DEBUG_FLAGS_DECL;
2411
2412     PERL_ARGS_ASSERT_MAKE_TRIE_FAILTABLE;
2413 #ifndef DEBUGGING
2414     PERL_UNUSED_ARG(depth);
2415 #endif
2416
2417
2418     ARG_SET( stclass, data_slot );
2419     aho = (reg_ac_data *) PerlMemShared_calloc( 1, sizeof(reg_ac_data) );
2420     RExC_rxi->data->data[ data_slot ] = (void*)aho;
2421     aho->trie=trie_offset;
2422     aho->states=(reg_trie_state *)PerlMemShared_malloc( numstates * sizeof(reg_trie_state) );
2423     Copy( trie->states, aho->states, numstates, reg_trie_state );
2424     Newxz( q, numstates, U32);
2425     aho->fail = (U32 *) PerlMemShared_calloc( numstates, sizeof(U32) );
2426     aho->refcount = 1;
2427     fail = aho->fail;
2428     /* initialize fail[0..1] to be 1 so that we always have
2429        a valid final fail state */
2430     fail[ 0 ] = fail[ 1 ] = 1;
2431
2432     for ( charid = 0; charid < ucharcount ; charid++ ) {
2433         const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 );
2434         if ( newstate ) {
2435             q[ q_write ] = newstate;
2436             /* set to point at the root */
2437             fail[ q[ q_write++ ] ]=1;
2438         }
2439     }
2440     while ( q_read < q_write) {
2441         const U32 cur = q[ q_read++ % numstates ];
2442         base = trie->states[ cur ].trans.base;
2443
2444         for ( charid = 0 ; charid < ucharcount ; charid++ ) {
2445             const U32 ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 );
2446             if (ch_state) {
2447                 U32 fail_state = cur;
2448                 U32 fail_base;
2449                 do {
2450                     fail_state = fail[ fail_state ];
2451                     fail_base = aho->states[ fail_state ].trans.base;
2452                 } while ( !TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 ) );
2453
2454                 fail_state = TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 );
2455                 fail[ ch_state ] = fail_state;
2456                 if ( !aho->states[ ch_state ].wordnum && aho->states[ fail_state ].wordnum )
2457                 {
2458                         aho->states[ ch_state ].wordnum =  aho->states[ fail_state ].wordnum;
2459                 }
2460                 q[ q_write++ % numstates] = ch_state;
2461             }
2462         }
2463     }
2464     /* restore fail[0..1] to 0 so that we "fall out" of the AC loop
2465        when we fail in state 1, this allows us to use the
2466        charclass scan to find a valid start char. This is based on the principle
2467        that theres a good chance the string being searched contains lots of stuff
2468        that cant be a start char.
2469      */
2470     fail[ 0 ] = fail[ 1 ] = 0;
2471     DEBUG_TRIE_COMPILE_r({
2472         PerlIO_printf(Perl_debug_log,
2473                       "%*sStclass Failtable (%"UVuf" states): 0", 
2474                       (int)(depth * 2), "", (UV)numstates
2475         );
2476         for( q_read=1; q_read<numstates; q_read++ ) {
2477             PerlIO_printf(Perl_debug_log, ", %"UVuf, (UV)fail[q_read]);
2478         }
2479         PerlIO_printf(Perl_debug_log, "\n");
2480     });
2481     Safefree(q);
2482     /*RExC_seen |= REG_SEEN_TRIEDFA;*/
2483 }
2484
2485
2486 /*
2487  * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2.
2488  * These need to be revisited when a newer toolchain becomes available.
2489  */
2490 #if defined(__sparc64__) && defined(__GNUC__)
2491 #   if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
2492 #       undef  SPARC64_GCC_WORKAROUND
2493 #       define SPARC64_GCC_WORKAROUND 1
2494 #   endif
2495 #endif
2496
2497 #define DEBUG_PEEP(str,scan,depth) \
2498     DEBUG_OPTIMISE_r({if (scan){ \
2499        SV * const mysv=sv_newmortal(); \
2500        regnode *Next = regnext(scan); \
2501        regprop(RExC_rx, mysv, scan); \
2502        PerlIO_printf(Perl_debug_log, "%*s" str ">%3d: %s (%d)\n", \
2503        (int)depth*2, "", REG_NODE_NUM(scan), SvPV_nolen_const(mysv),\
2504        Next ? (REG_NODE_NUM(Next)) : 0 ); \
2505    }});
2506
2507
2508 /* The below joins as many adjacent EXACTish nodes as possible into a single
2509  * one, and looks for problematic sequences of characters whose folds vs.
2510  * non-folds have sufficiently different lengths, that the optimizer would be
2511  * fooled into rejecting legitimate matches of them, and the trie construction
2512  * code can't cope with them.  The joining is only done if:
2513  * 1) there is room in the current conglomerated node to entirely contain the
2514  *    next one.
2515  * 2) they are the exact same node type
2516  *
2517  * The adjacent nodes actually may be separated by NOTHING kind nodes, and
2518  * these get optimized out
2519  *
2520  * If there are problematic code sequences, *min_subtract is set to the delta
2521  * that the minimum size of the node can be less than its actual size.  And,
2522  * the node type of the result is changed to reflect that it contains these
2523  * sequences.
2524  *
2525  * And *has_exactf_sharp_s is set to indicate whether or not the node is EXACTF
2526  * and contains LATIN SMALL LETTER SHARP S
2527  *
2528  * This is as good a place as any to discuss the design of handling these
2529  * problematic sequences.  It's been wrong in Perl for a very long time.  There
2530  * are three code points in Unicode whose folded lengths differ so much from
2531  * the un-folded lengths that it causes problems for the optimizer and trie
2532  * construction.  Why only these are problematic, and not others where lengths
2533  * also differ is something I (khw) do not understand.  New versions of Unicode
2534  * might add more such code points.  Hopefully the logic in fold_grind.t that
2535  * figures out what to test (in part by verifying that each size-combination
2536  * gets tested) will catch any that do come along, so they can be added to the
2537  * special handling below.  The chances of new ones are actually rather small,
2538  * as most, if not all, of the world's scripts that have casefolding have
2539  * already been encoded by Unicode.  Also, a number of Unicode's decisions were
2540  * made to allow compatibility with pre-existing standards, and almost all of
2541  * those have already been dealt with.  These would otherwise be the most
2542  * likely candidates for generating further tricky sequences.  In other words,
2543  * Unicode by itself is unlikely to add new ones unless it is for compatibility
2544  * with pre-existing standards, and there aren't many of those left.
2545  *
2546  * The previous designs for dealing with these involved assigning a special
2547  * node for them.  This approach doesn't work, as evidenced by this example:
2548  *      "\xDFs" =~ /s\xDF/ui    # Used to fail before these patches
2549  * Both these fold to "sss", but if the pattern is parsed to create a node of
2550  * that would match just the \xDF, it won't be able to handle the case where a
2551  * successful match would have to cross the node's boundary.  The new approach
2552  * that hopefully generally solves the problem generates an EXACTFU_SS node
2553  * that is "sss".
2554  *
2555  * There are a number of components to the approach (a lot of work for just
2556  * three code points!):
2557  * 1)   This routine examines each EXACTFish node that could contain the
2558  *      problematic sequences.  It returns in *min_subtract how much to
2559  *      subtract from the the actual length of the string to get a real minimum
2560  *      for one that could match it.  This number is usually 0 except for the
2561  *      problematic sequences.  This delta is used by the caller to adjust the
2562  *      min length of the match, and the delta between min and max, so that the
2563  *      optimizer doesn't reject these possibilities based on size constraints.
2564  * 2)   These sequences are not currently correctly handled by the trie code
2565  *      either, so it changes the joined node type to ops that are not handled
2566  *      by trie's, those new ops being EXACTFU_SS and EXACTFU_NO_TRIE.
2567  * 3)   This is sufficient for the two Greek sequences (described below), but
2568  *      the one involving the Sharp s (\xDF) needs more.  The node type
2569  *      EXACTFU_SS is used for an EXACTFU node that contains at least one "ss"
2570  *      sequence in it.  For non-UTF-8 patterns and strings, this is the only
2571  *      case where there is a possible fold length change.  That means that a
2572  *      regular EXACTFU node without UTF-8 involvement doesn't have to concern
2573  *      itself with length changes, and so can be processed faster.  regexec.c
2574  *      takes advantage of this.  Generally, an EXACTFish node that is in UTF-8
2575  *      is pre-folded by regcomp.c.  This saves effort in regex matching.
2576  *      However, probably mostly for historical reasons, the pre-folding isn't
2577  *      done for non-UTF8 patterns (and it can't be for EXACTF and EXACTFL
2578  *      nodes, as what they fold to isn't known until runtime.)  The fold
2579  *      possibilities for the non-UTF8 patterns are quite simple, except for
2580  *      the sharp s.  All the ones that don't involve a UTF-8 target string
2581  *      are members of a fold-pair, and arrays are set up for all of them
2582  *      that quickly find the other member of the pair.  It might actually
2583  *      be faster to pre-fold these, but it isn't currently done, except for
2584  *      the sharp s.  Code elsewhere in this file makes sure that it gets
2585  *      folded to 'ss', even if the pattern isn't UTF-8.  This avoids the
2586  *      issues described in the next item.
2587  * 4)   A problem remains for the sharp s in EXACTF nodes.  Whether it matches
2588  *      'ss' or not is not knowable at compile time.  It will match iff the
2589  *      target string is in UTF-8, unlike the EXACTFU nodes, where it always
2590  *      matches; and the EXACTFL and EXACTFA nodes where it never does.  Thus
2591  *      it can't be folded to "ss" at compile time, unlike EXACTFU does as
2592  *      described in item 3).  An assumption that the optimizer part of
2593  *      regexec.c (probably unwittingly) makes is that a character in the
2594  *      pattern corresponds to at most a single character in the target string.
2595  *      (And I do mean character, and not byte here, unlike other parts of the
2596  *      documentation that have never been updated to account for multibyte
2597  *      Unicode.)  This assumption is wrong only in this case, as all other
2598  *      cases are either 1-1 folds when no UTF-8 is involved; or is true by
2599  *      virtue of having this file pre-fold UTF-8 patterns.   I'm
2600  *      reluctant to try to change this assumption, so instead the code punts.
2601  *      This routine examines EXACTF nodes for the sharp s, and returns a
2602  *      boolean indicating whether or not the node is an EXACTF node that
2603  *      contains a sharp s.  When it is true, the caller sets a flag that later
2604  *      causes the optimizer in this file to not set values for the floating
2605  *      and fixed string lengths, and thus avoids the optimizer code in
2606  *      regexec.c that makes the invalid assumption.  Thus, there is no
2607  *      optimization based on string lengths for EXACTF nodes that contain the
2608  *      sharp s.  This only happens for /id rules (which means the pattern
2609  *      isn't in UTF-8).
2610  */
2611
2612 #define JOIN_EXACT(scan,min_subtract,has_exactf_sharp_s, flags) \
2613     if (PL_regkind[OP(scan)] == EXACT) \
2614         join_exact(pRExC_state,(scan),(min_subtract),has_exactf_sharp_s, (flags),NULL,depth+1)
2615
2616 STATIC U32
2617 S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, UV *min_subtract, bool *has_exactf_sharp_s, U32 flags,regnode *val, U32 depth) {
2618     /* Merge several consecutive EXACTish nodes into one. */
2619     regnode *n = regnext(scan);
2620     U32 stringok = 1;
2621     regnode *next = scan + NODE_SZ_STR(scan);
2622     U32 merged = 0;
2623     U32 stopnow = 0;
2624 #ifdef DEBUGGING
2625     regnode *stop = scan;
2626     GET_RE_DEBUG_FLAGS_DECL;
2627 #else
2628     PERL_UNUSED_ARG(depth);
2629 #endif
2630
2631     PERL_ARGS_ASSERT_JOIN_EXACT;
2632 #ifndef EXPERIMENTAL_INPLACESCAN
2633     PERL_UNUSED_ARG(flags);
2634     PERL_UNUSED_ARG(val);
2635 #endif
2636     DEBUG_PEEP("join",scan,depth);
2637
2638     /* Look through the subsequent nodes in the chain.  Skip NOTHING, merge
2639      * EXACT ones that are mergeable to the current one. */
2640     while (n
2641            && (PL_regkind[OP(n)] == NOTHING
2642                || (stringok && OP(n) == OP(scan)))
2643            && NEXT_OFF(n)
2644            && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX)
2645     {
2646         
2647         if (OP(n) == TAIL || n > next)
2648             stringok = 0;
2649         if (PL_regkind[OP(n)] == NOTHING) {
2650             DEBUG_PEEP("skip:",n,depth);
2651             NEXT_OFF(scan) += NEXT_OFF(n);
2652             next = n + NODE_STEP_REGNODE;
2653 #ifdef DEBUGGING
2654             if (stringok)
2655                 stop = n;
2656 #endif
2657             n = regnext(n);
2658         }
2659         else if (stringok) {
2660             const unsigned int oldl = STR_LEN(scan);
2661             regnode * const nnext = regnext(n);
2662
2663             if (oldl + STR_LEN(n) > U8_MAX)
2664                 break;
2665             
2666             DEBUG_PEEP("merg",n,depth);
2667             merged++;
2668
2669             NEXT_OFF(scan) += NEXT_OFF(n);
2670             STR_LEN(scan) += STR_LEN(n);
2671             next = n + NODE_SZ_STR(n);
2672             /* Now we can overwrite *n : */
2673             Move(STRING(n), STRING(scan) + oldl, STR_LEN(n), char);
2674 #ifdef DEBUGGING
2675             stop = next - 1;
2676 #endif
2677             n = nnext;
2678             if (stopnow) break;
2679         }
2680
2681 #ifdef EXPERIMENTAL_INPLACESCAN
2682         if (flags && !NEXT_OFF(n)) {
2683             DEBUG_PEEP("atch", val, depth);
2684             if (reg_off_by_arg[OP(n)]) {
2685                 ARG_SET(n, val - n);
2686             }
2687             else {
2688                 NEXT_OFF(n) = val - n;
2689             }
2690             stopnow = 1;
2691         }
2692 #endif
2693     }
2694
2695     *min_subtract = 0;
2696     *has_exactf_sharp_s = FALSE;
2697
2698     /* Here, all the adjacent mergeable EXACTish nodes have been merged.  We
2699      * can now analyze for sequences of problematic code points.  (Prior to
2700      * this final joining, sequences could have been split over boundaries, and
2701      * hence missed).  The sequences only happen in folding, hence for any
2702      * non-EXACT EXACTish node */
2703     if (OP(scan) != EXACT) {
2704         U8 *s;
2705         U8 * s0 = (U8*) STRING(scan);
2706         U8 * const s_end = s0 + STR_LEN(scan);
2707
2708         /* The below is perhaps overboard, but this allows us to save a test
2709          * each time through the loop at the expense of a mask.  This is
2710          * because on both EBCDIC and ASCII machines, 'S' and 's' differ by a
2711          * single bit.  On ASCII they are 32 apart; on EBCDIC, they are 64.
2712          * This uses an exclusive 'or' to find that bit and then inverts it to
2713          * form a mask, with just a single 0, in the bit position where 'S' and
2714          * 's' differ. */
2715         const U8 S_or_s_mask = ~ ('S' ^ 's');
2716         const U8 s_masked = 's' & S_or_s_mask;
2717
2718         /* One pass is made over the node's string looking for all the
2719          * possibilities.  to avoid some tests in the loop, there are two main
2720          * cases, for UTF-8 patterns (which can't have EXACTF nodes) and
2721          * non-UTF-8 */
2722         if (UTF) {
2723
2724             /* There are two problematic Greek code points in Unicode
2725              * casefolding
2726              *
2727              * U+0390 - GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
2728              * U+03B0 - GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
2729              *
2730              * which casefold to
2731              *
2732              * Unicode                      UTF-8
2733              *
2734              * U+03B9 U+0308 U+0301         0xCE 0xB9 0xCC 0x88 0xCC 0x81
2735              * U+03C5 U+0308 U+0301         0xCF 0x85 0xCC 0x88 0xCC 0x81
2736              *
2737              * This means that in case-insensitive matching (or "loose
2738              * matching", as Unicode calls it), an EXACTF of length six (the
2739              * UTF-8 encoded byte length of the above casefolded versions) can
2740              * match a target string of length two (the byte length of UTF-8
2741              * encoded U+0390 or U+03B0).  This would rather mess up the
2742              * minimum length computation.  (there are other code points that
2743              * also fold to these two sequences, but the delta is smaller)
2744              *
2745              * If these sequences are found, the minimum length is decreased by
2746              * four (six minus two).
2747              *
2748              * Similarly, 'ss' may match the single char and byte LATIN SMALL
2749              * LETTER SHARP S.  We decrease the min length by 1 for each
2750              * occurrence of 'ss' found */
2751
2752 #ifdef EBCDIC /* RD tunifold greek 0390 and 03B0 */
2753 #           define U390_first_byte 0xb4
2754             const U8 U390_tail[] = "\x68\xaf\x49\xaf\x42";
2755 #           define U3B0_first_byte 0xb5
2756             const U8 U3B0_tail[] = "\x46\xaf\x49\xaf\x42";
2757 #else
2758 #           define U390_first_byte 0xce
2759             const U8 U390_tail[] = "\xb9\xcc\x88\xcc\x81";
2760 #           define U3B0_first_byte 0xcf
2761             const U8 U3B0_tail[] = "\x85\xcc\x88\xcc\x81";
2762 #endif
2763             const U8 len = sizeof(U390_tail); /* (-1 for NUL; +1 for 1st byte;
2764                                                  yields a net of 0 */
2765             /* Examine the string for one of the problematic sequences */
2766             for (s = s0;
2767                  s < s_end - 1; /* Can stop 1 before the end, as minimum length
2768                                  * sequence we are looking for is 2 */
2769                  s += UTF8SKIP(s))
2770             {
2771
2772                 /* Look for the first byte in each problematic sequence */
2773                 switch (*s) {
2774                     /* We don't have to worry about other things that fold to
2775                      * 's' (such as the long s, U+017F), as all above-latin1
2776                      * code points have been pre-folded */
2777                     case 's':
2778                     case 'S':
2779
2780                         /* Current character is an 's' or 'S'.  If next one is
2781                          * as well, we have the dreaded sequence */
2782                         if (((*(s+1) & S_or_s_mask) == s_masked)
2783                             /* These two node types don't have special handling
2784                              * for 'ss' */
2785                             && OP(scan) != EXACTFL && OP(scan) != EXACTFA)
2786                         {
2787                             *min_subtract += 1;
2788                             OP(scan) = EXACTFU_SS;
2789                             s++;    /* No need to look at this character again */
2790                         }
2791                         break;
2792
2793                     case U390_first_byte:
2794                         if (s_end - s >= len
2795
2796                             /* The 1's are because are skipping comparing the
2797                              * first byte */
2798                             && memEQ(s + 1, U390_tail, len - 1))
2799                         {
2800                             goto greek_sequence;
2801                         }
2802                         break;
2803
2804                     case U3B0_first_byte:
2805                         if (! (s_end - s >= len
2806                                && memEQ(s + 1, U3B0_tail, len - 1)))
2807                         {
2808                             break;
2809                         }
2810                       greek_sequence:
2811                         *min_subtract += 4;
2812
2813                         /* This can't currently be handled by trie's, so change
2814                          * the node type to indicate this.  If EXACTFA and
2815                          * EXACTFL were ever to be handled by trie's, this
2816                          * would have to be changed.  If this node has already
2817                          * been changed to EXACTFU_SS in this loop, leave it as
2818                          * is.  (I (khw) think it doesn't matter in regexec.c
2819                          * for UTF patterns, but no need to change it */
2820                         if (OP(scan) == EXACTFU) {
2821                             OP(scan) = EXACTFU_NO_TRIE;
2822                         }
2823                         s += 6; /* We already know what this sequence is.  Skip
2824                                    the rest of it */
2825                         break;
2826                 }
2827             }
2828         }
2829         else if (OP(scan) != EXACTFL && OP(scan) != EXACTFA) {
2830
2831             /* Here, the pattern is not UTF-8.  We need to look only for the
2832              * 'ss' sequence, and in the EXACTF case, the sharp s, which can be
2833              * in the final position.  Otherwise we can stop looking 1 byte
2834              * earlier because have to find both the first and second 's' */
2835             const U8* upper = (OP(scan) == EXACTF) ? s_end : s_end -1;
2836
2837             for (s = s0; s < upper; s++) {
2838                 switch (*s) {
2839                     case 'S':
2840                     case 's':
2841                         if (s_end - s > 1
2842                             && ((*(s+1) & S_or_s_mask) == s_masked))
2843                         {
2844                             *min_subtract += 1;
2845
2846                             /* EXACTF nodes need to know that the minimum
2847                              * length changed so that a sharp s in the string
2848                              * can match this ss in the pattern, but they
2849                              * remain EXACTF nodes, as they are not trie'able,
2850                              * so don't have to invent a new node type to
2851                              * exclude them from the trie code */
2852                             if (OP(scan) != EXACTF) {
2853                                 OP(scan) = EXACTFU_SS;
2854                             }
2855                             s++;
2856                         }
2857                         break;
2858                     case LATIN_SMALL_LETTER_SHARP_S:
2859                         if (OP(scan) == EXACTF) {
2860                             *has_exactf_sharp_s = TRUE;
2861                         }
2862                         break;
2863                 }
2864             }
2865         }
2866     }
2867
2868 #ifdef DEBUGGING
2869     /* Allow dumping but overwriting the collection of skipped
2870      * ops and/or strings with fake optimized ops */
2871     n = scan + NODE_SZ_STR(scan);
2872     while (n <= stop) {
2873         OP(n) = OPTIMIZED;
2874         FLAGS(n) = 0;
2875         NEXT_OFF(n) = 0;
2876         n++;
2877     }
2878 #endif
2879     DEBUG_OPTIMISE_r(if (merged){DEBUG_PEEP("finl",scan,depth)});
2880     return stopnow;
2881 }
2882
2883 /* REx optimizer.  Converts nodes into quicker variants "in place".
2884    Finds fixed substrings.  */
2885
2886 /* Stops at toplevel WHILEM as well as at "last". At end *scanp is set
2887    to the position after last scanned or to NULL. */
2888
2889 #define INIT_AND_WITHP \
2890     assert(!and_withp); \
2891     Newx(and_withp,1,struct regnode_charclass_class); \
2892     SAVEFREEPV(and_withp)
2893
2894 /* this is a chain of data about sub patterns we are processing that
2895    need to be handled separately/specially in study_chunk. Its so
2896    we can simulate recursion without losing state.  */
2897 struct scan_frame;
2898 typedef struct scan_frame {
2899     regnode *last;  /* last node to process in this frame */
2900     regnode *next;  /* next node to process when last is reached */
2901     struct scan_frame *prev; /*previous frame*/
2902     I32 stop; /* what stopparen do we use */
2903 } scan_frame;
2904
2905
2906 #define SCAN_COMMIT(s, data, m) scan_commit(s, data, m, is_inf)
2907
2908 #define CASE_SYNST_FNC(nAmE)                                       \
2909 case nAmE:                                                         \
2910     if (flags & SCF_DO_STCLASS_AND) {                              \
2911             for (value = 0; value < 256; value++)                  \
2912                 if (!is_ ## nAmE ## _cp(value))                       \
2913                     ANYOF_BITMAP_CLEAR(data->start_class, value);  \
2914     }                                                              \
2915     else {                                                         \
2916             for (value = 0; value < 256; value++)                  \
2917                 if (is_ ## nAmE ## _cp(value))                        \
2918                     ANYOF_BITMAP_SET(data->start_class, value);    \
2919     }                                                              \
2920     break;                                                         \
2921 case N ## nAmE:                                                    \
2922     if (flags & SCF_DO_STCLASS_AND) {                              \
2923             for (value = 0; value < 256; value++)                   \
2924                 if (is_ ## nAmE ## _cp(value))                         \
2925                     ANYOF_BITMAP_CLEAR(data->start_class, value);   \
2926     }                                                               \
2927     else {                                                          \
2928             for (value = 0; value < 256; value++)                   \
2929                 if (!is_ ## nAmE ## _cp(value))                        \
2930                     ANYOF_BITMAP_SET(data->start_class, value);     \
2931     }                                                               \
2932     break
2933
2934
2935
2936 STATIC I32
2937 S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
2938                         I32 *minlenp, I32 *deltap,
2939                         regnode *last,
2940                         scan_data_t *data,
2941                         I32 stopparen,
2942                         U8* recursed,
2943                         struct regnode_charclass_class *and_withp,
2944                         U32 flags, U32 depth)
2945                         /* scanp: Start here (read-write). */
2946                         /* deltap: Write maxlen-minlen here. */
2947                         /* last: Stop before this one. */
2948                         /* data: string data about the pattern */
2949                         /* stopparen: treat close N as END */
2950                         /* recursed: which subroutines have we recursed into */
2951                         /* and_withp: Valid if flags & SCF_DO_STCLASS_OR */
2952 {
2953     dVAR;
2954     I32 min = 0, pars = 0, code;
2955     regnode *scan = *scanp, *next;
2956     I32 delta = 0;
2957     int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
2958     int is_inf_internal = 0;            /* The studied chunk is infinite */
2959     I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
2960     scan_data_t data_fake;
2961     SV *re_trie_maxbuff = NULL;
2962     regnode *first_non_open = scan;
2963     I32 stopmin = I32_MAX;
2964     scan_frame *frame = NULL;
2965     GET_RE_DEBUG_FLAGS_DECL;
2966
2967     PERL_ARGS_ASSERT_STUDY_CHUNK;
2968
2969 #ifdef DEBUGGING
2970     StructCopy(&zero_scan_data, &data_fake, scan_data_t);
2971 #endif
2972
2973     if ( depth == 0 ) {
2974         while (first_non_open && OP(first_non_open) == OPEN)
2975             first_non_open=regnext(first_non_open);
2976     }
2977
2978
2979   fake_study_recurse:
2980     while ( scan && OP(scan) != END && scan < last ){
2981         UV min_subtract = 0;    /* How much to subtract from the minimum node
2982                                    length to get a real minimum (because the
2983                                    folded version may be shorter) */
2984         bool has_exactf_sharp_s = FALSE;
2985         /* Peephole optimizer: */
2986         DEBUG_STUDYDATA("Peep:", data,depth);
2987         DEBUG_PEEP("Peep",scan,depth);
2988
2989         /* Its not clear to khw or hv why this is done here, and not in the
2990          * clauses that deal with EXACT nodes.  khw's guess is that it's
2991          * because of a previous design */
2992         JOIN_EXACT(scan,&min_subtract, &has_exactf_sharp_s, 0);
2993
2994         /* Follow the next-chain of the current node and optimize
2995            away all the NOTHINGs from it.  */
2996         if (OP(scan) != CURLYX) {
2997             const int max = (reg_off_by_arg[OP(scan)]
2998                        ? I32_MAX
2999                        /* I32 may be smaller than U16 on CRAYs! */
3000                        : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
3001             int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
3002             int noff;
3003             regnode *n = scan;
3004
3005             /* Skip NOTHING and LONGJMP. */
3006             while ((n = regnext(n))
3007                    && ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
3008                        || ((OP(n) == LONGJMP) && (noff = ARG(n))))
3009                    && off + noff < max)
3010                 off += noff;
3011             if (reg_off_by_arg[OP(scan)])
3012                 ARG(scan) = off;
3013             else
3014                 NEXT_OFF(scan) = off;
3015         }
3016
3017
3018
3019         /* The principal pseudo-switch.  Cannot be a switch, since we
3020            look into several different things.  */
3021         if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
3022                    || OP(scan) == IFTHEN) {
3023             next = regnext(scan);
3024             code = OP(scan);
3025             /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
3026
3027             if (OP(next) == code || code == IFTHEN) {
3028                 /* NOTE - There is similar code to this block below for handling
3029                    TRIE nodes on a re-study.  If you change stuff here check there
3030                    too. */
3031                 I32 max1 = 0, min1 = I32_MAX, num = 0;
3032                 struct regnode_charclass_class accum;
3033                 regnode * const startbranch=scan;
3034
3035                 if (flags & SCF_DO_SUBSTR)
3036                     SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot merge strings after this. */
3037                 if (flags & SCF_DO_STCLASS)
3038                     cl_init_zero(pRExC_state, &accum);
3039
3040                 while (OP(scan) == code) {
3041                     I32 deltanext, minnext, f = 0, fake;
3042                     struct regnode_charclass_class this_class;
3043
3044                     num++;
3045                     data_fake.flags = 0;
3046                     if (data) {
3047                         data_fake.whilem_c = data->whilem_c;
3048                         data_fake.last_closep = data->last_closep;
3049                     }
3050                     else
3051                         data_fake.last_closep = &fake;
3052
3053                     data_fake.pos_delta = delta;
3054                     next = regnext(scan);
3055                     scan = NEXTOPER(scan);
3056                     if (code != BRANCH)
3057                         scan = NEXTOPER(scan);
3058                     if (flags & SCF_DO_STCLASS) {
3059                         cl_init(pRExC_state, &this_class);
3060                         data_fake.start_class = &this_class;
3061                         f = SCF_DO_STCLASS_AND;
3062                     }
3063                     if (flags & SCF_WHILEM_VISITED_POS)
3064                         f |= SCF_WHILEM_VISITED_POS;
3065
3066                     /* we suppose the run is continuous, last=next...*/
3067                     minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
3068                                           next, &data_fake,
3069                                           stopparen, recursed, NULL, f,depth+1);
3070                     if (min1 > minnext)
3071                         min1 = minnext;
3072                     if (max1 < minnext + deltanext)
3073                         max1 = minnext + deltanext;
3074                     if (deltanext == I32_MAX)
3075                         is_inf = is_inf_internal = 1;
3076                     scan = next;
3077                     if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3078                         pars++;
3079                     if (data_fake.flags & SCF_SEEN_ACCEPT) {
3080                         if ( stopmin > minnext) 
3081                             stopmin = min + min1;
3082                         flags &= ~SCF_DO_SUBSTR;
3083                         if (data)
3084                             data->flags |= SCF_SEEN_ACCEPT;
3085                     }
3086                     if (data) {
3087                         if (data_fake.flags & SF_HAS_EVAL)
3088                             data->flags |= SF_HAS_EVAL;
3089                         data->whilem_c = data_fake.whilem_c;
3090                     }
3091                     if (flags & SCF_DO_STCLASS)
3092                         cl_or(pRExC_state, &accum, &this_class);
3093                 }
3094                 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
3095                     min1 = 0;
3096                 if (flags & SCF_DO_SUBSTR) {
3097                     data->pos_min += min1;
3098                     data->pos_delta += max1 - min1;
3099                     if (max1 != min1 || is_inf)
3100                         data->longest = &(data->longest_float);
3101                 }
3102                 min += min1;
3103                 delta += max1 - min1;
3104                 if (flags & SCF_DO_STCLASS_OR) {
3105                     cl_or(pRExC_state, data->start_class, &accum);
3106                     if (min1) {
3107                         cl_and(data->start_class, and_withp);
3108                         flags &= ~SCF_DO_STCLASS;
3109                     }
3110                 }
3111                 else if (flags & SCF_DO_STCLASS_AND) {
3112                     if (min1) {
3113                         cl_and(data->start_class, &accum);
3114                         flags &= ~SCF_DO_STCLASS;
3115                     }
3116                     else {
3117                         /* Switch to OR mode: cache the old value of
3118                          * data->start_class */
3119                         INIT_AND_WITHP;
3120                         StructCopy(data->start_class, and_withp,
3121                                    struct regnode_charclass_class);
3122                         flags &= ~SCF_DO_STCLASS_AND;
3123                         StructCopy(&accum, data->start_class,
3124                                    struct regnode_charclass_class);
3125                         flags |= SCF_DO_STCLASS_OR;
3126                         data->start_class->flags |= ANYOF_EOS;
3127                     }
3128                 }
3129
3130                 if (PERL_ENABLE_TRIE_OPTIMISATION && OP( startbranch ) == BRANCH ) {
3131                 /* demq.
3132
3133                    Assuming this was/is a branch we are dealing with: 'scan' now
3134                    points at the item that follows the branch sequence, whatever
3135                    it is. We now start at the beginning of the sequence and look
3136                    for subsequences of
3137
3138                    BRANCH->EXACT=>x1
3139                    BRANCH->EXACT=>x2
3140                    tail
3141
3142                    which would be constructed from a pattern like /A|LIST|OF|WORDS/
3143
3144                    If we can find such a subsequence we need to turn the first
3145                    element into a trie and then add the subsequent branch exact
3146                    strings to the trie.
3147
3148                    We have two cases
3149
3150                      1. patterns where the whole set of branches can be converted. 
3151
3152                      2. patterns where only a subset can be converted.
3153
3154                    In case 1 we can replace the whole set with a single regop
3155                    for the trie. In case 2 we need to keep the start and end
3156                    branches so
3157
3158                      'BRANCH EXACT; BRANCH EXACT; BRANCH X'
3159                      becomes BRANCH TRIE; BRANCH X;
3160
3161                   There is an additional case, that being where there is a 
3162                   common prefix, which gets split out into an EXACT like node
3163                   preceding the TRIE node.
3164
3165                   If x(1..n)==tail then we can do a simple trie, if not we make
3166                   a "jump" trie, such that when we match the appropriate word
3167                   we "jump" to the appropriate tail node. Essentially we turn
3168                   a nested if into a case structure of sorts.
3169
3170                 */
3171
3172                     int made=0;
3173                     if (!re_trie_maxbuff) {
3174                         re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
3175                         if (!SvIOK(re_trie_maxbuff))
3176                             sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
3177                     }
3178                     if ( SvIV(re_trie_maxbuff)>=0  ) {
3179                         regnode *cur;
3180                         regnode *first = (regnode *)NULL;
3181                         regnode *last = (regnode *)NULL;
3182                         regnode *tail = scan;
3183                         U8 optype = 0;
3184                         U32 count=0;
3185
3186 #ifdef DEBUGGING
3187                         SV * const mysv = sv_newmortal();       /* for dumping */
3188 #endif
3189                         /* var tail is used because there may be a TAIL
3190                            regop in the way. Ie, the exacts will point to the
3191                            thing following the TAIL, but the last branch will
3192                            point at the TAIL. So we advance tail. If we
3193                            have nested (?:) we may have to move through several
3194                            tails.
3195                          */
3196
3197                         while ( OP( tail ) == TAIL ) {
3198                             /* this is the TAIL generated by (?:) */
3199                             tail = regnext( tail );
3200                         }
3201
3202                         
3203                         DEBUG_OPTIMISE_r({
3204                             regprop(RExC_rx, mysv, tail );
3205                             PerlIO_printf( Perl_debug_log, "%*s%s%s\n",
3206                                 (int)depth * 2 + 2, "", 
3207                                 "Looking for TRIE'able sequences. Tail node is: ", 
3208                                 SvPV_nolen_const( mysv )
3209                             );
3210                         });
3211                         
3212                         /*
3213
3214                            step through the branches, cur represents each
3215                            branch, noper is the first thing to be matched
3216                            as part of that branch and noper_next is the
3217                            regnext() of that node. if noper is an EXACT
3218                            and noper_next is the same as scan (our current
3219                            position in the regex) then the EXACT branch is
3220                            a possible optimization target. Once we have
3221                            two or more consecutive such branches we can
3222                            create a trie of the EXACT's contents and stich
3223                            it in place. If the sequence represents all of
3224                            the branches we eliminate the whole thing and
3225                            replace it with a single TRIE. If it is a
3226                            subsequence then we need to stitch it in. This
3227                            means the first branch has to remain, and needs
3228                            to be repointed at the item on the branch chain
3229                            following the last branch optimized. This could
3230                            be either a BRANCH, in which case the
3231                            subsequence is internal, or it could be the
3232                            item following the branch sequence in which
3233                            case the subsequence is at the end.
3234
3235                         */
3236
3237                         /* dont use tail as the end marker for this traverse */
3238                         for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) {
3239                             regnode * const noper = NEXTOPER( cur );
3240 #if defined(DEBUGGING) || defined(NOJUMPTRIE)
3241                             regnode * const noper_next = regnext( noper );
3242 #endif
3243
3244                             DEBUG_OPTIMISE_r({
3245                                 regprop(RExC_rx, mysv, cur);
3246                                 PerlIO_printf( Perl_debug_log, "%*s- %s (%d)",
3247                                    (int)depth * 2 + 2,"", SvPV_nolen_const( mysv ), REG_NODE_NUM(cur) );
3248
3249                                 regprop(RExC_rx, mysv, noper);
3250                                 PerlIO_printf( Perl_debug_log, " -> %s",
3251                                     SvPV_nolen_const(mysv));
3252
3253                                 if ( noper_next ) {
3254                                   regprop(RExC_rx, mysv, noper_next );
3255                                   PerlIO_printf( Perl_debug_log,"\t=> %s\t",
3256                                     SvPV_nolen_const(mysv));
3257                                 }
3258                                 PerlIO_printf( Perl_debug_log, "(First==%d,Last==%d,Cur==%d)\n",
3259                                    REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur) );
3260                             });
3261                             if ( (((first && optype!=NOTHING) ? OP( noper ) == optype
3262                                          : PL_regkind[ OP( noper ) ] == EXACT )
3263                                   || OP(noper) == NOTHING )
3264 #ifdef NOJUMPTRIE
3265                                   && noper_next == tail
3266 #endif
3267                                   && count < U16_MAX)
3268                             {
3269                                 count++;
3270                                 if ( !first || optype == NOTHING ) {
3271                                     if (!first) first = cur;
3272                                     optype = OP( noper );
3273                                 } else {
3274                                     last = cur;
3275                                 }
3276                             } else {
3277 /* 
3278     Currently the trie logic handles case insensitive matching properly only
3279     when the pattern is UTF-8 and the node is EXACTFU (thus forcing unicode
3280     semantics).
3281
3282     If/when this is fixed the following define can be swapped
3283     in below to fully enable trie logic.
3284
3285 #define TRIE_TYPE_IS_SAFE 1
3286
3287 Note that join_exact() assumes that the other types of EXACTFish nodes are not
3288 used in tries, so that would have to be updated if this changed
3289
3290 */
3291 #define TRIE_TYPE_IS_SAFE ((UTF && optype == EXACTFU) || optype==EXACT)
3292
3293                                 if ( last && TRIE_TYPE_IS_SAFE ) {
3294                                     make_trie( pRExC_state, 
3295                                             startbranch, first, cur, tail, count, 
3296                                             optype, depth+1 );
3297                                 }
3298                                 if ( PL_regkind[ OP( noper ) ] == EXACT
3299 #ifdef NOJUMPTRIE
3300                                      && noper_next == tail
3301 #endif
3302                                 ){
3303                                     count = 1;
3304                                     first = cur;
3305                                     optype = OP( noper );
3306                                 } else {
3307                                     count = 0;
3308                                     first = NULL;
3309                                     optype = 0;
3310                                 }
3311                                 last = NULL;
3312                             }
3313                         }
3314                         DEBUG_OPTIMISE_r({
3315                             regprop(RExC_rx, mysv, cur);
3316                             PerlIO_printf( Perl_debug_log,
3317                               "%*s- %s (%d) <SCAN FINISHED>\n", (int)depth * 2 + 2,
3318                               "", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
3319
3320                         });
3321                         
3322                         if ( last && TRIE_TYPE_IS_SAFE ) {
3323                             made= make_trie( pRExC_state, startbranch, first, scan, tail, count, optype, depth+1 );
3324 #ifdef TRIE_STUDY_OPT
3325                             if ( ((made == MADE_EXACT_TRIE && 
3326                                  startbranch == first) 
3327                                  || ( first_non_open == first )) && 
3328                                  depth==0 ) {
3329                                 flags |= SCF_TRIE_RESTUDY;
3330                                 if ( startbranch == first 
3331                                      && scan == tail ) 
3332                                 {
3333                                     RExC_seen &=~REG_TOP_LEVEL_BRANCHES;
3334                                 }
3335                             }
3336 #endif
3337                         }
3338                     }
3339                     
3340                 } /* do trie */
3341                 
3342             }
3343             else if ( code == BRANCHJ ) {  /* single branch is optimized. */
3344                 scan = NEXTOPER(NEXTOPER(scan));
3345             } else                      /* single branch is optimized. */
3346                 scan = NEXTOPER(scan);
3347             continue;
3348         } else if (OP(scan) == SUSPEND || OP(scan) == GOSUB || OP(scan) == GOSTART) {
3349             scan_frame *newframe = NULL;
3350             I32 paren;
3351             regnode *start;
3352             regnode *end;
3353
3354             if (OP(scan) != SUSPEND) {
3355             /* set the pointer */
3356                 if (OP(scan) == GOSUB) {
3357                     paren = ARG(scan);
3358                     RExC_recurse[ARG2L(scan)] = scan;
3359                     start = RExC_open_parens[paren-1];
3360                     end   = RExC_close_parens[paren-1];
3361                 } else {
3362                     paren = 0;
3363                     start = RExC_rxi->program + 1;
3364                     end   = RExC_opend;
3365                 }
3366                 if (!recursed) {
3367                     Newxz(recursed, (((RExC_npar)>>3) +1), U8);
3368                     SAVEFREEPV(recursed);
3369                 }
3370                 if (!PAREN_TEST(recursed,paren+1)) {
3371                     PAREN_SET(recursed,paren+1);
3372                     Newx(newframe,1,scan_frame);
3373                 } else {
3374                     if (flags & SCF_DO_SUBSTR) {
3375                         SCAN_COMMIT(pRExC_state,data,minlenp);
3376                         data->longest = &(data->longest_float);
3377                     }
3378                     is_inf = is_inf_internal = 1;
3379                     if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3380                         cl_anything(pRExC_state, data->start_class);
3381                     flags &= ~SCF_DO_STCLASS;
3382                 }
3383             } else {
3384                 Newx(newframe,1,scan_frame);
3385                 paren = stopparen;
3386                 start = scan+2;
3387                 end = regnext(scan);
3388             }
3389             if (newframe) {
3390                 assert(start);
3391                 assert(end);
3392                 SAVEFREEPV(newframe);
3393                 newframe->next = regnext(scan);
3394                 newframe->last = last;
3395                 newframe->stop = stopparen;
3396                 newframe->prev = frame;
3397
3398                 frame = newframe;
3399                 scan =  start;
3400                 stopparen = paren;
3401                 last = end;
3402
3403                 continue;
3404             }
3405         }
3406         else if (OP(scan) == EXACT) {
3407             I32 l = STR_LEN(scan);
3408             UV uc;
3409             if (UTF) {
3410                 const U8 * const s = (U8*)STRING(scan);
3411                 l = utf8_length(s, s + l);
3412                 uc = utf8_to_uvchr(s, NULL);
3413             } else {
3414                 uc = *((U8*)STRING(scan));
3415             }
3416             min += l;
3417             if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
3418                 /* The code below prefers earlier match for fixed
3419                    offset, later match for variable offset.  */
3420                 if (data->last_end == -1) { /* Update the start info. */
3421                     data->last_start_min = data->pos_min;
3422                     data->last_start_max = is_inf
3423                         ? I32_MAX : data->pos_min + data->pos_delta;
3424                 }
3425                 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
3426                 if (UTF)
3427                     SvUTF8_on(data->last_found);
3428                 {
3429                     SV * const sv = data->last_found;
3430                     MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
3431                         mg_find(sv, PERL_MAGIC_utf8) : NULL;
3432                     if (mg && mg->mg_len >= 0)
3433                         mg->mg_len += utf8_length((U8*)STRING(scan),
3434                                                   (U8*)STRING(scan)+STR_LEN(scan));
3435                 }
3436                 data->last_end = data->pos_min + l;
3437                 data->pos_min += l; /* As in the first entry. */
3438                 data->flags &= ~SF_BEFORE_EOL;
3439             }
3440             if (flags & SCF_DO_STCLASS_AND) {
3441                 /* Check whether it is compatible with what we know already! */
3442                 int compat = 1;
3443
3444
3445                 /* If compatible, we or it in below.  It is compatible if is
3446                  * in the bitmp and either 1) its bit or its fold is set, or 2)
3447                  * it's for a locale.  Even if there isn't unicode semantics
3448                  * here, at runtime there may be because of matching against a
3449                  * utf8 string, so accept a possible false positive for
3450                  * latin1-range folds */
3451                 if (uc >= 0x100 ||
3452                     (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
3453                     && !ANYOF_BITMAP_TEST(data->start_class, uc)
3454                     && (!(data->start_class->flags & ANYOF_LOC_NONBITMAP_FOLD)
3455                         || !ANYOF_BITMAP_TEST(data->start_class, PL_fold_latin1[uc])))
3456                     )
3457                 {
3458                     compat = 0;
3459                 }
3460                 ANYOF_CLASS_ZERO(data->start_class);
3461                 ANYOF_BITMAP_ZERO(data->start_class);
3462                 if (compat)
3463                     ANYOF_BITMAP_SET(data->start_class, uc);
3464                 else if (uc >= 0x100) {
3465                     int i;
3466
3467                     /* Some Unicode code points fold to the Latin1 range; as
3468                      * XXX temporary code, instead of figuring out if this is
3469                      * one, just assume it is and set all the start class bits
3470                      * that could be some such above 255 code point's fold
3471                      * which will generate fals positives.  As the code
3472                      * elsewhere that does compute the fold settles down, it
3473                      * can be extracted out and re-used here */
3474                     for (i = 0; i < 256; i++){
3475                         if (_HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)) {
3476                             ANYOF_BITMAP_SET(data->start_class, i);
3477                         }
3478                     }
3479                 }
3480                 data->start_class->flags &= ~ANYOF_EOS;
3481                 if (uc < 0x100)
3482                   data->start_class->flags &= ~ANYOF_UNICODE_ALL;
3483             }
3484             else if (flags & SCF_DO_STCLASS_OR) {
3485                 /* false positive possible if the class is case-folded */
3486                 if (uc < 0x100)
3487                     ANYOF_BITMAP_SET(data->start_class, uc);
3488                 else
3489                     data->start_class->flags |= ANYOF_UNICODE_ALL;
3490                 data->start_class->flags &= ~ANYOF_EOS;
3491                 cl_and(data->start_class, and_withp);
3492             }
3493             flags &= ~SCF_DO_STCLASS;
3494         }
3495         else if (PL_regkind[OP(scan)] == EXACT) { /* But OP != EXACT! */
3496             I32 l = STR_LEN(scan);
3497             UV uc = *((U8*)STRING(scan));
3498
3499             /* Search for fixed substrings supports EXACT only. */
3500             if (flags & SCF_DO_SUBSTR) {
3501                 assert(data);
3502                 SCAN_COMMIT(pRExC_state, data, minlenp);
3503             }
3504             if (UTF) {
3505                 const U8 * const s = (U8 *)STRING(scan);
3506                 l = utf8_length(s, s + l);
3507                 uc = utf8_to_uvchr(s, NULL);
3508             }
3509             else if (has_exactf_sharp_s) {
3510                 RExC_seen |= REG_SEEN_EXACTF_SHARP_S;
3511             }
3512             min += l - min_subtract;
3513             if (min < 0) {
3514                 min = 0;
3515             }
3516             delta += min_subtract;
3517             if (flags & SCF_DO_SUBSTR) {
3518                 data->pos_min += l - min_subtract;
3519                 if (data->pos_min < 0) {
3520                     data->pos_min = 0;
3521                 }
3522                 data->pos_delta += min_subtract;
3523                 if (min_subtract) {
3524                     data->longest = &(data->longest_float);
3525                 }
3526             }
3527             if (flags & SCF_DO_STCLASS_AND) {
3528                 /* Check whether it is compatible with what we know already! */
3529                 int compat = 1;
3530                 if (uc >= 0x100 ||
3531                  (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
3532                   && !ANYOF_BITMAP_TEST(data->start_class, uc)
3533                   && !ANYOF_BITMAP_TEST(data->start_class, PL_fold_latin1[uc])))
3534                 {
3535                     compat = 0;
3536                 }
3537                 ANYOF_CLASS_ZERO(data->start_class);
3538                 ANYOF_BITMAP_ZERO(data->start_class);
3539                 if (compat) {
3540                     ANYOF_BITMAP_SET(data->start_class, uc);
3541                     data->start_class->flags &= ~ANYOF_EOS;
3542                     data->start_class->flags |= ANYOF_LOC_NONBITMAP_FOLD;
3543                     if (OP(scan) == EXACTFL) {
3544                         /* XXX This set is probably no longer necessary, and
3545                          * probably wrong as LOCALE now is on in the initial
3546                          * state */
3547                         data->start_class->flags |= ANYOF_LOCALE;
3548                     }
3549                     else {
3550
3551                         /* Also set the other member of the fold pair.  In case
3552                          * that unicode semantics is called for at runtime, use
3553                          * the full latin1 fold.  (Can't do this for locale,
3554                          * because not known until runtime) */
3555                         ANYOF_BITMAP_SET(data->start_class, PL_fold_latin1[uc]);
3556
3557                         /* All other (EXACTFL handled above) folds except under
3558                          * /iaa that include s, S, and sharp_s also may include
3559                          * the others */
3560                         if (OP(scan) != EXACTFA) {
3561                             if (uc == 's' || uc == 'S') {
3562                                 ANYOF_BITMAP_SET(data->start_class,
3563                                                  LATIN_SMALL_LETTER_SHARP_S);
3564                             }
3565                             else if (uc == LATIN_SMALL_LETTER_SHARP_S) {
3566                                 ANYOF_BITMAP_SET(data->start_class, 's');
3567                                 ANYOF_BITMAP_SET(data->start_class, 'S');
3568                             }
3569                         }
3570                     }
3571                 }
3572                 else if (uc >= 0x100) {
3573                     int i;
3574                     for (i = 0; i < 256; i++){
3575                         if (_HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)) {
3576                             ANYOF_BITMAP_SET(data->start_class, i);
3577                         }
3578                     }
3579                 }
3580             }
3581             else if (flags & SCF_DO_STCLASS_OR) {
3582                 if (data->start_class->flags & ANYOF_LOC_NONBITMAP_FOLD) {
3583                     /* false positive possible if the class is case-folded.
3584                        Assume that the locale settings are the same... */
3585                     if (uc < 0x100) {
3586                         ANYOF_BITMAP_SET(data->start_class, uc);
3587                         if (OP(scan) != EXACTFL) {
3588
3589                             /* And set the other member of the fold pair, but
3590                              * can't do that in locale because not known until
3591                              * run-time */
3592                             ANYOF_BITMAP_SET(data->start_class,
3593                                              PL_fold_latin1[uc]);
3594
3595                             /* All folds except under /iaa that include s, S,
3596                              * and sharp_s also may include the others */
3597                             if (OP(scan) != EXACTFA) {
3598                                 if (uc == 's' || uc == 'S') {
3599                                     ANYOF_BITMAP_SET(data->start_class,
3600                                                    LATIN_SMALL_LETTER_SHARP_S);
3601                                 }
3602                                 else if (uc == LATIN_SMALL_LETTER_SHARP_S) {
3603                                     ANYOF_BITMAP_SET(data->start_class, 's');
3604                                     ANYOF_BITMAP_SET(data->start_class, 'S');
3605                                 }
3606                             }
3607                         }
3608                     }
3609                     data->start_class->flags &= ~ANYOF_EOS;
3610                 }
3611                 cl_and(data->start_class, and_withp);
3612             }
3613             flags &= ~SCF_DO_STCLASS;
3614         }
3615         else if (REGNODE_VARIES(OP(scan))) {
3616             I32 mincount, maxcount, minnext, deltanext, fl = 0;
3617             I32 f = flags, pos_before = 0;
3618             regnode * const oscan = scan;
3619             struct regnode_charclass_class this_class;
3620             struct regnode_charclass_class *oclass = NULL;
3621             I32 next_is_eval = 0;
3622
3623             switch (PL_regkind[OP(scan)]) {
3624             case WHILEM:                /* End of (?:...)* . */
3625                 scan = NEXTOPER(scan);
3626                 goto finish;
3627             case PLUS:
3628                 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
3629                     next = NEXTOPER(scan);
3630                     if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
3631                         mincount = 1;
3632                         maxcount = REG_INFTY;
3633                         next = regnext(scan);
3634                         scan = NEXTOPER(scan);
3635                         goto do_curly;
3636                     }
3637                 }
3638                 if (flags & SCF_DO_SUBSTR)
3639                     data->pos_min++;
3640                 min++;
3641                 /* Fall through. */
3642             case STAR:
3643                 if (flags & SCF_DO_STCLASS) {
3644                     mincount = 0;
3645                     maxcount = REG_INFTY;
3646                     next = regnext(scan);
3647                     scan = NEXTOPER(scan);
3648                     goto do_curly;
3649                 }
3650                 is_inf = is_inf_internal = 1;
3651                 scan = regnext(scan);
3652                 if (flags & SCF_DO_SUBSTR) {
3653                     SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot extend fixed substrings */
3654                     data->longest = &(data->longest_float);
3655                 }
3656                 goto optimize_curly_tail;
3657             case CURLY:
3658                 if (stopparen>0 && (OP(scan)==CURLYN || OP(scan)==CURLYM)
3659                     && (scan->flags == stopparen))
3660                 {
3661                     mincount = 1;
3662                     maxcount = 1;
3663                 } else {
3664                     mincount = ARG1(scan);
3665                     maxcount = ARG2(scan);
3666                 }
3667                 next = regnext(scan);
3668                 if (OP(scan) == CURLYX) {
3669                     I32 lp = (data ? *(data->last_closep) : 0);
3670                     scan->flags = ((lp <= (I32)U8_MAX) ? (U8)lp : U8_MAX);
3671                 }
3672                 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3673                 next_is_eval = (OP(scan) == EVAL);
3674               do_curly:
3675                 if (flags & SCF_DO_SUBSTR) {
3676                     if (mincount == 0) SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot extend fixed substrings */
3677                     pos_before = data->pos_min;
3678                 }
3679                 if (data) {
3680                     fl = data->flags;
3681                     data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
3682                     if (is_inf)
3683                         data->flags |= SF_IS_INF;
3684                 }
3685                 if (flags & SCF_DO_STCLASS) {
3686                     cl_init(pRExC_state, &this_class);
3687                     oclass = data->start_class;
3688                     data->start_class = &this_class;
3689                     f |= SCF_DO_STCLASS_AND;
3690                     f &= ~SCF_DO_STCLASS_OR;
3691                 }
3692                 /* Exclude from super-linear cache processing any {n,m}
3693                    regops for which the combination of input pos and regex
3694                    pos is not enough information to determine if a match
3695                    will be possible.
3696
3697                    For example, in the regex /foo(bar\s*){4,8}baz/ with the
3698                    regex pos at the \s*, the prospects for a match depend not
3699                    only on the input position but also on how many (bar\s*)
3700                    repeats into the {4,8} we are. */
3701                if ((mincount > 1) || (maxcount > 1 && maxcount != REG_INFTY))
3702                     f &= ~SCF_WHILEM_VISITED_POS;
3703
3704                 /* This will finish on WHILEM, setting scan, or on NULL: */
3705                 minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext, 
3706                                       last, data, stopparen, recursed, NULL,
3707                                       (mincount == 0
3708                                         ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
3709
3710                 if (flags & SCF_DO_STCLASS)
3711                     data->start_class = oclass;
3712                 if (mincount == 0 || minnext == 0) {
3713                     if (flags & SCF_DO_STCLASS_OR) {
3714                         cl_or(pRExC_state, data->start_class, &this_class);
3715                     }
3716                     else if (flags & SCF_DO_STCLASS_AND) {
3717                         /* Switch to OR mode: cache the old value of
3718                          * data->start_class */
3719                         INIT_AND_WITHP;
3720                         StructCopy(data->start_class, and_withp,
3721                                    struct regnode_charclass_class);
3722                         flags &= ~SCF_DO_STCLASS_AND;
3723                         StructCopy(&this_class, data->start_class,
3724                                    struct regnode_charclass_class);
3725                         flags |= SCF_DO_STCLASS_OR;
3726                         data->start_class->flags |= ANYOF_EOS;
3727                     }
3728                 } else {                /* Non-zero len */
3729                     if (flags & SCF_DO_STCLASS_OR) {
3730                         cl_or(pRExC_state, data->start_class, &this_class);
3731                         cl_and(data->start_class, and_withp);
3732                     }
3733                     else if (flags & SCF_DO_STCLASS_AND)
3734                         cl_and(data->start_class, &this_class);
3735                     flags &= ~SCF_DO_STCLASS;
3736                 }
3737                 if (!scan)              /* It was not CURLYX, but CURLY. */
3738                     scan = next;
3739                 if ( /* ? quantifier ok, except for (?{ ... }) */
3740                     (next_is_eval || !(mincount == 0 && maxcount == 1))
3741                     && (minnext == 0) && (deltanext == 0)
3742                     && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
3743                     && maxcount <= REG_INFTY/3) /* Complement check for big count */
3744                 {
3745                     ckWARNreg(RExC_parse,
3746                               "Quantifier unexpected on zero-length expression");
3747                 }
3748
3749                 min += minnext * mincount;
3750                 is_inf_internal |= ((maxcount == REG_INFTY
3751                                      && (minnext + deltanext) > 0)
3752                                     || deltanext == I32_MAX);
3753                 is_inf |= is_inf_internal;
3754                 delta += (minnext + deltanext) * maxcount - minnext * mincount;
3755
3756                 /* Try powerful optimization CURLYX => CURLYN. */
3757                 if (  OP(oscan) == CURLYX && data
3758                       && data->flags & SF_IN_PAR
3759                       && !(data->flags & SF_HAS_EVAL)
3760                       && !deltanext && minnext == 1 ) {
3761                     /* Try to optimize to CURLYN.  */
3762                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
3763                     regnode * const nxt1 = nxt;
3764 #ifdef DEBUGGING
3765                     regnode *nxt2;
3766 #endif
3767
3768                     /* Skip open. */
3769                     nxt = regnext(nxt);
3770                     if (!REGNODE_SIMPLE(OP(nxt))
3771                         && !(PL_regkind[OP(nxt)] == EXACT
3772                              && STR_LEN(nxt) == 1))
3773                         goto nogo;
3774 #ifdef DEBUGGING
3775                     nxt2 = nxt;
3776 #endif
3777                     nxt = regnext(nxt);
3778                     if (OP(nxt) != CLOSE)
3779                         goto nogo;
3780                     if (RExC_open_parens) {
3781                         RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
3782                         RExC_close_parens[ARG(nxt1)-1]=nxt+2; /*close->while*/
3783                     }
3784                     /* Now we know that nxt2 is the only contents: */
3785                     oscan->flags = (U8)ARG(nxt);
3786                     OP(oscan) = CURLYN;
3787                     OP(nxt1) = NOTHING; /* was OPEN. */
3788
3789 #ifdef DEBUGGING
3790                     OP(nxt1 + 1) = OPTIMIZED; /* was count. */
3791                     NEXT_OFF(nxt1+ 1) = 0; /* just for consistency. */
3792                     NEXT_OFF(nxt2) = 0; /* just for consistency with CURLY. */
3793                     OP(nxt) = OPTIMIZED;        /* was CLOSE. */
3794                     OP(nxt + 1) = OPTIMIZED; /* was count. */
3795                     NEXT_OFF(nxt+ 1) = 0; /* just for consistency. */
3796 #endif
3797                 }
3798               nogo:
3799
3800                 /* Try optimization CURLYX => CURLYM. */
3801                 if (  OP(oscan) == CURLYX && data
3802                       && !(data->flags & SF_HAS_PAR)
3803                       && !(data->flags & SF_HAS_EVAL)
3804                       && !deltanext     /* atom is fixed width */
3805                       && minnext != 0   /* CURLYM can't handle zero width */
3806                 ) {
3807                     /* XXXX How to optimize if data == 0? */
3808                     /* Optimize to a simpler form.  */
3809                     regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
3810                     regnode *nxt2;
3811
3812                     OP(oscan) = CURLYM;
3813                     while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
3814                             && (OP(nxt2) != WHILEM))
3815                         nxt = nxt2;
3816                     OP(nxt2)  = SUCCEED; /* Whas WHILEM */
3817                     /* Need to optimize away parenths. */
3818                     if ((data->flags & SF_IN_PAR) && OP(nxt) == CLOSE) {
3819                         /* Set the parenth number.  */
3820                         regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
3821
3822                         oscan->flags = (U8)ARG(nxt);
3823                         if (RExC_open_parens) {
3824                             RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
3825                             RExC_close_parens[ARG(nxt1)-1]=nxt2+1; /*close->NOTHING*/
3826                         }
3827                         OP(nxt1) = OPTIMIZED;   /* was OPEN. */
3828                         OP(nxt) = OPTIMIZED;    /* was CLOSE. */
3829
3830 #ifdef DEBUGGING
3831                         OP(nxt1 + 1) = OPTIMIZED; /* was count. */
3832                         OP(nxt + 1) = OPTIMIZED; /* was count. */
3833                         NEXT_OFF(nxt1 + 1) = 0; /* just for consistency. */
3834                         NEXT_OFF(nxt + 1) = 0; /* just for consistency. */
3835 #endif
3836 #if 0
3837                         while ( nxt1 && (OP(nxt1) != WHILEM)) {
3838                             regnode *nnxt = regnext(nxt1);
3839                             if (nnxt == nxt) {
3840                                 if (reg_off_by_arg[OP(nxt1)])
3841                                     ARG_SET(nxt1, nxt2 - nxt1);
3842                                 else if (nxt2 - nxt1 < U16_MAX)
3843                                     NEXT_OFF(nxt1) = nxt2 - nxt1;
3844                                 else
3845                                     OP(nxt) = NOTHING;  /* Cannot beautify */
3846                             }
3847                             nxt1 = nnxt;
3848                         }
3849 #endif
3850                         /* Optimize again: */
3851                         study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt,
3852                                     NULL, stopparen, recursed, NULL, 0,depth+1);
3853                     }
3854                     else
3855                         oscan->flags = 0;
3856                 }
3857                 else if ((OP(oscan) == CURLYX)
3858                          && (flags & SCF_WHILEM_VISITED_POS)
3859                          /* See the comment on a similar expression above.
3860                             However, this time it's not a subexpression
3861                             we care about, but the expression itself. */
3862                          && (maxcount == REG_INFTY)
3863                          && data && ++data->whilem_c < 16) {
3864                     /* This stays as CURLYX, we can put the count/of pair. */
3865                     /* Find WHILEM (as in regexec.c) */
3866                     regnode *nxt = oscan + NEXT_OFF(oscan);
3867
3868                     if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
3869                         nxt += ARG(nxt);
3870 &n