5 * "A fair jaw-cracker dwarf-language must be." --Samwise Gamgee
8 /* This file contains functions for compiling a regular expression. See
9 * also regexec.c which funnily enough, contains functions for executing
10 * a regular expression.
12 * This file is also copied at build time to ext/re/re_comp.c, where
13 * it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
14 * This causes the main functions to be compiled under new names and with
15 * debugging support added, which makes "use re 'debug'" work.
18 /* NOTE: this is derived from Henry Spencer's regexp code, and should not
19 * confused with the original package (see point 3 below). Thanks, Henry!
22 /* Additional note: this code is very heavily munged from Henry's version
23 * in places. In some spots I've traded clarity for efficiency, so don't
24 * blame Henry for some of the lack of readability.
27 /* The names of the functions have been changed from regcomp and
28 * regexec to pregcomp and pregexec in order to avoid conflicts
29 * with the POSIX routines of the same names.
32 #ifdef PERL_EXT_RE_BUILD
37 * pregcomp and pregexec -- regsub and regerror are not used in perl
39 * Copyright (c) 1986 by University of Toronto.
40 * Written by Henry Spencer. Not derived from licensed software.
42 * Permission is granted to anyone to use this software for any
43 * purpose on any computer system, and to redistribute it freely,
44 * subject to the following restrictions:
46 * 1. The author is not responsible for the consequences of use of
47 * this software, no matter how awful, even if they arise
50 * 2. The origin of this software must not be misrepresented, either
51 * by explicit claim or by omission.
53 * 3. Altered versions must be plainly marked as such, and must not
54 * be misrepresented as being the original software.
57 **** Alterations to Henry's code are...
59 **** Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
60 **** 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
62 **** You may distribute under the terms of either the GNU General Public
63 **** License or the Artistic License, as specified in the README file.
66 * Beware that some of this code is subtly aware of the way operator
67 * precedence is structured in regular expressions. Serious changes in
68 * regular-expression syntax might require a total rethink.
71 #define PERL_IN_REGCOMP_C
74 #ifndef PERL_IN_XSUB_RE
79 #ifdef PERL_IN_XSUB_RE
90 # if defined(BUGGY_MSC6)
91 /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
92 # pragma optimize("a",off)
93 /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
94 # pragma optimize("w",on )
95 # endif /* BUGGY_MSC6 */
102 typedef struct RExC_state_t {
103 U32 flags; /* are we folding, multilining? */
104 char *precomp; /* uncompiled string. */
106 char *start; /* Start of input for compile */
107 char *end; /* End of input for compile */
108 char *parse; /* Input-scan pointer. */
109 I32 whilem_seen; /* number of WHILEM in this expr */
110 regnode *emit_start; /* Start of emitted-code area */
111 regnode *emit; /* Code-emit pointer; ®dummy = don't = compiling */
112 I32 naughty; /* How bad is this pattern? */
113 I32 sawback; /* Did we see \1, ...? */
115 I32 size; /* Code size. */
116 I32 npar; /* () count. */
117 I32 nestroot; /* root parens we are in - used by accept */
121 regnode **open_parens; /* pointers to open parens */
122 regnode **close_parens; /* pointers to close parens */
123 regnode *opend; /* END node in program */
125 HV *charnames; /* cache of named sequences */
126 HV *paren_names; /* Paren names */
127 regnode **recurse; /* Recurse regops */
128 I32 recurse_count; /* Number of recurse regops */
130 char *starttry; /* -Dr: where regtry was called. */
131 #define RExC_starttry (pRExC_state->starttry)
134 const char *lastparse;
136 #define RExC_lastparse (pRExC_state->lastparse)
137 #define RExC_lastnum (pRExC_state->lastnum)
141 #define RExC_flags (pRExC_state->flags)
142 #define RExC_precomp (pRExC_state->precomp)
143 #define RExC_rx (pRExC_state->rx)
144 #define RExC_start (pRExC_state->start)
145 #define RExC_end (pRExC_state->end)
146 #define RExC_parse (pRExC_state->parse)
147 #define RExC_whilem_seen (pRExC_state->whilem_seen)
148 #define RExC_offsets (pRExC_state->rx->offsets) /* I am not like the others */
149 #define RExC_emit (pRExC_state->emit)
150 #define RExC_emit_start (pRExC_state->emit_start)
151 #define RExC_naughty (pRExC_state->naughty)
152 #define RExC_sawback (pRExC_state->sawback)
153 #define RExC_seen (pRExC_state->seen)
154 #define RExC_size (pRExC_state->size)
155 #define RExC_npar (pRExC_state->npar)
156 #define RExC_nestroot (pRExC_state->nestroot)
157 #define RExC_extralen (pRExC_state->extralen)
158 #define RExC_seen_zerolen (pRExC_state->seen_zerolen)
159 #define RExC_seen_evals (pRExC_state->seen_evals)
160 #define RExC_utf8 (pRExC_state->utf8)
161 #define RExC_charnames (pRExC_state->charnames)
162 #define RExC_open_parens (pRExC_state->open_parens)
163 #define RExC_close_parens (pRExC_state->close_parens)
164 #define RExC_opend (pRExC_state->opend)
165 #define RExC_paren_names (pRExC_state->paren_names)
166 #define RExC_recurse (pRExC_state->recurse)
167 #define RExC_recurse_count (pRExC_state->recurse_count)
169 #define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?')
170 #define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
171 ((*s) == '{' && regcurly(s)))
174 #undef SPSTART /* dratted cpp namespace... */
177 * Flags to be passed up and down.
179 #define WORST 0 /* Worst case. */
180 #define HASWIDTH 0x1 /* Known to match non-null strings. */
181 #define SIMPLE 0x2 /* Simple enough to be STAR/PLUS operand. */
182 #define SPSTART 0x4 /* Starts with * or +. */
183 #define TRYAGAIN 0x8 /* Weeded out a declaration. */
185 #define REG_NODE_NUM(x) ((x) ? (int)((x)-RExC_emit_start) : -1)
187 /* whether trie related optimizations are enabled */
188 #if PERL_ENABLE_EXTENDED_TRIE_OPTIMISATION
189 #define TRIE_STUDY_OPT
190 #define FULL_TRIE_STUDY
196 #define PBYTE(u8str,paren) ((U8*)(u8str))[(paren) >> 3]
197 #define PBITVAL(paren) (1 << ((paren) & 7))
198 #define PAREN_TEST(u8str,paren) ( PBYTE(u8str,paren) & PBITVAL(paren))
199 #define PAREN_SET(u8str,paren) PBYTE(u8str,paren) |= PBITVAL(paren)
200 #define PAREN_UNSET(u8str,paren) PBYTE(u8str,paren) &= (~PBITVAL(paren))
203 /* About scan_data_t.
205 During optimisation we recurse through the regexp program performing
206 various inplace (keyhole style) optimisations. In addition study_chunk
207 and scan_commit populate this data structure with information about
208 what strings MUST appear in the pattern. We look for the longest
209 string that must appear for at a fixed location, and we look for the
210 longest string that may appear at a floating location. So for instance
215 Both 'FOO' and 'A' are fixed strings. Both 'B' and 'BAR' are floating
216 strings (because they follow a .* construct). study_chunk will identify
217 both FOO and BAR as being the longest fixed and floating strings respectively.
219 The strings can be composites, for instance
223 will result in a composite fixed substring 'foo'.
225 For each string some basic information is maintained:
227 - offset or min_offset
228 This is the position the string must appear at, or not before.
229 It also implicitly (when combined with minlenp) tells us how many
230 character must match before the string we are searching.
231 Likewise when combined with minlenp and the length of the string
232 tells us how many characters must appear after the string we have
236 Only used for floating strings. This is the rightmost point that
237 the string can appear at. Ifset to I32 max it indicates that the
238 string can occur infinitely far to the right.
241 A pointer to the minimum length of the pattern that the string
242 was found inside. This is important as in the case of positive
243 lookahead or positive lookbehind we can have multiple patterns
248 The minimum length of the pattern overall is 3, the minimum length
249 of the lookahead part is 3, but the minimum length of the part that
250 will actually match is 1. So 'FOO's minimum length is 3, but the
251 minimum length for the F is 1. This is important as the minimum length
252 is used to determine offsets in front of and behind the string being
253 looked for. Since strings can be composites this is the length of the
254 pattern at the time it was commited with a scan_commit. Note that
255 the length is calculated by study_chunk, so that the minimum lengths
256 are not known until the full pattern has been compiled, thus the
257 pointer to the value.
261 In the case of lookbehind the string being searched for can be
262 offset past the start point of the final matching string.
263 If this value was just blithely removed from the min_offset it would
264 invalidate some of the calculations for how many chars must match
265 before or after (as they are derived from min_offset and minlen and
266 the length of the string being searched for).
267 When the final pattern is compiled and the data is moved from the
268 scan_data_t structure into the regexp structure the information
269 about lookbehind is factored in, with the information that would
270 have been lost precalculated in the end_shift field for the
273 The fields pos_min and pos_delta are used to store the minimum offset
274 and the delta to the maximum offset at the current point in the pattern.
278 typedef struct scan_data_t {
279 /*I32 len_min; unused */
280 /*I32 len_delta; unused */
284 I32 last_end; /* min value, <0 unless valid. */
287 SV **longest; /* Either &l_fixed, or &l_float. */
288 SV *longest_fixed; /* longest fixed string found in pattern */
289 I32 offset_fixed; /* offset where it starts */
290 I32 *minlen_fixed; /* pointer to the minlen relevent to the string */
291 I32 lookbehind_fixed; /* is the position of the string modfied by LB */
292 SV *longest_float; /* longest floating string found in pattern */
293 I32 offset_float_min; /* earliest point in string it can appear */
294 I32 offset_float_max; /* latest point in string it can appear */
295 I32 *minlen_float; /* pointer to the minlen relevent to the string */
296 I32 lookbehind_float; /* is the position of the string modified by LB */
300 struct regnode_charclass_class *start_class;
304 * Forward declarations for pregcomp()'s friends.
307 static const scan_data_t zero_scan_data =
308 { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ,0};
310 #define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
311 #define SF_BEFORE_SEOL 0x0001
312 #define SF_BEFORE_MEOL 0x0002
313 #define SF_FIX_BEFORE_EOL (SF_FIX_BEFORE_SEOL|SF_FIX_BEFORE_MEOL)
314 #define SF_FL_BEFORE_EOL (SF_FL_BEFORE_SEOL|SF_FL_BEFORE_MEOL)
317 # define SF_FIX_SHIFT_EOL (0+2)
318 # define SF_FL_SHIFT_EOL (0+4)
320 # define SF_FIX_SHIFT_EOL (+2)
321 # define SF_FL_SHIFT_EOL (+4)
324 #define SF_FIX_BEFORE_SEOL (SF_BEFORE_SEOL << SF_FIX_SHIFT_EOL)
325 #define SF_FIX_BEFORE_MEOL (SF_BEFORE_MEOL << SF_FIX_SHIFT_EOL)
327 #define SF_FL_BEFORE_SEOL (SF_BEFORE_SEOL << SF_FL_SHIFT_EOL)
328 #define SF_FL_BEFORE_MEOL (SF_BEFORE_MEOL << SF_FL_SHIFT_EOL) /* 0x20 */
329 #define SF_IS_INF 0x0040
330 #define SF_HAS_PAR 0x0080
331 #define SF_IN_PAR 0x0100
332 #define SF_HAS_EVAL 0x0200
333 #define SCF_DO_SUBSTR 0x0400
334 #define SCF_DO_STCLASS_AND 0x0800
335 #define SCF_DO_STCLASS_OR 0x1000
336 #define SCF_DO_STCLASS (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR)
337 #define SCF_WHILEM_VISITED_POS 0x2000
339 #define SCF_TRIE_RESTUDY 0x4000 /* Do restudy? */
340 #define SCF_SEEN_ACCEPT 0x8000
342 #define UTF (RExC_utf8 != 0)
343 #define LOC ((RExC_flags & PMf_LOCALE) != 0)
344 #define FOLD ((RExC_flags & PMf_FOLD) != 0)
346 #define OOB_UNICODE 12345678
347 #define OOB_NAMEDCLASS -1
349 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
350 #define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
353 /* length of regex to show in messages that don't mark a position within */
354 #define RegexLengthToShowInErrorMessages 127
357 * If MARKER[12] are adjusted, be sure to adjust the constants at the top
358 * of t/op/regmesg.t, the tests in t/op/re_tests, and those in
359 * op/pragma/warn/regcomp.
361 #define MARKER1 "<-- HERE" /* marker as it appears in the description */
362 #define MARKER2 " <-- HERE " /* marker as it appears within the regex */
364 #define REPORT_LOCATION " in regex; marked by " MARKER1 " in m/%.*s" MARKER2 "%s/"
367 * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
368 * arg. Show regex, up to a maximum length. If it's too long, chop and add
371 #define FAIL(msg) STMT_START { \
372 const char *ellipses = ""; \
373 IV len = RExC_end - RExC_precomp; \
376 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
377 if (len > RegexLengthToShowInErrorMessages) { \
378 /* chop 10 shorter than the max, to ensure meaning of "..." */ \
379 len = RegexLengthToShowInErrorMessages - 10; \
382 Perl_croak(aTHX_ "%s in regex m/%.*s%s/", \
383 msg, (int)len, RExC_precomp, ellipses); \
387 * Simple_vFAIL -- like FAIL, but marks the current location in the scan
389 #define Simple_vFAIL(m) STMT_START { \
390 const IV offset = RExC_parse - RExC_precomp; \
391 Perl_croak(aTHX_ "%s" REPORT_LOCATION, \
392 m, (int)offset, RExC_precomp, RExC_precomp + offset); \
396 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL()
398 #define vFAIL(m) STMT_START { \
400 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
405 * Like Simple_vFAIL(), but accepts two arguments.
407 #define Simple_vFAIL2(m,a1) STMT_START { \
408 const IV offset = RExC_parse - RExC_precomp; \
409 S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, \
410 (int)offset, RExC_precomp, RExC_precomp + offset); \
414 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL2().
416 #define vFAIL2(m,a1) STMT_START { \
418 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
419 Simple_vFAIL2(m, a1); \
424 * Like Simple_vFAIL(), but accepts three arguments.
426 #define Simple_vFAIL3(m, a1, a2) STMT_START { \
427 const IV offset = RExC_parse - RExC_precomp; \
428 S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, \
429 (int)offset, RExC_precomp, RExC_precomp + offset); \
433 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL3().
435 #define vFAIL3(m,a1,a2) STMT_START { \
437 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
438 Simple_vFAIL3(m, a1, a2); \
442 * Like Simple_vFAIL(), but accepts four arguments.
444 #define Simple_vFAIL4(m, a1, a2, a3) STMT_START { \
445 const IV offset = RExC_parse - RExC_precomp; \
446 S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3, \
447 (int)offset, RExC_precomp, RExC_precomp + offset); \
450 #define vWARN(loc,m) STMT_START { \
451 const IV offset = loc - RExC_precomp; \
452 Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s" REPORT_LOCATION, \
453 m, (int)offset, RExC_precomp, RExC_precomp + offset); \
456 #define vWARNdep(loc,m) STMT_START { \
457 const IV offset = loc - RExC_precomp; \
458 Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP), \
459 "%s" REPORT_LOCATION, \
460 m, (int)offset, RExC_precomp, RExC_precomp + offset); \
464 #define vWARN2(loc, m, a1) STMT_START { \
465 const IV offset = loc - RExC_precomp; \
466 Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
467 a1, (int)offset, RExC_precomp, RExC_precomp + offset); \
470 #define vWARN3(loc, m, a1, a2) STMT_START { \
471 const IV offset = loc - RExC_precomp; \
472 Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
473 a1, a2, (int)offset, RExC_precomp, RExC_precomp + offset); \
476 #define vWARN4(loc, m, a1, a2, a3) STMT_START { \
477 const IV offset = loc - RExC_precomp; \
478 Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
479 a1, a2, a3, (int)offset, RExC_precomp, RExC_precomp + offset); \
482 #define vWARN5(loc, m, a1, a2, a3, a4) STMT_START { \
483 const IV offset = loc - RExC_precomp; \
484 Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
485 a1, a2, a3, a4, (int)offset, RExC_precomp, RExC_precomp + offset); \
489 /* Allow for side effects in s */
490 #define REGC(c,s) STMT_START { \
491 if (!SIZE_ONLY) *(s) = (c); else (void)(s); \
494 /* Macros for recording node offsets. 20001227 mjd@plover.com
495 * Nodes are numbered 1, 2, 3, 4. Node #n's position is recorded in
496 * element 2*n-1 of the array. Element #2n holds the byte length node #n.
497 * Element 0 holds the number n.
498 * Position is 1 indexed.
501 #define Set_Node_Offset_To_R(node,byte) STMT_START { \
503 MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n", \
504 __LINE__, (int)(node), (int)(byte))); \
506 Perl_croak(aTHX_ "value of node is %d in Offset macro", (int)(node)); \
508 RExC_offsets[2*(node)-1] = (byte); \
513 #define Set_Node_Offset(node,byte) \
514 Set_Node_Offset_To_R((node)-RExC_emit_start, (byte)-RExC_start)
515 #define Set_Cur_Node_Offset Set_Node_Offset(RExC_emit, RExC_parse)
517 #define Set_Node_Length_To_R(node,len) STMT_START { \
519 MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n", \
520 __LINE__, (int)(node), (int)(len))); \
522 Perl_croak(aTHX_ "value of node is %d in Length macro", (int)(node)); \
524 RExC_offsets[2*(node)] = (len); \
529 #define Set_Node_Length(node,len) \
530 Set_Node_Length_To_R((node)-RExC_emit_start, len)
531 #define Set_Cur_Node_Length(len) Set_Node_Length(RExC_emit, len)
532 #define Set_Node_Cur_Length(node) \
533 Set_Node_Length(node, RExC_parse - parse_start)
535 /* Get offsets and lengths */
536 #define Node_Offset(n) (RExC_offsets[2*((n)-RExC_emit_start)-1])
537 #define Node_Length(n) (RExC_offsets[2*((n)-RExC_emit_start)])
539 #define Set_Node_Offset_Length(node,offset,len) STMT_START { \
540 Set_Node_Offset_To_R((node)-RExC_emit_start, (offset)); \
541 Set_Node_Length_To_R((node)-RExC_emit_start, (len)); \
545 #if PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS
546 #define EXPERIMENTAL_INPLACESCAN
549 #define DEBUG_STUDYDATA(data,depth) \
550 DEBUG_OPTIMISE_MORE_r(if(data){ \
551 PerlIO_printf(Perl_debug_log, \
552 "%*s"/* Len:%"IVdf"/%"IVdf" */" Pos:%"IVdf"/%"IVdf \
553 " Flags: %"IVdf" Whilem_c: %"IVdf" Lcp: %"IVdf" ", \
554 (int)(depth)*2, "", \
555 (IV)((data)->pos_min), \
556 (IV)((data)->pos_delta), \
557 (IV)((data)->flags), \
558 (IV)((data)->whilem_c), \
559 (IV)((data)->last_closep ? *((data)->last_closep) : -1) \
561 if ((data)->last_found) \
562 PerlIO_printf(Perl_debug_log, \
563 "Last:'%s' %"IVdf":%"IVdf"/%"IVdf" %sFixed:'%s' @ %"IVdf \
564 " %sFloat: '%s' @ %"IVdf"/%"IVdf"", \
565 SvPVX_const((data)->last_found), \
566 (IV)((data)->last_end), \
567 (IV)((data)->last_start_min), \
568 (IV)((data)->last_start_max), \
569 ((data)->longest && \
570 (data)->longest==&((data)->longest_fixed)) ? "*" : "", \
571 SvPVX_const((data)->longest_fixed), \
572 (IV)((data)->offset_fixed), \
573 ((data)->longest && \
574 (data)->longest==&((data)->longest_float)) ? "*" : "", \
575 SvPVX_const((data)->longest_float), \
576 (IV)((data)->offset_float_min), \
577 (IV)((data)->offset_float_max) \
579 PerlIO_printf(Perl_debug_log,"\n"); \
582 static void clear_re(pTHX_ void *r);
584 /* Mark that we cannot extend a found fixed substring at this point.
585 Update the longest found anchored substring and the longest found
586 floating substrings if needed. */
589 S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, I32 *minlenp)
591 const STRLEN l = CHR_SVLEN(data->last_found);
592 const STRLEN old_l = CHR_SVLEN(*data->longest);
593 GET_RE_DEBUG_FLAGS_DECL;
595 if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
596 SvSetMagicSV(*data->longest, data->last_found);
597 if (*data->longest == data->longest_fixed) {
598 data->offset_fixed = l ? data->last_start_min : data->pos_min;
599 if (data->flags & SF_BEFORE_EOL)
601 |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL);
603 data->flags &= ~SF_FIX_BEFORE_EOL;
604 data->minlen_fixed=minlenp;
605 data->lookbehind_fixed=0;
608 data->offset_float_min = l ? data->last_start_min : data->pos_min;
609 data->offset_float_max = (l
610 ? data->last_start_max
611 : data->pos_min + data->pos_delta);
612 if ((U32)data->offset_float_max > (U32)I32_MAX)
613 data->offset_float_max = I32_MAX;
614 if (data->flags & SF_BEFORE_EOL)
616 |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL);
618 data->flags &= ~SF_FL_BEFORE_EOL;
619 data->minlen_float=minlenp;
620 data->lookbehind_float=0;
623 SvCUR_set(data->last_found, 0);
625 SV * const sv = data->last_found;
626 if (SvUTF8(sv) && SvMAGICAL(sv)) {
627 MAGIC * const mg = mg_find(sv, PERL_MAGIC_utf8);
633 data->flags &= ~SF_BEFORE_EOL;
634 DEBUG_STUDYDATA(data,0);
637 /* Can match anything (initialization) */
639 S_cl_anything(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
641 ANYOF_CLASS_ZERO(cl);
642 ANYOF_BITMAP_SETALL(cl);
643 cl->flags = ANYOF_EOS|ANYOF_UNICODE_ALL;
645 cl->flags |= ANYOF_LOCALE;
648 /* Can match anything (initialization) */
650 S_cl_is_anything(const struct regnode_charclass_class *cl)
654 for (value = 0; value <= ANYOF_MAX; value += 2)
655 if (ANYOF_CLASS_TEST(cl, value) && ANYOF_CLASS_TEST(cl, value + 1))
657 if (!(cl->flags & ANYOF_UNICODE_ALL))
659 if (!ANYOF_BITMAP_TESTALLSET((const void*)cl))
664 /* Can match anything (initialization) */
666 S_cl_init(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
668 Zero(cl, 1, struct regnode_charclass_class);
670 cl_anything(pRExC_state, cl);
674 S_cl_init_zero(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
676 Zero(cl, 1, struct regnode_charclass_class);
678 cl_anything(pRExC_state, cl);
680 cl->flags |= ANYOF_LOCALE;
683 /* 'And' a given class with another one. Can create false positives */
684 /* We assume that cl is not inverted */
686 S_cl_and(struct regnode_charclass_class *cl,
687 const struct regnode_charclass_class *and_with)
690 assert(and_with->type == ANYOF);
691 if (!(and_with->flags & ANYOF_CLASS)
692 && !(cl->flags & ANYOF_CLASS)
693 && (and_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
694 && !(and_with->flags & ANYOF_FOLD)
695 && !(cl->flags & ANYOF_FOLD)) {
698 if (and_with->flags & ANYOF_INVERT)
699 for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
700 cl->bitmap[i] &= ~and_with->bitmap[i];
702 for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
703 cl->bitmap[i] &= and_with->bitmap[i];
704 } /* XXXX: logic is complicated otherwise, leave it along for a moment. */
705 if (!(and_with->flags & ANYOF_EOS))
706 cl->flags &= ~ANYOF_EOS;
708 if (cl->flags & ANYOF_UNICODE_ALL && and_with->flags & ANYOF_UNICODE &&
709 !(and_with->flags & ANYOF_INVERT)) {
710 cl->flags &= ~ANYOF_UNICODE_ALL;
711 cl->flags |= ANYOF_UNICODE;
712 ARG_SET(cl, ARG(and_with));
714 if (!(and_with->flags & ANYOF_UNICODE_ALL) &&
715 !(and_with->flags & ANYOF_INVERT))
716 cl->flags &= ~ANYOF_UNICODE_ALL;
717 if (!(and_with->flags & (ANYOF_UNICODE|ANYOF_UNICODE_ALL)) &&
718 !(and_with->flags & ANYOF_INVERT))
719 cl->flags &= ~ANYOF_UNICODE;
722 /* 'OR' a given class with another one. Can create false positives */
723 /* We assume that cl is not inverted */
725 S_cl_or(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, const struct regnode_charclass_class *or_with)
727 if (or_with->flags & ANYOF_INVERT) {
729 * (B1 | CL1) | (!B2 & !CL2) = (B1 | !B2 & !CL2) | (CL1 | (!B2 & !CL2))
730 * <= (B1 | !B2) | (CL1 | !CL2)
731 * which is wasteful if CL2 is small, but we ignore CL2:
732 * (B1 | CL1) | (!B2 & !CL2) <= (B1 | CL1) | !B2 = (B1 | !B2) | CL1
733 * XXXX Can we handle case-fold? Unclear:
734 * (OK1(i) | OK1(i')) | !(OK1(i) | OK1(i')) =
735 * (OK1(i) | OK1(i')) | (!OK1(i) & !OK1(i'))
737 if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
738 && !(or_with->flags & ANYOF_FOLD)
739 && !(cl->flags & ANYOF_FOLD) ) {
742 for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
743 cl->bitmap[i] |= ~or_with->bitmap[i];
744 } /* XXXX: logic is complicated otherwise */
746 cl_anything(pRExC_state, cl);
749 /* (B1 | CL1) | (B2 | CL2) = (B1 | B2) | (CL1 | CL2)) */
750 if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
751 && (!(or_with->flags & ANYOF_FOLD)
752 || (cl->flags & ANYOF_FOLD)) ) {
755 /* OR char bitmap and class bitmap separately */
756 for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
757 cl->bitmap[i] |= or_with->bitmap[i];
758 if (or_with->flags & ANYOF_CLASS) {
759 for (i = 0; i < ANYOF_CLASSBITMAP_SIZE; i++)
760 cl->classflags[i] |= or_with->classflags[i];
761 cl->flags |= ANYOF_CLASS;
764 else { /* XXXX: logic is complicated, leave it along for a moment. */
765 cl_anything(pRExC_state, cl);
768 if (or_with->flags & ANYOF_EOS)
769 cl->flags |= ANYOF_EOS;
771 if (cl->flags & ANYOF_UNICODE && or_with->flags & ANYOF_UNICODE &&
772 ARG(cl) != ARG(or_with)) {
773 cl->flags |= ANYOF_UNICODE_ALL;
774 cl->flags &= ~ANYOF_UNICODE;
776 if (or_with->flags & ANYOF_UNICODE_ALL) {
777 cl->flags |= ANYOF_UNICODE_ALL;
778 cl->flags &= ~ANYOF_UNICODE;
782 #define TRIE_LIST_ITEM(state,idx) (trie->states[state].trans.list)[ idx ]
783 #define TRIE_LIST_CUR(state) ( TRIE_LIST_ITEM( state, 0 ).forid )
784 #define TRIE_LIST_LEN(state) ( TRIE_LIST_ITEM( state, 0 ).newstate )
785 #define TRIE_LIST_USED(idx) ( trie->states[state].trans.list ? (TRIE_LIST_CUR( idx ) - 1) : 0 )
791 dump_trie_interim_list(trie,next_alloc)
792 dump_trie_interim_table(trie,next_alloc)
794 These routines dump out a trie in a somewhat readable format.
795 The _interim_ variants are used for debugging the interim
796 tables that are used to generate the final compressed
797 representation which is what dump_trie expects.
799 Part of the reason for their existance is to provide a form
800 of documentation as to how the different representations function.
806 Dumps the final compressed table form of the trie to Perl_debug_log.
807 Used for debugging make_trie().
811 S_dump_trie(pTHX_ const struct _reg_trie_data *trie,U32 depth)
814 SV *sv=sv_newmortal();
815 int colwidth= trie->widecharmap ? 6 : 4;
816 GET_RE_DEBUG_FLAGS_DECL;
819 PerlIO_printf( Perl_debug_log, "%*sChar : %-6s%-6s%-4s ",
820 (int)depth * 2 + 2,"",
821 "Match","Base","Ofs" );
823 for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
824 SV ** const tmp = av_fetch( trie->revcharmap, state, 0);
826 PerlIO_printf( Perl_debug_log, "%*s",
828 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
829 PL_colors[0], PL_colors[1],
830 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
831 PERL_PV_ESCAPE_FIRSTCHAR
836 PerlIO_printf( Perl_debug_log, "\n%*sState|-----------------------",
837 (int)depth * 2 + 2,"");
839 for( state = 0 ; state < trie->uniquecharcount ; state++ )
840 PerlIO_printf( Perl_debug_log, "%.*s", colwidth, "--------");
841 PerlIO_printf( Perl_debug_log, "\n");
843 for( state = 1 ; state < trie->statecount ; state++ ) {
844 const U32 base = trie->states[ state ].trans.base;
846 PerlIO_printf( Perl_debug_log, "%*s#%4"UVXf"|", (int)depth * 2 + 2,"", (UV)state);
848 if ( trie->states[ state ].wordnum ) {
849 PerlIO_printf( Perl_debug_log, " W%4X", trie->states[ state ].wordnum );
851 PerlIO_printf( Perl_debug_log, "%6s", "" );
854 PerlIO_printf( Perl_debug_log, " @%4"UVXf" ", (UV)base );
859 while( ( base + ofs < trie->uniquecharcount ) ||
860 ( base + ofs - trie->uniquecharcount < trie->lasttrans
861 && trie->trans[ base + ofs - trie->uniquecharcount ].check != state))
864 PerlIO_printf( Perl_debug_log, "+%2"UVXf"[ ", (UV)ofs);
866 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
867 if ( ( base + ofs >= trie->uniquecharcount ) &&
868 ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
869 trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
871 PerlIO_printf( Perl_debug_log, "%*"UVXf,
873 (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next );
875 PerlIO_printf( Perl_debug_log, "%*s",colwidth," ." );
879 PerlIO_printf( Perl_debug_log, "]");
882 PerlIO_printf( Perl_debug_log, "\n" );
886 dump_trie_interim_list(trie,next_alloc)
887 Dumps a fully constructed but uncompressed trie in list form.
888 List tries normally only are used for construction when the number of
889 possible chars (trie->uniquecharcount) is very high.
890 Used for debugging make_trie().
893 S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, U32 next_alloc,U32 depth)
896 SV *sv=sv_newmortal();
897 int colwidth= trie->widecharmap ? 6 : 4;
898 GET_RE_DEBUG_FLAGS_DECL;
899 /* print out the table precompression. */
900 PerlIO_printf( Perl_debug_log, "%*sState :Word | Transition Data\n%*s%s",
901 (int)depth * 2 + 2,"", (int)depth * 2 + 2,"",
902 "------:-----+-----------------\n" );
904 for( state=1 ; state < next_alloc ; state ++ ) {
907 PerlIO_printf( Perl_debug_log, "%*s %4"UVXf" :",
908 (int)depth * 2 + 2,"", (UV)state );
909 if ( ! trie->states[ state ].wordnum ) {
910 PerlIO_printf( Perl_debug_log, "%5s| ","");
912 PerlIO_printf( Perl_debug_log, "W%4x| ",
913 trie->states[ state ].wordnum
916 for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
917 SV ** const tmp = av_fetch( trie->revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0);
919 PerlIO_printf( Perl_debug_log, "%*s:%3X=%4"UVXf" | ",
921 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
922 PL_colors[0], PL_colors[1],
923 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
924 PERL_PV_ESCAPE_FIRSTCHAR
926 TRIE_LIST_ITEM(state,charid).forid,
927 (UV)TRIE_LIST_ITEM(state,charid).newstate
930 PerlIO_printf(Perl_debug_log, "\n%*s| ",
931 (int)((depth * 2) + 14), "");
934 PerlIO_printf( Perl_debug_log, "\n");
939 dump_trie_interim_table(trie,next_alloc)
940 Dumps a fully constructed but uncompressed trie in table form.
941 This is the normal DFA style state transition table, with a few
942 twists to facilitate compression later.
943 Used for debugging make_trie().
946 S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, U32 next_alloc, U32 depth)
950 SV *sv=sv_newmortal();
951 int colwidth= trie->widecharmap ? 6 : 4;
952 GET_RE_DEBUG_FLAGS_DECL;
955 print out the table precompression so that we can do a visual check
956 that they are identical.
959 PerlIO_printf( Perl_debug_log, "%*sChar : ",(int)depth * 2 + 2,"" );
961 for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
962 SV ** const tmp = av_fetch( trie->revcharmap, charid, 0);
964 PerlIO_printf( Perl_debug_log, "%*s",
966 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
967 PL_colors[0], PL_colors[1],
968 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
969 PERL_PV_ESCAPE_FIRSTCHAR
975 PerlIO_printf( Perl_debug_log, "\n%*sState+-",(int)depth * 2 + 2,"" );
977 for( charid=0 ; charid < trie->uniquecharcount ; charid++ ) {
978 PerlIO_printf( Perl_debug_log, "%.*s", colwidth,"--------");
981 PerlIO_printf( Perl_debug_log, "\n" );
983 for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
985 PerlIO_printf( Perl_debug_log, "%*s%4"UVXf" : ",
986 (int)depth * 2 + 2,"",
987 (UV)TRIE_NODENUM( state ) );
989 for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
990 UV v=(UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next );
992 PerlIO_printf( Perl_debug_log, "%*"UVXf, colwidth, v );
994 PerlIO_printf( Perl_debug_log, "%*s", colwidth, "." );
996 if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
997 PerlIO_printf( Perl_debug_log, " (%4"UVXf")\n", (UV)trie->trans[ state ].check );
999 PerlIO_printf( Perl_debug_log, " (%4"UVXf") W%4X\n", (UV)trie->trans[ state ].check,
1000 trie->states[ TRIE_NODENUM( state ) ].wordnum );
1007 /* make_trie(startbranch,first,last,tail,word_count,flags,depth)
1008 startbranch: the first branch in the whole branch sequence
1009 first : start branch of sequence of branch-exact nodes.
1010 May be the same as startbranch
1011 last : Thing following the last branch.
1012 May be the same as tail.
1013 tail : item following the branch sequence
1014 count : words in the sequence
1015 flags : currently the OP() type we will be building one of /EXACT(|F|Fl)/
1016 depth : indent depth
1018 Inplace optimizes a sequence of 2 or more Branch-Exact nodes into a TRIE node.
1020 A trie is an N'ary tree where the branches are determined by digital
1021 decomposition of the key. IE, at the root node you look up the 1st character and
1022 follow that branch repeat until you find the end of the branches. Nodes can be
1023 marked as "accepting" meaning they represent a complete word. Eg:
1027 would convert into the following structure. Numbers represent states, letters
1028 following numbers represent valid transitions on the letter from that state, if
1029 the number is in square brackets it represents an accepting state, otherwise it
1030 will be in parenthesis.
1032 +-h->+-e->[3]-+-r->(8)-+-s->[9]
1036 (1) +-i->(6)-+-s->[7]
1038 +-s->(3)-+-h->(4)-+-e->[5]
1040 Accept Word Mapping: 3=>1 (he),5=>2 (she), 7=>3 (his), 9=>4 (hers)
1042 This shows that when matching against the string 'hers' we will begin at state 1
1043 read 'h' and move to state 2, read 'e' and move to state 3 which is accepting,
1044 then read 'r' and go to state 8 followed by 's' which takes us to state 9 which
1045 is also accepting. Thus we know that we can match both 'he' and 'hers' with a
1046 single traverse. We store a mapping from accepting to state to which word was
1047 matched, and then when we have multiple possibilities we try to complete the
1048 rest of the regex in the order in which they occured in the alternation.
1050 The only prior NFA like behaviour that would be changed by the TRIE support is
1051 the silent ignoring of duplicate alternations which are of the form:
1053 / (DUPE|DUPE) X? (?{ ... }) Y /x
1055 Thus EVAL blocks follwing a trie may be called a different number of times with
1056 and without the optimisation. With the optimisations dupes will be silently
1057 ignored. This inconsistant behaviour of EVAL type nodes is well established as
1058 the following demonstrates:
1060 'words'=~/(word|word|word)(?{ print $1 })[xyz]/
1062 which prints out 'word' three times, but
1064 'words'=~/(word|word|word)(?{ print $1 })S/
1066 which doesnt print it out at all. This is due to other optimisations kicking in.
1068 Example of what happens on a structural level:
1070 The regexp /(ac|ad|ab)+/ will produce the folowing debug output:
1072 1: CURLYM[1] {1,32767}(18)
1083 This would be optimizable with startbranch=5, first=5, last=16, tail=16
1084 and should turn into:
1086 1: CURLYM[1] {1,32767}(18)
1088 [Words:3 Chars Stored:6 Unique Chars:4 States:5 NCP:1]
1096 Cases where tail != last would be like /(?foo|bar)baz/:
1106 which would be optimizable with startbranch=1, first=1, last=7, tail=8
1107 and would end up looking like:
1110 [Words:2 Chars Stored:6 Unique Chars:5 States:7 NCP:1]
1117 d = uvuni_to_utf8_flags(d, uv, 0);
1119 is the recommended Unicode-aware way of saying
1124 #define TRIE_STORE_REVCHAR \
1126 SV *tmp = newSVpvs(""); \
1127 if (UTF) SvUTF8_on(tmp); \
1128 Perl_sv_catpvf( aTHX_ tmp, "%c", (int)uvc ); \
1129 av_push( TRIE_REVCHARMAP(trie), tmp ); \
1132 #define TRIE_READ_CHAR STMT_START { \
1136 if ( foldlen > 0 ) { \
1137 uvc = utf8n_to_uvuni( scan, UTF8_MAXLEN, &len, uniflags ); \
1142 uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
1143 uvc = to_uni_fold( uvc, foldbuf, &foldlen ); \
1144 foldlen -= UNISKIP( uvc ); \
1145 scan = foldbuf + UNISKIP( uvc ); \
1148 uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
1158 #define TRIE_LIST_PUSH(state,fid,ns) STMT_START { \
1159 if ( TRIE_LIST_CUR( state ) >=TRIE_LIST_LEN( state ) ) { \
1160 U32 ging = TRIE_LIST_LEN( state ) *= 2; \
1161 Renew( trie->states[ state ].trans.list, ging, reg_trie_trans_le ); \
1163 TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).forid = fid; \
1164 TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).newstate = ns; \
1165 TRIE_LIST_CUR( state )++; \
1168 #define TRIE_LIST_NEW(state) STMT_START { \
1169 Newxz( trie->states[ state ].trans.list, \
1170 4, reg_trie_trans_le ); \
1171 TRIE_LIST_CUR( state ) = 1; \
1172 TRIE_LIST_LEN( state ) = 4; \
1175 #define TRIE_HANDLE_WORD(state) STMT_START { \
1176 U16 dupe= trie->states[ state ].wordnum; \
1177 regnode * const noper_next = regnext( noper ); \
1179 if (trie->wordlen) \
1180 trie->wordlen[ curword ] = wordlen; \
1182 /* store the word for dumping */ \
1184 if (OP(noper) != NOTHING) \
1185 tmp = newSVpvn(STRING(noper), STR_LEN(noper)); \
1187 tmp = newSVpvn( "", 0 ); \
1188 if ( UTF ) SvUTF8_on( tmp ); \
1189 av_push( trie->words, tmp ); \
1194 if ( noper_next < tail ) { \
1196 Newxz( trie->jump, word_count + 1, U16); \
1197 trie->jump[curword] = (U16)(noper_next - convert); \
1199 jumper = noper_next; \
1201 nextbranch= regnext(cur); \
1205 /* So it's a dupe. This means we need to maintain a */\
1206 /* linked-list from the first to the next. */\
1207 /* we only allocate the nextword buffer when there */\
1208 /* a dupe, so first time we have to do the allocation */\
1209 if (!trie->nextword) \
1210 Newxz( trie->nextword, word_count + 1, U16); \
1211 while ( trie->nextword[dupe] ) \
1212 dupe= trie->nextword[dupe]; \
1213 trie->nextword[dupe]= curword; \
1215 /* we haven't inserted this word yet. */ \
1216 trie->states[ state ].wordnum = curword; \
1221 #define TRIE_TRANS_STATE(state,base,ucharcount,charid,special) \
1222 ( ( base + charid >= ucharcount \
1223 && base + charid < ubound \
1224 && state == trie->trans[ base - ucharcount + charid ].check \
1225 && trie->trans[ base - ucharcount + charid ].next ) \
1226 ? trie->trans[ base - ucharcount + charid ].next \
1227 : ( state==1 ? special : 0 ) \
1231 #define MADE_JUMP_TRIE 2
1232 #define MADE_EXACT_TRIE 4
1235 S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 word_count, U32 flags, U32 depth)
1238 /* first pass, loop through and scan words */
1239 reg_trie_data *trie;
1241 const U32 uniflags = UTF8_ALLOW_DEFAULT;
1246 regnode *jumper = NULL;
1247 regnode *nextbranch = NULL;
1248 regnode *convert = NULL;
1249 /* we just use folder as a flag in utf8 */
1250 const U8 * const folder = ( flags == EXACTF
1252 : ( flags == EXACTFL
1258 const U32 data_slot = add_data( pRExC_state, 1, "t" );
1259 SV *re_trie_maxbuff;
1261 /* these are only used during construction but are useful during
1262 * debugging so we store them in the struct when debugging.
1264 STRLEN trie_charcount=0;
1265 AV *trie_revcharmap;
1267 GET_RE_DEBUG_FLAGS_DECL;
1269 PERL_UNUSED_ARG(depth);
1272 Newxz( trie, 1, reg_trie_data );
1274 trie->startstate = 1;
1275 trie->wordcount = word_count;
1276 RExC_rx->data->data[ data_slot ] = (void*)trie;
1277 Newxz( trie->charmap, 256, U16 );
1278 if (!(UTF && folder))
1279 Newxz( trie->bitmap, ANYOF_BITMAP_SIZE, char );
1281 trie->words = newAV();
1283 TRIE_REVCHARMAP(trie) = newAV();
1285 re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
1286 if (!SvIOK(re_trie_maxbuff)) {
1287 sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
1290 PerlIO_printf( Perl_debug_log,
1291 "%*smake_trie start==%d, first==%d, last==%d, tail==%d depth=%d\n",
1292 (int)depth * 2 + 2, "",
1293 REG_NODE_NUM(startbranch),REG_NODE_NUM(first),
1294 REG_NODE_NUM(last), REG_NODE_NUM(tail),
1298 /* Find the node we are going to overwrite */
1299 if ( first == startbranch && OP( last ) != BRANCH ) {
1300 /* whole branch chain */
1303 /* branch sub-chain */
1304 convert = NEXTOPER( first );
1307 /* -- First loop and Setup --
1309 We first traverse the branches and scan each word to determine if it
1310 contains widechars, and how many unique chars there are, this is
1311 important as we have to build a table with at least as many columns as we
1314 We use an array of integers to represent the character codes 0..255
1315 (trie->charmap) and we use a an HV* to store unicode characters. We use the
1316 native representation of the character value as the key and IV's for the
1319 *TODO* If we keep track of how many times each character is used we can
1320 remap the columns so that the table compression later on is more
1321 efficient in terms of memory by ensuring most common value is in the
1322 middle and the least common are on the outside. IMO this would be better
1323 than a most to least common mapping as theres a decent chance the most
1324 common letter will share a node with the least common, meaning the node
1325 will not be compressable. With a middle is most common approach the worst
1326 case is when we have the least common nodes twice.
1330 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1331 regnode * const noper = NEXTOPER( cur );
1332 const U8 *uc = (U8*)STRING( noper );
1333 const U8 * const e = uc + STR_LEN( noper );
1335 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1336 const U8 *scan = (U8*)NULL;
1337 U32 wordlen = 0; /* required init */
1340 if (OP(noper) == NOTHING) {
1345 TRIE_BITMAP_SET(trie,*uc);
1346 if ( folder ) TRIE_BITMAP_SET(trie,folder[ *uc ]);
1348 for ( ; uc < e ; uc += len ) {
1349 TRIE_CHARCOUNT(trie)++;
1353 if ( !trie->charmap[ uvc ] ) {
1354 trie->charmap[ uvc ]=( ++trie->uniquecharcount );
1356 trie->charmap[ folder[ uvc ] ] = trie->charmap[ uvc ];
1361 if ( !trie->widecharmap )
1362 trie->widecharmap = newHV();
1364 svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 1 );
1367 Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%"UVXf, uvc );
1369 if ( !SvTRUE( *svpp ) ) {
1370 sv_setiv( *svpp, ++trie->uniquecharcount );
1375 if( cur == first ) {
1378 } else if (chars < trie->minlen) {
1380 } else if (chars > trie->maxlen) {
1384 } /* end first pass */
1385 DEBUG_TRIE_COMPILE_r(
1386 PerlIO_printf( Perl_debug_log, "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
1387 (int)depth * 2 + 2,"",
1388 ( trie->widecharmap ? "UTF8" : "NATIVE" ), (int)word_count,
1389 (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount,
1390 (int)trie->minlen, (int)trie->maxlen )
1392 Newxz( trie->wordlen, word_count, U32 );
1395 We now know what we are dealing with in terms of unique chars and
1396 string sizes so we can calculate how much memory a naive
1397 representation using a flat table will take. If it's over a reasonable
1398 limit (as specified by ${^RE_TRIE_MAXBUF}) we use a more memory
1399 conservative but potentially much slower representation using an array
1402 At the end we convert both representations into the same compressed
1403 form that will be used in regexec.c for matching with. The latter
1404 is a form that cannot be used to construct with but has memory
1405 properties similar to the list form and access properties similar
1406 to the table form making it both suitable for fast searches and
1407 small enough that its feasable to store for the duration of a program.
1409 See the comment in the code where the compressed table is produced
1410 inplace from the flat tabe representation for an explanation of how
1411 the compression works.
1416 if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1) > SvIV(re_trie_maxbuff) ) {
1418 Second Pass -- Array Of Lists Representation
1420 Each state will be represented by a list of charid:state records
1421 (reg_trie_trans_le) the first such element holds the CUR and LEN
1422 points of the allocated array. (See defines above).
1424 We build the initial structure using the lists, and then convert
1425 it into the compressed table form which allows faster lookups
1426 (but cant be modified once converted).
1429 STRLEN transcount = 1;
1431 DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
1432 "%*sCompiling trie using list compiler\n",
1433 (int)depth * 2 + 2, ""));
1435 Newxz( trie->states, TRIE_CHARCOUNT(trie) + 2, reg_trie_state );
1439 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1441 regnode * const noper = NEXTOPER( cur );
1442 U8 *uc = (U8*)STRING( noper );
1443 const U8 * const e = uc + STR_LEN( noper );
1444 U32 state = 1; /* required init */
1445 U16 charid = 0; /* sanity init */
1446 U8 *scan = (U8*)NULL; /* sanity init */
1447 STRLEN foldlen = 0; /* required init */
1448 U32 wordlen = 0; /* required init */
1449 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1451 if (OP(noper) != NOTHING) {
1452 for ( ; uc < e ; uc += len ) {
1457 charid = trie->charmap[ uvc ];
1459 SV** const svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 0);
1463 charid=(U16)SvIV( *svpp );
1466 /* charid is now 0 if we dont know the char read, or nonzero if we do */
1473 if ( !trie->states[ state ].trans.list ) {
1474 TRIE_LIST_NEW( state );
1476 for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) {
1477 if ( TRIE_LIST_ITEM( state, check ).forid == charid ) {
1478 newstate = TRIE_LIST_ITEM( state, check ).newstate;
1483 newstate = next_alloc++;
1484 TRIE_LIST_PUSH( state, charid, newstate );
1489 Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1493 TRIE_HANDLE_WORD(state);
1495 } /* end second pass */
1497 /* next alloc is the NEXT state to be allocated */
1498 trie->statecount = next_alloc;
1499 Renew( trie->states, next_alloc, reg_trie_state );
1501 /* and now dump it out before we compress it */
1502 DEBUG_TRIE_COMPILE_MORE_r(
1503 dump_trie_interim_list(trie,next_alloc,depth+1)
1506 Newxz( trie->trans, transcount ,reg_trie_trans );
1513 for( state=1 ; state < next_alloc ; state ++ ) {
1517 DEBUG_TRIE_COMPILE_MORE_r(
1518 PerlIO_printf( Perl_debug_log, "tp: %d zp: %d ",tp,zp)
1522 if (trie->states[state].trans.list) {
1523 U16 minid=TRIE_LIST_ITEM( state, 1).forid;
1527 for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1528 const U16 forid = TRIE_LIST_ITEM( state, idx).forid;
1529 if ( forid < minid ) {
1531 } else if ( forid > maxid ) {
1535 if ( transcount < tp + maxid - minid + 1) {
1537 Renew( trie->trans, transcount, reg_trie_trans );
1538 Zero( trie->trans + (transcount / 2), transcount / 2 , reg_trie_trans );
1540 base = trie->uniquecharcount + tp - minid;
1541 if ( maxid == minid ) {
1543 for ( ; zp < tp ; zp++ ) {
1544 if ( ! trie->trans[ zp ].next ) {
1545 base = trie->uniquecharcount + zp - minid;
1546 trie->trans[ zp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1547 trie->trans[ zp ].check = state;
1553 trie->trans[ tp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1554 trie->trans[ tp ].check = state;
1559 for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1560 const U32 tid = base - trie->uniquecharcount + TRIE_LIST_ITEM( state, idx ).forid;
1561 trie->trans[ tid ].next = TRIE_LIST_ITEM( state, idx ).newstate;
1562 trie->trans[ tid ].check = state;
1564 tp += ( maxid - minid + 1 );
1566 Safefree(trie->states[ state ].trans.list);
1569 DEBUG_TRIE_COMPILE_MORE_r(
1570 PerlIO_printf( Perl_debug_log, " base: %d\n",base);
1573 trie->states[ state ].trans.base=base;
1575 trie->lasttrans = tp + 1;
1579 Second Pass -- Flat Table Representation.
1581 we dont use the 0 slot of either trans[] or states[] so we add 1 to each.
1582 We know that we will need Charcount+1 trans at most to store the data
1583 (one row per char at worst case) So we preallocate both structures
1584 assuming worst case.
1586 We then construct the trie using only the .next slots of the entry
1589 We use the .check field of the first entry of the node temporarily to
1590 make compression both faster and easier by keeping track of how many non
1591 zero fields are in the node.
1593 Since trans are numbered from 1 any 0 pointer in the table is a FAIL
1596 There are two terms at use here: state as a TRIE_NODEIDX() which is a
1597 number representing the first entry of the node, and state as a
1598 TRIE_NODENUM() which is the trans number. state 1 is TRIE_NODEIDX(1) and
1599 TRIE_NODENUM(1), state 2 is TRIE_NODEIDX(2) and TRIE_NODENUM(3) if there
1600 are 2 entrys per node. eg:
1608 The table is internally in the right hand, idx form. However as we also
1609 have to deal with the states array which is indexed by nodenum we have to
1610 use TRIE_NODENUM() to convert.
1613 DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
1614 "%*sCompiling trie using table compiler\n",
1615 (int)depth * 2 + 2, ""));
1617 Newxz( trie->trans, ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1,
1619 Newxz( trie->states, TRIE_CHARCOUNT(trie) + 2, reg_trie_state );
1620 next_alloc = trie->uniquecharcount + 1;
1623 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1625 regnode * const noper = NEXTOPER( cur );
1626 const U8 *uc = (U8*)STRING( noper );
1627 const U8 * const e = uc + STR_LEN( noper );
1629 U32 state = 1; /* required init */
1631 U16 charid = 0; /* sanity init */
1632 U32 accept_state = 0; /* sanity init */
1633 U8 *scan = (U8*)NULL; /* sanity init */
1635 STRLEN foldlen = 0; /* required init */
1636 U32 wordlen = 0; /* required init */
1637 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1639 if ( OP(noper) != NOTHING ) {
1640 for ( ; uc < e ; uc += len ) {
1645 charid = trie->charmap[ uvc ];
1647 SV* const * const svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 0);
1648 charid = svpp ? (U16)SvIV(*svpp) : 0;
1652 if ( !trie->trans[ state + charid ].next ) {
1653 trie->trans[ state + charid ].next = next_alloc;
1654 trie->trans[ state ].check++;
1655 next_alloc += trie->uniquecharcount;
1657 state = trie->trans[ state + charid ].next;
1659 Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1661 /* charid is now 0 if we dont know the char read, or nonzero if we do */
1664 accept_state = TRIE_NODENUM( state );
1665 TRIE_HANDLE_WORD(accept_state);
1667 } /* end second pass */
1669 /* and now dump it out before we compress it */
1670 DEBUG_TRIE_COMPILE_MORE_r(
1671 dump_trie_interim_table(trie,next_alloc,depth+1)
1676 * Inplace compress the table.*
1678 For sparse data sets the table constructed by the trie algorithm will
1679 be mostly 0/FAIL transitions or to put it another way mostly empty.
1680 (Note that leaf nodes will not contain any transitions.)
1682 This algorithm compresses the tables by eliminating most such
1683 transitions, at the cost of a modest bit of extra work during lookup:
1685 - Each states[] entry contains a .base field which indicates the
1686 index in the state[] array wheres its transition data is stored.
1688 - If .base is 0 there are no valid transitions from that node.
1690 - If .base is nonzero then charid is added to it to find an entry in
1693 -If trans[states[state].base+charid].check!=state then the
1694 transition is taken to be a 0/Fail transition. Thus if there are fail
1695 transitions at the front of the node then the .base offset will point
1696 somewhere inside the previous nodes data (or maybe even into a node
1697 even earlier), but the .check field determines if the transition is
1701 The following process inplace converts the table to the compressed
1702 table: We first do not compress the root node 1,and mark its all its
1703 .check pointers as 1 and set its .base pointer as 1 as well. This
1704 allows to do a DFA construction from the compressed table later, and
1705 ensures that any .base pointers we calculate later are greater than
1708 - We set 'pos' to indicate the first entry of the second node.
1710 - We then iterate over the columns of the node, finding the first and
1711 last used entry at l and m. We then copy l..m into pos..(pos+m-l),
1712 and set the .check pointers accordingly, and advance pos
1713 appropriately and repreat for the next node. Note that when we copy
1714 the next pointers we have to convert them from the original
1715 NODEIDX form to NODENUM form as the former is not valid post
1718 - If a node has no transitions used we mark its base as 0 and do not
1719 advance the pos pointer.
1721 - If a node only has one transition we use a second pointer into the
1722 structure to fill in allocated fail transitions from other states.
1723 This pointer is independent of the main pointer and scans forward
1724 looking for null transitions that are allocated to a state. When it
1725 finds one it writes the single transition into the "hole". If the
1726 pointer doesnt find one the single transition is appended as normal.
1728 - Once compressed we can Renew/realloc the structures to release the
1731 See "Table-Compression Methods" in sec 3.9 of the Red Dragon,
1732 specifically Fig 3.47 and the associated pseudocode.
1736 const U32 laststate = TRIE_NODENUM( next_alloc );
1739 trie->statecount = laststate;
1741 for ( state = 1 ; state < laststate ; state++ ) {
1743 const U32 stateidx = TRIE_NODEIDX( state );
1744 const U32 o_used = trie->trans[ stateidx ].check;
1745 U32 used = trie->trans[ stateidx ].check;
1746 trie->trans[ stateidx ].check = 0;
1748 for ( charid = 0 ; used && charid < trie->uniquecharcount ; charid++ ) {
1749 if ( flag || trie->trans[ stateidx + charid ].next ) {
1750 if ( trie->trans[ stateidx + charid ].next ) {
1752 for ( ; zp < pos ; zp++ ) {
1753 if ( ! trie->trans[ zp ].next ) {
1757 trie->states[ state ].trans.base = zp + trie->uniquecharcount - charid ;
1758 trie->trans[ zp ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1759 trie->trans[ zp ].check = state;
1760 if ( ++zp > pos ) pos = zp;
1767 trie->states[ state ].trans.base = pos + trie->uniquecharcount - charid ;
1769 trie->trans[ pos ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1770 trie->trans[ pos ].check = state;
1775 trie->lasttrans = pos + 1;
1776 Renew( trie->states, laststate, reg_trie_state);
1777 DEBUG_TRIE_COMPILE_MORE_r(
1778 PerlIO_printf( Perl_debug_log,
1779 "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
1780 (int)depth * 2 + 2,"",
1781 (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1 ),
1784 ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
1787 } /* end table compress */
1789 DEBUG_TRIE_COMPILE_MORE_r(
1790 PerlIO_printf(Perl_debug_log, "%*sStatecount:%"UVxf" Lasttrans:%"UVxf"\n",
1791 (int)depth * 2 + 2, "",
1792 (UV)trie->statecount,
1793 (UV)trie->lasttrans)
1795 /* resize the trans array to remove unused space */
1796 Renew( trie->trans, trie->lasttrans, reg_trie_trans);
1798 /* and now dump out the compressed format */
1799 DEBUG_TRIE_COMPILE_r(
1800 dump_trie(trie,depth+1)
1803 { /* Modify the program and insert the new TRIE node*/
1804 U8 nodetype =(U8)(flags & 0xFF);
1808 regnode *optimize = NULL;
1810 U32 mjd_nodelen = 0;
1813 This means we convert either the first branch or the first Exact,
1814 depending on whether the thing following (in 'last') is a branch
1815 or not and whther first is the startbranch (ie is it a sub part of
1816 the alternation or is it the whole thing.)
1817 Assuming its a sub part we conver the EXACT otherwise we convert
1818 the whole branch sequence, including the first.
1820 /* Find the node we are going to overwrite */
1821 if ( first != startbranch || OP( last ) == BRANCH ) {
1822 /* branch sub-chain */
1823 NEXT_OFF( first ) = (U16)(last - first);
1825 mjd_offset= Node_Offset((convert));
1826 mjd_nodelen= Node_Length((convert));
1828 /* whole branch chain */
1831 const regnode *nop = NEXTOPER( convert );
1832 mjd_offset= Node_Offset((nop));
1833 mjd_nodelen= Node_Length((nop));
1838 PerlIO_printf(Perl_debug_log, "%*sMJD offset:%"UVuf" MJD length:%"UVuf"\n",
1839 (int)depth * 2 + 2, "",
1840 (UV)mjd_offset, (UV)mjd_nodelen)
1843 /* But first we check to see if there is a common prefix we can
1844 split out as an EXACT and put in front of the TRIE node. */
1845 trie->startstate= 1;
1846 if ( trie->bitmap && !trie->widecharmap && !trie->jump ) {
1848 for ( state = 1 ; state < trie->statecount-1 ; state++ ) {
1852 const U32 base = trie->states[ state ].trans.base;
1854 if ( trie->states[state].wordnum )
1857 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
1858 if ( ( base + ofs >= trie->uniquecharcount ) &&
1859 ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
1860 trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
1862 if ( ++count > 1 ) {
1863 SV **tmp = av_fetch( TRIE_REVCHARMAP(trie), ofs, 0);
1864 const U8 *ch = (U8*)SvPV_nolen_const( *tmp );
1865 if ( state == 1 ) break;
1867 Zero(trie->bitmap, ANYOF_BITMAP_SIZE, char);
1869 PerlIO_printf(Perl_debug_log,
1870 "%*sNew Start State=%"UVuf" Class: [",
1871 (int)depth * 2 + 2, "",
1874 SV ** const tmp = av_fetch( TRIE_REVCHARMAP(trie), idx, 0);
1875 const U8 * const ch = (U8*)SvPV_nolen_const( *tmp );
1877 TRIE_BITMAP_SET(trie,*ch);
1879 TRIE_BITMAP_SET(trie, folder[ *ch ]);
1881 PerlIO_printf(Perl_debug_log, (char*)ch)
1885 TRIE_BITMAP_SET(trie,*ch);
1887 TRIE_BITMAP_SET(trie,folder[ *ch ]);
1888 DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"%s", ch));
1894 SV **tmp = av_fetch( TRIE_REVCHARMAP(trie), idx, 0);
1895 const char *ch = SvPV_nolen_const( *tmp );
1897 PerlIO_printf( Perl_debug_log,
1898 "%*sPrefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
1899 (int)depth * 2 + 2, "",
1900 (UV)state, (UV)idx, ch)
1903 OP( convert ) = nodetype;
1904 str=STRING(convert);
1913 DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"]\n"));
1919 regnode *n = convert+NODE_SZ_STR(convert);
1920 NEXT_OFF(convert) = NODE_SZ_STR(convert);
1921 trie->startstate = state;
1922 trie->minlen -= (state - 1);
1923 trie->maxlen -= (state - 1);
1925 regnode *fix = convert;
1927 Set_Node_Offset_Length(convert, mjd_offset, state - 1);
1928 while( ++fix < n ) {
1929 Set_Node_Offset_Length(fix, 0, 0);
1935 NEXT_OFF(convert) = (U16)(tail - convert);
1936 DEBUG_r(optimize= n);
1942 if ( trie->maxlen ) {
1943 NEXT_OFF( convert ) = (U16)(tail - convert);
1944 ARG_SET( convert, data_slot );
1945 /* Store the offset to the first unabsorbed branch in
1946 jump[0], which is otherwise unused by the jump logic.
1947 We use this when dumping a trie and during optimisation. */
1949 trie->jump[0] = (U16)(nextbranch - convert);
1952 if ( !trie->states[trie->startstate].wordnum && trie->bitmap &&
1953 ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) )
1955 OP( convert ) = TRIEC;
1956 Copy(trie->bitmap, ((struct regnode_charclass *)convert)->bitmap, ANYOF_BITMAP_SIZE, char);
1957 Safefree(trie->bitmap);
1960 OP( convert ) = TRIE;
1962 /* store the type in the flags */
1963 convert->flags = nodetype;
1967 + regarglen[ OP( convert ) ];
1969 /* XXX We really should free up the resource in trie now,
1970 as we won't use them - (which resources?) dmq */
1972 /* needed for dumping*/
1973 DEBUG_r(if (optimize) {
1974 regnode *opt = convert;
1975 while ( ++opt < optimize) {
1976 Set_Node_Offset_Length(opt,0,0);
1979 Try to clean up some of the debris left after the
1982 while( optimize < jumper ) {
1983 mjd_nodelen += Node_Length((optimize));
1984 OP( optimize ) = OPTIMIZED;
1985 Set_Node_Offset_Length(optimize,0,0);
1988 Set_Node_Offset_Length(convert,mjd_offset,mjd_nodelen);
1990 } /* end node insert */
1992 SvREFCNT_dec(TRIE_REVCHARMAP(trie));
1996 : trie->startstate>1
2002 S_make_trie_failtable(pTHX_ RExC_state_t *pRExC_state, regnode *source, regnode *stclass, U32 depth)
2004 /* The Trie is constructed and compressed now so we can build a fail array now if its needed
2006 This is basically the Aho-Corasick algorithm. Its from exercise 3.31 and 3.32 in the
2007 "Red Dragon" -- Compilers, principles, techniques, and tools. Aho, Sethi, Ullman 1985/88
2010 We find the fail state for each state in the trie, this state is the longest proper
2011 suffix of the current states 'word' that is also a proper prefix of another word in our
2012 trie. State 1 represents the word '' and is the thus the default fail state. This allows
2013 the DFA not to have to restart after its tried and failed a word at a given point, it
2014 simply continues as though it had been matching the other word in the first place.
2016 'abcdgu'=~/abcdefg|cdgu/
2017 When we get to 'd' we are still matching the first word, we would encounter 'g' which would
2018 fail, which would bring use to the state representing 'd' in the second word where we would
2019 try 'g' and succeed, prodceding to match 'cdgu'.
2021 /* add a fail transition */
2022 reg_trie_data *trie=(reg_trie_data *)RExC_rx->data->data[ARG(source)];
2024 const U32 ucharcount = trie->uniquecharcount;
2025 const U32 numstates = trie->statecount;
2026 const U32 ubound = trie->lasttrans + ucharcount;
2030 U32 base = trie->states[ 1 ].trans.base;
2033 const U32 data_slot = add_data( pRExC_state, 1, "T" );
2034 GET_RE_DEBUG_FLAGS_DECL;
2036 PERL_UNUSED_ARG(depth);
2040 ARG_SET( stclass, data_slot );
2041 Newxz( aho, 1, reg_ac_data );
2042 RExC_rx->data->data[ data_slot ] = (void*)aho;
2044 aho->states=(reg_trie_state *)savepvn((const char*)trie->states,
2045 numstates * sizeof(reg_trie_state));
2046 Newxz( q, numstates, U32);
2047 Newxz( aho->fail, numstates, U32 );
2050 /* initialize fail[0..1] to be 1 so that we always have
2051 a valid final fail state */
2052 fail[ 0 ] = fail[ 1 ] = 1;
2054 for ( charid = 0; charid < ucharcount ; charid++ ) {
2055 const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 );
2057 q[ q_write ] = newstate;
2058 /* set to point at the root */
2059 fail[ q[ q_write++ ] ]=1;
2062 while ( q_read < q_write) {
2063 const U32 cur = q[ q_read++ % numstates ];
2064 base = trie->states[ cur ].trans.base;
2066 for ( charid = 0 ; charid < ucharcount ; charid++ ) {
2067 const U32 ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 );
2069 U32 fail_state = cur;
2072 fail_state = fail[ fail_state ];
2073 fail_base = aho->states[ fail_state ].trans.base;
2074 } while ( !TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 ) );
2076 fail_state = TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 );
2077 fail[ ch_state ] = fail_state;
2078 if ( !aho->states[ ch_state ].wordnum && aho->states[ fail_state ].wordnum )
2080 aho->states[ ch_state ].wordnum = aho->states[ fail_state ].wordnum;
2082 q[ q_write++ % numstates] = ch_state;
2086 /* restore fail[0..1] to 0 so that we "fall out" of the AC loop
2087 when we fail in state 1, this allows us to use the
2088 charclass scan to find a valid start char. This is based on the principle
2089 that theres a good chance the string being searched contains lots of stuff
2090 that cant be a start char.
2092 fail[ 0 ] = fail[ 1 ] = 0;
2093 DEBUG_TRIE_COMPILE_r({
2094 PerlIO_printf(Perl_debug_log,
2095 "%*sStclass Failtable (%"UVuf" states): 0",
2096 (int)(depth * 2), "", (UV)numstates
2098 for( q_read=1; q_read<numstates; q_read++ ) {
2099 PerlIO_printf(Perl_debug_log, ", %"UVuf, (UV)fail[q_read]);
2101 PerlIO_printf(Perl_debug_log, "\n");
2104 /*RExC_seen |= REG_SEEN_TRIEDFA;*/
2109 * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2.
2110 * These need to be revisited when a newer toolchain becomes available.
2112 #if defined(__sparc64__) && defined(__GNUC__)
2113 # if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
2114 # undef SPARC64_GCC_WORKAROUND
2115 # define SPARC64_GCC_WORKAROUND 1
2119 #define DEBUG_PEEP(str,scan,depth) \
2120 DEBUG_OPTIMISE_r({ \
2121 SV * const mysv=sv_newmortal(); \
2122 regnode *Next = regnext(scan); \
2123 regprop(RExC_rx, mysv, scan); \
2124 PerlIO_printf(Perl_debug_log, "%*s" str ">%3d: %s (%d)\n", \
2125 (int)depth*2, "", REG_NODE_NUM(scan), SvPV_nolen_const(mysv),\
2126 Next ? (REG_NODE_NUM(Next)) : 0 ); \
2133 #define JOIN_EXACT(scan,min,flags) \
2134 if (PL_regkind[OP(scan)] == EXACT) \
2135 join_exact(pRExC_state,(scan),(min),(flags),NULL,depth+1)
2138 S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, I32 *min, U32 flags,regnode *val, U32 depth) {
2139 /* Merge several consecutive EXACTish nodes into one. */
2140 regnode *n = regnext(scan);
2142 regnode *next = scan + NODE_SZ_STR(scan);
2146 regnode *stop = scan;
2147 GET_RE_DEBUG_FLAGS_DECL;
2149 PERL_UNUSED_ARG(depth);
2151 #ifndef EXPERIMENTAL_INPLACESCAN
2152 PERL_UNUSED_ARG(flags);
2153 PERL_UNUSED_ARG(val);
2155 DEBUG_PEEP("join",scan,depth);
2157 /* Skip NOTHING, merge EXACT*. */
2159 ( PL_regkind[OP(n)] == NOTHING ||
2160 (stringok && (OP(n) == OP(scan))))
2162 && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
2164 if (OP(n) == TAIL || n > next)
2166 if (PL_regkind[OP(n)] == NOTHING) {
2167 DEBUG_PEEP("skip:",n,depth);
2168 NEXT_OFF(scan) += NEXT_OFF(n);
2169 next = n + NODE_STEP_REGNODE;
2176 else if (stringok) {
2177 const unsigned int oldl = STR_LEN(scan);
2178 regnode * const nnext = regnext(n);
2180 DEBUG_PEEP("merg",n,depth);
2183 if (oldl + STR_LEN(n) > U8_MAX)
2185 NEXT_OFF(scan) += NEXT_OFF(n);
2186 STR_LEN(scan) += STR_LEN(n);
2187 next = n + NODE_SZ_STR(n);
2188 /* Now we can overwrite *n : */
2189 Move(STRING(n), STRING(scan) + oldl, STR_LEN(n), char);
2197 #ifdef EXPERIMENTAL_INPLACESCAN
2198 if (flags && !NEXT_OFF(n)) {
2199 DEBUG_PEEP("atch", val, depth);
2200 if (reg_off_by_arg[OP(n)]) {
2201 ARG_SET(n, val - n);
2204 NEXT_OFF(n) = val - n;
2211 if (UTF && ( OP(scan) == EXACTF ) && ( STR_LEN(scan) >= 6 ) ) {
2213 Two problematic code points in Unicode casefolding of EXACT nodes:
2215 U+0390 - GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
2216 U+03B0 - GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
2222 U+03B9 U+0308 U+0301 0xCE 0xB9 0xCC 0x88 0xCC 0x81
2223 U+03C5 U+0308 U+0301 0xCF 0x85 0xCC 0x88 0xCC 0x81
2225 This means that in case-insensitive matching (or "loose matching",
2226 as Unicode calls it), an EXACTF of length six (the UTF-8 encoded byte
2227 length of the above casefolded versions) can match a target string
2228 of length two (the byte length of UTF-8 encoded U+0390 or U+03B0).
2229 This would rather mess up the minimum length computation.
2231 What we'll do is to look for the tail four bytes, and then peek
2232 at the preceding two bytes to see whether we need to decrease
2233 the minimum length by four (six minus two).
2235 Thanks to the design of UTF-8, there cannot be false matches:
2236 A sequence of valid UTF-8 bytes cannot be a subsequence of
2237 another valid sequence of UTF-8 bytes.
2240 char * const s0 = STRING(scan), *s, *t;
2241 char * const s1 = s0 + STR_LEN(scan) - 1;
2242 char * const s2 = s1 - 4;
2243 #ifdef EBCDIC /* RD tunifold greek 0390 and 03B0 */
2244 const char t0[] = "\xaf\x49\xaf\x42";
2246 const char t0[] = "\xcc\x88\xcc\x81";
2248 const char * const t1 = t0 + 3;
2251 s < s2 && (t = ninstr(s, s1, t0, t1));
2254 if (((U8)t[-1] == 0x68 && (U8)t[-2] == 0xB4) ||
2255 ((U8)t[-1] == 0x46 && (U8)t[-2] == 0xB5))
2257 if (((U8)t[-1] == 0xB9 && (U8)t[-2] == 0xCE) ||
2258 ((U8)t[-1] == 0x85 && (U8)t[-2] == 0xCF))
2266 n = scan + NODE_SZ_STR(scan);
2268 if (PL_regkind[OP(n)] != NOTHING || OP(n) == NOTHING) {
2275 DEBUG_OPTIMISE_r(if (merged){DEBUG_PEEP("finl",scan,depth)});
2279 /* REx optimizer. Converts nodes into quickier variants "in place".
2280 Finds fixed substrings. */
2282 /* Stops at toplevel WHILEM as well as at "last". At end *scanp is set
2283 to the position after last scanned or to NULL. */
2285 #define INIT_AND_WITHP \
2286 assert(!and_withp); \
2287 Newx(and_withp,1,struct regnode_charclass_class); \
2288 SAVEFREEPV(and_withp)
2291 S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
2292 I32 *minlenp, I32 *deltap,
2297 struct regnode_charclass_class *and_withp,
2298 U32 flags, U32 depth)
2299 /* scanp: Start here (read-write). */
2300 /* deltap: Write maxlen-minlen here. */
2301 /* last: Stop before this one. */
2302 /* data: string data about the pattern */
2303 /* stopparen: treat close N as END */
2304 /* recursed: which subroutines have we recursed into */
2305 /* and_withp: Valid if flags & SCF_DO_STCLASS_OR */
2308 I32 min = 0, pars = 0, code;
2309 regnode *scan = *scanp, *next;
2311 int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
2312 int is_inf_internal = 0; /* The studied chunk is infinite */
2313 I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
2314 scan_data_t data_fake;
2315 SV *re_trie_maxbuff = NULL;
2316 regnode *first_non_open = scan;
2317 I32 stopmin = I32_MAX;
2318 GET_RE_DEBUG_FLAGS_DECL;
2320 StructCopy(&zero_scan_data, &data_fake, scan_data_t);
2324 while (first_non_open && OP(first_non_open) == OPEN)
2325 first_non_open=regnext(first_non_open);
2329 while (scan && OP(scan) != END && scan < last) {
2330 /* Peephole optimizer: */
2331 DEBUG_STUDYDATA(data,depth);
2332 DEBUG_PEEP("Peep",scan,depth);
2333 JOIN_EXACT(scan,&min,0);
2335 /* Follow the next-chain of the current node and optimize
2336 away all the NOTHINGs from it. */
2337 if (OP(scan) != CURLYX) {
2338 const int max = (reg_off_by_arg[OP(scan)]
2340 /* I32 may be smaller than U16 on CRAYs! */
2341 : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
2342 int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
2346 /* Skip NOTHING and LONGJMP. */
2347 while ((n = regnext(n))
2348 && ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
2349 || ((OP(n) == LONGJMP) && (noff = ARG(n))))
2350 && off + noff < max)
2352 if (reg_off_by_arg[OP(scan)])
2355 NEXT_OFF(scan) = off;
2360 /* The principal pseudo-switch. Cannot be a switch, since we
2361 look into several different things. */
2362 if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
2363 || OP(scan) == IFTHEN || OP(scan) == SUSPEND) {
2364 next = regnext(scan);
2366 /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
2368 if (OP(next) == code || code == IFTHEN || code == SUSPEND) {
2369 /* NOTE - There is similar code to this block below for handling
2370 TRIE nodes on a re-study. If you change stuff here check there
2372 I32 max1 = 0, min1 = I32_MAX, num = 0;
2373 struct regnode_charclass_class accum;
2374 regnode * const startbranch=scan;
2376 if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
2377 scan_commit(pRExC_state, data, minlenp); /* Cannot merge strings after this. */
2378 if (flags & SCF_DO_STCLASS)
2379 cl_init_zero(pRExC_state, &accum);
2381 while (OP(scan) == code) {
2382 I32 deltanext, minnext, f = 0, fake;
2383 struct regnode_charclass_class this_class;
2386 data_fake.flags = 0;
2388 data_fake.whilem_c = data->whilem_c;
2389 data_fake.last_closep = data->last_closep;
2392 data_fake.last_closep = &fake;
2393 next = regnext(scan);
2394 scan = NEXTOPER(scan);
2396 scan = NEXTOPER(scan);
2397 if (flags & SCF_DO_STCLASS) {
2398 cl_init(pRExC_state, &this_class);
2399 data_fake.start_class = &this_class;
2400 f = SCF_DO_STCLASS_AND;
2402 if (flags & SCF_WHILEM_VISITED_POS)
2403 f |= SCF_WHILEM_VISITED_POS;
2405 /* we suppose the run is continuous, last=next...*/
2406 minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
2408 stopparen, recursed, NULL, f,depth+1);
2411 if (max1 < minnext + deltanext)
2412 max1 = minnext + deltanext;
2413 if (deltanext == I32_MAX)
2414 is_inf = is_inf_internal = 1;
2416 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
2418 if (data_fake.flags & SCF_SEEN_ACCEPT) {
2419 if ( stopmin > minnext)
2420 stopmin = min + min1;
2421 flags &= ~SCF_DO_SUBSTR;
2423 data->flags |= SCF_SEEN_ACCEPT;
2426 if (data_fake.flags & SF_HAS_EVAL)
2427 data->flags |= SF_HAS_EVAL;
2428 data->whilem_c = data_fake.whilem_c;
2430 if (flags & SCF_DO_STCLASS)
2431 cl_or(pRExC_state, &accum, &this_class);
2432 if (code == SUSPEND)
2435 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
2437 if (flags & SCF_DO_SUBSTR) {
2438 data->pos_min += min1;
2439 data->pos_delta += max1 - min1;
2440 if (max1 != min1 || is_inf)
2441 data->longest = &(data->longest_float);
2444 delta += max1 - min1;
2445 if (flags & SCF_DO_STCLASS_OR) {
2446 cl_or(pRExC_state, data->start_class, &accum);
2448 cl_and(data->start_class, and_withp);
2449 flags &= ~SCF_DO_STCLASS;
2452 else if (flags & SCF_DO_STCLASS_AND) {
2454 cl_and(data->start_class, &accum);
2455 flags &= ~SCF_DO_STCLASS;
2458 /* Switch to OR mode: cache the old value of
2459 * data->start_class */
2461 StructCopy(data->start_class, and_withp,
2462 struct regnode_charclass_class);
2463 flags &= ~SCF_DO_STCLASS_AND;
2464 StructCopy(&accum, data->start_class,
2465 struct regnode_charclass_class);
2466 flags |= SCF_DO_STCLASS_OR;
2467 data->start_class->flags |= ANYOF_EOS;
2471 if (PERL_ENABLE_TRIE_OPTIMISATION && OP( startbranch ) == BRANCH ) {
2474 Assuming this was/is a branch we are dealing with: 'scan' now
2475 points at the item that follows the branch sequence, whatever
2476 it is. We now start at the beginning of the sequence and look
2483 which would be constructed from a pattern like /A|LIST|OF|WORDS/
2485 If we can find such a subseqence we need to turn the first
2486 element into a trie and then add the subsequent branch exact
2487 strings to the trie.
2491 1. patterns where the whole set of branch can be converted.
2493 2. patterns where only a subset can be converted.
2495 In case 1 we can replace the whole set with a single regop
2496 for the trie. In case 2 we need to keep the start and end
2499 'BRANCH EXACT; BRANCH EXACT; BRANCH X'
2500 becomes BRANCH TRIE; BRANCH X;
2502 There is an additional case, that being where there is a
2503 common prefix, which gets split out into an EXACT like node
2504 preceding the TRIE node.
2506 If x(1..n)==tail then we can do a simple trie, if not we make
2507 a "jump" trie, such that when we match the appropriate word
2508 we "jump" to the appopriate tail node. Essentailly we turn
2509 a nested if into a case structure of sorts.
2514 if (!re_trie_maxbuff) {
2515 re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
2516 if (!SvIOK(re_trie_maxbuff))
2517 sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
2519 if ( SvIV(re_trie_maxbuff)>=0 ) {
2521 regnode *first = (regnode *)NULL;
2522 regnode *last = (regnode *)NULL;
2523 regnode *tail = scan;
2528 SV * const mysv = sv_newmortal(); /* for dumping */
2530 /* var tail is used because there may be a TAIL
2531 regop in the way. Ie, the exacts will point to the
2532 thing following the TAIL, but the last branch will
2533 point at the TAIL. So we advance tail. If we
2534 have nested (?:) we may have to move through several
2538 while ( OP( tail ) == TAIL ) {
2539 /* this is the TAIL generated by (?:) */
2540 tail = regnext( tail );
2545 regprop(RExC_rx, mysv, tail );
2546 PerlIO_printf( Perl_debug_log, "%*s%s%s\n",
2547 (int)depth * 2 + 2, "",
2548 "Looking for TRIE'able sequences. Tail node is: ",
2549 SvPV_nolen_const( mysv )
2555 step through the branches, cur represents each
2556 branch, noper is the first thing to be matched
2557 as part of that branch and noper_next is the
2558 regnext() of that node. if noper is an EXACT
2559 and noper_next is the same as scan (our current
2560 position in the regex) then the EXACT branch is
2561 a possible optimization target. Once we have
2562 two or more consequetive such branches we can
2563 create a trie of the EXACT's contents and stich
2564 it in place. If the sequence represents all of
2565 the branches we eliminate the whole thing and
2566 replace it with a single TRIE. If it is a
2567 subsequence then we need to stitch it in. This
2568 means the first branch has to remain, and needs
2569 to be repointed at the item on the branch chain
2570 following the last branch optimized. This could
2571 be either a BRANCH, in which case the
2572 subsequence is internal, or it could be the
2573 item following the branch sequence in which
2574 case the subsequence is at the end.
2578 /* dont use tail as the end marker for this traverse */
2579 for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) {
2580 regnode * const noper = NEXTOPER( cur );
2581 #if defined(DEBUGGING) || defined(NOJUMPTRIE)
2582 regnode * const noper_next = regnext( noper );
2586 regprop(RExC_rx, mysv, cur);
2587 PerlIO_printf( Perl_debug_log, "%*s- %s (%d)",
2588 (int)depth * 2 + 2,"", SvPV_nolen_const( mysv ), REG_NODE_NUM(cur) );
2590 regprop(RExC_rx, mysv, noper);
2591 PerlIO_printf( Perl_debug_log, " -> %s",
2592 SvPV_nolen_const(mysv));
2595 regprop(RExC_rx, mysv, noper_next );
2596 PerlIO_printf( Perl_debug_log,"\t=> %s\t",
2597 SvPV_nolen_const(mysv));
2599 PerlIO_printf( Perl_debug_log, "(First==%d,Last==%d,Cur==%d)\n",
2600 REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur) );
2602 if ( (((first && optype!=NOTHING) ? OP( noper ) == optype
2603 : PL_regkind[ OP( noper ) ] == EXACT )
2604 || OP(noper) == NOTHING )
2606 && noper_next == tail
2611 if ( !first || optype == NOTHING ) {
2612 if (!first) first = cur;
2613 optype = OP( noper );
2619 make_trie( pRExC_state,
2620 startbranch, first, cur, tail, count,
2623 if ( PL_regkind[ OP( noper ) ] == EXACT
2625 && noper_next == tail
2630 optype = OP( noper );
2640 regprop(RExC_rx, mysv, cur);
2641 PerlIO_printf( Perl_debug_log,
2642 "%*s- %s (%d) <SCAN FINISHED>\n", (int)depth * 2 + 2,
2643 "", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
2647 made= make_trie( pRExC_state, startbranch, first, scan, tail, count, optype, depth+1 );
2648 #ifdef TRIE_STUDY_OPT
2649 if ( ((made == MADE_EXACT_TRIE &&
2650 startbranch == first)
2651 || ( first_non_open == first )) &&
2653 flags |= SCF_TRIE_RESTUDY;
2661 else if ( code == BRANCHJ ) { /* single branch is optimized. */
2662 scan = NEXTOPER(NEXTOPER(scan));
2663 } else /* single branch is optimized. */
2664 scan = NEXTOPER(scan);
2667 else if (OP(scan) == EXACT) {
2668 I32 l = STR_LEN(scan);
2671 const U8 * const s = (U8*)STRING(scan);
2672 l = utf8_length(s, s + l);
2673 uc = utf8_to_uvchr(s, NULL);
2675 uc = *((U8*)STRING(scan));
2678 if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
2679 /* The code below prefers earlier match for fixed
2680 offset, later match for variable offset. */
2681 if (data->last_end == -1) { /* Update the start info. */
2682 data->last_start_min = data->pos_min;
2683 data->last_start_max = is_inf
2684 ? I32_MAX : data->pos_min + data->pos_delta;
2686 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
2688 SvUTF8_on(data->last_found);
2690 SV * const sv = data->last_found;
2691 MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
2692 mg_find(sv, PERL_MAGIC_utf8) : NULL;
2693 if (mg && mg->mg_len >= 0)
2694 mg->mg_len += utf8_length((U8*)STRING(scan),
2695 (U8*)STRING(scan)+STR_LEN(scan));
2697 data->last_end = data->pos_min + l;
2698 data->pos_min += l; /* As in the first entry. */
2699 data->flags &= ~SF_BEFORE_EOL;
2701 if (flags & SCF_DO_STCLASS_AND) {
2702 /* Check whether it is compatible with what we know already! */
2706 (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
2707 && !ANYOF_BITMAP_TEST(data->start_class, uc)
2708 && (!(data->start_class->flags & ANYOF_FOLD)
2709 || !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
2712 ANYOF_CLASS_ZERO(data->start_class);
2713 ANYOF_BITMAP_ZERO(data->start_class);
2715 ANYOF_BITMAP_SET(data->start_class, uc);
2716 data->start_class->flags &= ~ANYOF_EOS;
2718 data->start_class->flags &= ~ANYOF_UNICODE_ALL;
2720 else if (flags & SCF_DO_STCLASS_OR) {
2721 /* false positive possible if the class is case-folded */
2723 ANYOF_BITMAP_SET(data->start_class, uc);
2725 data->start_class->flags |= ANYOF_UNICODE_ALL;
2726 data->start_class->flags &= ~ANYOF_EOS;
2727 cl_and(data->start_class, and_withp);
2729 flags &= ~SCF_DO_STCLASS;
2731 else if (PL_regkind[OP(scan)] == EXACT) { /* But OP != EXACT! */
2732 I32 l = STR_LEN(scan);
2733 UV uc = *((U8*)STRING(scan));
2735 /* Search for fixed substrings supports EXACT only. */
2736 if (flags & SCF_DO_SUBSTR) {
2738 scan_commit(pRExC_state, data, minlenp);
2741 const U8 * const s = (U8 *)STRING(scan);
2742 l = utf8_length(s, s + l);
2743 uc = utf8_to_uvchr(s, NULL);
2746 if (flags & SCF_DO_SUBSTR)
2748 if (flags & SCF_DO_STCLASS_AND) {
2749 /* Check whether it is compatible with what we know already! */
2753 (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
2754 && !ANYOF_BITMAP_TEST(data->start_class, uc)
2755 && !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
2757 ANYOF_CLASS_ZERO(data->start_class);
2758 ANYOF_BITMAP_ZERO(data->start_class);
2760 ANYOF_BITMAP_SET(data->start_class, uc);
2761 data->start_class->flags &= ~ANYOF_EOS;
2762 data->start_class->flags |= ANYOF_FOLD;
2763 if (OP(scan) == EXACTFL)
2764 data->start_class->flags |= ANYOF_LOCALE;
2767 else if (flags & SCF_DO_STCLASS_OR) {
2768 if (data->start_class->flags & ANYOF_FOLD) {
2769 /* false positive possible if the class is case-folded.
2770 Assume that the locale settings are the same... */
2772 ANYOF_BITMAP_SET(data->start_class, uc);
2773 data->start_class->flags &= ~ANYOF_EOS;
2775 cl_and(data->start_class, and_withp);
2777 flags &= ~SCF_DO_STCLASS;
2779 else if (strchr((const char*)PL_varies,OP(scan))) {
2780 I32 mincount, maxcount, minnext, deltanext, fl = 0;
2781 I32 f = flags, pos_before = 0;
2782 regnode * const oscan = scan;
2783 struct regnode_charclass_class this_class;
2784 struct regnode_charclass_class *oclass = NULL;
2785 I32 next_is_eval = 0;
2787 switch (PL_regkind[OP(scan)]) {
2788 case WHILEM: /* End of (?:...)* . */
2789 scan = NEXTOPER(scan);
2792 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
2793 next = NEXTOPER(scan);
2794 if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
2796 maxcount = REG_INFTY;
2797 next = regnext(scan);
2798 scan = NEXTOPER(scan);
2802 if (flags & SCF_DO_SUBSTR)
2807 if (flags & SCF_DO_STCLASS) {
2809 maxcount = REG_INFTY;
2810 next = regnext(scan);
2811 scan = NEXTOPER(scan);
2814 is_inf = is_inf_internal = 1;
2815 scan = regnext(scan);
2816 if (flags & SCF_DO_SUBSTR) {
2817 scan_commit(pRExC_state, data, minlenp); /* Cannot extend fixed substrings */
2818 data->longest = &(data->longest_float);
2820 goto optimize_curly_tail;
2822 if (stopparen>0 && (OP(scan)==CURLYN || OP(scan)==CURLYM)
2823 && (scan->flags == stopparen))
2828 mincount = ARG1(scan);
2829 maxcount = ARG2(scan);
2831 next = regnext(scan);
2832 if (OP(scan) == CURLYX) {
2833 I32 lp = (data ? *(data->last_closep) : 0);
2834 scan->flags = ((lp <= (I32)U8_MAX) ? (U8)lp : U8_MAX);
2836 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
2837 next_is_eval = (OP(scan) == EVAL);
2839 if (flags & SCF_DO_SUBSTR) {
2840 if (mincount == 0) scan_commit(pRExC_state,data,minlenp); /* Cannot extend fixed substrings */
2841 pos_before = data->pos_min;
2845 data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
2847 data->flags |= SF_IS_INF;
2849 if (flags & SCF_DO_STCLASS) {
2850 cl_init(pRExC_state, &this_class);
2851 oclass = data->start_class;
2852 data->start_class = &this_class;
2853 f |= SCF_DO_STCLASS_AND;
2854 f &= ~SCF_DO_STCLASS_OR;
2856 /* These are the cases when once a subexpression
2857 fails at a particular position, it cannot succeed
2858 even after backtracking at the enclosing scope.
2860 XXXX what if minimal match and we are at the
2861 initial run of {n,m}? */
2862 if ((mincount != maxcount - 1) && (maxcount != REG_INFTY))
2863 f &= ~SCF_WHILEM_VISITED_POS;
2865 /* This will finish on WHILEM, setting scan, or on NULL: */
2866 minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
2867 last, data, stopparen, recursed, NULL,
2869 ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
2871 if (flags & SCF_DO_STCLASS)
2872 data->start_class = oclass;
2873 if (mincount == 0 || minnext == 0) {
2874 if (flags & SCF_DO_STCLASS_OR) {
2875 cl_or(pRExC_state, data->start_class, &this_class);
2877 else if (flags & SCF_DO_STCLASS_AND) {
2878 /* Switch to OR mode: cache the old value of
2879 * data->start_class */
2881 StructCopy(data->start_class, and_withp,
2882 struct regnode_charclass_class);
2883 flags &= ~SCF_DO_STCLASS_AND;
2884 StructCopy(&this_class, data->start_class,
2885 struct regnode_charclass_class);
2886 flags |= SCF_DO_STCLASS_OR;
2887 data->start_class->flags |= ANYOF_EOS;
2889 } else { /* Non-zero len */
2890 if (flags & SCF_DO_STCLASS_OR) {
2891 cl_or(pRExC_state, data->start_class, &this_class);
2892 cl_and(data->start_class, and_withp);
2894 else if (flags & SCF_DO_STCLASS_AND)
2895 cl_and(data->start_class, &this_class);
2896 flags &= ~SCF_DO_STCLASS;
2898 if (!scan) /* It was not CURLYX, but CURLY. */
2900 if ( /* ? quantifier ok, except for (?{ ... }) */
2901 (next_is_eval || !(mincount == 0 && maxcount == 1))
2902 && (minnext == 0) && (deltanext == 0)
2903 && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
2904 && maxcount <= REG_INFTY/3 /* Complement check for big count */
2905 && ckWARN(WARN_REGEXP))
2908 "Quantifier unexpected on zero-length expression");
2911 min += minnext * mincount;
2912 is_inf_internal |= ((maxcount == REG_INFTY
2913 && (minnext + deltanext) > 0)
2914 || deltanext == I32_MAX);
2915 is_inf |= is_inf_internal;
2916 delta += (minnext + deltanext) * maxcount - minnext * mincount;
2918 /* Try powerful optimization CURLYX => CURLYN. */
2919 if ( OP(oscan) == CURLYX && data
2920 && data->flags & SF_IN_PAR
2921 && !(data->flags & SF_HAS_EVAL)
2922 && !deltanext && minnext == 1 ) {
2923 /* Try to optimize to CURLYN. */
2924 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
2925 regnode * const nxt1 = nxt;
2932 if (!strchr((const char*)PL_simple,OP(nxt))
2933 && !(PL_regkind[OP(nxt)] == EXACT
2934 && STR_LEN(nxt) == 1))
2940 if (OP(nxt) != CLOSE)
2942 if (RExC_open_parens) {
2943 RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
2944 RExC_close_parens[ARG(nxt1)-1]=nxt+2; /*close->while*/
2946 /* Now we know that nxt2 is the only contents: */
2947 oscan->flags = (U8)ARG(nxt);
2949 OP(nxt1) = NOTHING; /* was OPEN. */
2952 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
2953 NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
2954 NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */
2955 OP(nxt) = OPTIMIZED; /* was CLOSE. */
2956 OP(nxt + 1) = OPTIMIZED; /* was count. */
2957 NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
2962 /* Try optimization CURLYX => CURLYM. */
2963 if ( OP(oscan) == CURLYX && data
2964 && !(data->flags & SF_HAS_PAR)
2965 && !(data->flags & SF_HAS_EVAL)
2966 && !deltanext /* atom is fixed width */
2967 && minnext != 0 /* CURLYM can't handle zero width */
2969 /* XXXX How to optimize if data == 0? */
2970 /* Optimize to a simpler form. */
2971 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
2975 while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
2976 && (OP(nxt2) != WHILEM))
2978 OP(nxt2) = SUCCEED; /* Whas WHILEM */
2979 /* Need to optimize away parenths. */
2980 if (data->flags & SF_IN_PAR) {
2981 /* Set the parenth number. */
2982 regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
2984 if (OP(nxt) != CLOSE)
2985 FAIL("Panic opt close");
2986 oscan->flags = (U8)ARG(nxt);
2987 if (RExC_open_parens) {
2988 RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
2989 RExC_close_parens[ARG(nxt1)-1]=nxt2+1; /*close->NOTHING*/
2991 OP(nxt1) = OPTIMIZED; /* was OPEN. */
2992 OP(nxt) = OPTIMIZED; /* was CLOSE. */
2995 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
2996 OP(nxt + 1) = OPTIMIZED; /* was count. */
2997 NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
2998 NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
3001 while ( nxt1 && (OP(nxt1) != WHILEM)) {
3002 regnode *nnxt = regnext(nxt1);
3005 if (reg_off_by_arg[OP(nxt1)])
3006 ARG_SET(nxt1, nxt2 - nxt1);
3007 else if (nxt2 - nxt1 < U16_MAX)
3008 NEXT_OFF(nxt1) = nxt2 - nxt1;
3010 OP(nxt) = NOTHING; /* Cannot beautify */
3015 /* Optimize again: */
3016 study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt,
3017 NULL, stopparen, recursed, NULL, 0,depth+1);
3022 else if ((OP(oscan) == CURLYX)
3023 && (flags & SCF_WHILEM_VISITED_POS)
3024 /* See the comment on a similar expression above.
3025 However, this time it not a subexpression
3026 we care about, but the expression itself. */
3027 && (maxcount == REG_INFTY)
3028 && data && ++data->whilem_c < 16) {
3029 /* This stays as CURLYX, we can put the count/of pair. */
3030 /* Find WHILEM (as in regexec.c) */
3031 regnode *nxt = oscan + NEXT_OFF(oscan);
3033 if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
3035 PREVOPER(nxt)->flags = (U8)(data->whilem_c
3036 | (RExC_whilem_seen << 4)); /* On WHILEM */
3038 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
3040 if (flags & SCF_DO_SUBSTR) {
3041 SV *last_str = NULL;
3042 int counted = mincount != 0;
3044 if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
3045 #if defined(SPARC64_GCC_WORKAROUND)
3048 const char *s = NULL;
3051 if (pos_before >= data->last_start_min)
3054 b = data->last_start_min;
3057 s = SvPV_const(data->last_found, l);
3058 old = b - data->last_start_min;
3061 I32 b = pos_before >= data->last_start_min
3062 ? pos_before : data->last_start_min;
3064 const char * const s = SvPV_const(data->last_found, l);
3065 I32 old = b - data->last_start_min;
3069 old = utf8_hop((U8*)s, old) - (U8*)s;
3072 /* Get the added string: */
3073 last_str = newSVpvn(s + old, l);
3075 SvUTF8_on(last_str);
3076 if (deltanext == 0 && pos_before == b) {
3077 /* What was added is a constant string */
3079 SvGROW(last_str, (mincount * l) + 1);
3080 repeatcpy(SvPVX(last_str) + l,
3081 SvPVX_const(last_str), l, mincount - 1);
3082 SvCUR_set(last_str, SvCUR(last_str) * mincount);
3083 /* Add additional parts. */
3084 SvCUR_set(data->last_found,
3085 SvCUR(data->last_found) - l);
3086 sv_catsv(data->last_found, last_str);
3088 SV * sv = data->last_found;
3090 SvUTF8(sv) && SvMAGICAL(sv) ?
3091 mg_find(sv, PERL_MAGIC_utf8) : NULL;
3092 if (mg && mg->mg_len >= 0)
3093 mg->mg_len += CHR_SVLEN(last_str);
3095 data->last_end += l * (mincount - 1);
3098 /* start offset must point into the last copy */
3099 data->last_start_min += minnext * (mincount - 1);
3100 data->last_start_max += is_inf ? I32_MAX
3101 : (maxcount - 1) * (minnext + data->pos_delta);
3104 /* It is counted once already... */
3105 data->pos_min += minnext * (mincount - counted);
3106 data->pos_delta += - counted * deltanext +
3107 (minnext + deltanext) * maxcount - minnext * mincount;
3108 if (mincount != maxcount) {
3109 /* Cannot extend fixed substrings found inside
3111 scan_commit(pRExC_state,data,minlenp);
3112 if (mincount && last_str) {
3113 SV * const sv = data->last_found;
3114 MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
3115 mg_find(sv, PERL_MAGIC_utf8) : NULL;
3119 sv_setsv(sv, last_str);
3120 data->last_end = data->pos_min;
3121 data->last_start_min =
3122 data->pos_min - CHR_SVLEN(last_str);
3123 data->last_start_max = is_inf
3125 : data->pos_min + data->pos_delta
3126 - CHR_SVLEN(last_str);
3128 data->longest = &(data->longest_float);
3130 SvREFCNT_dec(last_str);
3132 if (data && (fl & SF_HAS_EVAL))
3133 data->flags |= SF_HAS_EVAL;
3134 optimize_curly_tail:
3135 if (OP(oscan) != CURLYX) {
3136 while (PL_regkind[OP(next = regnext(oscan))] == NOTHING
3138 NEXT_OFF(oscan) += NEXT_OFF(next);
3141 default: /* REF and CLUMP only? */
3142 if (flags & SCF_DO_SUBSTR) {
3143 scan_commit(pRExC_state,data,minlenp); /* Cannot expect anything... */
3144 data->longest = &(data->longest_float);
3146 is_inf = is_inf_internal = 1;
3147 if (flags & SCF_DO_STCLASS_OR)
3148 cl_anything(pRExC_state, data->start_class);
3149 flags &= ~SCF_DO_STCLASS;
3153 else if (strchr((const char*)PL_simple,OP(scan))) {
3156 if (flags & SCF_DO_SUBSTR) {
3157 scan_commit(pRExC_state,data,minlenp);
3161 if (flags & SCF_DO_STCLASS) {
3162 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
3164 /* Some of the logic below assumes that switching
3165 locale on will only add false positives. */
3166 switch (PL_regkind[OP(scan)]) {
3170 /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
3171 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3172 cl_anything(pRExC_state, data->start_class);
3175 if (OP(scan) == SANY)
3177 if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
3178 value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
3179 || (data->start_class->flags & ANYOF_CLASS));
3180 cl_anything(pRExC_state, data->start_class);
3182 if (flags & SCF_DO_STCLASS_AND || !value)
3183 ANYOF_BITMAP_CLEAR(data->start_class,'\n');
3186 if (flags & SCF_DO_STCLASS_AND)
3187 cl_and(data->start_class,
3188 (struct regnode_charclass_class*)scan);
3190 cl_or(pRExC_state, data->start_class,
3191 (struct regnode_charclass_class*)scan);
3194 if (flags & SCF_DO_STCLASS_AND) {
3195 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3196 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
3197 for (value = 0; value < 256; value++)
3198 if (!isALNUM(value))
3199 ANYOF_BITMAP_CLEAR(data->start_class, value);
3203 if (data->start_class->flags & ANYOF_LOCALE)
3204 ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
3206 for (value = 0; value < 256; value++)
3208 ANYOF_BITMAP_SET(data->start_class, value);
3213 if (flags & SCF_DO_STCLASS_AND) {
3214 if (data->start_class->flags & ANYOF_LOCALE)
3215 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
3218 ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
3219 data->start_class->flags |= ANYOF_LOCALE;
3223 if (flags & SCF_DO_STCLASS_AND) {
3224 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3225 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
3226 for (value = 0; value < 256; value++)
3228 ANYOF_BITMAP_CLEAR(data->start_class, value);
3232 if (data->start_class->flags & ANYOF_LOCALE)
3233 ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
3235 for (value = 0; value < 256; value++)
3236 if (!isALNUM(value))
3237 ANYOF_BITMAP_SET(data->start_class, value);
3242 if (flags & SCF_DO_STCLASS_AND) {
3243 if (data->start_class->flags & ANYOF_LOCALE)
3244 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
3247 data->start_class->flags |= ANYOF_LOCALE;
3248 ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
3252 if (flags & SCF_DO_STCLASS_AND) {
3253 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3254 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
3255 for (value = 0; value < 256; value++)
3256 if (!isSPACE(value))
3257 ANYOF_BITMAP_CLEAR(data->start_class, value);
3261 if (data->start_class->flags & ANYOF_LOCALE)
3262 ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
3264 for (value = 0; value < 256; value++)
3266 ANYOF_BITMAP_SET(data->start_class, value);
3271 if (flags & SCF_DO_STCLASS_AND) {
3272 if (data->start_class->flags & ANYOF_LOCALE)
3273 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
3276 data->start_class->flags |= ANYOF_LOCALE;
3277 ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
3281 if (flags & SCF_DO_STCLASS_AND) {
3282 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3283 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3284 for (value = 0; value < 256; value++)
3286 ANYOF_BITMAP_CLEAR(data->start_class, value);
3290 if (data->start_class->flags & ANYOF_LOCALE)
3291 ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3293 for (value = 0; value < 256; value++)
3294 if (!isSPACE(value))
3295 ANYOF_BITMAP_SET(data->start_class, value);
3300 if (flags & SCF_DO_STCLASS_AND) {
3301 if (data->start_class->flags & ANYOF_LOCALE) {
3302 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3303 for (value = 0; value < 256; value++)
3304 if (!isSPACE(value))
3305 ANYOF_BITMAP_CLEAR(data->start_class, value);
3309 data->start_class->flags |= ANYOF_LOCALE;
3310 ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3314 if (flags & SCF_DO_STCLASS_AND) {
3315 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
3316 for (value = 0; value < 256; value++)
3317 if (!isDIGIT(value))
3318 ANYOF_BITMAP_CLEAR(data->start_class, value);
3321 if (data->start_class->flags & ANYOF_LOCALE)
3322 ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
3324 for (value = 0; value < 256; value++)
3326 ANYOF_BITMAP_SET(data->start_class, value);
3331 if (flags & SCF_DO_STCLASS_AND) {
3332 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
3333 for (value = 0; value < 256; value++)
3335 ANYOF_BITMAP_CLEAR(data->start_class, value);
3338 if (data->start_class->flags & ANYOF_LOCALE)
3339 ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
3341 for (value = 0; value < 256; value++)
3342 if (!isDIGIT(value))
3343 ANYOF_BITMAP_SET(data->start_class, value);
3348 if (flags & SCF_DO_STCLASS_OR)
3349 cl_and(data->start_class, and_withp);
3350 flags &= ~SCF_DO_STCLASS;
3353 else if (PL_regkind[OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
3354 data->flags |= (OP(scan) == MEOL
3358 else if ( PL_regkind[OP(scan)] == BRANCHJ
3359 /* Lookbehind, or need to calculate parens/evals/stclass: */
3360 && (scan->flags || data || (flags & SCF_DO_STCLASS))
3361 && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
3362 if ( !PERL_ENABLE_POSITIVE_ASSERTION_STUDY
3363 || OP(scan) == UNLESSM )
3365 /* Negative Lookahead/lookbehind
3366 In this case we can't do fixed string optimisation.
3369 I32 deltanext, minnext, fake = 0;
3371 struct regnode_charclass_class intrnl;
3374 data_fake.flags = 0;
3376 data_fake.whilem_c = data->whilem_c;
3377 data_fake.last_closep = data->last_closep;
3380 data_fake.last_closep = &fake;
3381 if ( flags & SCF_DO_STCLASS && !scan->flags
3382 && OP(scan) == IFMATCH ) { /* Lookahead */
3383 cl_init(pRExC_state, &intrnl);
3384 data_fake.start_class = &intrnl;
3385 f |= SCF_DO_STCLASS_AND;
3387 if (flags & SCF_WHILEM_VISITED_POS)
3388 f |= SCF_WHILEM_VISITED_POS;
3389 next = regnext(scan);
3390 nscan = NEXTOPER(NEXTOPER(scan));
3391 minnext = study_chunk(pRExC_state, &nscan, minlenp, &deltanext,
3392 last, &data_fake, stopparen, recursed, NULL, f, depth+1);
3395 vFAIL("Variable length lookbehind not implemented");
3397 else if (minnext > (I32)U8_MAX) {
3398 vFAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
3400 scan->flags = (U8)minnext;
3403 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3405 if (data_fake.flags & SF_HAS_EVAL)
3406 data->flags |= SF_HAS_EVAL;
3407 data->whilem_c = data_fake.whilem_c;
3409 if (f & SCF_DO_STCLASS_AND) {
3410 const int was = (data->start_class->flags & ANYOF_EOS);
3412 cl_and(data->start_class, &intrnl);
3414 data->start_class->flags |= ANYOF_EOS;
3417 #if PERL_ENABLE_POSITIVE_ASSERTION_STUDY
3419 /* Positive Lookahead/lookbehind
3420 In this case we can do fixed string optimisation,
3421 but we must be careful about it. Note in the case of
3422 lookbehind the positions will be offset by the minimum
3423 length of the pattern, something we won't know about
3424 until after the recurse.
3426 I32 deltanext, fake = 0;
3428 struct regnode_charclass_class intrnl;
3430 /* We use SAVEFREEPV so that when the full compile
3431 is finished perl will clean up the allocated
3432 minlens when its all done. This was we don't
3433 have to worry about freeing them when we know
3434 they wont be used, which would be a pain.
3437 Newx( minnextp, 1, I32 );
3438 SAVEFREEPV(minnextp);
3441 StructCopy(data, &data_fake, scan_data_t);
3442 if ((flags & SCF_DO_SUBSTR) && data->last_found) {
3445 scan_commit(pRExC_state, &data_fake,minlenp);
3446 data_fake.last_found=newSVsv(data->last_found);
3450 data_fake.last_closep = &fake;
3451 data_fake.flags = 0;
3453 data_fake.flags |= SF_IS_INF;
3454 if ( flags & SCF_DO_STCLASS && !scan->flags
3455 && OP(scan) == IFMATCH ) { /* Lookahead */
3456 cl_init(pRExC_state, &intrnl);
3457 data_fake.start_class = &intrnl;
3458 f |= SCF_DO_STCLASS_AND;
3460 if (flags & SCF_WHILEM_VISITED_POS)
3461 f |= SCF_WHILEM_VISITED_POS;
3462 next = regnext(scan);
3463 nscan = NEXTOPER(NEXTOPER(scan));
3465 *minnextp = study_chunk(pRExC_state, &nscan, minnextp, &deltanext,
3466 last, &data_fake, stopparen, recursed, NULL, f,depth+1);
3469 vFAIL("Variable length lookbehind not implemented");
3471 else if (*minnextp > (I32)U8_MAX) {
3472 vFAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
3474 scan->flags = (U8)*minnextp;
3479 if (f & SCF_DO_STCLASS_AND) {
3480 const int was = (data->start_class->flags & ANYOF_EOS);
3482 cl_and(data->start_class, &intrnl);
3484 data->start_class->flags |= ANYOF_EOS;
3487 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3489 if (data_fake.flags & SF_HAS_EVAL)
3490 data->flags |= SF_HAS_EVAL;
3491 data->whilem_c = data_fake.whilem_c;
3492 if ((flags & SCF_DO_SUBSTR) && data_fake.last_found) {
3493 if (RExC_rx->minlen<*minnextp)
3494 RExC_rx->minlen=*minnextp;
3495 scan_commit(pRExC_state, &data_fake, minnextp);
3496 SvREFCNT_dec(data_fake.last_found);
3498 if ( data_fake.minlen_fixed != minlenp )
3500 data->offset_fixed= data_fake.offset_fixed;
3501 data->minlen_fixed= data_fake.minlen_fixed;
3502 data->lookbehind_fixed+= scan->flags;
3504 if ( data_fake.minlen_float != minlenp )
3506 data->minlen_float= data_fake.minlen_float;
3507 data->offset_float_min=data_fake.offset_float_min;
3508 data->offset_float_max=data_fake.offset_float_max;
3509 data->lookbehind_float+= scan->flags;
3518 else if (OP(scan) == OPEN) {
3519 if (stopparen != (I32)ARG(scan))
3522 else if (OP(scan) == CLOSE) {
3523 if (stopparen == (I32)ARG(scan)) {
3526 if ((I32)ARG(scan) == is_par) {
3527 next = regnext(scan);
3529 if ( next && (OP(next) != WHILEM) && next < last)
3530 is_par = 0; /* Disable optimization */
3533 *(data->last_closep) = ARG(scan);
3535 else if (OP(scan) == GOSUB || OP(scan) == GOSTART) {
3536 /* set the pointer */
3540 if (OP(scan) == GOSUB) {
3542 RExC_recurse[ARG2L(scan)] = scan;
3543 start = RExC_open_parens[paren-1];
3544 end = RExC_close_parens[paren-1];
3547 start = RExC_rx->program + 1;
3553 Newxz(recursed, (((RExC_npar)>>3) +1), U8);
3554 SAVEFREEPV(recursed);
3556 if (!PAREN_TEST(recursed,paren+1)) {
3558 PAREN_SET(recursed,paren+1);
3560 DEBUG_PEEP("goto",start,depth);
3573 if (deltanext == I32_MAX) {
3574 is_inf = is_inf_internal = 1;
3577 DEBUG_PEEP("rtrn",end,depth);
3578 PAREN_UNSET(recursed,paren+1);
3580 if (flags & SCF_DO_SUBSTR) {
3581 scan_commit(pRExC_state,data,minlenp);
3582 data->longest = &(data->longest_float);
3584 is_inf = is_inf_internal = 1;
3585 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3586 cl_anything(pRExC_state, data->start_class);
3587 flags &= ~SCF_DO_STCLASS;
3590 else if (OP(scan) == EVAL) {
3592 data->flags |= SF_HAS_EVAL;
3594 else if ( PL_regkind[OP(scan)] == ENDLIKE ) {
3595 if (flags & SCF_DO_SUBSTR) {
3596 scan_commit(pRExC_state,data,minlenp);
3597 flags &= ~SCF_DO_SUBSTR;
3599 if (data && OP(scan)==ACCEPT) {
3600 data->flags |= SCF_SEEN_ACCEPT;
3605 else if (OP(scan) == LOGICAL && scan->flags == 2) /* Embedded follows */
3607 if (flags & SCF_DO_SUBSTR) {
3608 scan_commit(pRExC_state,data,minlenp);
3609 data->longest = &(data->longest_float);
3611 is_inf = is_inf_internal = 1;
3612 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3613 cl_anything(pRExC_state, data->start_class);
3614 flags &= ~SCF_DO_STCLASS;
3616 #ifdef TRIE_STUDY_OPT
3617 #ifdef FULL_TRIE_STUDY
3618 else if (PL_regkind[OP(scan)] == TRIE) {
3619 /* NOTE - There is similar code to this block above for handling
3620 BRANCH nodes on the initial study. If you change stuff here
3622 regnode *trie_node= scan;
3623 regnode *tail= regnext(scan);
3624 reg_trie_data *trie = (reg_trie_data*)RExC_rx->data->data[ ARG(scan) ];
3625 I32 max1 = 0, min1 = I32_MAX;
3626 struct regnode_charclass_class accum;
3628 if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
3629 scan_commit(pRExC_state, data,minlenp); /* Cannot merge strings after this. */
3630 if (flags & SCF_DO_STCLASS)
3631 cl_init_zero(pRExC_state, &accum);
3637 const regnode *nextbranch= NULL;
3640 for ( word=1 ; word <= trie->wordcount ; word++)
3642 I32 deltanext=0, minnext=0, f = 0, fake;
3643 struct regnode_charclass_class this_class;
3645 data_fake.flags = 0;
3647 data_fake.whilem_c = data->whilem_c;
3648 data_fake.last_closep = data->last_closep;
3651 data_fake.last_closep = &fake;
3653 if (flags & SCF_DO_STCLASS) {
3654 cl_init(pRExC_state, &this_class);
3655 data_fake.start_class = &this_class;
3656 f = SCF_DO_STCLASS_AND;
3658 if (flags & SCF_WHILEM_VISITED_POS)
3659 f |= SCF_WHILEM_VISITED_POS;
3661 if (trie->jump[word]) {
3663 nextbranch = trie_node + trie->jump[0];
3664 scan= trie_node + trie->jump[word];
3665 /* We go from the jump point to the branch that follows
3666 it. Note this means we need the vestigal unused branches
3667 even though they arent otherwise used.
3669 minnext = study_chunk(pRExC_state, &scan, minlenp,
3670 &deltanext, (regnode *)nextbranch, &data_fake,
3671 stopparen, recursed, NULL, f,depth+1);
3673 if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH)
3674 nextbranch= regnext((regnode*)nextbranch);
3676 if (min1 > (I32)(minnext + trie->minlen))
3677 min1 = minnext + trie->minlen;
3678 if (max1 < (I32)(minnext + deltanext + trie->maxlen))
3679 max1 = minnext + deltanext + trie->maxlen;
3680 if (deltanext == I32_MAX)
3681 is_inf = is_inf_internal = 1;
3683 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3685 if (data_fake.flags & SCF_SEEN_ACCEPT) {
3686 if ( stopmin > min + min1)
3687 stopmin = min + min1;
3688 flags &= ~SCF_DO_SUBSTR;
3690 data->flags |= SCF_SEEN_ACCEPT;
3693 if (data_fake.flags & SF_HAS_EVAL)
3694 data->flags |= SF_HAS_EVAL;
3695 data->whilem_c = data_fake.whilem_c;
3697 if (flags & SCF_DO_STCLASS)
3698 cl_or(pRExC_state, &accum, &this_class);
3701 if (flags & SCF_DO_SUBSTR) {
3702 data->pos_min += min1;
3703 data->pos_delta += max1 - min1;
3704 if (max1 != min1 || is_inf)
3705 data->longest = &(data->longest_float);
3708 delta += max1 - min1;
3709 if (flags & SCF_DO_STCLASS_OR) {
3710 cl_or(pRExC_state, data->start_class, &accum);
3712 cl_and(data->start_class, and_withp);
3713 flags &= ~SCF_DO_STCLASS;
3716 else if (flags & SCF_DO_STCLASS_AND) {
3718 cl_and(data->start_class, &accum);
3719 flags &= ~SCF_DO_STCLASS;
3722 /* Switch to OR mode: cache the old value of
3723 * data->start_class */
3725 StructCopy(data->start_class, and_withp,
3726 struct regnode_charclass_class);
3727 flags &= ~SCF_DO_STCLASS_AND;
3728 StructCopy(&accum, data->start_class,
3729 struct regnode_charclass_class);
3730 flags |= SCF_DO_STCLASS_OR;
3731 data->start_class->flags |= ANYOF_EOS;
3738 else if (PL_regkind[OP(scan)] == TRIE) {
3739 reg_trie_data *trie = (reg_trie_data*)RExC_rx->data->data[ ARG(scan) ];
3742 min += trie->minlen;
3743 delta += (trie->maxlen - trie->minlen);
3744 flags &= ~SCF_DO_STCLASS; /* xxx */
3745 if (flags & SCF_DO_SUBSTR) {
3746 scan_commit(pRExC_state,data,minlenp); /* Cannot expect anything... */
3747 data->pos_min += trie->minlen;
3748 data->pos_delta += (trie->maxlen - trie->minlen);
3749 if (trie->maxlen != trie->minlen)
3750 data->longest = &(data->longest_float);
3752 if (trie->jump) /* no more substrings -- for now /grr*/
3753 flags &= ~SCF_DO_SUBSTR;
3755 #endif /* old or new */
3756 #endif /* TRIE_STUDY_OPT */
3757 /* Else: zero-length, ignore. */
3758 scan = regnext(scan);
3763 *deltap = is_inf_internal ? I32_MAX : delta;
3764 if (flags & SCF_DO_SUBSTR && is_inf)
3765 data->pos_delta = I32_MAX - data->pos_min;
3766 if (is_par > (I32)U8_MAX)
3768 if (is_par && pars==1 && data) {
3769 data->flags |= SF_IN_PAR;
3770 data->flags &= ~SF_HAS_PAR;
3772 else if (pars && data) {
3773 data->flags |= SF_HAS_PAR;
3774 data->flags &= ~SF_IN_PAR;
3776 if (flags & SCF_DO_STCLASS_OR)
3777 cl_and(data->start_class, and_withp);
3778 if (flags & SCF_TRIE_RESTUDY)
3779 data->flags |= SCF_TRIE_RESTUDY;
3781 DEBUG_STUDYDATA(data,depth);
3783 return min < stopmin ? min : stopmin;
3787 S_add_data(RExC_state_t *pRExC_state, I32 n, const char *s)
3789 if (RExC_rx->data) {
3790 const U32 count = RExC_rx->data->count;
3791 Renewc(RExC_rx->data,
3792 sizeof(*RExC_rx->data) + sizeof(void*) * (count + n - 1),
3793 char, struct reg_data);
3794 Renew(RExC_rx->data->what, count + n, U8);
3795 RExC_rx->data->count += n;
3798 Newxc(RExC_rx->data, sizeof(*RExC_rx->data) + sizeof(void*) * (n - 1),
3799 char, struct reg_data);
3800 Newx(RExC_rx->data->what, n, U8);
3801 RExC_rx->data->count = n;
3803 Copy(s, RExC_rx->data->what + RExC_rx->data->count - n, n, U8);
3804 return RExC_rx->data->count - n;
3807 #ifndef PERL_IN_XSUB_RE
3809 Perl_reginitcolors(pTHX)
3812 const char * const s = PerlEnv_getenv("PERL_RE_COLORS");
3814 char *t = savepv(s);
3818 t = strchr(t, '\t');
3824 PL_colors[i] = t = (char *)"";
3829 PL_colors[i++] = (char *)"";
3836 #ifdef TRIE_STUDY_OPT
3837 #define CHECK_RESTUDY_GOTO \
3839 (data.flags & SCF_TRIE_RESTUDY) \
3843 #define CHECK_RESTUDY_GOTO
3847 - pregcomp - compile a regular expression into internal code
3849 * We can't allocate space until we know how big the compiled form will be,
3850 * but we can't compile it (and thus know how big it is) until we've got a
3851 * place to put the code. So we cheat: we compile it twice, once with code
3852 * generation turned off and size counting turned on, and once "for real".
3853 * This also means that we don't allocate space until we are sure that the
3854 * thing really will compile successfully, and we never have to move the
3855 * code and thus invalidate pointers into it. (Note that it has to be in
https://perl5.git.perl.org / perl5.git / blob