5 * 'A fair jaw-cracker dwarf-language must be.' --Samwise Gamgee
7 * [p.285 of _The Lord of the Rings_, II/iii: "The Ring Goes South"]
10 /* This file contains functions for compiling a regular expression. See
11 * also regexec.c which funnily enough, contains functions for executing
12 * a regular expression.
14 * This file is also copied at build time to ext/re/re_comp.c, where
15 * it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
16 * This causes the main functions to be compiled under new names and with
17 * debugging support added, which makes "use re 'debug'" work.
20 /* NOTE: this is derived from Henry Spencer's regexp code, and should not
21 * confused with the original package (see point 3 below). Thanks, Henry!
24 /* Additional note: this code is very heavily munged from Henry's version
25 * in places. In some spots I've traded clarity for efficiency, so don't
26 * blame Henry for some of the lack of readability.
29 /* The names of the functions have been changed from regcomp and
30 * regexec to pregcomp and pregexec in order to avoid conflicts
31 * with the POSIX routines of the same names.
34 #ifdef PERL_EXT_RE_BUILD
39 * pregcomp and pregexec -- regsub and regerror are not used in perl
41 * Copyright (c) 1986 by University of Toronto.
42 * Written by Henry Spencer. Not derived from licensed software.
44 * Permission is granted to anyone to use this software for any
45 * purpose on any computer system, and to redistribute it freely,
46 * subject to the following restrictions:
48 * 1. The author is not responsible for the consequences of use of
49 * this software, no matter how awful, even if they arise
52 * 2. The origin of this software must not be misrepresented, either
53 * by explicit claim or by omission.
55 * 3. Altered versions must be plainly marked as such, and must not
56 * be misrepresented as being the original software.
59 **** Alterations to Henry's code are...
61 **** Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
62 **** 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
63 **** by Larry Wall and others
65 **** You may distribute under the terms of either the GNU General Public
66 **** License or the Artistic License, as specified in the README file.
69 * Beware that some of this code is subtly aware of the way operator
70 * precedence is structured in regular expressions. Serious changes in
71 * regular-expression syntax might require a total rethink.
74 #define PERL_IN_REGCOMP_C
77 #ifndef PERL_IN_XSUB_RE
82 #ifdef PERL_IN_XSUB_RE
88 #include "dquote_static.c"
95 # if defined(BUGGY_MSC6)
96 /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
97 # pragma optimize("a",off)
98 /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
99 # pragma optimize("w",on )
100 # endif /* BUGGY_MSC6 */
104 #define STATIC static
107 typedef struct RExC_state_t {
108 U32 flags; /* are we folding, multilining? */
109 char *precomp; /* uncompiled string. */
110 REGEXP *rx_sv; /* The SV that is the regexp. */
111 regexp *rx; /* perl core regexp structure */
112 regexp_internal *rxi; /* internal data for regexp object pprivate field */
113 char *start; /* Start of input for compile */
114 char *end; /* End of input for compile */
115 char *parse; /* Input-scan pointer. */
116 I32 whilem_seen; /* number of WHILEM in this expr */
117 regnode *emit_start; /* Start of emitted-code area */
118 regnode *emit_bound; /* First regnode outside of the allocated space */
119 regnode *emit; /* Code-emit pointer; ®dummy = don't = compiling */
120 I32 naughty; /* How bad is this pattern? */
121 I32 sawback; /* Did we see \1, ...? */
123 I32 size; /* Code size. */
124 I32 npar; /* Capture buffer count, (OPEN). */
125 I32 cpar; /* Capture buffer count, (CLOSE). */
126 I32 nestroot; /* root parens we are in - used by accept */
130 regnode **open_parens; /* pointers to open parens */
131 regnode **close_parens; /* pointers to close parens */
132 regnode *opend; /* END node in program */
133 I32 utf8; /* whether the pattern is utf8 or not */
134 I32 orig_utf8; /* whether the pattern was originally in utf8 */
135 /* XXX use this for future optimisation of case
136 * where pattern must be upgraded to utf8. */
137 HV *paren_names; /* Paren names */
139 regnode **recurse; /* Recurse regops */
140 I32 recurse_count; /* Number of recurse regops */
142 char *starttry; /* -Dr: where regtry was called. */
143 #define RExC_starttry (pRExC_state->starttry)
146 const char *lastparse;
148 AV *paren_name_list; /* idx -> name */
149 #define RExC_lastparse (pRExC_state->lastparse)
150 #define RExC_lastnum (pRExC_state->lastnum)
151 #define RExC_paren_name_list (pRExC_state->paren_name_list)
155 #define RExC_flags (pRExC_state->flags)
156 #define RExC_precomp (pRExC_state->precomp)
157 #define RExC_rx_sv (pRExC_state->rx_sv)
158 #define RExC_rx (pRExC_state->rx)
159 #define RExC_rxi (pRExC_state->rxi)
160 #define RExC_start (pRExC_state->start)
161 #define RExC_end (pRExC_state->end)
162 #define RExC_parse (pRExC_state->parse)
163 #define RExC_whilem_seen (pRExC_state->whilem_seen)
164 #ifdef RE_TRACK_PATTERN_OFFSETS
165 #define RExC_offsets (pRExC_state->rxi->u.offsets) /* I am not like the others */
167 #define RExC_emit (pRExC_state->emit)
168 #define RExC_emit_start (pRExC_state->emit_start)
169 #define RExC_emit_bound (pRExC_state->emit_bound)
170 #define RExC_naughty (pRExC_state->naughty)
171 #define RExC_sawback (pRExC_state->sawback)
172 #define RExC_seen (pRExC_state->seen)
173 #define RExC_size (pRExC_state->size)
174 #define RExC_npar (pRExC_state->npar)
175 #define RExC_nestroot (pRExC_state->nestroot)
176 #define RExC_extralen (pRExC_state->extralen)
177 #define RExC_seen_zerolen (pRExC_state->seen_zerolen)
178 #define RExC_seen_evals (pRExC_state->seen_evals)
179 #define RExC_utf8 (pRExC_state->utf8)
180 #define RExC_orig_utf8 (pRExC_state->orig_utf8)
181 #define RExC_open_parens (pRExC_state->open_parens)
182 #define RExC_close_parens (pRExC_state->close_parens)
183 #define RExC_opend (pRExC_state->opend)
184 #define RExC_paren_names (pRExC_state->paren_names)
185 #define RExC_recurse (pRExC_state->recurse)
186 #define RExC_recurse_count (pRExC_state->recurse_count)
189 #define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?')
190 #define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
191 ((*s) == '{' && regcurly(s)))
194 #undef SPSTART /* dratted cpp namespace... */
197 * Flags to be passed up and down.
199 #define WORST 0 /* Worst case. */
200 #define HASWIDTH 0x01 /* Known to match non-null strings. */
202 /* Simple enough to be STAR/PLUS operand, in an EXACT node must be a single
203 * character, and if utf8, must be invariant. */
205 #define SPSTART 0x04 /* Starts with * or +. */
206 #define TRYAGAIN 0x08 /* Weeded out a declaration. */
207 #define POSTPONED 0x10 /* (?1),(?&name), (??{...}) or similar */
209 #define REG_NODE_NUM(x) ((x) ? (int)((x)-RExC_emit_start) : -1)
211 /* whether trie related optimizations are enabled */
212 #if PERL_ENABLE_EXTENDED_TRIE_OPTIMISATION
213 #define TRIE_STUDY_OPT
214 #define FULL_TRIE_STUDY
220 #define PBYTE(u8str,paren) ((U8*)(u8str))[(paren) >> 3]
221 #define PBITVAL(paren) (1 << ((paren) & 7))
222 #define PAREN_TEST(u8str,paren) ( PBYTE(u8str,paren) & PBITVAL(paren))
223 #define PAREN_SET(u8str,paren) PBYTE(u8str,paren) |= PBITVAL(paren)
224 #define PAREN_UNSET(u8str,paren) PBYTE(u8str,paren) &= (~PBITVAL(paren))
226 /* If not already in utf8, do a longjmp back to the beginning */
227 #define UTF8_LONGJMP 42 /* Choose a value not likely to ever conflict */
228 #define REQUIRE_UTF8 STMT_START { \
229 if (! UTF) JMPENV_JUMP(UTF8_LONGJMP); \
232 /* About scan_data_t.
234 During optimisation we recurse through the regexp program performing
235 various inplace (keyhole style) optimisations. In addition study_chunk
236 and scan_commit populate this data structure with information about
237 what strings MUST appear in the pattern. We look for the longest
238 string that must appear at a fixed location, and we look for the
239 longest string that may appear at a floating location. So for instance
244 Both 'FOO' and 'A' are fixed strings. Both 'B' and 'BAR' are floating
245 strings (because they follow a .* construct). study_chunk will identify
246 both FOO and BAR as being the longest fixed and floating strings respectively.
248 The strings can be composites, for instance
252 will result in a composite fixed substring 'foo'.
254 For each string some basic information is maintained:
256 - offset or min_offset
257 This is the position the string must appear at, or not before.
258 It also implicitly (when combined with minlenp) tells us how many
259 characters must match before the string we are searching for.
260 Likewise when combined with minlenp and the length of the string it
261 tells us how many characters must appear after the string we have
265 Only used for floating strings. This is the rightmost point that
266 the string can appear at. If set to I32 max it indicates that the
267 string can occur infinitely far to the right.
270 A pointer to the minimum length of the pattern that the string
271 was found inside. This is important as in the case of positive
272 lookahead or positive lookbehind we can have multiple patterns
277 The minimum length of the pattern overall is 3, the minimum length
278 of the lookahead part is 3, but the minimum length of the part that
279 will actually match is 1. So 'FOO's minimum length is 3, but the
280 minimum length for the F is 1. This is important as the minimum length
281 is used to determine offsets in front of and behind the string being
282 looked for. Since strings can be composites this is the length of the
283 pattern at the time it was committed with a scan_commit. Note that
284 the length is calculated by study_chunk, so that the minimum lengths
285 are not known until the full pattern has been compiled, thus the
286 pointer to the value.
290 In the case of lookbehind the string being searched for can be
291 offset past the start point of the final matching string.
292 If this value was just blithely removed from the min_offset it would
293 invalidate some of the calculations for how many chars must match
294 before or after (as they are derived from min_offset and minlen and
295 the length of the string being searched for).
296 When the final pattern is compiled and the data is moved from the
297 scan_data_t structure into the regexp structure the information
298 about lookbehind is factored in, with the information that would
299 have been lost precalculated in the end_shift field for the
302 The fields pos_min and pos_delta are used to store the minimum offset
303 and the delta to the maximum offset at the current point in the pattern.
307 typedef struct scan_data_t {
308 /*I32 len_min; unused */
309 /*I32 len_delta; unused */
313 I32 last_end; /* min value, <0 unless valid. */
316 SV **longest; /* Either &l_fixed, or &l_float. */
317 SV *longest_fixed; /* longest fixed string found in pattern */
318 I32 offset_fixed; /* offset where it starts */
319 I32 *minlen_fixed; /* pointer to the minlen relevant to the string */
320 I32 lookbehind_fixed; /* is the position of the string modfied by LB */
321 SV *longest_float; /* longest floating string found in pattern */
322 I32 offset_float_min; /* earliest point in string it can appear */
323 I32 offset_float_max; /* latest point in string it can appear */
324 I32 *minlen_float; /* pointer to the minlen relevant to the string */
325 I32 lookbehind_float; /* is the position of the string modified by LB */
329 struct regnode_charclass_class *start_class;
333 * Forward declarations for pregcomp()'s friends.
336 static const scan_data_t zero_scan_data =
337 { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ,0};
339 #define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
340 #define SF_BEFORE_SEOL 0x0001
341 #define SF_BEFORE_MEOL 0x0002
342 #define SF_FIX_BEFORE_EOL (SF_FIX_BEFORE_SEOL|SF_FIX_BEFORE_MEOL)
343 #define SF_FL_BEFORE_EOL (SF_FL_BEFORE_SEOL|SF_FL_BEFORE_MEOL)
346 # define SF_FIX_SHIFT_EOL (0+2)
347 # define SF_FL_SHIFT_EOL (0+4)
349 # define SF_FIX_SHIFT_EOL (+2)
350 # define SF_FL_SHIFT_EOL (+4)
353 #define SF_FIX_BEFORE_SEOL (SF_BEFORE_SEOL << SF_FIX_SHIFT_EOL)
354 #define SF_FIX_BEFORE_MEOL (SF_BEFORE_MEOL << SF_FIX_SHIFT_EOL)
356 #define SF_FL_BEFORE_SEOL (SF_BEFORE_SEOL << SF_FL_SHIFT_EOL)
357 #define SF_FL_BEFORE_MEOL (SF_BEFORE_MEOL << SF_FL_SHIFT_EOL) /* 0x20 */
358 #define SF_IS_INF 0x0040
359 #define SF_HAS_PAR 0x0080
360 #define SF_IN_PAR 0x0100
361 #define SF_HAS_EVAL 0x0200
362 #define SCF_DO_SUBSTR 0x0400
363 #define SCF_DO_STCLASS_AND 0x0800
364 #define SCF_DO_STCLASS_OR 0x1000
365 #define SCF_DO_STCLASS (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR)
366 #define SCF_WHILEM_VISITED_POS 0x2000
368 #define SCF_TRIE_RESTUDY 0x4000 /* Do restudy? */
369 #define SCF_SEEN_ACCEPT 0x8000
371 #define UTF cBOOL(RExC_utf8)
372 #define LOC (get_regex_charset(RExC_flags) == REGEX_LOCALE_CHARSET)
373 #define UNI_SEMANTICS (get_regex_charset(RExC_flags) == REGEX_UNICODE_CHARSET)
375 #define FOLD cBOOL(RExC_flags & RXf_PMf_FOLD)
377 #define OOB_UNICODE 12345678
378 #define OOB_NAMEDCLASS -1
380 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
381 #define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
384 /* length of regex to show in messages that don't mark a position within */
385 #define RegexLengthToShowInErrorMessages 127
388 * If MARKER[12] are adjusted, be sure to adjust the constants at the top
389 * of t/op/regmesg.t, the tests in t/op/re_tests, and those in
390 * op/pragma/warn/regcomp.
392 #define MARKER1 "<-- HERE" /* marker as it appears in the description */
393 #define MARKER2 " <-- HERE " /* marker as it appears within the regex */
395 #define REPORT_LOCATION " in regex; marked by " MARKER1 " in m/%.*s" MARKER2 "%s/"
398 * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
399 * arg. Show regex, up to a maximum length. If it's too long, chop and add
402 #define _FAIL(code) STMT_START { \
403 const char *ellipses = ""; \
404 IV len = RExC_end - RExC_precomp; \
407 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \
408 if (len > RegexLengthToShowInErrorMessages) { \
409 /* chop 10 shorter than the max, to ensure meaning of "..." */ \
410 len = RegexLengthToShowInErrorMessages - 10; \
416 #define FAIL(msg) _FAIL( \
417 Perl_croak(aTHX_ "%s in regex m/%.*s%s/", \
418 msg, (int)len, RExC_precomp, ellipses))
420 #define FAIL2(msg,arg) _FAIL( \
421 Perl_croak(aTHX_ msg " in regex m/%.*s%s/", \
422 arg, (int)len, RExC_precomp, ellipses))
425 * Simple_vFAIL -- like FAIL, but marks the current location in the scan
427 #define Simple_vFAIL(m) STMT_START { \
428 const IV offset = RExC_parse - RExC_precomp; \
429 Perl_croak(aTHX_ "%s" REPORT_LOCATION, \
430 m, (int)offset, RExC_precomp, RExC_precomp + offset); \
434 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL()
436 #define vFAIL(m) STMT_START { \
438 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \
443 * Like Simple_vFAIL(), but accepts two arguments.
445 #define Simple_vFAIL2(m,a1) STMT_START { \
446 const IV offset = RExC_parse - RExC_precomp; \
447 S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, \
448 (int)offset, RExC_precomp, RExC_precomp + offset); \
452 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL2().
454 #define vFAIL2(m,a1) STMT_START { \
456 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \
457 Simple_vFAIL2(m, a1); \
462 * Like Simple_vFAIL(), but accepts three arguments.
464 #define Simple_vFAIL3(m, a1, a2) STMT_START { \
465 const IV offset = RExC_parse - RExC_precomp; \
466 S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, \
467 (int)offset, RExC_precomp, RExC_precomp + offset); \
471 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL3().
473 #define vFAIL3(m,a1,a2) STMT_START { \
475 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \
476 Simple_vFAIL3(m, a1, a2); \
480 * Like Simple_vFAIL(), but accepts four arguments.
482 #define Simple_vFAIL4(m, a1, a2, a3) STMT_START { \
483 const IV offset = RExC_parse - RExC_precomp; \
484 S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3, \
485 (int)offset, RExC_precomp, RExC_precomp + offset); \
488 #define ckWARNreg(loc,m) STMT_START { \
489 const IV offset = loc - RExC_precomp; \
490 Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
491 (int)offset, RExC_precomp, RExC_precomp + offset); \
494 #define ckWARNregdep(loc,m) STMT_START { \
495 const IV offset = loc - RExC_precomp; \
496 Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP), \
498 (int)offset, RExC_precomp, RExC_precomp + offset); \
501 #define ckWARN2reg(loc, m, a1) STMT_START { \
502 const IV offset = loc - RExC_precomp; \
503 Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
504 a1, (int)offset, RExC_precomp, RExC_precomp + offset); \
507 #define vWARN3(loc, m, a1, a2) STMT_START { \
508 const IV offset = loc - RExC_precomp; \
509 Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
510 a1, a2, (int)offset, RExC_precomp, RExC_precomp + offset); \
513 #define ckWARN3reg(loc, m, a1, a2) STMT_START { \
514 const IV offset = loc - RExC_precomp; \
515 Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
516 a1, a2, (int)offset, RExC_precomp, RExC_precomp + offset); \
519 #define vWARN4(loc, m, a1, a2, a3) STMT_START { \
520 const IV offset = loc - RExC_precomp; \
521 Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
522 a1, a2, a3, (int)offset, RExC_precomp, RExC_precomp + offset); \
525 #define ckWARN4reg(loc, m, a1, a2, a3) STMT_START { \
526 const IV offset = loc - RExC_precomp; \
527 Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
528 a1, a2, a3, (int)offset, RExC_precomp, RExC_precomp + offset); \
531 #define vWARN5(loc, m, a1, a2, a3, a4) STMT_START { \
532 const IV offset = loc - RExC_precomp; \
533 Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
534 a1, a2, a3, a4, (int)offset, RExC_precomp, RExC_precomp + offset); \
538 /* Allow for side effects in s */
539 #define REGC(c,s) STMT_START { \
540 if (!SIZE_ONLY) *(s) = (c); else (void)(s); \
543 /* Macros for recording node offsets. 20001227 mjd@plover.com
544 * Nodes are numbered 1, 2, 3, 4. Node #n's position is recorded in
545 * element 2*n-1 of the array. Element #2n holds the byte length node #n.
546 * Element 0 holds the number n.
547 * Position is 1 indexed.
549 #ifndef RE_TRACK_PATTERN_OFFSETS
550 #define Set_Node_Offset_To_R(node,byte)
551 #define Set_Node_Offset(node,byte)
552 #define Set_Cur_Node_Offset
553 #define Set_Node_Length_To_R(node,len)
554 #define Set_Node_Length(node,len)
555 #define Set_Node_Cur_Length(node)
556 #define Node_Offset(n)
557 #define Node_Length(n)
558 #define Set_Node_Offset_Length(node,offset,len)
559 #define ProgLen(ri) ri->u.proglen
560 #define SetProgLen(ri,x) ri->u.proglen = x
562 #define ProgLen(ri) ri->u.offsets[0]
563 #define SetProgLen(ri,x) ri->u.offsets[0] = x
564 #define Set_Node_Offset_To_R(node,byte) STMT_START { \
566 MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n", \
567 __LINE__, (int)(node), (int)(byte))); \
569 Perl_croak(aTHX_ "value of node is %d in Offset macro", (int)(node)); \
571 RExC_offsets[2*(node)-1] = (byte); \
576 #define Set_Node_Offset(node,byte) \
577 Set_Node_Offset_To_R((node)-RExC_emit_start, (byte)-RExC_start)
578 #define Set_Cur_Node_Offset Set_Node_Offset(RExC_emit, RExC_parse)
580 #define Set_Node_Length_To_R(node,len) STMT_START { \
582 MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n", \
583 __LINE__, (int)(node), (int)(len))); \
585 Perl_croak(aTHX_ "value of node is %d in Length macro", (int)(node)); \
587 RExC_offsets[2*(node)] = (len); \
592 #define Set_Node_Length(node,len) \
593 Set_Node_Length_To_R((node)-RExC_emit_start, len)
594 #define Set_Cur_Node_Length(len) Set_Node_Length(RExC_emit, len)
595 #define Set_Node_Cur_Length(node) \
596 Set_Node_Length(node, RExC_parse - parse_start)
598 /* Get offsets and lengths */
599 #define Node_Offset(n) (RExC_offsets[2*((n)-RExC_emit_start)-1])
600 #define Node_Length(n) (RExC_offsets[2*((n)-RExC_emit_start)])
602 #define Set_Node_Offset_Length(node,offset,len) STMT_START { \
603 Set_Node_Offset_To_R((node)-RExC_emit_start, (offset)); \
604 Set_Node_Length_To_R((node)-RExC_emit_start, (len)); \
608 #if PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS
609 #define EXPERIMENTAL_INPLACESCAN
610 #endif /*PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS*/
612 #define DEBUG_STUDYDATA(str,data,depth) \
613 DEBUG_OPTIMISE_MORE_r(if(data){ \
614 PerlIO_printf(Perl_debug_log, \
615 "%*s" str "Pos:%"IVdf"/%"IVdf \
616 " Flags: 0x%"UVXf" Whilem_c: %"IVdf" Lcp: %"IVdf" %s", \
617 (int)(depth)*2, "", \
618 (IV)((data)->pos_min), \
619 (IV)((data)->pos_delta), \
620 (UV)((data)->flags), \
621 (IV)((data)->whilem_c), \
622 (IV)((data)->last_closep ? *((data)->last_closep) : -1), \
623 is_inf ? "INF " : "" \
625 if ((data)->last_found) \
626 PerlIO_printf(Perl_debug_log, \
627 "Last:'%s' %"IVdf":%"IVdf"/%"IVdf" %sFixed:'%s' @ %"IVdf \
628 " %sFloat: '%s' @ %"IVdf"/%"IVdf"", \
629 SvPVX_const((data)->last_found), \
630 (IV)((data)->last_end), \
631 (IV)((data)->last_start_min), \
632 (IV)((data)->last_start_max), \
633 ((data)->longest && \
634 (data)->longest==&((data)->longest_fixed)) ? "*" : "", \
635 SvPVX_const((data)->longest_fixed), \
636 (IV)((data)->offset_fixed), \
637 ((data)->longest && \
638 (data)->longest==&((data)->longest_float)) ? "*" : "", \
639 SvPVX_const((data)->longest_float), \
640 (IV)((data)->offset_float_min), \
641 (IV)((data)->offset_float_max) \
643 PerlIO_printf(Perl_debug_log,"\n"); \
646 static void clear_re(pTHX_ void *r);
648 /* Mark that we cannot extend a found fixed substring at this point.
649 Update the longest found anchored substring and the longest found
650 floating substrings if needed. */
653 S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, I32 *minlenp, int is_inf)
655 const STRLEN l = CHR_SVLEN(data->last_found);
656 const STRLEN old_l = CHR_SVLEN(*data->longest);
657 GET_RE_DEBUG_FLAGS_DECL;
659 PERL_ARGS_ASSERT_SCAN_COMMIT;
661 if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
662 SvSetMagicSV(*data->longest, data->last_found);
663 if (*data->longest == data->longest_fixed) {
664 data->offset_fixed = l ? data->last_start_min : data->pos_min;
665 if (data->flags & SF_BEFORE_EOL)
667 |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL);
669 data->flags &= ~SF_FIX_BEFORE_EOL;
670 data->minlen_fixed=minlenp;
671 data->lookbehind_fixed=0;
673 else { /* *data->longest == data->longest_float */
674 data->offset_float_min = l ? data->last_start_min : data->pos_min;
675 data->offset_float_max = (l
676 ? data->last_start_max
677 : data->pos_min + data->pos_delta);
678 if (is_inf || (U32)data->offset_float_max > (U32)I32_MAX)
679 data->offset_float_max = I32_MAX;
680 if (data->flags & SF_BEFORE_EOL)
682 |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL);
684 data->flags &= ~SF_FL_BEFORE_EOL;
685 data->minlen_float=minlenp;
686 data->lookbehind_float=0;
689 SvCUR_set(data->last_found, 0);
691 SV * const sv = data->last_found;
692 if (SvUTF8(sv) && SvMAGICAL(sv)) {
693 MAGIC * const mg = mg_find(sv, PERL_MAGIC_utf8);
699 data->flags &= ~SF_BEFORE_EOL;
700 DEBUG_STUDYDATA("commit: ",data,0);
703 /* Can match anything (initialization) */
705 S_cl_anything(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
707 PERL_ARGS_ASSERT_CL_ANYTHING;
709 ANYOF_CLASS_ZERO(cl);
710 ANYOF_BITMAP_SETALL(cl);
711 cl->flags = ANYOF_EOS|ANYOF_UNICODE_ALL|ANYOF_LOC_NONBITMAP_FOLD|ANYOF_NON_UTF8_LATIN1_ALL;
713 cl->flags |= ANYOF_LOCALE;
716 /* Can match anything (initialization) */
718 S_cl_is_anything(const struct regnode_charclass_class *cl)
722 PERL_ARGS_ASSERT_CL_IS_ANYTHING;
724 for (value = 0; value <= ANYOF_MAX; value += 2)
725 if (ANYOF_CLASS_TEST(cl, value) && ANYOF_CLASS_TEST(cl, value + 1))
727 if (!(cl->flags & ANYOF_UNICODE_ALL))
729 if (!ANYOF_BITMAP_TESTALLSET((const void*)cl))
734 /* Can match anything (initialization) */
736 S_cl_init(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
738 PERL_ARGS_ASSERT_CL_INIT;
740 Zero(cl, 1, struct regnode_charclass_class);
742 cl_anything(pRExC_state, cl);
746 S_cl_init_zero(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
748 PERL_ARGS_ASSERT_CL_INIT_ZERO;
750 Zero(cl, 1, struct regnode_charclass_class);
752 cl_anything(pRExC_state, cl);
754 cl->flags |= ANYOF_LOCALE;
757 /* 'And' a given class with another one. Can create false positives */
758 /* We assume that cl is not inverted */
760 S_cl_and(struct regnode_charclass_class *cl,
761 const struct regnode_charclass_class *and_with)
763 PERL_ARGS_ASSERT_CL_AND;
765 assert(and_with->type == ANYOF);
767 if (!(ANYOF_CLASS_TEST_ANY_SET(and_with))
768 && !(ANYOF_CLASS_TEST_ANY_SET(cl))
769 && (and_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
770 && !(and_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
771 && !(cl->flags & ANYOF_LOC_NONBITMAP_FOLD)) {
774 if (and_with->flags & ANYOF_INVERT)
775 for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
776 cl->bitmap[i] &= ~and_with->bitmap[i];
778 for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
779 cl->bitmap[i] &= and_with->bitmap[i];
780 } /* XXXX: logic is complicated otherwise, leave it along for a moment. */
781 if (!(and_with->flags & ANYOF_EOS))
782 cl->flags &= ~ANYOF_EOS;
784 if (!(and_with->flags & ANYOF_LOC_NONBITMAP_FOLD))
785 cl->flags &= ~ANYOF_LOC_NONBITMAP_FOLD;
786 if (!(and_with->flags & ANYOF_NON_UTF8_LATIN1_ALL))
787 cl->flags &= ~ANYOF_NON_UTF8_LATIN1_ALL;
789 if (cl->flags & ANYOF_UNICODE_ALL && and_with->flags & ANYOF_NONBITMAP &&
790 !(and_with->flags & ANYOF_INVERT)) {
791 cl->flags &= ~ANYOF_UNICODE_ALL;
792 cl->flags |= and_with->flags & ANYOF_NONBITMAP; /* field is 2 bits; use
795 ARG_SET(cl, ARG(and_with));
797 if (!(and_with->flags & ANYOF_UNICODE_ALL) &&
798 !(and_with->flags & ANYOF_INVERT))
799 cl->flags &= ~ANYOF_UNICODE_ALL;
800 if (!(and_with->flags & (ANYOF_NONBITMAP|ANYOF_UNICODE_ALL)) &&
801 !(and_with->flags & ANYOF_INVERT))
802 cl->flags &= ~ANYOF_NONBITMAP;
805 /* 'OR' a given class with another one. Can create false positives */
806 /* We assume that cl is not inverted */
808 S_cl_or(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, const struct regnode_charclass_class *or_with)
810 PERL_ARGS_ASSERT_CL_OR;
812 if (or_with->flags & ANYOF_INVERT) {
814 * (B1 | CL1) | (!B2 & !CL2) = (B1 | !B2 & !CL2) | (CL1 | (!B2 & !CL2))
815 * <= (B1 | !B2) | (CL1 | !CL2)
816 * which is wasteful if CL2 is small, but we ignore CL2:
817 * (B1 | CL1) | (!B2 & !CL2) <= (B1 | CL1) | !B2 = (B1 | !B2) | CL1
818 * XXXX Can we handle case-fold? Unclear:
819 * (OK1(i) | OK1(i')) | !(OK1(i) | OK1(i')) =
820 * (OK1(i) | OK1(i')) | (!OK1(i) & !OK1(i'))
822 if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
823 && !(or_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
824 && !(cl->flags & ANYOF_LOC_NONBITMAP_FOLD) ) {
827 for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
828 cl->bitmap[i] |= ~or_with->bitmap[i];
829 } /* XXXX: logic is complicated otherwise */
831 cl_anything(pRExC_state, cl);
834 /* (B1 | CL1) | (B2 | CL2) = (B1 | B2) | (CL1 | CL2)) */
835 if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
836 && (!(or_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
837 || (cl->flags & ANYOF_LOC_NONBITMAP_FOLD)) ) {
840 /* OR char bitmap and class bitmap separately */
841 for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
842 cl->bitmap[i] |= or_with->bitmap[i];
843 if (ANYOF_CLASS_TEST_ANY_SET(or_with)) {
844 for (i = 0; i < ANYOF_CLASSBITMAP_SIZE; i++)
845 cl->classflags[i] |= or_with->classflags[i];
846 cl->flags |= ANYOF_CLASS;
849 else { /* XXXX: logic is complicated, leave it along for a moment. */
850 cl_anything(pRExC_state, cl);
853 if (or_with->flags & ANYOF_EOS)
854 cl->flags |= ANYOF_EOS;
855 if (!(or_with->flags & ANYOF_NON_UTF8_LATIN1_ALL))
856 cl->flags |= ANYOF_NON_UTF8_LATIN1_ALL;
858 if (or_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
859 cl->flags |= ANYOF_LOC_NONBITMAP_FOLD;
861 /* If both nodes match something outside the bitmap, but what they match
862 * outside is not the same pointer, and hence not easily compared, give up
863 * and allow the start class to match everything outside the bitmap */
864 if (cl->flags & ANYOF_NONBITMAP && or_with->flags & ANYOF_NONBITMAP &&
865 ARG(cl) != ARG(or_with)) {
866 cl->flags |= ANYOF_UNICODE_ALL;
869 if (or_with->flags & ANYOF_UNICODE_ALL) {
870 cl->flags |= ANYOF_UNICODE_ALL;
874 #define TRIE_LIST_ITEM(state,idx) (trie->states[state].trans.list)[ idx ]
875 #define TRIE_LIST_CUR(state) ( TRIE_LIST_ITEM( state, 0 ).forid )
876 #define TRIE_LIST_LEN(state) ( TRIE_LIST_ITEM( state, 0 ).newstate )
877 #define TRIE_LIST_USED(idx) ( trie->states[state].trans.list ? (TRIE_LIST_CUR( idx ) - 1) : 0 )
882 dump_trie(trie,widecharmap,revcharmap)
883 dump_trie_interim_list(trie,widecharmap,revcharmap,next_alloc)
884 dump_trie_interim_table(trie,widecharmap,revcharmap,next_alloc)
886 These routines dump out a trie in a somewhat readable format.
887 The _interim_ variants are used for debugging the interim
888 tables that are used to generate the final compressed
889 representation which is what dump_trie expects.
891 Part of the reason for their existence is to provide a form
892 of documentation as to how the different representations function.
897 Dumps the final compressed table form of the trie to Perl_debug_log.
898 Used for debugging make_trie().
902 S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap,
903 AV *revcharmap, U32 depth)
906 SV *sv=sv_newmortal();
907 int colwidth= widecharmap ? 6 : 4;
909 GET_RE_DEBUG_FLAGS_DECL;
911 PERL_ARGS_ASSERT_DUMP_TRIE;
913 PerlIO_printf( Perl_debug_log, "%*sChar : %-6s%-6s%-4s ",
914 (int)depth * 2 + 2,"",
915 "Match","Base","Ofs" );
917 for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
918 SV ** const tmp = av_fetch( revcharmap, state, 0);
920 PerlIO_printf( Perl_debug_log, "%*s",
922 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
923 PL_colors[0], PL_colors[1],
924 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
925 PERL_PV_ESCAPE_FIRSTCHAR
930 PerlIO_printf( Perl_debug_log, "\n%*sState|-----------------------",
931 (int)depth * 2 + 2,"");
933 for( state = 0 ; state < trie->uniquecharcount ; state++ )
934 PerlIO_printf( Perl_debug_log, "%.*s", colwidth, "--------");
935 PerlIO_printf( Perl_debug_log, "\n");
937 for( state = 1 ; state < trie->statecount ; state++ ) {
938 const U32 base = trie->states[ state ].trans.base;
940 PerlIO_printf( Perl_debug_log, "%*s#%4"UVXf"|", (int)depth * 2 + 2,"", (UV)state);
942 if ( trie->states[ state ].wordnum ) {
943 PerlIO_printf( Perl_debug_log, " W%4X", trie->states[ state ].wordnum );
945 PerlIO_printf( Perl_debug_log, "%6s", "" );
948 PerlIO_printf( Perl_debug_log, " @%4"UVXf" ", (UV)base );
953 while( ( base + ofs < trie->uniquecharcount ) ||
954 ( base + ofs - trie->uniquecharcount < trie->lasttrans
955 && trie->trans[ base + ofs - trie->uniquecharcount ].check != state))
958 PerlIO_printf( Perl_debug_log, "+%2"UVXf"[ ", (UV)ofs);
960 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
961 if ( ( base + ofs >= trie->uniquecharcount ) &&
962 ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
963 trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
965 PerlIO_printf( Perl_debug_log, "%*"UVXf,
967 (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next );
969 PerlIO_printf( Perl_debug_log, "%*s",colwidth," ." );
973 PerlIO_printf( Perl_debug_log, "]");
976 PerlIO_printf( Perl_debug_log, "\n" );
978 PerlIO_printf(Perl_debug_log, "%*sword_info N:(prev,len)=", (int)depth*2, "");
979 for (word=1; word <= trie->wordcount; word++) {
980 PerlIO_printf(Perl_debug_log, " %d:(%d,%d)",
981 (int)word, (int)(trie->wordinfo[word].prev),
982 (int)(trie->wordinfo[word].len));
984 PerlIO_printf(Perl_debug_log, "\n" );
987 Dumps a fully constructed but uncompressed trie in list form.
988 List tries normally only are used for construction when the number of
989 possible chars (trie->uniquecharcount) is very high.
990 Used for debugging make_trie().
993 S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie,
994 HV *widecharmap, AV *revcharmap, U32 next_alloc,
998 SV *sv=sv_newmortal();
999 int colwidth= widecharmap ? 6 : 4;
1000 GET_RE_DEBUG_FLAGS_DECL;
1002 PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_LIST;
1004 /* print out the table precompression. */
1005 PerlIO_printf( Perl_debug_log, "%*sState :Word | Transition Data\n%*s%s",
1006 (int)depth * 2 + 2,"", (int)depth * 2 + 2,"",
1007 "------:-----+-----------------\n" );
1009 for( state=1 ; state < next_alloc ; state ++ ) {
1012 PerlIO_printf( Perl_debug_log, "%*s %4"UVXf" :",
1013 (int)depth * 2 + 2,"", (UV)state );
1014 if ( ! trie->states[ state ].wordnum ) {
1015 PerlIO_printf( Perl_debug_log, "%5s| ","");
1017 PerlIO_printf( Perl_debug_log, "W%4x| ",
1018 trie->states[ state ].wordnum
1021 for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
1022 SV ** const tmp = av_fetch( revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0);
1024 PerlIO_printf( Perl_debug_log, "%*s:%3X=%4"UVXf" | ",
1026 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
1027 PL_colors[0], PL_colors[1],
1028 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
1029 PERL_PV_ESCAPE_FIRSTCHAR
1031 TRIE_LIST_ITEM(state,charid).forid,
1032 (UV)TRIE_LIST_ITEM(state,charid).newstate
1035 PerlIO_printf(Perl_debug_log, "\n%*s| ",
1036 (int)((depth * 2) + 14), "");
1039 PerlIO_printf( Perl_debug_log, "\n");
1044 Dumps a fully constructed but uncompressed trie in table form.
1045 This is the normal DFA style state transition table, with a few
1046 twists to facilitate compression later.
1047 Used for debugging make_trie().
1050 S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie,
1051 HV *widecharmap, AV *revcharmap, U32 next_alloc,
1056 SV *sv=sv_newmortal();
1057 int colwidth= widecharmap ? 6 : 4;
1058 GET_RE_DEBUG_FLAGS_DECL;
1060 PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_TABLE;
1063 print out the table precompression so that we can do a visual check
1064 that they are identical.
1067 PerlIO_printf( Perl_debug_log, "%*sChar : ",(int)depth * 2 + 2,"" );
1069 for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
1070 SV ** const tmp = av_fetch( revcharmap, charid, 0);
1072 PerlIO_printf( Perl_debug_log, "%*s",
1074 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
1075 PL_colors[0], PL_colors[1],
1076 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
1077 PERL_PV_ESCAPE_FIRSTCHAR
1083 PerlIO_printf( Perl_debug_log, "\n%*sState+-",(int)depth * 2 + 2,"" );
1085 for( charid=0 ; charid < trie->uniquecharcount ; charid++ ) {
1086 PerlIO_printf( Perl_debug_log, "%.*s", colwidth,"--------");
1089 PerlIO_printf( Perl_debug_log, "\n" );
1091 for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
1093 PerlIO_printf( Perl_debug_log, "%*s%4"UVXf" : ",
1094 (int)depth * 2 + 2,"",
1095 (UV)TRIE_NODENUM( state ) );
1097 for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
1098 UV v=(UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next );
1100 PerlIO_printf( Perl_debug_log, "%*"UVXf, colwidth, v );
1102 PerlIO_printf( Perl_debug_log, "%*s", colwidth, "." );
1104 if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
1105 PerlIO_printf( Perl_debug_log, " (%4"UVXf")\n", (UV)trie->trans[ state ].check );
1107 PerlIO_printf( Perl_debug_log, " (%4"UVXf") W%4X\n", (UV)trie->trans[ state ].check,
1108 trie->states[ TRIE_NODENUM( state ) ].wordnum );
1116 /* make_trie(startbranch,first,last,tail,word_count,flags,depth)
1117 startbranch: the first branch in the whole branch sequence
1118 first : start branch of sequence of branch-exact nodes.
1119 May be the same as startbranch
1120 last : Thing following the last branch.
1121 May be the same as tail.
1122 tail : item following the branch sequence
1123 count : words in the sequence
1124 flags : currently the OP() type we will be building one of /EXACT(|F|Fl)/
1125 depth : indent depth
1127 Inplace optimizes a sequence of 2 or more Branch-Exact nodes into a TRIE node.
1129 A trie is an N'ary tree where the branches are determined by digital
1130 decomposition of the key. IE, at the root node you look up the 1st character and
1131 follow that branch repeat until you find the end of the branches. Nodes can be
1132 marked as "accepting" meaning they represent a complete word. Eg:
1136 would convert into the following structure. Numbers represent states, letters
1137 following numbers represent valid transitions on the letter from that state, if
1138 the number is in square brackets it represents an accepting state, otherwise it
1139 will be in parenthesis.
1141 +-h->+-e->[3]-+-r->(8)-+-s->[9]
1145 (1) +-i->(6)-+-s->[7]
1147 +-s->(3)-+-h->(4)-+-e->[5]
1149 Accept Word Mapping: 3=>1 (he),5=>2 (she), 7=>3 (his), 9=>4 (hers)
1151 This shows that when matching against the string 'hers' we will begin at state 1
1152 read 'h' and move to state 2, read 'e' and move to state 3 which is accepting,
1153 then read 'r' and go to state 8 followed by 's' which takes us to state 9 which
1154 is also accepting. Thus we know that we can match both 'he' and 'hers' with a
1155 single traverse. We store a mapping from accepting to state to which word was
1156 matched, and then when we have multiple possibilities we try to complete the
1157 rest of the regex in the order in which they occured in the alternation.
1159 The only prior NFA like behaviour that would be changed by the TRIE support is
1160 the silent ignoring of duplicate alternations which are of the form:
1162 / (DUPE|DUPE) X? (?{ ... }) Y /x
1164 Thus EVAL blocks following a trie may be called a different number of times with
1165 and without the optimisation. With the optimisations dupes will be silently
1166 ignored. This inconsistent behaviour of EVAL type nodes is well established as
1167 the following demonstrates:
1169 'words'=~/(word|word|word)(?{ print $1 })[xyz]/
1171 which prints out 'word' three times, but
1173 'words'=~/(word|word|word)(?{ print $1 })S/
1175 which doesnt print it out at all. This is due to other optimisations kicking in.
1177 Example of what happens on a structural level:
1179 The regexp /(ac|ad|ab)+/ will produce the following debug output:
1181 1: CURLYM[1] {1,32767}(18)
1192 This would be optimizable with startbranch=5, first=5, last=16, tail=16
1193 and should turn into:
1195 1: CURLYM[1] {1,32767}(18)
1197 [Words:3 Chars Stored:6 Unique Chars:4 States:5 NCP:1]
1205 Cases where tail != last would be like /(?foo|bar)baz/:
1215 which would be optimizable with startbranch=1, first=1, last=7, tail=8
1216 and would end up looking like:
1219 [Words:2 Chars Stored:6 Unique Chars:5 States:7 NCP:1]
1226 d = uvuni_to_utf8_flags(d, uv, 0);
1228 is the recommended Unicode-aware way of saying
1233 #define TRIE_STORE_REVCHAR \
1236 SV *zlopp = newSV(2); \
1237 unsigned char *flrbbbbb = (unsigned char *) SvPVX(zlopp); \
1238 unsigned const char *const kapow = uvuni_to_utf8(flrbbbbb, uvc & 0xFF); \
1239 SvCUR_set(zlopp, kapow - flrbbbbb); \
1242 av_push(revcharmap, zlopp); \
1244 char ooooff = (char)uvc; \
1245 av_push(revcharmap, newSVpvn(&ooooff, 1)); \
1249 #define TRIE_READ_CHAR STMT_START { \
1253 if ( foldlen > 0 ) { \
1254 uvc = utf8n_to_uvuni( scan, UTF8_MAXLEN, &len, uniflags ); \
1259 uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
1260 uvc = to_uni_fold( uvc, foldbuf, &foldlen ); \
1261 foldlen -= UNISKIP( uvc ); \
1262 scan = foldbuf + UNISKIP( uvc ); \
1265 uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
1275 #define TRIE_LIST_PUSH(state,fid,ns) STMT_START { \
1276 if ( TRIE_LIST_CUR( state ) >=TRIE_LIST_LEN( state ) ) { \
1277 U32 ging = TRIE_LIST_LEN( state ) *= 2; \
1278 Renew( trie->states[ state ].trans.list, ging, reg_trie_trans_le ); \
1280 TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).forid = fid; \
1281 TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).newstate = ns; \
1282 TRIE_LIST_CUR( state )++; \
1285 #define TRIE_LIST_NEW(state) STMT_START { \
1286 Newxz( trie->states[ state ].trans.list, \
1287 4, reg_trie_trans_le ); \
1288 TRIE_LIST_CUR( state ) = 1; \
1289 TRIE_LIST_LEN( state ) = 4; \
1292 #define TRIE_HANDLE_WORD(state) STMT_START { \
1293 U16 dupe= trie->states[ state ].wordnum; \
1294 regnode * const noper_next = regnext( noper ); \
1297 /* store the word for dumping */ \
1299 if (OP(noper) != NOTHING) \
1300 tmp = newSVpvn_utf8(STRING(noper), STR_LEN(noper), UTF); \
1302 tmp = newSVpvn_utf8( "", 0, UTF ); \
1303 av_push( trie_words, tmp ); \
1307 trie->wordinfo[curword].prev = 0; \
1308 trie->wordinfo[curword].len = wordlen; \
1309 trie->wordinfo[curword].accept = state; \
1311 if ( noper_next < tail ) { \
1313 trie->jump = (U16 *) PerlMemShared_calloc( word_count + 1, sizeof(U16) ); \
1314 trie->jump[curword] = (U16)(noper_next - convert); \
1316 jumper = noper_next; \
1318 nextbranch= regnext(cur); \
1322 /* It's a dupe. Pre-insert into the wordinfo[].prev */\
1323 /* chain, so that when the bits of chain are later */\
1324 /* linked together, the dups appear in the chain */\
1325 trie->wordinfo[curword].prev = trie->wordinfo[dupe].prev; \
1326 trie->wordinfo[dupe].prev = curword; \
1328 /* we haven't inserted this word yet. */ \
1329 trie->states[ state ].wordnum = curword; \
1334 #define TRIE_TRANS_STATE(state,base,ucharcount,charid,special) \
1335 ( ( base + charid >= ucharcount \
1336 && base + charid < ubound \
1337 && state == trie->trans[ base - ucharcount + charid ].check \
1338 && trie->trans[ base - ucharcount + charid ].next ) \
1339 ? trie->trans[ base - ucharcount + charid ].next \
1340 : ( state==1 ? special : 0 ) \
1344 #define MADE_JUMP_TRIE 2
1345 #define MADE_EXACT_TRIE 4
1348 S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 word_count, U32 flags, U32 depth)
1351 /* first pass, loop through and scan words */
1352 reg_trie_data *trie;
1353 HV *widecharmap = NULL;
1354 AV *revcharmap = newAV();
1356 const U32 uniflags = UTF8_ALLOW_DEFAULT;
1361 regnode *jumper = NULL;
1362 regnode *nextbranch = NULL;
1363 regnode *convert = NULL;
1364 U32 *prev_states; /* temp array mapping each state to previous one */
1365 /* we just use folder as a flag in utf8 */
1366 const U8 * folder = NULL;
1369 const U32 data_slot = add_data( pRExC_state, 4, "tuuu" );
1370 AV *trie_words = NULL;
1371 /* along with revcharmap, this only used during construction but both are
1372 * useful during debugging so we store them in the struct when debugging.
1375 const U32 data_slot = add_data( pRExC_state, 2, "tu" );
1376 STRLEN trie_charcount=0;
1378 SV *re_trie_maxbuff;
1379 GET_RE_DEBUG_FLAGS_DECL;
1381 PERL_ARGS_ASSERT_MAKE_TRIE;
1383 PERL_UNUSED_ARG(depth);
1387 case EXACTFU: folder = PL_fold_latin1; break;
1388 case EXACTF: folder = PL_fold; break;
1389 case EXACTFL: folder = PL_fold_locale; break;
1392 trie = (reg_trie_data *) PerlMemShared_calloc( 1, sizeof(reg_trie_data) );
1394 trie->startstate = 1;
1395 trie->wordcount = word_count;
1396 RExC_rxi->data->data[ data_slot ] = (void*)trie;
1397 trie->charmap = (U16 *) PerlMemShared_calloc( 256, sizeof(U16) );
1398 if (!(UTF && folder))
1399 trie->bitmap = (char *) PerlMemShared_calloc( ANYOF_BITMAP_SIZE, 1 );
1400 trie->wordinfo = (reg_trie_wordinfo *) PerlMemShared_calloc(
1401 trie->wordcount+1, sizeof(reg_trie_wordinfo));
1404 trie_words = newAV();
1407 re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
1408 if (!SvIOK(re_trie_maxbuff)) {
1409 sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
1412 PerlIO_printf( Perl_debug_log,
1413 "%*smake_trie start==%d, first==%d, last==%d, tail==%d depth=%d\n",
1414 (int)depth * 2 + 2, "",
1415 REG_NODE_NUM(startbranch),REG_NODE_NUM(first),
1416 REG_NODE_NUM(last), REG_NODE_NUM(tail),
1420 /* Find the node we are going to overwrite */
1421 if ( first == startbranch && OP( last ) != BRANCH ) {
1422 /* whole branch chain */
1425 /* branch sub-chain */
1426 convert = NEXTOPER( first );
1429 /* -- First loop and Setup --
1431 We first traverse the branches and scan each word to determine if it
1432 contains widechars, and how many unique chars there are, this is
1433 important as we have to build a table with at least as many columns as we
1436 We use an array of integers to represent the character codes 0..255
1437 (trie->charmap) and we use a an HV* to store Unicode characters. We use the
1438 native representation of the character value as the key and IV's for the
1441 *TODO* If we keep track of how many times each character is used we can
1442 remap the columns so that the table compression later on is more
1443 efficient in terms of memory by ensuring the most common value is in the
1444 middle and the least common are on the outside. IMO this would be better
1445 than a most to least common mapping as theres a decent chance the most
1446 common letter will share a node with the least common, meaning the node
1447 will not be compressible. With a middle is most common approach the worst
1448 case is when we have the least common nodes twice.
1452 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1453 regnode * const noper = NEXTOPER( cur );
1454 const U8 *uc = (U8*)STRING( noper );
1455 const U8 * const e = uc + STR_LEN( noper );
1457 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1458 const U8 *scan = (U8*)NULL;
1459 U32 wordlen = 0; /* required init */
1461 bool set_bit = trie->bitmap ? 1 : 0; /*store the first char in the bitmap?*/
1463 if (OP(noper) == NOTHING) {
1467 if ( set_bit ) /* bitmap only alloced when !(UTF&&Folding) */
1468 TRIE_BITMAP_SET(trie,*uc); /* store the raw first byte
1469 regardless of encoding */
1471 for ( ; uc < e ; uc += len ) {
1472 TRIE_CHARCOUNT(trie)++;
1476 if ( !trie->charmap[ uvc ] ) {
1477 trie->charmap[ uvc ]=( ++trie->uniquecharcount );
1479 trie->charmap[ folder[ uvc ] ] = trie->charmap[ uvc ];
1483 /* store the codepoint in the bitmap, and its folded
1485 TRIE_BITMAP_SET(trie,uvc);
1487 /* store the folded codepoint */
1488 if ( folder ) TRIE_BITMAP_SET(trie,folder[ uvc ]);
1491 /* store first byte of utf8 representation of
1492 variant codepoints */
1493 if (! UNI_IS_INVARIANT(uvc)) {
1494 TRIE_BITMAP_SET(trie, UTF8_TWO_BYTE_HI(uvc));
1497 set_bit = 0; /* We've done our bit :-) */
1502 widecharmap = newHV();
1504 svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 1 );
1507 Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%"UVXf, uvc );
1509 if ( !SvTRUE( *svpp ) ) {
1510 sv_setiv( *svpp, ++trie->uniquecharcount );
1515 if( cur == first ) {
1518 } else if (chars < trie->minlen) {
1520 } else if (chars > trie->maxlen) {
1524 } /* end first pass */
1525 DEBUG_TRIE_COMPILE_r(
1526 PerlIO_printf( Perl_debug_log, "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
1527 (int)depth * 2 + 2,"",
1528 ( widecharmap ? "UTF8" : "NATIVE" ), (int)word_count,
1529 (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount,
1530 (int)trie->minlen, (int)trie->maxlen )
1534 We now know what we are dealing with in terms of unique chars and
1535 string sizes so we can calculate how much memory a naive
1536 representation using a flat table will take. If it's over a reasonable
1537 limit (as specified by ${^RE_TRIE_MAXBUF}) we use a more memory
1538 conservative but potentially much slower representation using an array
1541 At the end we convert both representations into the same compressed
1542 form that will be used in regexec.c for matching with. The latter
1543 is a form that cannot be used to construct with but has memory
1544 properties similar to the list form and access properties similar
1545 to the table form making it both suitable for fast searches and
1546 small enough that its feasable to store for the duration of a program.
1548 See the comment in the code where the compressed table is produced
1549 inplace from the flat tabe representation for an explanation of how
1550 the compression works.
1555 Newx(prev_states, TRIE_CHARCOUNT(trie) + 2, U32);
1558 if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1) > SvIV(re_trie_maxbuff) ) {
1560 Second Pass -- Array Of Lists Representation
1562 Each state will be represented by a list of charid:state records
1563 (reg_trie_trans_le) the first such element holds the CUR and LEN
1564 points of the allocated array. (See defines above).
1566 We build the initial structure using the lists, and then convert
1567 it into the compressed table form which allows faster lookups
1568 (but cant be modified once converted).
1571 STRLEN transcount = 1;
1573 DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
1574 "%*sCompiling trie using list compiler\n",
1575 (int)depth * 2 + 2, ""));
1577 trie->states = (reg_trie_state *)
1578 PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
1579 sizeof(reg_trie_state) );
1583 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1585 regnode * const noper = NEXTOPER( cur );
1586 U8 *uc = (U8*)STRING( noper );
1587 const U8 * const e = uc + STR_LEN( noper );
1588 U32 state = 1; /* required init */
1589 U16 charid = 0; /* sanity init */
1590 U8 *scan = (U8*)NULL; /* sanity init */
1591 STRLEN foldlen = 0; /* required init */
1592 U32 wordlen = 0; /* required init */
1593 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1595 if (OP(noper) != NOTHING) {
1596 for ( ; uc < e ; uc += len ) {
1601 charid = trie->charmap[ uvc ];
1603 SV** const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
1607 charid=(U16)SvIV( *svpp );
1610 /* charid is now 0 if we dont know the char read, or nonzero if we do */
1617 if ( !trie->states[ state ].trans.list ) {
1618 TRIE_LIST_NEW( state );
1620 for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) {
1621 if ( TRIE_LIST_ITEM( state, check ).forid == charid ) {
1622 newstate = TRIE_LIST_ITEM( state, check ).newstate;
1627 newstate = next_alloc++;
1628 prev_states[newstate] = state;
1629 TRIE_LIST_PUSH( state, charid, newstate );
1634 Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1638 TRIE_HANDLE_WORD(state);
1640 } /* end second pass */
1642 /* next alloc is the NEXT state to be allocated */
1643 trie->statecount = next_alloc;
1644 trie->states = (reg_trie_state *)
1645 PerlMemShared_realloc( trie->states,
1647 * sizeof(reg_trie_state) );
1649 /* and now dump it out before we compress it */
1650 DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_list(trie, widecharmap,
1651 revcharmap, next_alloc,
1655 trie->trans = (reg_trie_trans *)
1656 PerlMemShared_calloc( transcount, sizeof(reg_trie_trans) );
1663 for( state=1 ; state < next_alloc ; state ++ ) {
1667 DEBUG_TRIE_COMPILE_MORE_r(
1668 PerlIO_printf( Perl_debug_log, "tp: %d zp: %d ",tp,zp)
1672 if (trie->states[state].trans.list) {
1673 U16 minid=TRIE_LIST_ITEM( state, 1).forid;
1677 for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1678 const U16 forid = TRIE_LIST_ITEM( state, idx).forid;
1679 if ( forid < minid ) {
1681 } else if ( forid > maxid ) {
1685 if ( transcount < tp + maxid - minid + 1) {
1687 trie->trans = (reg_trie_trans *)
1688 PerlMemShared_realloc( trie->trans,
1690 * sizeof(reg_trie_trans) );
1691 Zero( trie->trans + (transcount / 2), transcount / 2 , reg_trie_trans );
1693 base = trie->uniquecharcount + tp - minid;
1694 if ( maxid == minid ) {
1696 for ( ; zp < tp ; zp++ ) {
1697 if ( ! trie->trans[ zp ].next ) {
1698 base = trie->uniquecharcount + zp - minid;
1699 trie->trans[ zp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1700 trie->trans[ zp ].check = state;
1706 trie->trans[ tp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1707 trie->trans[ tp ].check = state;
1712 for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1713 const U32 tid = base - trie->uniquecharcount + TRIE_LIST_ITEM( state, idx ).forid;
1714 trie->trans[ tid ].next = TRIE_LIST_ITEM( state, idx ).newstate;
1715 trie->trans[ tid ].check = state;
1717 tp += ( maxid - minid + 1 );
1719 Safefree(trie->states[ state ].trans.list);
1722 DEBUG_TRIE_COMPILE_MORE_r(
1723 PerlIO_printf( Perl_debug_log, " base: %d\n",base);
1726 trie->states[ state ].trans.base=base;
1728 trie->lasttrans = tp + 1;
1732 Second Pass -- Flat Table Representation.
1734 we dont use the 0 slot of either trans[] or states[] so we add 1 to each.
1735 We know that we will need Charcount+1 trans at most to store the data
1736 (one row per char at worst case) So we preallocate both structures
1737 assuming worst case.
1739 We then construct the trie using only the .next slots of the entry
1742 We use the .check field of the first entry of the node temporarily to
1743 make compression both faster and easier by keeping track of how many non
1744 zero fields are in the node.
1746 Since trans are numbered from 1 any 0 pointer in the table is a FAIL
1749 There are two terms at use here: state as a TRIE_NODEIDX() which is a
1750 number representing the first entry of the node, and state as a
1751 TRIE_NODENUM() which is the trans number. state 1 is TRIE_NODEIDX(1) and
1752 TRIE_NODENUM(1), state 2 is TRIE_NODEIDX(2) and TRIE_NODENUM(3) if there
1753 are 2 entrys per node. eg:
1761 The table is internally in the right hand, idx form. However as we also
1762 have to deal with the states array which is indexed by nodenum we have to
1763 use TRIE_NODENUM() to convert.
1766 DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
1767 "%*sCompiling trie using table compiler\n",
1768 (int)depth * 2 + 2, ""));
1770 trie->trans = (reg_trie_trans *)
1771 PerlMemShared_calloc( ( TRIE_CHARCOUNT(trie) + 1 )
1772 * trie->uniquecharcount + 1,
1773 sizeof(reg_trie_trans) );
1774 trie->states = (reg_trie_state *)
1775 PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
1776 sizeof(reg_trie_state) );
1777 next_alloc = trie->uniquecharcount + 1;
1780 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1782 regnode * const noper = NEXTOPER( cur );
1783 const U8 *uc = (U8*)STRING( noper );
1784 const U8 * const e = uc + STR_LEN( noper );
1786 U32 state = 1; /* required init */
1788 U16 charid = 0; /* sanity init */
1789 U32 accept_state = 0; /* sanity init */
1790 U8 *scan = (U8*)NULL; /* sanity init */
1792 STRLEN foldlen = 0; /* required init */
1793 U32 wordlen = 0; /* required init */
1794 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1796 if ( OP(noper) != NOTHING ) {
1797 for ( ; uc < e ; uc += len ) {
1802 charid = trie->charmap[ uvc ];
1804 SV* const * const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
1805 charid = svpp ? (U16)SvIV(*svpp) : 0;
1809 if ( !trie->trans[ state + charid ].next ) {
1810 trie->trans[ state + charid ].next = next_alloc;
1811 trie->trans[ state ].check++;
1812 prev_states[TRIE_NODENUM(next_alloc)]
1813 = TRIE_NODENUM(state);
1814 next_alloc += trie->uniquecharcount;
1816 state = trie->trans[ state + charid ].next;
1818 Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1820 /* charid is now 0 if we dont know the char read, or nonzero if we do */
1823 accept_state = TRIE_NODENUM( state );
1824 TRIE_HANDLE_WORD(accept_state);
1826 } /* end second pass */
1828 /* and now dump it out before we compress it */
1829 DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_table(trie, widecharmap,
1831 next_alloc, depth+1));
1835 * Inplace compress the table.*
1837 For sparse data sets the table constructed by the trie algorithm will
1838 be mostly 0/FAIL transitions or to put it another way mostly empty.
1839 (Note that leaf nodes will not contain any transitions.)
1841 This algorithm compresses the tables by eliminating most such
1842 transitions, at the cost of a modest bit of extra work during lookup:
1844 - Each states[] entry contains a .base field which indicates the
1845 index in the state[] array wheres its transition data is stored.
1847 - If .base is 0 there are no valid transitions from that node.
1849 - If .base is nonzero then charid is added to it to find an entry in
1852 -If trans[states[state].base+charid].check!=state then the
1853 transition is taken to be a 0/Fail transition. Thus if there are fail
1854 transitions at the front of the node then the .base offset will point
1855 somewhere inside the previous nodes data (or maybe even into a node
1856 even earlier), but the .check field determines if the transition is
1860 The following process inplace converts the table to the compressed
1861 table: We first do not compress the root node 1,and mark all its
1862 .check pointers as 1 and set its .base pointer as 1 as well. This
1863 allows us to do a DFA construction from the compressed table later,
1864 and ensures that any .base pointers we calculate later are greater
1867 - We set 'pos' to indicate the first entry of the second node.
1869 - We then iterate over the columns of the node, finding the first and
1870 last used entry at l and m. We then copy l..m into pos..(pos+m-l),
1871 and set the .check pointers accordingly, and advance pos
1872 appropriately and repreat for the next node. Note that when we copy
1873 the next pointers we have to convert them from the original
1874 NODEIDX form to NODENUM form as the former is not valid post
1877 - If a node has no transitions used we mark its base as 0 and do not
1878 advance the pos pointer.
1880 - If a node only has one transition we use a second pointer into the
1881 structure to fill in allocated fail transitions from other states.
1882 This pointer is independent of the main pointer and scans forward
1883 looking for null transitions that are allocated to a state. When it
1884 finds one it writes the single transition into the "hole". If the
1885 pointer doesnt find one the single transition is appended as normal.
1887 - Once compressed we can Renew/realloc the structures to release the
1890 See "Table-Compression Methods" in sec 3.9 of the Red Dragon,
1891 specifically Fig 3.47 and the associated pseudocode.
1895 const U32 laststate = TRIE_NODENUM( next_alloc );
1898 trie->statecount = laststate;
1900 for ( state = 1 ; state < laststate ; state++ ) {
1902 const U32 stateidx = TRIE_NODEIDX( state );
1903 const U32 o_used = trie->trans[ stateidx ].check;
1904 U32 used = trie->trans[ stateidx ].check;
1905 trie->trans[ stateidx ].check = 0;
1907 for ( charid = 0 ; used && charid < trie->uniquecharcount ; charid++ ) {
1908 if ( flag || trie->trans[ stateidx + charid ].next ) {
1909 if ( trie->trans[ stateidx + charid ].next ) {
1911 for ( ; zp < pos ; zp++ ) {
1912 if ( ! trie->trans[ zp ].next ) {
1916 trie->states[ state ].trans.base = zp + trie->uniquecharcount - charid ;
1917 trie->trans[ zp ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1918 trie->trans[ zp ].check = state;
1919 if ( ++zp > pos ) pos = zp;
1926 trie->states[ state ].trans.base = pos + trie->uniquecharcount - charid ;
1928 trie->trans[ pos ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1929 trie->trans[ pos ].check = state;
1934 trie->lasttrans = pos + 1;
1935 trie->states = (reg_trie_state *)
1936 PerlMemShared_realloc( trie->states, laststate
1937 * sizeof(reg_trie_state) );
1938 DEBUG_TRIE_COMPILE_MORE_r(
1939 PerlIO_printf( Perl_debug_log,
1940 "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
1941 (int)depth * 2 + 2,"",
1942 (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1 ),
1945 ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
1948 } /* end table compress */
1950 DEBUG_TRIE_COMPILE_MORE_r(
1951 PerlIO_printf(Perl_debug_log, "%*sStatecount:%"UVxf" Lasttrans:%"UVxf"\n",
1952 (int)depth * 2 + 2, "",
1953 (UV)trie->statecount,
1954 (UV)trie->lasttrans)
1956 /* resize the trans array to remove unused space */
1957 trie->trans = (reg_trie_trans *)
1958 PerlMemShared_realloc( trie->trans, trie->lasttrans
1959 * sizeof(reg_trie_trans) );
1961 { /* Modify the program and insert the new TRIE node */
1962 U8 nodetype =(U8)(flags & 0xFF);
1966 regnode *optimize = NULL;
1967 #ifdef RE_TRACK_PATTERN_OFFSETS
1970 U32 mjd_nodelen = 0;
1971 #endif /* RE_TRACK_PATTERN_OFFSETS */
1972 #endif /* DEBUGGING */
1974 This means we convert either the first branch or the first Exact,
1975 depending on whether the thing following (in 'last') is a branch
1976 or not and whther first is the startbranch (ie is it a sub part of
1977 the alternation or is it the whole thing.)
1978 Assuming its a sub part we convert the EXACT otherwise we convert
1979 the whole branch sequence, including the first.
1981 /* Find the node we are going to overwrite */
1982 if ( first != startbranch || OP( last ) == BRANCH ) {
1983 /* branch sub-chain */
1984 NEXT_OFF( first ) = (U16)(last - first);
1985 #ifdef RE_TRACK_PATTERN_OFFSETS
1987 mjd_offset= Node_Offset((convert));
1988 mjd_nodelen= Node_Length((convert));
1991 /* whole branch chain */
1993 #ifdef RE_TRACK_PATTERN_OFFSETS
1996 const regnode *nop = NEXTOPER( convert );
1997 mjd_offset= Node_Offset((nop));
1998 mjd_nodelen= Node_Length((nop));
2002 PerlIO_printf(Perl_debug_log, "%*sMJD offset:%"UVuf" MJD length:%"UVuf"\n",
2003 (int)depth * 2 + 2, "",
2004 (UV)mjd_offset, (UV)mjd_nodelen)
2007 /* But first we check to see if there is a common prefix we can
2008 split out as an EXACT and put in front of the TRIE node. */
2009 trie->startstate= 1;
2010 if ( trie->bitmap && !widecharmap && !trie->jump ) {
2012 for ( state = 1 ; state < trie->statecount-1 ; state++ ) {
2016 const U32 base = trie->states[ state ].trans.base;
2018 if ( trie->states[state].wordnum )
2021 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
2022 if ( ( base + ofs >= trie->uniquecharcount ) &&
2023 ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
2024 trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
2026 if ( ++count > 1 ) {
2027 SV **tmp = av_fetch( revcharmap, ofs, 0);
2028 const U8 *ch = (U8*)SvPV_nolen_const( *tmp );
2029 if ( state == 1 ) break;
2031 Zero(trie->bitmap, ANYOF_BITMAP_SIZE, char);
2033 PerlIO_printf(Perl_debug_log,
2034 "%*sNew Start State=%"UVuf" Class: [",
2035 (int)depth * 2 + 2, "",
2038 SV ** const tmp = av_fetch( revcharmap, idx, 0);
2039 const U8 * const ch = (U8*)SvPV_nolen_const( *tmp );
2041 TRIE_BITMAP_SET(trie,*ch);
2043 TRIE_BITMAP_SET(trie, folder[ *ch ]);
2045 PerlIO_printf(Perl_debug_log, "%s", (char*)ch)
2049 TRIE_BITMAP_SET(trie,*ch);
2051 TRIE_BITMAP_SET(trie,folder[ *ch ]);
2052 DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"%s", ch));
2058 SV **tmp = av_fetch( revcharmap, idx, 0);
2060 char *ch = SvPV( *tmp, len );
2062 SV *sv=sv_newmortal();
2063 PerlIO_printf( Perl_debug_log,
2064 "%*sPrefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
2065 (int)depth * 2 + 2, "",
2067 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6,
2068 PL_colors[0], PL_colors[1],
2069 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
2070 PERL_PV_ESCAPE_FIRSTCHAR
2075 OP( convert ) = nodetype;
2076 str=STRING(convert);
2079 STR_LEN(convert) += len;
2085 DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"]\n"));
2090 trie->prefixlen = (state-1);
2092 regnode *n = convert+NODE_SZ_STR(convert);
2093 NEXT_OFF(convert) = NODE_SZ_STR(convert);
2094 trie->startstate = state;
2095 trie->minlen -= (state - 1);
2096 trie->maxlen -= (state - 1);
2098 /* At least the UNICOS C compiler choked on this
2099 * being argument to DEBUG_r(), so let's just have
2102 #ifdef PERL_EXT_RE_BUILD
2108 regnode *fix = convert;
2109 U32 word = trie->wordcount;
2111 Set_Node_Offset_Length(convert, mjd_offset, state - 1);
2112 while( ++fix < n ) {
2113 Set_Node_Offset_Length(fix, 0, 0);
2116 SV ** const tmp = av_fetch( trie_words, word, 0 );
2118 if ( STR_LEN(convert) <= SvCUR(*tmp) )
2119 sv_chop(*tmp, SvPV_nolen(*tmp) + STR_LEN(convert));
2121 sv_chop(*tmp, SvPV_nolen(*tmp) + SvCUR(*tmp));
2129 NEXT_OFF(convert) = (U16)(tail - convert);
2130 DEBUG_r(optimize= n);
2136 if ( trie->maxlen ) {
2137 NEXT_OFF( convert ) = (U16)(tail - convert);
2138 ARG_SET( convert, data_slot );
2139 /* Store the offset to the first unabsorbed branch in
2140 jump[0], which is otherwise unused by the jump logic.
2141 We use this when dumping a trie and during optimisation. */
2143 trie->jump[0] = (U16)(nextbranch - convert);
2145 /* If the start state is not accepting (meaning there is no empty string/NOTHING)
2146 * and there is a bitmap
2147 * and the first "jump target" node we found leaves enough room
2148 * then convert the TRIE node into a TRIEC node, with the bitmap
2149 * embedded inline in the opcode - this is hypothetically faster.
2151 if ( !trie->states[trie->startstate].wordnum
2153 && ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) )
2155 OP( convert ) = TRIEC;
2156 Copy(trie->bitmap, ((struct regnode_charclass *)convert)->bitmap, ANYOF_BITMAP_SIZE, char);
2157 PerlMemShared_free(trie->bitmap);
2160 OP( convert ) = TRIE;
2162 /* store the type in the flags */
2163 convert->flags = nodetype;
2167 + regarglen[ OP( convert ) ];
2169 /* XXX We really should free up the resource in trie now,
2170 as we won't use them - (which resources?) dmq */
2172 /* needed for dumping*/
2173 DEBUG_r(if (optimize) {
2174 regnode *opt = convert;
2176 while ( ++opt < optimize) {
2177 Set_Node_Offset_Length(opt,0,0);
2180 Try to clean up some of the debris left after the
2183 while( optimize < jumper ) {
2184 mjd_nodelen += Node_Length((optimize));
2185 OP( optimize ) = OPTIMIZED;
2186 Set_Node_Offset_Length(optimize,0,0);
2189 Set_Node_Offset_Length(convert,mjd_offset,mjd_nodelen);
2191 } /* end node insert */
2193 /* Finish populating the prev field of the wordinfo array. Walk back
2194 * from each accept state until we find another accept state, and if
2195 * so, point the first word's .prev field at the second word. If the
2196 * second already has a .prev field set, stop now. This will be the
2197 * case either if we've already processed that word's accept state,
2198 * or that state had multiple words, and the overspill words were
2199 * already linked up earlier.
2206 for (word=1; word <= trie->wordcount; word++) {
2208 if (trie->wordinfo[word].prev)
2210 state = trie->wordinfo[word].accept;
2212 state = prev_states[state];
2215 prev = trie->states[state].wordnum;
2219 trie->wordinfo[word].prev = prev;
2221 Safefree(prev_states);
2225 /* and now dump out the compressed format */
2226 DEBUG_TRIE_COMPILE_r(dump_trie(trie, widecharmap, revcharmap, depth+1));
2228 RExC_rxi->data->data[ data_slot + 1 ] = (void*)widecharmap;
2230 RExC_rxi->data->data[ data_slot + TRIE_WORDS_OFFSET ] = (void*)trie_words;
2231 RExC_rxi->data->data[ data_slot + 3 ] = (void*)revcharmap;
2233 SvREFCNT_dec(revcharmap);
2237 : trie->startstate>1
2243 S_make_trie_failtable(pTHX_ RExC_state_t *pRExC_state, regnode *source, regnode *stclass, U32 depth)
2245 /* The Trie is constructed and compressed now so we can build a fail array if it's needed
2247 This is basically the Aho-Corasick algorithm. Its from exercise 3.31 and 3.32 in the
2248 "Red Dragon" -- Compilers, principles, techniques, and tools. Aho, Sethi, Ullman 1985/88
2251 We find the fail state for each state in the trie, this state is the longest proper
2252 suffix of the current state's 'word' that is also a proper prefix of another word in our
2253 trie. State 1 represents the word '' and is thus the default fail state. This allows
2254 the DFA not to have to restart after its tried and failed a word at a given point, it
2255 simply continues as though it had been matching the other word in the first place.
2257 'abcdgu'=~/abcdefg|cdgu/
2258 When we get to 'd' we are still matching the first word, we would encounter 'g' which would
2259 fail, which would bring us to the state representing 'd' in the second word where we would
2260 try 'g' and succeed, proceeding to match 'cdgu'.
2262 /* add a fail transition */
2263 const U32 trie_offset = ARG(source);
2264 reg_trie_data *trie=(reg_trie_data *)RExC_rxi->data->data[trie_offset];
2266 const U32 ucharcount = trie->uniquecharcount;
2267 const U32 numstates = trie->statecount;
2268 const U32 ubound = trie->lasttrans + ucharcount;
2272 U32 base = trie->states[ 1 ].trans.base;
2275 const U32 data_slot = add_data( pRExC_state, 1, "T" );
2276 GET_RE_DEBUG_FLAGS_DECL;
2278 PERL_ARGS_ASSERT_MAKE_TRIE_FAILTABLE;
2280 PERL_UNUSED_ARG(depth);
2284 ARG_SET( stclass, data_slot );
2285 aho = (reg_ac_data *) PerlMemShared_calloc( 1, sizeof(reg_ac_data) );
2286 RExC_rxi->data->data[ data_slot ] = (void*)aho;
2287 aho->trie=trie_offset;
2288 aho->states=(reg_trie_state *)PerlMemShared_malloc( numstates * sizeof(reg_trie_state) );
2289 Copy( trie->states, aho->states, numstates, reg_trie_state );
2290 Newxz( q, numstates, U32);
2291 aho->fail = (U32 *) PerlMemShared_calloc( numstates, sizeof(U32) );
2294 /* initialize fail[0..1] to be 1 so that we always have
2295 a valid final fail state */
2296 fail[ 0 ] = fail[ 1 ] = 1;
2298 for ( charid = 0; charid < ucharcount ; charid++ ) {
2299 const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 );
2301 q[ q_write ] = newstate;
2302 /* set to point at the root */
2303 fail[ q[ q_write++ ] ]=1;
2306 while ( q_read < q_write) {
2307 const U32 cur = q[ q_read++ % numstates ];
2308 base = trie->states[ cur ].trans.base;
2310 for ( charid = 0 ; charid < ucharcount ; charid++ ) {
2311 const U32 ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 );
2313 U32 fail_state = cur;
2316 fail_state = fail[ fail_state ];
2317 fail_base = aho->states[ fail_state ].trans.base;
2318 } while ( !TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 ) );
2320 fail_state = TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 );
2321 fail[ ch_state ] = fail_state;
2322 if ( !aho->states[ ch_state ].wordnum && aho->states[ fail_state ].wordnum )
2324 aho->states[ ch_state ].wordnum = aho->states[ fail_state ].wordnum;
2326 q[ q_write++ % numstates] = ch_state;
2330 /* restore fail[0..1] to 0 so that we "fall out" of the AC loop
2331 when we fail in state 1, this allows us to use the
2332 charclass scan to find a valid start char. This is based on the principle
2333 that theres a good chance the string being searched contains lots of stuff
2334 that cant be a start char.
2336 fail[ 0 ] = fail[ 1 ] = 0;
2337 DEBUG_TRIE_COMPILE_r({
2338 PerlIO_printf(Perl_debug_log,
2339 "%*sStclass Failtable (%"UVuf" states): 0",
2340 (int)(depth * 2), "", (UV)numstates
2342 for( q_read=1; q_read<numstates; q_read++ ) {
2343 PerlIO_printf(Perl_debug_log, ", %"UVuf, (UV)fail[q_read]);
2345 PerlIO_printf(Perl_debug_log, "\n");
2348 /*RExC_seen |= REG_SEEN_TRIEDFA;*/
2353 * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2.
2354 * These need to be revisited when a newer toolchain becomes available.
2356 #if defined(__sparc64__) && defined(__GNUC__)
2357 # if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
2358 # undef SPARC64_GCC_WORKAROUND
2359 # define SPARC64_GCC_WORKAROUND 1
2363 #define DEBUG_PEEP(str,scan,depth) \
2364 DEBUG_OPTIMISE_r({if (scan){ \
2365 SV * const mysv=sv_newmortal(); \
2366 regnode *Next = regnext(scan); \
2367 regprop(RExC_rx, mysv, scan); \
2368 PerlIO_printf(Perl_debug_log, "%*s" str ">%3d: %s (%d)\n", \
2369 (int)depth*2, "", REG_NODE_NUM(scan), SvPV_nolen_const(mysv),\
2370 Next ? (REG_NODE_NUM(Next)) : 0 ); \
2377 #define JOIN_EXACT(scan,min,flags) \
2378 if (PL_regkind[OP(scan)] == EXACT) \
2379 join_exact(pRExC_state,(scan),(min),(flags),NULL,depth+1)
2382 S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, I32 *min, U32 flags,regnode *val, U32 depth) {
2383 /* Merge several consecutive EXACTish nodes into one. */
2384 regnode *n = regnext(scan);
2386 regnode *next = scan + NODE_SZ_STR(scan);
2390 regnode *stop = scan;
2391 GET_RE_DEBUG_FLAGS_DECL;
2393 PERL_UNUSED_ARG(depth);
2396 PERL_ARGS_ASSERT_JOIN_EXACT;
2397 #ifndef EXPERIMENTAL_INPLACESCAN
2398 PERL_UNUSED_ARG(flags);
2399 PERL_UNUSED_ARG(val);
2401 DEBUG_PEEP("join",scan,depth);
2403 /* Skip NOTHING, merge EXACT*. */
2405 ( PL_regkind[OP(n)] == NOTHING ||
2406 (stringok && (OP(n) == OP(scan))))
2408 && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
2410 if (OP(n) == TAIL || n > next)
2412 if (PL_regkind[OP(n)] == NOTHING) {
2413 DEBUG_PEEP("skip:",n,depth);
2414 NEXT_OFF(scan) += NEXT_OFF(n);
2415 next = n + NODE_STEP_REGNODE;
2422 else if (stringok) {
2423 const unsigned int oldl = STR_LEN(scan);
2424 regnode * const nnext = regnext(n);
2426 DEBUG_PEEP("merg",n,depth);
2429 if (oldl + STR_LEN(n) > U8_MAX)
2431 NEXT_OFF(scan) += NEXT_OFF(n);
2432 STR_LEN(scan) += STR_LEN(n);
2433 next = n + NODE_SZ_STR(n);
2434 /* Now we can overwrite *n : */
2435 Move(STRING(n), STRING(scan) + oldl, STR_LEN(n), char);
2443 #ifdef EXPERIMENTAL_INPLACESCAN
2444 if (flags && !NEXT_OFF(n)) {
2445 DEBUG_PEEP("atch", val, depth);
2446 if (reg_off_by_arg[OP(n)]) {
2447 ARG_SET(n, val - n);
2450 NEXT_OFF(n) = val - n;
2456 #define GREEK_SMALL_LETTER_IOTA_WITH_DIALYTIKA_AND_TONOS 0x0390
2457 #define IOTA_D_T GREEK_SMALL_LETTER_IOTA_WITH_DIALYTIKA_AND_TONOS
2458 #define GREEK_SMALL_LETTER_UPSILON_WITH_DIALYTIKA_AND_TONOS 0x03B0
2459 #define UPSILON_D_T GREEK_SMALL_LETTER_UPSILON_WITH_DIALYTIKA_AND_TONOS
2462 && ( OP(scan) == EXACTF || OP(scan) == EXACTFU)
2463 && ( STR_LEN(scan) >= 6 ) )
2466 Two problematic code points in Unicode casefolding of EXACT nodes:
2468 U+0390 - GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
2469 U+03B0 - GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
2475 U+03B9 U+0308 U+0301 0xCE 0xB9 0xCC 0x88 0xCC 0x81
2476 U+03C5 U+0308 U+0301 0xCF 0x85 0xCC 0x88 0xCC 0x81
2478 This means that in case-insensitive matching (or "loose matching",
2479 as Unicode calls it), an EXACTF of length six (the UTF-8 encoded byte
2480 length of the above casefolded versions) can match a target string
2481 of length two (the byte length of UTF-8 encoded U+0390 or U+03B0).
2482 This would rather mess up the minimum length computation.
2484 What we'll do is to look for the tail four bytes, and then peek
2485 at the preceding two bytes to see whether we need to decrease
2486 the minimum length by four (six minus two).
2488 Thanks to the design of UTF-8, there cannot be false matches:
2489 A sequence of valid UTF-8 bytes cannot be a subsequence of
2490 another valid sequence of UTF-8 bytes.
2493 char * const s0 = STRING(scan), *s, *t;
2494 char * const s1 = s0 + STR_LEN(scan) - 1;
2495 char * const s2 = s1 - 4;
2496 #ifdef EBCDIC /* RD tunifold greek 0390 and 03B0 */
2497 const char t0[] = "\xaf\x49\xaf\x42";
2499 const char t0[] = "\xcc\x88\xcc\x81";
2501 const char * const t1 = t0 + 3;
2504 s < s2 && (t = ninstr(s, s1, t0, t1));
2507 if (((U8)t[-1] == 0x68 && (U8)t[-2] == 0xB4) ||
2508 ((U8)t[-1] == 0x46 && (U8)t[-2] == 0xB5))
2510 if (((U8)t[-1] == 0xB9 && (U8)t[-2] == 0xCE) ||
2511 ((U8)t[-1] == 0x85 && (U8)t[-2] == 0xCF))
2519 n = scan + NODE_SZ_STR(scan);
2521 if (PL_regkind[OP(n)] != NOTHING || OP(n) == NOTHING) {
2528 DEBUG_OPTIMISE_r(if (merged){DEBUG_PEEP("finl",scan,depth)});
2532 /* REx optimizer. Converts nodes into quicker variants "in place".
2533 Finds fixed substrings. */
2535 /* Stops at toplevel WHILEM as well as at "last". At end *scanp is set
2536 to the position after last scanned or to NULL. */
2538 #define INIT_AND_WITHP \
2539 assert(!and_withp); \
2540 Newx(and_withp,1,struct regnode_charclass_class); \
2541 SAVEFREEPV(and_withp)
2543 /* this is a chain of data about sub patterns we are processing that
2544 need to be handled separately/specially in study_chunk. Its so
2545 we can simulate recursion without losing state. */
2547 typedef struct scan_frame {
2548 regnode *last; /* last node to process in this frame */
2549 regnode *next; /* next node to process when last is reached */
2550 struct scan_frame *prev; /*previous frame*/
2551 I32 stop; /* what stopparen do we use */
2555 #define SCAN_COMMIT(s, data, m) scan_commit(s, data, m, is_inf)
2557 #define CASE_SYNST_FNC(nAmE) \
2559 if (flags & SCF_DO_STCLASS_AND) { \
2560 for (value = 0; value < 256; value++) \
2561 if (!is_ ## nAmE ## _cp(value)) \
2562 ANYOF_BITMAP_CLEAR(data->start_class, value); \
2565 for (value = 0; value < 256; value++) \
2566 if (is_ ## nAmE ## _cp(value)) \
2567 ANYOF_BITMAP_SET(data->start_class, value); \
2571 if (flags & SCF_DO_STCLASS_AND) { \
2572 for (value = 0; value < 256; value++) \
2573 if (is_ ## nAmE ## _cp(value)) \
2574 ANYOF_BITMAP_CLEAR(data->start_class, value); \
2577 for (value = 0; value < 256; value++) \
2578 if (!is_ ## nAmE ## _cp(value)) \
2579 ANYOF_BITMAP_SET(data->start_class, value); \
2586 S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
2587 I32 *minlenp, I32 *deltap,
2592 struct regnode_charclass_class *and_withp,
2593 U32 flags, U32 depth)
2594 /* scanp: Start here (read-write). */
2595 /* deltap: Write maxlen-minlen here. */
2596 /* last: Stop before this one. */
2597 /* data: string data about the pattern */
2598 /* stopparen: treat close N as END */
2599 /* recursed: which subroutines have we recursed into */
2600 /* and_withp: Valid if flags & SCF_DO_STCLASS_OR */
2603 I32 min = 0, pars = 0, code;
2604 regnode *scan = *scanp, *next;
2606 int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
2607 int is_inf_internal = 0; /* The studied chunk is infinite */
2608 I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
2609 scan_data_t data_fake;
2610 SV *re_trie_maxbuff = NULL;
2611 regnode *first_non_open = scan;
2612 I32 stopmin = I32_MAX;
2613 scan_frame *frame = NULL;
2614 GET_RE_DEBUG_FLAGS_DECL;
2616 PERL_ARGS_ASSERT_STUDY_CHUNK;
2619 StructCopy(&zero_scan_data, &data_fake, scan_data_t);
2623 while (first_non_open && OP(first_non_open) == OPEN)
2624 first_non_open=regnext(first_non_open);
2629 while ( scan && OP(scan) != END && scan < last ){
2630 /* Peephole optimizer: */
2631 DEBUG_STUDYDATA("Peep:", data,depth);
2632 DEBUG_PEEP("Peep",scan,depth);
2633 JOIN_EXACT(scan,&min,0);
2635 /* Follow the next-chain of the current node and optimize
2636 away all the NOTHINGs from it. */
2637 if (OP(scan) != CURLYX) {
2638 const int max = (reg_off_by_arg[OP(scan)]
2640 /* I32 may be smaller than U16 on CRAYs! */
2641 : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
2642 int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
2646 /* Skip NOTHING and LONGJMP. */
2647 while ((n = regnext(n))
2648 && ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
2649 || ((OP(n) == LONGJMP) && (noff = ARG(n))))
2650 && off + noff < max)
2652 if (reg_off_by_arg[OP(scan)])
2655 NEXT_OFF(scan) = off;
2660 /* The principal pseudo-switch. Cannot be a switch, since we
2661 look into several different things. */
2662 if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
2663 || OP(scan) == IFTHEN) {
2664 next = regnext(scan);
2666 /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
2668 if (OP(next) == code || code == IFTHEN) {
2669 /* NOTE - There is similar code to this block below for handling
2670 TRIE nodes on a re-study. If you change stuff here check there
2672 I32 max1 = 0, min1 = I32_MAX, num = 0;
2673 struct regnode_charclass_class accum;
2674 regnode * const startbranch=scan;
2676 if (flags & SCF_DO_SUBSTR)
2677 SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot merge strings after this. */
2678 if (flags & SCF_DO_STCLASS)
2679 cl_init_zero(pRExC_state, &accum);
2681 while (OP(scan) == code) {
2682 I32 deltanext, minnext, f = 0, fake;
2683 struct regnode_charclass_class this_class;
2686 data_fake.flags = 0;
2688 data_fake.whilem_c = data->whilem_c;
2689 data_fake.last_closep = data->last_closep;
2692 data_fake.last_closep = &fake;
2694 data_fake.pos_delta = delta;
2695 next = regnext(scan);
2696 scan = NEXTOPER(scan);
2698 scan = NEXTOPER(scan);
2699 if (flags & SCF_DO_STCLASS) {
2700 cl_init(pRExC_state, &this_class);
2701 data_fake.start_class = &this_class;
2702 f = SCF_DO_STCLASS_AND;
2704 if (flags & SCF_WHILEM_VISITED_POS)
2705 f |= SCF_WHILEM_VISITED_POS;
2707 /* we suppose the run is continuous, last=next...*/
2708 minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
2710 stopparen, recursed, NULL, f,depth+1);
2713 if (max1 < minnext + deltanext)
2714 max1 = minnext + deltanext;
2715 if (deltanext == I32_MAX)
2716 is_inf = is_inf_internal = 1;
2718 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
2720 if (data_fake.flags & SCF_SEEN_ACCEPT) {
2721 if ( stopmin > minnext)
2722 stopmin = min + min1;
2723 flags &= ~SCF_DO_SUBSTR;
2725 data->flags |= SCF_SEEN_ACCEPT;
2728 if (data_fake.flags & SF_HAS_EVAL)
2729 data->flags |= SF_HAS_EVAL;
2730 data->whilem_c = data_fake.whilem_c;
2732 if (flags & SCF_DO_STCLASS)
2733 cl_or(pRExC_state, &accum, &this_class);
2735 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
2737 if (flags & SCF_DO_SUBSTR) {
2738 data->pos_min += min1;
2739 data->pos_delta += max1 - min1;
2740 if (max1 != min1 || is_inf)
2741 data->longest = &(data->longest_float);
2744 delta += max1 - min1;
2745 if (flags & SCF_DO_STCLASS_OR) {
2746 cl_or(pRExC_state, data->start_class, &accum);
2748 cl_and(data->start_class, and_withp);
2749 flags &= ~SCF_DO_STCLASS;
2752 else if (flags & SCF_DO_STCLASS_AND) {
2754 cl_and(data->start_class, &accum);
2755 flags &= ~SCF_DO_STCLASS;
2758 /* Switch to OR mode: cache the old value of
2759 * data->start_class */
2761 StructCopy(data->start_class, and_withp,
2762 struct regnode_charclass_class);
2763 flags &= ~SCF_DO_STCLASS_AND;
2764 StructCopy(&accum, data->start_class,
2765 struct regnode_charclass_class);
2766 flags |= SCF_DO_STCLASS_OR;
2767 data->start_class->flags |= ANYOF_EOS;
2771 if (PERL_ENABLE_TRIE_OPTIMISATION && OP( startbranch ) == BRANCH ) {
2774 Assuming this was/is a branch we are dealing with: 'scan' now
2775 points at the item that follows the branch sequence, whatever
2776 it is. We now start at the beginning of the sequence and look
2783 which would be constructed from a pattern like /A|LIST|OF|WORDS/
2785 If we can find such a subsequence we need to turn the first
2786 element into a trie and then add the subsequent branch exact
2787 strings to the trie.
2791 1. patterns where the whole set of branches can be converted.
2793 2. patterns where only a subset can be converted.
2795 In case 1 we can replace the whole set with a single regop
2796 for the trie. In case 2 we need to keep the start and end
2799 'BRANCH EXACT; BRANCH EXACT; BRANCH X'
2800 becomes BRANCH TRIE; BRANCH X;
2802 There is an additional case, that being where there is a
2803 common prefix, which gets split out into an EXACT like node
2804 preceding the TRIE node.
2806 If x(1..n)==tail then we can do a simple trie, if not we make
2807 a "jump" trie, such that when we match the appropriate word
2808 we "jump" to the appropriate tail node. Essentially we turn
2809 a nested if into a case structure of sorts.
2814 if (!re_trie_maxbuff) {
2815 re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
2816 if (!SvIOK(re_trie_maxbuff))
2817 sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
2819 if ( SvIV(re_trie_maxbuff)>=0 ) {
2821 regnode *first = (regnode *)NULL;
2822 regnode *last = (regnode *)NULL;
2823 regnode *tail = scan;
2828 SV * const mysv = sv_newmortal(); /* for dumping */
2830 /* var tail is used because there may be a TAIL
2831 regop in the way. Ie, the exacts will point to the
2832 thing following the TAIL, but the last branch will
2833 point at the TAIL. So we advance tail. If we
2834 have nested (?:) we may have to move through several
2838 while ( OP( tail ) == TAIL ) {
2839 /* this is the TAIL generated by (?:) */
2840 tail = regnext( tail );
2845 regprop(RExC_rx, mysv, tail );
2846 PerlIO_printf( Perl_debug_log, "%*s%s%s\n",
2847 (int)depth * 2 + 2, "",
2848 "Looking for TRIE'able sequences. Tail node is: ",
2849 SvPV_nolen_const( mysv )
2855 step through the branches, cur represents each
2856 branch, noper is the first thing to be matched
2857 as part of that branch and noper_next is the
2858 regnext() of that node. if noper is an EXACT
2859 and noper_next is the same as scan (our current
2860 position in the regex) then the EXACT branch is
2861 a possible optimization target. Once we have
2862 two or more consecutive such branches we can
2863 create a trie of the EXACT's contents and stich
2864 it in place. If the sequence represents all of
2865 the branches we eliminate the whole thing and
2866 replace it with a single TRIE. If it is a
2867 subsequence then we need to stitch it in. This
2868 means the first branch has to remain, and needs
2869 to be repointed at the item on the branch chain
2870 following the last branch optimized. This could
2871 be either a BRANCH, in which case the
2872 subsequence is internal, or it could be the
2873 item following the branch sequence in which
2874 case the subsequence is at the end.
2878 /* dont use tail as the end marker for this traverse */
2879 for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) {
2880 regnode * const noper = NEXTOPER( cur );
2881 #if defined(DEBUGGING) || defined(NOJUMPTRIE)
2882 regnode * const noper_next = regnext( noper );
2886 regprop(RExC_rx, mysv, cur);
2887 PerlIO_printf( Perl_debug_log, "%*s- %s (%d)",
2888 (int)depth * 2 + 2,"", SvPV_nolen_const( mysv ), REG_NODE_NUM(cur) );
2890 regprop(RExC_rx, mysv, noper);
2891 PerlIO_printf( Perl_debug_log, " -> %s",
2892 SvPV_nolen_const(mysv));
2895 regprop(RExC_rx, mysv, noper_next );
2896 PerlIO_printf( Perl_debug_log,"\t=> %s\t",
2897 SvPV_nolen_const(mysv));
2899 PerlIO_printf( Perl_debug_log, "(First==%d,Last==%d,Cur==%d)\n",
2900 REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur) );
2902 if ( (((first && optype!=NOTHING) ? OP( noper ) == optype
2903 : PL_regkind[ OP( noper ) ] == EXACT )
2904 || OP(noper) == NOTHING )
2906 && noper_next == tail
2911 if ( !first || optype == NOTHING ) {
2912 if (!first) first = cur;
2913 optype = OP( noper );
2919 Currently we do not believe that the trie logic can
2920 handle case insensitive matching properly when the
2921 pattern is not unicode (thus forcing unicode semantics).
2923 If/when this is fixed the following define can be swapped
2924 in below to fully enable trie logic.
2926 #define TRIE_TYPE_IS_SAFE 1
2929 #define TRIE_TYPE_IS_SAFE (UTF || optype==EXACT)
2931 if ( last && TRIE_TYPE_IS_SAFE ) {
2932 make_trie( pRExC_state,
2933 startbranch, first, cur, tail, count,
2936 if ( PL_regkind[ OP( noper ) ] == EXACT
2938 && noper_next == tail
2943 optype = OP( noper );
2953 regprop(RExC_rx, mysv, cur);
2954 PerlIO_printf( Perl_debug_log,
2955 "%*s- %s (%d) <SCAN FINISHED>\n", (int)depth * 2 + 2,
2956 "", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
2960 if ( last && TRIE_TYPE_IS_SAFE ) {
2961 made= make_trie( pRExC_state, startbranch, first, scan, tail, count, optype, depth+1 );
2962 #ifdef TRIE_STUDY_OPT
2963 if ( ((made == MADE_EXACT_TRIE &&
2964 startbranch == first)
2965 || ( first_non_open == first )) &&
2967 flags |= SCF_TRIE_RESTUDY;
2968 if ( startbranch == first
2971 RExC_seen &=~REG_TOP_LEVEL_BRANCHES;
2981 else if ( code == BRANCHJ ) { /* single branch is optimized. */
2982 scan = NEXTOPER(NEXTOPER(scan));
2983 } else /* single branch is optimized. */
2984 scan = NEXTOPER(scan);
2986 } else if (OP(scan) == SUSPEND || OP(scan) == GOSUB || OP(scan) == GOSTART) {
2987 scan_frame *newframe = NULL;
2992 if (OP(scan) != SUSPEND) {
2993 /* set the pointer */
2994 if (OP(scan) == GOSUB) {
2996 RExC_recurse[ARG2L(scan)] = scan;
2997 start = RExC_open_parens[paren-1];
2998 end = RExC_close_parens[paren-1];
3001 start = RExC_rxi->program + 1;
3005 Newxz(recursed, (((RExC_npar)>>3) +1), U8);
3006 SAVEFREEPV(recursed);
3008 if (!PAREN_TEST(recursed,paren+1)) {
3009 PAREN_SET(recursed,paren+1);
3010 Newx(newframe,1,scan_frame);
3012 if (flags & SCF_DO_SUBSTR) {
3013 SCAN_COMMIT(pRExC_state,data,minlenp);
3014 data->longest = &(data->longest_float);
3016 is_inf = is_inf_internal = 1;
3017 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3018 cl_anything(pRExC_state, data->start_class);
3019 flags &= ~SCF_DO_STCLASS;
3022 Newx(newframe,1,scan_frame);
3025 end = regnext(scan);
3030 SAVEFREEPV(newframe);
3031 newframe->next = regnext(scan);
3032 newframe->last = last;
3033 newframe->stop = stopparen;
3034 newframe->prev = frame;
3044 else if (OP(scan) == EXACT) {
3045 I32 l = STR_LEN(scan);
3048 const U8 * const s = (U8*)STRING(scan);
3049 l = utf8_length(s, s + l);
3050 uc = utf8_to_uvchr(s, NULL);
3052 uc = *((U8*)STRING(scan));
3055 if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
3056 /* The code below prefers earlier match for fixed
3057 offset, later match for variable offset. */
3058 if (data->last_end == -1) { /* Update the start info. */
3059 data->last_start_min = data->pos_min;
3060 data->last_start_max = is_inf
3061 ? I32_MAX : data->pos_min + data->pos_delta;
3063 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
3065 SvUTF8_on(data->last_found);
3067 SV * const sv = data->last_found;
3068 MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
3069 mg_find(sv, PERL_MAGIC_utf8) : NULL;
3070 if (mg && mg->mg_len >= 0)
3071 mg->mg_len += utf8_length((U8*)STRING(scan),
3072 (U8*)STRING(scan)+STR_LEN(scan));
3074 data->last_end = data->pos_min + l;
3075 data->pos_min += l; /* As in the first entry. */
3076 data->flags &= ~SF_BEFORE_EOL;
3078 if (flags & SCF_DO_STCLASS_AND) {
3079 /* Check whether it is compatible with what we know already! */
3083 /* If compatible, we or it in below. It is compatible if is
3084 * in the bitmp and either 1) its bit or its fold is set, or 2)
3085 * it's for a locale. Even if there isn't unicode semantics
3086 * here, at runtime there may be because of matching against a
3087 * utf8 string, so accept a possible false positive for
3088 * latin1-range folds */
3090 (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
3091 && !ANYOF_BITMAP_TEST(data->start_class, uc)
3092 && (!(data->start_class->flags & ANYOF_LOC_NONBITMAP_FOLD)
3093 || !ANYOF_BITMAP_TEST(data->start_class, PL_fold_latin1[uc])))
3096 ANYOF_CLASS_ZERO(data->start_class);
3097 ANYOF_BITMAP_ZERO(data->start_class);
3099 ANYOF_BITMAP_SET(data->start_class, uc);
3100 data->start_class->flags &= ~ANYOF_EOS;
3102 data->start_class->flags &= ~ANYOF_UNICODE_ALL;
3104 else if (flags & SCF_DO_STCLASS_OR) {
3105 /* false positive possible if the class is case-folded */
3107 ANYOF_BITMAP_SET(data->start_class, uc);
3109 data->start_class->flags |= ANYOF_UNICODE_ALL;
3110 data->start_class->flags &= ~ANYOF_EOS;
3111 cl_and(data->start_class, and_withp);
3113 flags &= ~SCF_DO_STCLASS;
3115 else if (PL_regkind[OP(scan)] == EXACT) { /* But OP != EXACT! */
3116 I32 l = STR_LEN(scan);
3117 UV uc = *((U8*)STRING(scan));
3119 /* Search for fixed substrings supports EXACT only. */
3120 if (flags & SCF_DO_SUBSTR) {
3122 SCAN_COMMIT(pRExC_state, data, minlenp);
3125 const U8 * const s = (U8 *)STRING(scan);
3126 l = utf8_length(s, s + l);
3127 uc = utf8_to_uvchr(s, NULL);
3130 if (flags & SCF_DO_SUBSTR)
3132 if (flags & SCF_DO_STCLASS_AND) {
3133 /* Check whether it is compatible with what we know already! */
3136 (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
3137 && !ANYOF_BITMAP_TEST(data->start_class, uc)
3138 && !ANYOF_BITMAP_TEST(data->start_class, PL_fold_latin1[uc])))
3142 ANYOF_CLASS_ZERO(data->start_class);
3143 ANYOF_BITMAP_ZERO(data->start_class);
3145 ANYOF_BITMAP_SET(data->start_class, uc);
3146 data->start_class->flags &= ~ANYOF_EOS;
3147 data->start_class->flags |= ANYOF_LOC_NONBITMAP_FOLD;
3148 if (OP(scan) == EXACTFL) {
3149 data->start_class->flags |= ANYOF_LOCALE;
3153 /* Also set the other member of the fold pair. In case
3154 * that unicode semantics is called for at runtime, use
3155 * the full latin1 fold. (Can't do this for locale,
3156 * because not known until runtime */
3157 ANYOF_BITMAP_SET(data->start_class, PL_fold_latin1[uc]);
3161 else if (flags & SCF_DO_STCLASS_OR) {
3162 if (data->start_class->flags & ANYOF_LOC_NONBITMAP_FOLD) {
3163 /* false positive possible if the class is case-folded.
3164 Assume that the locale settings are the same... */
3166 ANYOF_BITMAP_SET(data->start_class, uc);
3167 if (OP(scan) != EXACTFL) {
3169 /* And set the other member of the fold pair, but
3170 * can't do that in locale because not known until
3172 ANYOF_BITMAP_SET(data->start_class,
3173 PL_fold_latin1[uc]);
3176 data->start_class->flags &= ~ANYOF_EOS;
3178 cl_and(data->start_class, and_withp);
3180 flags &= ~SCF_DO_STCLASS;
3182 else if (REGNODE_VARIES(OP(scan))) {
3183 I32 mincount, maxcount, minnext, deltanext, fl = 0;
3184 I32 f = flags, pos_before = 0;
3185 regnode * const oscan = scan;
3186 struct regnode_charclass_class this_class;
3187 struct regnode_charclass_class *oclass = NULL;
3188 I32 next_is_eval = 0;
3190 switch (PL_regkind[OP(scan)]) {
3191 case WHILEM: /* End of (?:...)* . */
3192 scan = NEXTOPER(scan);
3195 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
3196 next = NEXTOPER(scan);
3197 if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
3199 maxcount = REG_INFTY;
3200 next = regnext(scan);
3201 scan = NEXTOPER(scan);
3205 if (flags & SCF_DO_SUBSTR)
3210 if (flags & SCF_DO_STCLASS) {
3212 maxcount = REG_INFTY;
3213 next = regnext(scan);
3214 scan = NEXTOPER(scan);
3217 is_inf = is_inf_internal = 1;
3218 scan = regnext(scan);
3219 if (flags & SCF_DO_SUBSTR) {
3220 SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot extend fixed substrings */
3221 data->longest = &(data->longest_float);
3223 goto optimize_curly_tail;
3225 if (stopparen>0 && (OP(scan)==CURLYN || OP(scan)==CURLYM)
3226 && (scan->flags == stopparen))
3231 mincount = ARG1(scan);
3232 maxcount = ARG2(scan);
3234 next = regnext(scan);
3235 if (OP(scan) == CURLYX) {
3236 I32 lp = (data ? *(data->last_closep) : 0);
3237 scan->flags = ((lp <= (I32)U8_MAX) ? (U8)lp : U8_MAX);
3239 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3240 next_is_eval = (OP(scan) == EVAL);
3242 if (flags & SCF_DO_SUBSTR) {
3243 if (mincount == 0) SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot extend fixed substrings */
3244 pos_before = data->pos_min;
3248 data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
3250 data->flags |= SF_IS_INF;
3252 if (flags & SCF_DO_STCLASS) {
3253 cl_init(pRExC_state, &this_class);
3254 oclass = data->start_class;
3255 data->start_class = &this_class;
3256 f |= SCF_DO_STCLASS_AND;
3257 f &= ~SCF_DO_STCLASS_OR;
3259 /* Exclude from super-linear cache processing any {n,m}
3260 regops for which the combination of input pos and regex
3261 pos is not enough information to determine if a match
3264 For example, in the regex /foo(bar\s*){4,8}baz/ with the
3265 regex pos at the \s*, the prospects for a match depend not
3266 only on the input position but also on how many (bar\s*)
3267 repeats into the {4,8} we are. */
3268 if ((mincount > 1) || (maxcount > 1 && maxcount != REG_INFTY))
3269 f &= ~SCF_WHILEM_VISITED_POS;
3271 /* This will finish on WHILEM, setting scan, or on NULL: */
3272 minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
3273 last, data, stopparen, recursed, NULL,
3275 ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
3277 if (flags & SCF_DO_STCLASS)
3278 data->start_class = oclass;
3279 if (mincount == 0 || minnext == 0) {
3280 if (flags & SCF_DO_STCLASS_OR) {
3281 cl_or(pRExC_state, data->start_class, &this_class);
3283 else if (flags & SCF_DO_STCLASS_AND) {
3284 /* Switch to OR mode: cache the old value of
3285 * data->start_class */
3287 StructCopy(data->start_class, and_withp,
3288 struct regnode_charclass_class);
3289 flags &= ~SCF_DO_STCLASS_AND;
3290 StructCopy(&this_class, data->start_class,
3291 struct regnode_charclass_class);
3292 flags |= SCF_DO_STCLASS_OR;
3293 data->start_class->flags |= ANYOF_EOS;
3295 } else { /* Non-zero len */
3296 if (flags & SCF_DO_STCLASS_OR) {
3297 cl_or(pRExC_state, data->start_class, &this_class);
3298 cl_and(data->start_class, and_withp);
3300 else if (flags & SCF_DO_STCLASS_AND)
3301 cl_and(data->start_class, &this_class);
3302 flags &= ~SCF_DO_STCLASS;
3304 if (!scan) /* It was not CURLYX, but CURLY. */
3306 if ( /* ? quantifier ok, except for (?{ ... }) */
3307 (next_is_eval || !(mincount == 0 && maxcount == 1))
3308 && (minnext == 0) && (deltanext == 0)
3309 && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
3310 && maxcount <= REG_INFTY/3) /* Complement check for big count */
3312 ckWARNreg(RExC_parse,
3313 "Quantifier unexpected on zero-length expression");
3316 min += minnext * mincount;
3317 is_inf_internal |= ((maxcount == REG_INFTY
3318 && (minnext + deltanext) > 0)
3319 || deltanext == I32_MAX);
3320 is_inf |= is_inf_internal;
3321 delta += (minnext + deltanext) * maxcount - minnext * mincount;
3323 /* Try powerful optimization CURLYX => CURLYN. */
3324 if ( OP(oscan) == CURLYX && data
3325 && data->flags & SF_IN_PAR
3326 && !(data->flags & SF_HAS_EVAL)
3327 && !deltanext && minnext == 1 ) {
3328 /* Try to optimize to CURLYN. */
3329 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
3330 regnode * const nxt1 = nxt;
3337 if (!REGNODE_SIMPLE(OP(nxt))
3338 && !(PL_regkind[OP(nxt)] == EXACT
3339 && STR_LEN(nxt) == 1))
3345 if (OP(nxt) != CLOSE)
3347 if (RExC_open_parens) {
3348 RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
3349 RExC_close_parens[ARG(nxt1)-1]=nxt+2; /*close->while*/
3351 /* Now we know that nxt2 is the only contents: */
3352 oscan->flags = (U8)ARG(nxt);
3354 OP(nxt1) = NOTHING; /* was OPEN. */
3357 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
3358 NEXT_OFF(nxt1+ 1) = 0; /* just for consistency. */
3359 NEXT_OFF(nxt2) = 0; /* just for consistency with CURLY. */
3360 OP(nxt) = OPTIMIZED; /* was CLOSE. */
3361 OP(nxt + 1) = OPTIMIZED; /* was count. */
3362 NEXT_OFF(nxt+ 1) = 0; /* just for consistency. */
3367 /* Try optimization CURLYX => CURLYM. */
3368 if ( OP(oscan) == CURLYX && data
3369 && !(data->flags & SF_HAS_PAR)
3370 && !(data->flags & SF_HAS_EVAL)
3371 && !deltanext /* atom is fixed width */
3372 && minnext != 0 /* CURLYM can't handle zero width */
3374 /* XXXX How to optimize if data == 0? */
3375 /* Optimize to a simpler form. */
3376 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
3380 while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
3381 && (OP(nxt2) != WHILEM))
3383 OP(nxt2) = SUCCEED; /* Whas WHILEM */
3384 /* Need to optimize away parenths. */
3385 if ((data->flags & SF_IN_PAR) && OP(nxt) == CLOSE) {
3386 /* Set the parenth number. */
3387 regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
3389 oscan->flags = (U8)ARG(nxt);
3390 if (RExC_open_parens) {
3391 RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
3392 RExC_close_parens[ARG(nxt1)-1]=nxt2+1; /*close->NOTHING*/
3394 OP(nxt1) = OPTIMIZED; /* was OPEN. */
3395 OP(nxt) = OPTIMIZED; /* was CLOSE. */
3398 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
3399 OP(nxt + 1) = OPTIMIZED; /* was count. */
3400 NEXT_OFF(nxt1 + 1) = 0; /* just for consistency. */
3401 NEXT_OFF(nxt + 1) = 0; /* just for consistency. */
3404 while ( nxt1 && (OP(nxt1) != WHILEM)) {
3405 regnode *nnxt = regnext(nxt1);
3407 if (reg_off_by_arg[OP(nxt1)])
3408 ARG_SET(nxt1, nxt2 - nxt1);
3409 else if (nxt2 - nxt1 < U16_MAX)
3410 NEXT_OFF(nxt1) = nxt2 - nxt1;
3412 OP(nxt) = NOTHING; /* Cannot beautify */
3417 /* Optimize again: */
3418 study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt,
3419 NULL, stopparen, recursed, NULL, 0,depth+1);
3424 else if ((OP(oscan) == CURLYX)
3425 && (flags & SCF_WHILEM_VISITED_POS)
3426 /* See the comment on a similar expression above.
3427 However, this time it's not a subexpression
3428 we care about, but the expression itself. */
3429 && (maxcount == REG_INFTY)
3430 && data && ++data->whilem_c < 16) {
3431 /* This stays as CURLYX, we can put the count/of pair. */
3432 /* Find WHILEM (as in regexec.c) */
3433 regnode *nxt = oscan + NEXT_OFF(oscan);
3435 if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
3437 PREVOPER(nxt)->flags = (U8)(data->whilem_c
3438 | (RExC_whilem_seen << 4)); /* On WHILEM */
3440 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
3442 if (flags & SCF_DO_SUBSTR) {
3443 SV *last_str = NULL;
3444 int counted = mincount != 0;
3446 if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
3447 #if defined(SPARC64_GCC_WORKAROUND)
3450 const char *s = NULL;
3453 if (pos_before >= data->last_start_min)
3456 b = data->last_start_min;
3459 s = SvPV_const(data->last_found, l);
3460 old = b - data->last_start_min;
3463 I32 b = pos_before >= data->last_start_min
3464 ? pos_before : data->last_start_min;
3466 const char * const s = SvPV_const(data->last_found, l);
3467 I32 old = b - data->last_start_min;
3471 old = utf8_hop((U8*)s, old) - (U8*)s;
3473 /* Get the added string: */
3474 last_str = newSVpvn_utf8(s + old, l, UTF);
3475 if (deltanext == 0 && pos_before == b) {
3476 /* What was added is a constant string */
3478 SvGROW(last_str, (mincount * l) + 1);
3479 repeatcpy(SvPVX(last_str) + l,
3480 SvPVX_const(last_str), l, mincount - 1);
3481 SvCUR_set(last_str, SvCUR(last_str) * mincount);
3482 /* Add additional parts. */
3483 SvCUR_set(data->last_found,
3484 SvCUR(data->last_found) - l);
3485 sv_catsv(data->last_found, last_str);
3487 SV * sv = data->last_found;
3489 SvUTF8(sv) && SvMAGICAL(sv) ?
3490 mg_find(sv, PERL_MAGIC_utf8) : NULL;
3491 if (mg && mg->mg_len >= 0)
3492 mg->mg_len += CHR_SVLEN(last_str) - l;
3494 data->last_end += l * (mincount - 1);
3497 /* start offset must point into the last copy */
3498 data->last_start_min += minnext * (mincount - 1);
3499 data->last_start_max += is_inf ? I32_MAX
3500 : (maxcount - 1) * (minnext + data->pos_delta);
3503 /* It is counted once already... */
3504 data->pos_min += minnext * (mincount - counted);
3505 data->pos_delta += - counted * deltanext +
3506 (minnext + deltanext) * maxcount - minnext * mincount;
3507 if (mincount != maxcount) {
3508 /* Cannot extend fixed substrings found inside
3510 SCAN_COMMIT(pRExC_state,data,minlenp);
3511 if (mincount && last_str) {
3512 SV * const sv = data->last_found;
3513 MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
3514 mg_find(sv, PERL_MAGIC_utf8) : NULL;
3518 sv_setsv(sv, last_str);
3519 data->last_end = data->pos_min;
3520 data->last_start_min =
3521 data->pos_min - CHR_SVLEN(last_str);
3522 data->last_start_max = is_inf
3524 : data->pos_min + data->pos_delta
3525 - CHR_SVLEN(last_str);
3527 data->longest = &(data->longest_float);
3529 SvREFCNT_dec(last_str);
3531 if (data && (fl & SF_HAS_EVAL))
3532 data->flags |= SF_HAS_EVAL;
3533 optimize_curly_tail:
3534 if (OP(oscan) != CURLYX) {
3535 while (PL_regkind[OP(next = regnext(oscan))] == NOTHING
3537 NEXT_OFF(oscan) += NEXT_OFF(next);
3540 default: /* REF, ANYOFV, and CLUMP only? */
3541 if (flags & SCF_DO_SUBSTR) {
3542 SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot expect anything... */
3543 data->longest = &(data->longest_float);
3545 is_inf = is_inf_internal = 1;
3546 if (flags & SCF_DO_STCLASS_OR)
3547 cl_anything(pRExC_state, data->start_class);
3548 flags &= ~SCF_DO_STCLASS;
3552 else if (OP(scan) == LNBREAK) {
3553 if (flags & SCF_DO_STCLASS) {
3555 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
3556 if (flags & SCF_DO_STCLASS_AND) {
3557 for (value = 0; value < 256; value++)
3558 if (!is_VERTWS_cp(value))
3559 ANYOF_BITMAP_CLEAR(data->start_class, value);
3562 for (value = 0; value < 256; value++)
3563 if (is_VERTWS_cp(value))
3564 ANYOF_BITMAP_SET(data->start_class, value);
3566 if (flags & SCF_DO_STCLASS_OR)
3567 cl_and(data->start_class, and_withp);
3568 flags &= ~SCF_DO_STCLASS;
3572 if (flags & SCF_DO_SUBSTR) {
3573 SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot expect anything... */
3575 data->pos_delta += 1;
3576 data->longest = &(data->longest_float);
3579 else if (OP(scan) == FOLDCHAR) {
3580 int d = ARG(scan) == LATIN_SMALL_LETTER_SHARP_S ? 1 : 2;
3581 flags &= ~SCF_DO_STCLASS;
3584 if (flags & SCF_DO_SUBSTR) {
3585 SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot expect anything... */
3587 data->pos_delta += d;
3588 data->longest = &(data->longest_float);
3591 else if (REGNODE_SIMPLE(OP(scan))) {
3594 if (flags & SCF_DO_SUBSTR) {
3595 SCAN_COMMIT(pRExC_state,data,minlenp);
3599 if (flags & SCF_DO_STCLASS) {
3600 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
3602 /* Some of the logic below assumes that switching
3603 locale on will only add false positives. */
3604 switch (PL_regkind[OP(scan)]) {
3608 /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
3609 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3610 cl_anything(pRExC_state, data->start_class);
3613 if (OP(scan) == SANY)
3615 if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
3616 value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
3617 || ANYOF_CLASS_TEST_ANY_SET(data->start_class));
3618 cl_anything(pRExC_state, data->start_class);
3620 if (flags & SCF_DO_STCLASS_AND || !value)
3621 ANYOF_BITMAP_CLEAR(data->start_class,'\n');
3624 if (flags & SCF_DO_STCLASS_AND)
3625 cl_and(data->start_class,
3626 (struct regnode_charclass_class*)scan);
3628 cl_or(pRExC_state, data->start_class,
3629 (struct regnode_charclass_class*)scan);
3632 if (flags & SCF_DO_STCLASS_AND) {
3633 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3634 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
3635 if (FLAGS(scan) == REGEX_UNICODE_CHARSET) {
3636 for (value = 0; value < 256; value++) {
3637 if (!isWORDCHAR_L1(value)) {
3638 ANYOF_BITMAP_CLEAR(data->start_class, value);
3642 for (value = 0; value < 256; value++) {
3643 if (!isALNUM(value)) {
3644 ANYOF_BITMAP_CLEAR(data->start_class, value);
3651 if (data->start_class->flags & ANYOF_LOCALE)
3652 ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
3653 else if (FLAGS(scan) == REGEX_UNICODE_CHARSET) {
3654 for (value = 0; value < 256; value++) {
3655 if (isWORDCHAR_L1(value)) {
3656 ANYOF_BITMAP_SET(data->start_class, value);
3660 for (value = 0; value < 256; value++) {
3661 if (isALNUM(value)) {
3662 ANYOF_BITMAP_SET(data->start_class, value);
3669 if (flags & SCF_DO_STCLASS_AND) {
3670 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3671 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
3672 if (FLAGS(scan) == REGEX_UNICODE_CHARSET) {
3673 for (value = 0; value < 256; value++) {
3674 if (isWORDCHAR_L1(value)) {
3675 ANYOF_BITMAP_CLEAR(data->start_class, value);
3679 for (value = 0; value < 256; value++) {
3680 if (isALNUM(value)) {
3681 ANYOF_BITMAP_CLEAR(data->start_class, value);
3688 if (data->start_class->flags & ANYOF_LOCALE)
3689 ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
3691 for (value = 0; value < 256; value++)
3692 if (!isALNUM(value))
3693 ANYOF_BITMAP_SET(data->start_class, value);
3698 if (flags & SCF_DO_STCLASS_AND) {
3699 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3700 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
3701 if (FLAGS(scan) == REGEX_UNICODE_CHARSET) {
3702 for (value = 0; value < 256; value++) {
3703 if (!isSPACE_L1(value)) {
3704 ANYOF_BITMAP_CLEAR(data->start_class, value);
3708 for (value = 0; value < 256; value++) {
3709 if (!isSPACE(value)) {
3710 ANYOF_BITMAP_CLEAR(data->start_class, value);
3717 if (data->start_class->flags & ANYOF_LOCALE) {
3718 ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
3720 else if (FLAGS(scan) == REGEX_UNICODE_CHARSET) {
3721 for (value = 0; value < 256; value++) {
3722 if (isSPACE_L1(value)) {
3723 ANYOF_BITMAP_SET(data->start_class, value);
3727 for (value = 0; value < 256; value++) {
3728 if (isSPACE(value)) {
3729 ANYOF_BITMAP_SET(data->start_class, value);
3736 if (flags & SCF_DO_STCLASS_AND) {
3737 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3738 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3739 if (FLAGS(scan) == REGEX_UNICODE_CHARSET) {
3740 for (value = 0; value < 256; value++) {
3741 if (isSPACE_L1(value)) {
3742 ANYOF_BITMAP_CLEAR(data->start_class, value);
3746 for (value = 0; value < 256; value++) {
3747 if (isSPACE(value)) {
3748 ANYOF_BITMAP_CLEAR(data->start_class, value);
3755 if (data->start_class->flags & ANYOF_LOCALE)
3756 ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3757 else if (FLAGS(scan) == REGEX_UNICODE_CHARSET) {
3758 for (value = 0; value < 256; value++) {
3759 if (!isSPACE_L1(value)) {
3760 ANYOF_BITMAP_SET(data->start_class, value);
3765 for (value = 0; value < 256; value++) {
3766 if (!isSPACE(value)) {
3767 ANYOF_BITMAP_SET(data->start_class, value);
3774 if (flags & SCF_DO_STCLASS_AND) {
3775 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
3776 for (value = 0; value < 256; value++)
3777 if (!isDIGIT(value))
3778 ANYOF_BITMAP_CLEAR(data->start_class, value);
3781 if (data->start_class->flags & ANYOF_LOCALE)
3782 ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
3784 for (value = 0; value < 256; value++)
3786 ANYOF_BITMAP_SET(data->start_class, value);
3791 if (flags & SCF_DO_STCLASS_AND) {
3792 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
3793 for (value = 0; value < 256; value++)
3795 ANYOF_BITMAP_CLEAR(data->start_class, value);
3798 if (data->start_class->flags & ANYOF_LOCALE)
3799 ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
3801 for (value = 0; value < 256; value++)
3802 if (!isDIGIT(value))
3803 ANYOF_BITMAP_SET(data->start_class, value);
3807 CASE_SYNST_FNC(VERTWS);
3808 CASE_SYNST_FNC(HORIZWS);
3811 if (flags & SCF_DO_STCLASS_OR)
3812 cl_and(data->start_class, and_withp);
3813 flags &= ~SCF_DO_STCLASS;
3816 else if (PL_regkind[OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
3817 data->flags |= (OP(scan) == MEOL
3821 else if ( PL_regkind[OP(scan)] == BRANCHJ
https://perl5.git.perl.org / perl5.git / blob