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 cBOOL(RExC_flags & RXf_PMf_LOCALE)
373 #define UNI_SEMANTICS cBOOL(RExC_flags & RXf_PMf_UNICODE)
374 #define FOLD cBOOL(RExC_flags & RXf_PMf_FOLD)
376 #define OOB_UNICODE 12345678
377 #define OOB_NAMEDCLASS -1
379 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
380 #define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
383 /* length of regex to show in messages that don't mark a position within */
384 #define RegexLengthToShowInErrorMessages 127
387 * If MARKER[12] are adjusted, be sure to adjust the constants at the top
388 * of t/op/regmesg.t, the tests in t/op/re_tests, and those in
389 * op/pragma/warn/regcomp.
391 #define MARKER1 "<-- HERE" /* marker as it appears in the description */
392 #define MARKER2 " <-- HERE " /* marker as it appears within the regex */
394 #define REPORT_LOCATION " in regex; marked by " MARKER1 " in m/%.*s" MARKER2 "%s/"
397 * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
398 * arg. Show regex, up to a maximum length. If it's too long, chop and add
401 #define _FAIL(code) STMT_START { \
402 const char *ellipses = ""; \
403 IV len = RExC_end - RExC_precomp; \
406 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \
407 if (len > RegexLengthToShowInErrorMessages) { \
408 /* chop 10 shorter than the max, to ensure meaning of "..." */ \
409 len = RegexLengthToShowInErrorMessages - 10; \
415 #define FAIL(msg) _FAIL( \
416 Perl_croak(aTHX_ "%s in regex m/%.*s%s/", \
417 msg, (int)len, RExC_precomp, ellipses))
419 #define FAIL2(msg,arg) _FAIL( \
420 Perl_croak(aTHX_ msg " in regex m/%.*s%s/", \
421 arg, (int)len, RExC_precomp, ellipses))
424 * Simple_vFAIL -- like FAIL, but marks the current location in the scan
426 #define Simple_vFAIL(m) STMT_START { \
427 const IV offset = RExC_parse - RExC_precomp; \
428 Perl_croak(aTHX_ "%s" REPORT_LOCATION, \
429 m, (int)offset, RExC_precomp, RExC_precomp + offset); \
433 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL()
435 #define vFAIL(m) STMT_START { \
437 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \
442 * Like Simple_vFAIL(), but accepts two arguments.
444 #define Simple_vFAIL2(m,a1) STMT_START { \
445 const IV offset = RExC_parse - RExC_precomp; \
446 S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, \
447 (int)offset, RExC_precomp, RExC_precomp + offset); \
451 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL2().
453 #define vFAIL2(m,a1) STMT_START { \
455 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \
456 Simple_vFAIL2(m, a1); \
461 * Like Simple_vFAIL(), but accepts three arguments.
463 #define Simple_vFAIL3(m, a1, a2) STMT_START { \
464 const IV offset = RExC_parse - RExC_precomp; \
465 S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, \
466 (int)offset, RExC_precomp, RExC_precomp + offset); \
470 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL3().
472 #define vFAIL3(m,a1,a2) STMT_START { \
474 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \
475 Simple_vFAIL3(m, a1, a2); \
479 * Like Simple_vFAIL(), but accepts four arguments.
481 #define Simple_vFAIL4(m, a1, a2, a3) STMT_START { \
482 const IV offset = RExC_parse - RExC_precomp; \
483 S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3, \
484 (int)offset, RExC_precomp, RExC_precomp + offset); \
487 #define ckWARNreg(loc,m) STMT_START { \
488 const IV offset = loc - RExC_precomp; \
489 Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
490 (int)offset, RExC_precomp, RExC_precomp + offset); \
493 #define ckWARNregdep(loc,m) STMT_START { \
494 const IV offset = loc - RExC_precomp; \
495 Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP), \
497 (int)offset, RExC_precomp, RExC_precomp + offset); \
500 #define ckWARN2reg(loc, m, a1) STMT_START { \
501 const IV offset = loc - RExC_precomp; \
502 Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
503 a1, (int)offset, RExC_precomp, RExC_precomp + offset); \
506 #define vWARN3(loc, m, a1, a2) STMT_START { \
507 const IV offset = loc - RExC_precomp; \
508 Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
509 a1, a2, (int)offset, RExC_precomp, RExC_precomp + offset); \
512 #define ckWARN3reg(loc, m, a1, a2) STMT_START { \
513 const IV offset = loc - RExC_precomp; \
514 Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
515 a1, a2, (int)offset, RExC_precomp, RExC_precomp + offset); \
518 #define vWARN4(loc, m, a1, a2, a3) STMT_START { \
519 const IV offset = loc - RExC_precomp; \
520 Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
521 a1, a2, a3, (int)offset, RExC_precomp, RExC_precomp + offset); \
524 #define ckWARN4reg(loc, m, a1, a2, a3) STMT_START { \
525 const IV offset = loc - RExC_precomp; \
526 Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
527 a1, a2, a3, (int)offset, RExC_precomp, RExC_precomp + offset); \
530 #define vWARN5(loc, m, a1, a2, a3, a4) STMT_START { \
531 const IV offset = loc - RExC_precomp; \
532 Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
533 a1, a2, a3, a4, (int)offset, RExC_precomp, RExC_precomp + offset); \
537 /* Allow for side effects in s */
538 #define REGC(c,s) STMT_START { \
539 if (!SIZE_ONLY) *(s) = (c); else (void)(s); \
542 /* Macros for recording node offsets. 20001227 mjd@plover.com
543 * Nodes are numbered 1, 2, 3, 4. Node #n's position is recorded in
544 * element 2*n-1 of the array. Element #2n holds the byte length node #n.
545 * Element 0 holds the number n.
546 * Position is 1 indexed.
548 #ifndef RE_TRACK_PATTERN_OFFSETS
549 #define Set_Node_Offset_To_R(node,byte)
550 #define Set_Node_Offset(node,byte)
551 #define Set_Cur_Node_Offset
552 #define Set_Node_Length_To_R(node,len)
553 #define Set_Node_Length(node,len)
554 #define Set_Node_Cur_Length(node)
555 #define Node_Offset(n)
556 #define Node_Length(n)
557 #define Set_Node_Offset_Length(node,offset,len)
558 #define ProgLen(ri) ri->u.proglen
559 #define SetProgLen(ri,x) ri->u.proglen = x
561 #define ProgLen(ri) ri->u.offsets[0]
562 #define SetProgLen(ri,x) ri->u.offsets[0] = x
563 #define Set_Node_Offset_To_R(node,byte) STMT_START { \
565 MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n", \
566 __LINE__, (int)(node), (int)(byte))); \
568 Perl_croak(aTHX_ "value of node is %d in Offset macro", (int)(node)); \
570 RExC_offsets[2*(node)-1] = (byte); \
575 #define Set_Node_Offset(node,byte) \
576 Set_Node_Offset_To_R((node)-RExC_emit_start, (byte)-RExC_start)
577 #define Set_Cur_Node_Offset Set_Node_Offset(RExC_emit, RExC_parse)
579 #define Set_Node_Length_To_R(node,len) STMT_START { \
581 MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n", \
582 __LINE__, (int)(node), (int)(len))); \
584 Perl_croak(aTHX_ "value of node is %d in Length macro", (int)(node)); \
586 RExC_offsets[2*(node)] = (len); \
591 #define Set_Node_Length(node,len) \
592 Set_Node_Length_To_R((node)-RExC_emit_start, len)
593 #define Set_Cur_Node_Length(len) Set_Node_Length(RExC_emit, len)
594 #define Set_Node_Cur_Length(node) \
595 Set_Node_Length(node, RExC_parse - parse_start)
597 /* Get offsets and lengths */
598 #define Node_Offset(n) (RExC_offsets[2*((n)-RExC_emit_start)-1])
599 #define Node_Length(n) (RExC_offsets[2*((n)-RExC_emit_start)])
601 #define Set_Node_Offset_Length(node,offset,len) STMT_START { \
602 Set_Node_Offset_To_R((node)-RExC_emit_start, (offset)); \
603 Set_Node_Length_To_R((node)-RExC_emit_start, (len)); \
607 #if PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS
608 #define EXPERIMENTAL_INPLACESCAN
609 #endif /*PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS*/
611 #define DEBUG_STUDYDATA(str,data,depth) \
612 DEBUG_OPTIMISE_MORE_r(if(data){ \
613 PerlIO_printf(Perl_debug_log, \
614 "%*s" str "Pos:%"IVdf"/%"IVdf \
615 " Flags: 0x%"UVXf" Whilem_c: %"IVdf" Lcp: %"IVdf" %s", \
616 (int)(depth)*2, "", \
617 (IV)((data)->pos_min), \
618 (IV)((data)->pos_delta), \
619 (UV)((data)->flags), \
620 (IV)((data)->whilem_c), \
621 (IV)((data)->last_closep ? *((data)->last_closep) : -1), \
622 is_inf ? "INF " : "" \
624 if ((data)->last_found) \
625 PerlIO_printf(Perl_debug_log, \
626 "Last:'%s' %"IVdf":%"IVdf"/%"IVdf" %sFixed:'%s' @ %"IVdf \
627 " %sFloat: '%s' @ %"IVdf"/%"IVdf"", \
628 SvPVX_const((data)->last_found), \
629 (IV)((data)->last_end), \
630 (IV)((data)->last_start_min), \
631 (IV)((data)->last_start_max), \
632 ((data)->longest && \
633 (data)->longest==&((data)->longest_fixed)) ? "*" : "", \
634 SvPVX_const((data)->longest_fixed), \
635 (IV)((data)->offset_fixed), \
636 ((data)->longest && \
637 (data)->longest==&((data)->longest_float)) ? "*" : "", \
638 SvPVX_const((data)->longest_float), \
639 (IV)((data)->offset_float_min), \
640 (IV)((data)->offset_float_max) \
642 PerlIO_printf(Perl_debug_log,"\n"); \
645 static void clear_re(pTHX_ void *r);
647 /* Mark that we cannot extend a found fixed substring at this point.
648 Update the longest found anchored substring and the longest found
649 floating substrings if needed. */
652 S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, I32 *minlenp, int is_inf)
654 const STRLEN l = CHR_SVLEN(data->last_found);
655 const STRLEN old_l = CHR_SVLEN(*data->longest);
656 GET_RE_DEBUG_FLAGS_DECL;
658 PERL_ARGS_ASSERT_SCAN_COMMIT;
660 if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
661 SvSetMagicSV(*data->longest, data->last_found);
662 if (*data->longest == data->longest_fixed) {
663 data->offset_fixed = l ? data->last_start_min : data->pos_min;
664 if (data->flags & SF_BEFORE_EOL)
666 |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL);
668 data->flags &= ~SF_FIX_BEFORE_EOL;
669 data->minlen_fixed=minlenp;
670 data->lookbehind_fixed=0;
672 else { /* *data->longest == data->longest_float */
673 data->offset_float_min = l ? data->last_start_min : data->pos_min;
674 data->offset_float_max = (l
675 ? data->last_start_max
676 : data->pos_min + data->pos_delta);
677 if (is_inf || (U32)data->offset_float_max > (U32)I32_MAX)
678 data->offset_float_max = I32_MAX;
679 if (data->flags & SF_BEFORE_EOL)
681 |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL);
683 data->flags &= ~SF_FL_BEFORE_EOL;
684 data->minlen_float=minlenp;
685 data->lookbehind_float=0;
688 SvCUR_set(data->last_found, 0);
690 SV * const sv = data->last_found;
691 if (SvUTF8(sv) && SvMAGICAL(sv)) {
692 MAGIC * const mg = mg_find(sv, PERL_MAGIC_utf8);
698 data->flags &= ~SF_BEFORE_EOL;
699 DEBUG_STUDYDATA("commit: ",data,0);
702 /* Can match anything (initialization) */
704 S_cl_anything(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
706 PERL_ARGS_ASSERT_CL_ANYTHING;
708 ANYOF_CLASS_ZERO(cl);
709 ANYOF_BITMAP_SETALL(cl);
710 cl->flags = ANYOF_EOS|ANYOF_UNICODE_ALL|ANYOF_LOC_NONBITMAP_FOLD|ANYOF_NON_UTF8_LATIN1_ALL;
712 cl->flags |= ANYOF_LOCALE;
715 /* Can match anything (initialization) */
717 S_cl_is_anything(const struct regnode_charclass_class *cl)
721 PERL_ARGS_ASSERT_CL_IS_ANYTHING;
723 for (value = 0; value <= ANYOF_MAX; value += 2)
724 if (ANYOF_CLASS_TEST(cl, value) && ANYOF_CLASS_TEST(cl, value + 1))
726 if (!(cl->flags & ANYOF_UNICODE_ALL))
728 if (!ANYOF_BITMAP_TESTALLSET((const void*)cl))
733 /* Can match anything (initialization) */
735 S_cl_init(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
737 PERL_ARGS_ASSERT_CL_INIT;
739 Zero(cl, 1, struct regnode_charclass_class);
741 cl_anything(pRExC_state, cl);
745 S_cl_init_zero(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
747 PERL_ARGS_ASSERT_CL_INIT_ZERO;
749 Zero(cl, 1, struct regnode_charclass_class);
751 cl_anything(pRExC_state, cl);
753 cl->flags |= ANYOF_LOCALE;
756 /* 'And' a given class with another one. Can create false positives */
757 /* We assume that cl is not inverted */
759 S_cl_and(struct regnode_charclass_class *cl,
760 const struct regnode_charclass_class *and_with)
762 PERL_ARGS_ASSERT_CL_AND;
764 assert(and_with->type == ANYOF);
766 if (!(ANYOF_CLASS_TEST_ANY_SET(and_with))
767 && !(ANYOF_CLASS_TEST_ANY_SET(cl))
768 && (and_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
769 && !(and_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
770 && !(cl->flags & ANYOF_LOC_NONBITMAP_FOLD)) {
773 if (and_with->flags & ANYOF_INVERT)
774 for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
775 cl->bitmap[i] &= ~and_with->bitmap[i];
777 for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
778 cl->bitmap[i] &= and_with->bitmap[i];
779 } /* XXXX: logic is complicated otherwise, leave it along for a moment. */
780 if (!(and_with->flags & ANYOF_EOS))
781 cl->flags &= ~ANYOF_EOS;
783 if (!(and_with->flags & ANYOF_LOC_NONBITMAP_FOLD))
784 cl->flags &= ~ANYOF_LOC_NONBITMAP_FOLD;
785 if (!(and_with->flags & ANYOF_NON_UTF8_LATIN1_ALL))
786 cl->flags &= ~ANYOF_NON_UTF8_LATIN1_ALL;
788 if (cl->flags & ANYOF_UNICODE_ALL && and_with->flags & ANYOF_NONBITMAP &&
789 !(and_with->flags & ANYOF_INVERT)) {
790 cl->flags &= ~ANYOF_UNICODE_ALL;
791 cl->flags |= and_with->flags & ANYOF_NONBITMAP; /* field is 2 bits; use
794 ARG_SET(cl, ARG(and_with));
796 if (!(and_with->flags & ANYOF_UNICODE_ALL) &&
797 !(and_with->flags & ANYOF_INVERT))
798 cl->flags &= ~ANYOF_UNICODE_ALL;
799 if (!(and_with->flags & (ANYOF_NONBITMAP|ANYOF_UNICODE_ALL)) &&
800 !(and_with->flags & ANYOF_INVERT))
801 cl->flags &= ~ANYOF_NONBITMAP;
804 /* 'OR' a given class with another one. Can create false positives */
805 /* We assume that cl is not inverted */
807 S_cl_or(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, const struct regnode_charclass_class *or_with)
809 PERL_ARGS_ASSERT_CL_OR;
811 if (or_with->flags & ANYOF_INVERT) {
813 * (B1 | CL1) | (!B2 & !CL2) = (B1 | !B2 & !CL2) | (CL1 | (!B2 & !CL2))
814 * <= (B1 | !B2) | (CL1 | !CL2)
815 * which is wasteful if CL2 is small, but we ignore CL2:
816 * (B1 | CL1) | (!B2 & !CL2) <= (B1 | CL1) | !B2 = (B1 | !B2) | CL1
817 * XXXX Can we handle case-fold? Unclear:
818 * (OK1(i) | OK1(i')) | !(OK1(i) | OK1(i')) =
819 * (OK1(i) | OK1(i')) | (!OK1(i) & !OK1(i'))
821 if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
822 && !(or_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
823 && !(cl->flags & ANYOF_LOC_NONBITMAP_FOLD) ) {
826 for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
827 cl->bitmap[i] |= ~or_with->bitmap[i];
828 } /* XXXX: logic is complicated otherwise */
830 cl_anything(pRExC_state, cl);
833 /* (B1 | CL1) | (B2 | CL2) = (B1 | B2) | (CL1 | CL2)) */
834 if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
835 && (!(or_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
836 || (cl->flags & ANYOF_LOC_NONBITMAP_FOLD)) ) {
839 /* OR char bitmap and class bitmap separately */
840 for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
841 cl->bitmap[i] |= or_with->bitmap[i];
842 if (ANYOF_CLASS_TEST_ANY_SET(or_with)) {
843 for (i = 0; i < ANYOF_CLASSBITMAP_SIZE; i++)
844 cl->classflags[i] |= or_with->classflags[i];
845 cl->flags |= ANYOF_CLASS;
848 else { /* XXXX: logic is complicated, leave it along for a moment. */
849 cl_anything(pRExC_state, cl);
852 if (or_with->flags & ANYOF_EOS)
853 cl->flags |= ANYOF_EOS;
854 if (!(or_with->flags & ANYOF_NON_UTF8_LATIN1_ALL))
855 cl->flags |= ANYOF_NON_UTF8_LATIN1_ALL;
857 if (or_with->flags & ANYOF_LOC_NONBITMAP_FOLD)
858 cl->flags |= ANYOF_LOC_NONBITMAP_FOLD;
860 /* If both nodes match something outside the bitmap, but what they match
861 * outside is not the same pointer, and hence not easily compared, give up
862 * and allow the start class to match everything outside the bitmap */
863 if (cl->flags & ANYOF_NONBITMAP && or_with->flags & ANYOF_NONBITMAP &&
864 ARG(cl) != ARG(or_with)) {
865 cl->flags |= ANYOF_UNICODE_ALL;
868 if (or_with->flags & ANYOF_UNICODE_ALL) {
869 cl->flags |= ANYOF_UNICODE_ALL;
873 #define TRIE_LIST_ITEM(state,idx) (trie->states[state].trans.list)[ idx ]
874 #define TRIE_LIST_CUR(state) ( TRIE_LIST_ITEM( state, 0 ).forid )
875 #define TRIE_LIST_LEN(state) ( TRIE_LIST_ITEM( state, 0 ).newstate )
876 #define TRIE_LIST_USED(idx) ( trie->states[state].trans.list ? (TRIE_LIST_CUR( idx ) - 1) : 0 )
881 dump_trie(trie,widecharmap,revcharmap)
882 dump_trie_interim_list(trie,widecharmap,revcharmap,next_alloc)
883 dump_trie_interim_table(trie,widecharmap,revcharmap,next_alloc)
885 These routines dump out a trie in a somewhat readable format.
886 The _interim_ variants are used for debugging the interim
887 tables that are used to generate the final compressed
888 representation which is what dump_trie expects.
890 Part of the reason for their existence is to provide a form
891 of documentation as to how the different representations function.
896 Dumps the final compressed table form of the trie to Perl_debug_log.
897 Used for debugging make_trie().
901 S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap,
902 AV *revcharmap, U32 depth)
905 SV *sv=sv_newmortal();
906 int colwidth= widecharmap ? 6 : 4;
908 GET_RE_DEBUG_FLAGS_DECL;
910 PERL_ARGS_ASSERT_DUMP_TRIE;
912 PerlIO_printf( Perl_debug_log, "%*sChar : %-6s%-6s%-4s ",
913 (int)depth * 2 + 2,"",
914 "Match","Base","Ofs" );
916 for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
917 SV ** const tmp = av_fetch( revcharmap, state, 0);
919 PerlIO_printf( Perl_debug_log, "%*s",
921 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
922 PL_colors[0], PL_colors[1],
923 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
924 PERL_PV_ESCAPE_FIRSTCHAR
929 PerlIO_printf( Perl_debug_log, "\n%*sState|-----------------------",
930 (int)depth * 2 + 2,"");
932 for( state = 0 ; state < trie->uniquecharcount ; state++ )
933 PerlIO_printf( Perl_debug_log, "%.*s", colwidth, "--------");
934 PerlIO_printf( Perl_debug_log, "\n");
936 for( state = 1 ; state < trie->statecount ; state++ ) {
937 const U32 base = trie->states[ state ].trans.base;
939 PerlIO_printf( Perl_debug_log, "%*s#%4"UVXf"|", (int)depth * 2 + 2,"", (UV)state);
941 if ( trie->states[ state ].wordnum ) {
942 PerlIO_printf( Perl_debug_log, " W%4X", trie->states[ state ].wordnum );
944 PerlIO_printf( Perl_debug_log, "%6s", "" );
947 PerlIO_printf( Perl_debug_log, " @%4"UVXf" ", (UV)base );
952 while( ( base + ofs < trie->uniquecharcount ) ||
953 ( base + ofs - trie->uniquecharcount < trie->lasttrans
954 && trie->trans[ base + ofs - trie->uniquecharcount ].check != state))
957 PerlIO_printf( Perl_debug_log, "+%2"UVXf"[ ", (UV)ofs);
959 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
960 if ( ( base + ofs >= trie->uniquecharcount ) &&
961 ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
962 trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
964 PerlIO_printf( Perl_debug_log, "%*"UVXf,
966 (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next );
968 PerlIO_printf( Perl_debug_log, "%*s",colwidth," ." );
972 PerlIO_printf( Perl_debug_log, "]");
975 PerlIO_printf( Perl_debug_log, "\n" );
977 PerlIO_printf(Perl_debug_log, "%*sword_info N:(prev,len)=", (int)depth*2, "");
978 for (word=1; word <= trie->wordcount; word++) {
979 PerlIO_printf(Perl_debug_log, " %d:(%d,%d)",
980 (int)word, (int)(trie->wordinfo[word].prev),
981 (int)(trie->wordinfo[word].len));
983 PerlIO_printf(Perl_debug_log, "\n" );
986 Dumps a fully constructed but uncompressed trie in list form.
987 List tries normally only are used for construction when the number of
988 possible chars (trie->uniquecharcount) is very high.
989 Used for debugging make_trie().
992 S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie,
993 HV *widecharmap, AV *revcharmap, U32 next_alloc,
997 SV *sv=sv_newmortal();
998 int colwidth= widecharmap ? 6 : 4;
999 GET_RE_DEBUG_FLAGS_DECL;
1001 PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_LIST;
1003 /* print out the table precompression. */
1004 PerlIO_printf( Perl_debug_log, "%*sState :Word | Transition Data\n%*s%s",
1005 (int)depth * 2 + 2,"", (int)depth * 2 + 2,"",
1006 "------:-----+-----------------\n" );
1008 for( state=1 ; state < next_alloc ; state ++ ) {
1011 PerlIO_printf( Perl_debug_log, "%*s %4"UVXf" :",
1012 (int)depth * 2 + 2,"", (UV)state );
1013 if ( ! trie->states[ state ].wordnum ) {
1014 PerlIO_printf( Perl_debug_log, "%5s| ","");
1016 PerlIO_printf( Perl_debug_log, "W%4x| ",
1017 trie->states[ state ].wordnum
1020 for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
1021 SV ** const tmp = av_fetch( revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0);
1023 PerlIO_printf( Perl_debug_log, "%*s:%3X=%4"UVXf" | ",
1025 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
1026 PL_colors[0], PL_colors[1],
1027 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
1028 PERL_PV_ESCAPE_FIRSTCHAR
1030 TRIE_LIST_ITEM(state,charid).forid,
1031 (UV)TRIE_LIST_ITEM(state,charid).newstate
1034 PerlIO_printf(Perl_debug_log, "\n%*s| ",
1035 (int)((depth * 2) + 14), "");
1038 PerlIO_printf( Perl_debug_log, "\n");
1043 Dumps a fully constructed but uncompressed trie in table form.
1044 This is the normal DFA style state transition table, with a few
1045 twists to facilitate compression later.
1046 Used for debugging make_trie().
1049 S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie,
1050 HV *widecharmap, AV *revcharmap, U32 next_alloc,
1055 SV *sv=sv_newmortal();
1056 int colwidth= widecharmap ? 6 : 4;
1057 GET_RE_DEBUG_FLAGS_DECL;
1059 PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_TABLE;
1062 print out the table precompression so that we can do a visual check
1063 that they are identical.
1066 PerlIO_printf( Perl_debug_log, "%*sChar : ",(int)depth * 2 + 2,"" );
1068 for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
1069 SV ** const tmp = av_fetch( revcharmap, charid, 0);
1071 PerlIO_printf( Perl_debug_log, "%*s",
1073 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
1074 PL_colors[0], PL_colors[1],
1075 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
1076 PERL_PV_ESCAPE_FIRSTCHAR
1082 PerlIO_printf( Perl_debug_log, "\n%*sState+-",(int)depth * 2 + 2,"" );
1084 for( charid=0 ; charid < trie->uniquecharcount ; charid++ ) {
1085 PerlIO_printf( Perl_debug_log, "%.*s", colwidth,"--------");
1088 PerlIO_printf( Perl_debug_log, "\n" );
1090 for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
1092 PerlIO_printf( Perl_debug_log, "%*s%4"UVXf" : ",
1093 (int)depth * 2 + 2,"",
1094 (UV)TRIE_NODENUM( state ) );
1096 for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
1097 UV v=(UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next );
1099 PerlIO_printf( Perl_debug_log, "%*"UVXf, colwidth, v );
1101 PerlIO_printf( Perl_debug_log, "%*s", colwidth, "." );
1103 if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
1104 PerlIO_printf( Perl_debug_log, " (%4"UVXf")\n", (UV)trie->trans[ state ].check );
1106 PerlIO_printf( Perl_debug_log, " (%4"UVXf") W%4X\n", (UV)trie->trans[ state ].check,
1107 trie->states[ TRIE_NODENUM( state ) ].wordnum );
1115 /* make_trie(startbranch,first,last,tail,word_count,flags,depth)
1116 startbranch: the first branch in the whole branch sequence
1117 first : start branch of sequence of branch-exact nodes.
1118 May be the same as startbranch
1119 last : Thing following the last branch.
1120 May be the same as tail.
1121 tail : item following the branch sequence
1122 count : words in the sequence
1123 flags : currently the OP() type we will be building one of /EXACT(|F|Fl)/
1124 depth : indent depth
1126 Inplace optimizes a sequence of 2 or more Branch-Exact nodes into a TRIE node.
1128 A trie is an N'ary tree where the branches are determined by digital
1129 decomposition of the key. IE, at the root node you look up the 1st character and
1130 follow that branch repeat until you find the end of the branches. Nodes can be
1131 marked as "accepting" meaning they represent a complete word. Eg:
1135 would convert into the following structure. Numbers represent states, letters
1136 following numbers represent valid transitions on the letter from that state, if
1137 the number is in square brackets it represents an accepting state, otherwise it
1138 will be in parenthesis.
1140 +-h->+-e->[3]-+-r->(8)-+-s->[9]
1144 (1) +-i->(6)-+-s->[7]
1146 +-s->(3)-+-h->(4)-+-e->[5]
1148 Accept Word Mapping: 3=>1 (he),5=>2 (she), 7=>3 (his), 9=>4 (hers)
1150 This shows that when matching against the string 'hers' we will begin at state 1
1151 read 'h' and move to state 2, read 'e' and move to state 3 which is accepting,
1152 then read 'r' and go to state 8 followed by 's' which takes us to state 9 which
1153 is also accepting. Thus we know that we can match both 'he' and 'hers' with a
1154 single traverse. We store a mapping from accepting to state to which word was
1155 matched, and then when we have multiple possibilities we try to complete the
1156 rest of the regex in the order in which they occured in the alternation.
1158 The only prior NFA like behaviour that would be changed by the TRIE support is
1159 the silent ignoring of duplicate alternations which are of the form:
1161 / (DUPE|DUPE) X? (?{ ... }) Y /x
1163 Thus EVAL blocks following a trie may be called a different number of times with
1164 and without the optimisation. With the optimisations dupes will be silently
1165 ignored. This inconsistent behaviour of EVAL type nodes is well established as
1166 the following demonstrates:
1168 'words'=~/(word|word|word)(?{ print $1 })[xyz]/
1170 which prints out 'word' three times, but
1172 'words'=~/(word|word|word)(?{ print $1 })S/
1174 which doesnt print it out at all. This is due to other optimisations kicking in.
1176 Example of what happens on a structural level:
1178 The regexp /(ac|ad|ab)+/ will produce the following debug output:
1180 1: CURLYM[1] {1,32767}(18)
1191 This would be optimizable with startbranch=5, first=5, last=16, tail=16
1192 and should turn into:
1194 1: CURLYM[1] {1,32767}(18)
1196 [Words:3 Chars Stored:6 Unique Chars:4 States:5 NCP:1]
1204 Cases where tail != last would be like /(?foo|bar)baz/:
1214 which would be optimizable with startbranch=1, first=1, last=7, tail=8
1215 and would end up looking like:
1218 [Words:2 Chars Stored:6 Unique Chars:5 States:7 NCP:1]
1225 d = uvuni_to_utf8_flags(d, uv, 0);
1227 is the recommended Unicode-aware way of saying
1232 #define TRIE_STORE_REVCHAR \
1235 SV *zlopp = newSV(2); \
1236 unsigned char *flrbbbbb = (unsigned char *) SvPVX(zlopp); \
1237 unsigned const char *const kapow = uvuni_to_utf8(flrbbbbb, uvc & 0xFF); \
1238 SvCUR_set(zlopp, kapow - flrbbbbb); \
1241 av_push(revcharmap, zlopp); \
1243 char ooooff = (char)uvc; \
1244 av_push(revcharmap, newSVpvn(&ooooff, 1)); \
1248 #define TRIE_READ_CHAR STMT_START { \
1252 if ( foldlen > 0 ) { \
1253 uvc = utf8n_to_uvuni( scan, UTF8_MAXLEN, &len, uniflags ); \
1258 uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
1259 uvc = to_uni_fold( uvc, foldbuf, &foldlen ); \
1260 foldlen -= UNISKIP( uvc ); \
1261 scan = foldbuf + UNISKIP( uvc ); \
1264 uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
1274 #define TRIE_LIST_PUSH(state,fid,ns) STMT_START { \
1275 if ( TRIE_LIST_CUR( state ) >=TRIE_LIST_LEN( state ) ) { \
1276 U32 ging = TRIE_LIST_LEN( state ) *= 2; \
1277 Renew( trie->states[ state ].trans.list, ging, reg_trie_trans_le ); \
1279 TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).forid = fid; \
1280 TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).newstate = ns; \
1281 TRIE_LIST_CUR( state )++; \
1284 #define TRIE_LIST_NEW(state) STMT_START { \
1285 Newxz( trie->states[ state ].trans.list, \
1286 4, reg_trie_trans_le ); \
1287 TRIE_LIST_CUR( state ) = 1; \
1288 TRIE_LIST_LEN( state ) = 4; \
1291 #define TRIE_HANDLE_WORD(state) STMT_START { \
1292 U16 dupe= trie->states[ state ].wordnum; \
1293 regnode * const noper_next = regnext( noper ); \
1296 /* store the word for dumping */ \
1298 if (OP(noper) != NOTHING) \
1299 tmp = newSVpvn_utf8(STRING(noper), STR_LEN(noper), UTF); \
1301 tmp = newSVpvn_utf8( "", 0, UTF ); \
1302 av_push( trie_words, tmp ); \
1306 trie->wordinfo[curword].prev = 0; \
1307 trie->wordinfo[curword].len = wordlen; \
1308 trie->wordinfo[curword].accept = state; \
1310 if ( noper_next < tail ) { \
1312 trie->jump = (U16 *) PerlMemShared_calloc( word_count + 1, sizeof(U16) ); \
1313 trie->jump[curword] = (U16)(noper_next - convert); \
1315 jumper = noper_next; \
1317 nextbranch= regnext(cur); \
1321 /* It's a dupe. Pre-insert into the wordinfo[].prev */\
1322 /* chain, so that when the bits of chain are later */\
1323 /* linked together, the dups appear in the chain */\
1324 trie->wordinfo[curword].prev = trie->wordinfo[dupe].prev; \
1325 trie->wordinfo[dupe].prev = curword; \
1327 /* we haven't inserted this word yet. */ \
1328 trie->states[ state ].wordnum = curword; \
1333 #define TRIE_TRANS_STATE(state,base,ucharcount,charid,special) \
1334 ( ( base + charid >= ucharcount \
1335 && base + charid < ubound \
1336 && state == trie->trans[ base - ucharcount + charid ].check \
1337 && trie->trans[ base - ucharcount + charid ].next ) \
1338 ? trie->trans[ base - ucharcount + charid ].next \
1339 : ( state==1 ? special : 0 ) \
1343 #define MADE_JUMP_TRIE 2
1344 #define MADE_EXACT_TRIE 4
1347 S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 word_count, U32 flags, U32 depth)
1350 /* first pass, loop through and scan words */
1351 reg_trie_data *trie;
1352 HV *widecharmap = NULL;
1353 AV *revcharmap = newAV();
1355 const U32 uniflags = UTF8_ALLOW_DEFAULT;
1360 regnode *jumper = NULL;
1361 regnode *nextbranch = NULL;
1362 regnode *convert = NULL;
1363 U32 *prev_states; /* temp array mapping each state to previous one */
1364 /* we just use folder as a flag in utf8 */
1365 const U8 * folder = NULL;
1368 const U32 data_slot = add_data( pRExC_state, 4, "tuuu" );
1369 AV *trie_words = NULL;
1370 /* along with revcharmap, this only used during construction but both are
1371 * useful during debugging so we store them in the struct when debugging.
1374 const U32 data_slot = add_data( pRExC_state, 2, "tu" );
1375 STRLEN trie_charcount=0;
1377 SV *re_trie_maxbuff;
1378 GET_RE_DEBUG_FLAGS_DECL;
1380 PERL_ARGS_ASSERT_MAKE_TRIE;
1382 PERL_UNUSED_ARG(depth);
1386 case EXACTFU: folder = PL_fold_latin1; break;
1387 case EXACTF: folder = PL_fold; break;
1388 case EXACTFL: folder = PL_fold_locale; break;
1391 trie = (reg_trie_data *) PerlMemShared_calloc( 1, sizeof(reg_trie_data) );
1393 trie->startstate = 1;
1394 trie->wordcount = word_count;
1395 RExC_rxi->data->data[ data_slot ] = (void*)trie;
1396 trie->charmap = (U16 *) PerlMemShared_calloc( 256, sizeof(U16) );
1397 if (!(UTF && folder))
1398 trie->bitmap = (char *) PerlMemShared_calloc( ANYOF_BITMAP_SIZE, 1 );
1399 trie->wordinfo = (reg_trie_wordinfo *) PerlMemShared_calloc(
1400 trie->wordcount+1, sizeof(reg_trie_wordinfo));
1403 trie_words = newAV();
1406 re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
1407 if (!SvIOK(re_trie_maxbuff)) {
1408 sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
1411 PerlIO_printf( Perl_debug_log,
1412 "%*smake_trie start==%d, first==%d, last==%d, tail==%d depth=%d\n",
1413 (int)depth * 2 + 2, "",
1414 REG_NODE_NUM(startbranch),REG_NODE_NUM(first),
1415 REG_NODE_NUM(last), REG_NODE_NUM(tail),
1419 /* Find the node we are going to overwrite */
1420 if ( first == startbranch && OP( last ) != BRANCH ) {
1421 /* whole branch chain */
1424 /* branch sub-chain */
1425 convert = NEXTOPER( first );
1428 /* -- First loop and Setup --
1430 We first traverse the branches and scan each word to determine if it
1431 contains widechars, and how many unique chars there are, this is
1432 important as we have to build a table with at least as many columns as we
1435 We use an array of integers to represent the character codes 0..255
1436 (trie->charmap) and we use a an HV* to store Unicode characters. We use the
1437 native representation of the character value as the key and IV's for the
1440 *TODO* If we keep track of how many times each character is used we can
1441 remap the columns so that the table compression later on is more
1442 efficient in terms of memory by ensuring the most common value is in the
1443 middle and the least common are on the outside. IMO this would be better
1444 than a most to least common mapping as theres a decent chance the most
1445 common letter will share a node with the least common, meaning the node
1446 will not be compressible. With a middle is most common approach the worst
1447 case is when we have the least common nodes twice.
1451 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1452 regnode * const noper = NEXTOPER( cur );
1453 const U8 *uc = (U8*)STRING( noper );
1454 const U8 * const e = uc + STR_LEN( noper );
1456 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1457 const U8 *scan = (U8*)NULL;
1458 U32 wordlen = 0; /* required init */
1460 bool set_bit = trie->bitmap ? 1 : 0; /*store the first char in the bitmap?*/
1462 if (OP(noper) == NOTHING) {
1466 if ( set_bit ) /* bitmap only alloced when !(UTF&&Folding) */
1467 TRIE_BITMAP_SET(trie,*uc); /* store the raw first byte
1468 regardless of encoding */
1470 for ( ; uc < e ; uc += len ) {
1471 TRIE_CHARCOUNT(trie)++;
1475 if ( !trie->charmap[ uvc ] ) {
1476 trie->charmap[ uvc ]=( ++trie->uniquecharcount );
1478 trie->charmap[ folder[ uvc ] ] = trie->charmap[ uvc ];
1482 /* store the codepoint in the bitmap, and its folded
1484 TRIE_BITMAP_SET(trie,uvc);
1486 /* store the folded codepoint */
1487 if ( folder ) TRIE_BITMAP_SET(trie,folder[ uvc ]);
1490 /* store first byte of utf8 representation of
1491 variant codepoints */
1492 if (! UNI_IS_INVARIANT(uvc)) {
1493 TRIE_BITMAP_SET(trie, UTF8_TWO_BYTE_HI(uvc));
1496 set_bit = 0; /* We've done our bit :-) */
1501 widecharmap = newHV();
1503 svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 1 );
1506 Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%"UVXf, uvc );
1508 if ( !SvTRUE( *svpp ) ) {
1509 sv_setiv( *svpp, ++trie->uniquecharcount );
1514 if( cur == first ) {
1517 } else if (chars < trie->minlen) {
1519 } else if (chars > trie->maxlen) {
1523 } /* end first pass */
1524 DEBUG_TRIE_COMPILE_r(
1525 PerlIO_printf( Perl_debug_log, "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
1526 (int)depth * 2 + 2,"",
1527 ( widecharmap ? "UTF8" : "NATIVE" ), (int)word_count,
1528 (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount,
1529 (int)trie->minlen, (int)trie->maxlen )
1533 We now know what we are dealing with in terms of unique chars and
1534 string sizes so we can calculate how much memory a naive
1535 representation using a flat table will take. If it's over a reasonable
1536 limit (as specified by ${^RE_TRIE_MAXBUF}) we use a more memory
1537 conservative but potentially much slower representation using an array
1540 At the end we convert both representations into the same compressed
1541 form that will be used in regexec.c for matching with. The latter
1542 is a form that cannot be used to construct with but has memory
1543 properties similar to the list form and access properties similar
1544 to the table form making it both suitable for fast searches and
1545 small enough that its feasable to store for the duration of a program.
1547 See the comment in the code where the compressed table is produced
1548 inplace from the flat tabe representation for an explanation of how
1549 the compression works.
1554 Newx(prev_states, TRIE_CHARCOUNT(trie) + 2, U32);
1557 if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1) > SvIV(re_trie_maxbuff) ) {
1559 Second Pass -- Array Of Lists Representation
1561 Each state will be represented by a list of charid:state records
1562 (reg_trie_trans_le) the first such element holds the CUR and LEN
1563 points of the allocated array. (See defines above).
1565 We build the initial structure using the lists, and then convert
1566 it into the compressed table form which allows faster lookups
1567 (but cant be modified once converted).
1570 STRLEN transcount = 1;
1572 DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
1573 "%*sCompiling trie using list compiler\n",
1574 (int)depth * 2 + 2, ""));
1576 trie->states = (reg_trie_state *)
1577 PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
1578 sizeof(reg_trie_state) );
1582 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1584 regnode * const noper = NEXTOPER( cur );
1585 U8 *uc = (U8*)STRING( noper );
1586 const U8 * const e = uc + STR_LEN( noper );
1587 U32 state = 1; /* required init */
1588 U16 charid = 0; /* sanity init */
1589 U8 *scan = (U8*)NULL; /* sanity init */
1590 STRLEN foldlen = 0; /* required init */
1591 U32 wordlen = 0; /* required init */
1592 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1594 if (OP(noper) != NOTHING) {
1595 for ( ; uc < e ; uc += len ) {
1600 charid = trie->charmap[ uvc ];
1602 SV** const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
1606 charid=(U16)SvIV( *svpp );
1609 /* charid is now 0 if we dont know the char read, or nonzero if we do */
1616 if ( !trie->states[ state ].trans.list ) {
1617 TRIE_LIST_NEW( state );
1619 for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) {
1620 if ( TRIE_LIST_ITEM( state, check ).forid == charid ) {
1621 newstate = TRIE_LIST_ITEM( state, check ).newstate;
1626 newstate = next_alloc++;
1627 prev_states[newstate] = state;
1628 TRIE_LIST_PUSH( state, charid, newstate );
1633 Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1637 TRIE_HANDLE_WORD(state);
1639 } /* end second pass */
1641 /* next alloc is the NEXT state to be allocated */
1642 trie->statecount = next_alloc;
1643 trie->states = (reg_trie_state *)
1644 PerlMemShared_realloc( trie->states,
1646 * sizeof(reg_trie_state) );
1648 /* and now dump it out before we compress it */
1649 DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_list(trie, widecharmap,
1650 revcharmap, next_alloc,
1654 trie->trans = (reg_trie_trans *)
1655 PerlMemShared_calloc( transcount, sizeof(reg_trie_trans) );
1662 for( state=1 ; state < next_alloc ; state ++ ) {
1666 DEBUG_TRIE_COMPILE_MORE_r(
1667 PerlIO_printf( Perl_debug_log, "tp: %d zp: %d ",tp,zp)
1671 if (trie->states[state].trans.list) {
1672 U16 minid=TRIE_LIST_ITEM( state, 1).forid;
1676 for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1677 const U16 forid = TRIE_LIST_ITEM( state, idx).forid;
1678 if ( forid < minid ) {
1680 } else if ( forid > maxid ) {
1684 if ( transcount < tp + maxid - minid + 1) {
1686 trie->trans = (reg_trie_trans *)
1687 PerlMemShared_realloc( trie->trans,
1689 * sizeof(reg_trie_trans) );
1690 Zero( trie->trans + (transcount / 2), transcount / 2 , reg_trie_trans );
1692 base = trie->uniquecharcount + tp - minid;
1693 if ( maxid == minid ) {
1695 for ( ; zp < tp ; zp++ ) {
1696 if ( ! trie->trans[ zp ].next ) {
1697 base = trie->uniquecharcount + zp - minid;
1698 trie->trans[ zp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1699 trie->trans[ zp ].check = state;
1705 trie->trans[ tp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1706 trie->trans[ tp ].check = state;
1711 for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
1712 const U32 tid = base - trie->uniquecharcount + TRIE_LIST_ITEM( state, idx ).forid;
1713 trie->trans[ tid ].next = TRIE_LIST_ITEM( state, idx ).newstate;
1714 trie->trans[ tid ].check = state;
1716 tp += ( maxid - minid + 1 );
1718 Safefree(trie->states[ state ].trans.list);
1721 DEBUG_TRIE_COMPILE_MORE_r(
1722 PerlIO_printf( Perl_debug_log, " base: %d\n",base);
1725 trie->states[ state ].trans.base=base;
1727 trie->lasttrans = tp + 1;
1731 Second Pass -- Flat Table Representation.
1733 we dont use the 0 slot of either trans[] or states[] so we add 1 to each.
1734 We know that we will need Charcount+1 trans at most to store the data
1735 (one row per char at worst case) So we preallocate both structures
1736 assuming worst case.
1738 We then construct the trie using only the .next slots of the entry
1741 We use the .check field of the first entry of the node temporarily to
1742 make compression both faster and easier by keeping track of how many non
1743 zero fields are in the node.
1745 Since trans are numbered from 1 any 0 pointer in the table is a FAIL
1748 There are two terms at use here: state as a TRIE_NODEIDX() which is a
1749 number representing the first entry of the node, and state as a
1750 TRIE_NODENUM() which is the trans number. state 1 is TRIE_NODEIDX(1) and
1751 TRIE_NODENUM(1), state 2 is TRIE_NODEIDX(2) and TRIE_NODENUM(3) if there
1752 are 2 entrys per node. eg:
1760 The table is internally in the right hand, idx form. However as we also
1761 have to deal with the states array which is indexed by nodenum we have to
1762 use TRIE_NODENUM() to convert.
1765 DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
1766 "%*sCompiling trie using table compiler\n",
1767 (int)depth * 2 + 2, ""));
1769 trie->trans = (reg_trie_trans *)
1770 PerlMemShared_calloc( ( TRIE_CHARCOUNT(trie) + 1 )
1771 * trie->uniquecharcount + 1,
1772 sizeof(reg_trie_trans) );
1773 trie->states = (reg_trie_state *)
1774 PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
1775 sizeof(reg_trie_state) );
1776 next_alloc = trie->uniquecharcount + 1;
1779 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1781 regnode * const noper = NEXTOPER( cur );
1782 const U8 *uc = (U8*)STRING( noper );
1783 const U8 * const e = uc + STR_LEN( noper );
1785 U32 state = 1; /* required init */
1787 U16 charid = 0; /* sanity init */
1788 U32 accept_state = 0; /* sanity init */
1789 U8 *scan = (U8*)NULL; /* sanity init */
1791 STRLEN foldlen = 0; /* required init */
1792 U32 wordlen = 0; /* required init */
1793 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1795 if ( OP(noper) != NOTHING ) {
1796 for ( ; uc < e ; uc += len ) {
1801 charid = trie->charmap[ uvc ];
1803 SV* const * const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
1804 charid = svpp ? (U16)SvIV(*svpp) : 0;
1808 if ( !trie->trans[ state + charid ].next ) {
1809 trie->trans[ state + charid ].next = next_alloc;
1810 trie->trans[ state ].check++;
1811 prev_states[TRIE_NODENUM(next_alloc)]
1812 = TRIE_NODENUM(state);
1813 next_alloc += trie->uniquecharcount;
1815 state = trie->trans[ state + charid ].next;
1817 Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
1819 /* charid is now 0 if we dont know the char read, or nonzero if we do */
1822 accept_state = TRIE_NODENUM( state );
1823 TRIE_HANDLE_WORD(accept_state);
1825 } /* end second pass */
1827 /* and now dump it out before we compress it */
1828 DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_table(trie, widecharmap,
1830 next_alloc, depth+1));
1834 * Inplace compress the table.*
1836 For sparse data sets the table constructed by the trie algorithm will
1837 be mostly 0/FAIL transitions or to put it another way mostly empty.
1838 (Note that leaf nodes will not contain any transitions.)
1840 This algorithm compresses the tables by eliminating most such
1841 transitions, at the cost of a modest bit of extra work during lookup:
1843 - Each states[] entry contains a .base field which indicates the
1844 index in the state[] array wheres its transition data is stored.
1846 - If .base is 0 there are no valid transitions from that node.
1848 - If .base is nonzero then charid is added to it to find an entry in
1851 -If trans[states[state].base+charid].check!=state then the
1852 transition is taken to be a 0/Fail transition. Thus if there are fail
1853 transitions at the front of the node then the .base offset will point
1854 somewhere inside the previous nodes data (or maybe even into a node
1855 even earlier), but the .check field determines if the transition is
1859 The following process inplace converts the table to the compressed
1860 table: We first do not compress the root node 1,and mark all its
1861 .check pointers as 1 and set its .base pointer as 1 as well. This
1862 allows us to do a DFA construction from the compressed table later,
1863 and ensures that any .base pointers we calculate later are greater
1866 - We set 'pos' to indicate the first entry of the second node.
1868 - We then iterate over the columns of the node, finding the first and
1869 last used entry at l and m. We then copy l..m into pos..(pos+m-l),
1870 and set the .check pointers accordingly, and advance pos
1871 appropriately and repreat for the next node. Note that when we copy
1872 the next pointers we have to convert them from the original
1873 NODEIDX form to NODENUM form as the former is not valid post
1876 - If a node has no transitions used we mark its base as 0 and do not
1877 advance the pos pointer.
1879 - If a node only has one transition we use a second pointer into the
1880 structure to fill in allocated fail transitions from other states.
1881 This pointer is independent of the main pointer and scans forward
1882 looking for null transitions that are allocated to a state. When it
1883 finds one it writes the single transition into the "hole". If the
1884 pointer doesnt find one the single transition is appended as normal.
1886 - Once compressed we can Renew/realloc the structures to release the
1889 See "Table-Compression Methods" in sec 3.9 of the Red Dragon,
1890 specifically Fig 3.47 and the associated pseudocode.
1894 const U32 laststate = TRIE_NODENUM( next_alloc );
1897 trie->statecount = laststate;
1899 for ( state = 1 ; state < laststate ; state++ ) {
1901 const U32 stateidx = TRIE_NODEIDX( state );
1902 const U32 o_used = trie->trans[ stateidx ].check;
1903 U32 used = trie->trans[ stateidx ].check;
1904 trie->trans[ stateidx ].check = 0;
1906 for ( charid = 0 ; used && charid < trie->uniquecharcount ; charid++ ) {
1907 if ( flag || trie->trans[ stateidx + charid ].next ) {
1908 if ( trie->trans[ stateidx + charid ].next ) {
1910 for ( ; zp < pos ; zp++ ) {
1911 if ( ! trie->trans[ zp ].next ) {
1915 trie->states[ state ].trans.base = zp + trie->uniquecharcount - charid ;
1916 trie->trans[ zp ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1917 trie->trans[ zp ].check = state;
1918 if ( ++zp > pos ) pos = zp;
1925 trie->states[ state ].trans.base = pos + trie->uniquecharcount - charid ;
1927 trie->trans[ pos ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1928 trie->trans[ pos ].check = state;
1933 trie->lasttrans = pos + 1;
1934 trie->states = (reg_trie_state *)
1935 PerlMemShared_realloc( trie->states, laststate
1936 * sizeof(reg_trie_state) );
1937 DEBUG_TRIE_COMPILE_MORE_r(
1938 PerlIO_printf( Perl_debug_log,
1939 "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
1940 (int)depth * 2 + 2,"",
1941 (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1 ),
1944 ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
1947 } /* end table compress */
1949 DEBUG_TRIE_COMPILE_MORE_r(
1950 PerlIO_printf(Perl_debug_log, "%*sStatecount:%"UVxf" Lasttrans:%"UVxf"\n",
1951 (int)depth * 2 + 2, "",
1952 (UV)trie->statecount,
1953 (UV)trie->lasttrans)
1955 /* resize the trans array to remove unused space */
1956 trie->trans = (reg_trie_trans *)
1957 PerlMemShared_realloc( trie->trans, trie->lasttrans
1958 * sizeof(reg_trie_trans) );
1960 { /* Modify the program and insert the new TRIE node */
1961 U8 nodetype =(U8)(flags & 0xFF);
1965 regnode *optimize = NULL;
1966 #ifdef RE_TRACK_PATTERN_OFFSETS
1969 U32 mjd_nodelen = 0;
1970 #endif /* RE_TRACK_PATTERN_OFFSETS */
1971 #endif /* DEBUGGING */
1973 This means we convert either the first branch or the first Exact,
1974 depending on whether the thing following (in 'last') is a branch
1975 or not and whther first is the startbranch (ie is it a sub part of
1976 the alternation or is it the whole thing.)
1977 Assuming its a sub part we convert the EXACT otherwise we convert
1978 the whole branch sequence, including the first.
1980 /* Find the node we are going to overwrite */
1981 if ( first != startbranch || OP( last ) == BRANCH ) {
1982 /* branch sub-chain */
1983 NEXT_OFF( first ) = (U16)(last - first);
1984 #ifdef RE_TRACK_PATTERN_OFFSETS
1986 mjd_offset= Node_Offset((convert));
1987 mjd_nodelen= Node_Length((convert));
1990 /* whole branch chain */
1992 #ifdef RE_TRACK_PATTERN_OFFSETS
1995 const regnode *nop = NEXTOPER( convert );
1996 mjd_offset= Node_Offset((nop));
1997 mjd_nodelen= Node_Length((nop));
2001 PerlIO_printf(Perl_debug_log, "%*sMJD offset:%"UVuf" MJD length:%"UVuf"\n",
2002 (int)depth * 2 + 2, "",
2003 (UV)mjd_offset, (UV)mjd_nodelen)
2006 /* But first we check to see if there is a common prefix we can
2007 split out as an EXACT and put in front of the TRIE node. */
2008 trie->startstate= 1;
2009 if ( trie->bitmap && !widecharmap && !trie->jump ) {
2011 for ( state = 1 ; state < trie->statecount-1 ; state++ ) {
2015 const U32 base = trie->states[ state ].trans.base;
2017 if ( trie->states[state].wordnum )
2020 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
2021 if ( ( base + ofs >= trie->uniquecharcount ) &&
2022 ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
2023 trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
2025 if ( ++count > 1 ) {
2026 SV **tmp = av_fetch( revcharmap, ofs, 0);
2027 const U8 *ch = (U8*)SvPV_nolen_const( *tmp );
2028 if ( state == 1 ) break;
2030 Zero(trie->bitmap, ANYOF_BITMAP_SIZE, char);
2032 PerlIO_printf(Perl_debug_log,
2033 "%*sNew Start State=%"UVuf" Class: [",
2034 (int)depth * 2 + 2, "",
2037 SV ** const tmp = av_fetch( revcharmap, idx, 0);
2038 const U8 * const ch = (U8*)SvPV_nolen_const( *tmp );
2040 TRIE_BITMAP_SET(trie,*ch);
2042 TRIE_BITMAP_SET(trie, folder[ *ch ]);
2044 PerlIO_printf(Perl_debug_log, "%s", (char*)ch)
2048 TRIE_BITMAP_SET(trie,*ch);
2050 TRIE_BITMAP_SET(trie,folder[ *ch ]);
2051 DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"%s", ch));
2057 SV **tmp = av_fetch( revcharmap, idx, 0);
2059 char *ch = SvPV( *tmp, len );
2061 SV *sv=sv_newmortal();
2062 PerlIO_printf( Perl_debug_log,
2063 "%*sPrefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
2064 (int)depth * 2 + 2, "",
2066 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6,
2067 PL_colors[0], PL_colors[1],
2068 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
2069 PERL_PV_ESCAPE_FIRSTCHAR
2074 OP( convert ) = nodetype;
2075 str=STRING(convert);
2078 STR_LEN(convert) += len;
2084 DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"]\n"));
2089 trie->prefixlen = (state-1);
2091 regnode *n = convert+NODE_SZ_STR(convert);
2092 NEXT_OFF(convert) = NODE_SZ_STR(convert);
2093 trie->startstate = state;
2094 trie->minlen -= (state - 1);
2095 trie->maxlen -= (state - 1);
2097 /* At least the UNICOS C compiler choked on this
2098 * being argument to DEBUG_r(), so let's just have
2101 #ifdef PERL_EXT_RE_BUILD
2107 regnode *fix = convert;
2108 U32 word = trie->wordcount;
2110 Set_Node_Offset_Length(convert, mjd_offset, state - 1);
2111 while( ++fix < n ) {
2112 Set_Node_Offset_Length(fix, 0, 0);
2115 SV ** const tmp = av_fetch( trie_words, word, 0 );
2117 if ( STR_LEN(convert) <= SvCUR(*tmp) )
2118 sv_chop(*tmp, SvPV_nolen(*tmp) + STR_LEN(convert));
2120 sv_chop(*tmp, SvPV_nolen(*tmp) + SvCUR(*tmp));
2128 NEXT_OFF(convert) = (U16)(tail - convert);
2129 DEBUG_r(optimize= n);
2135 if ( trie->maxlen ) {
2136 NEXT_OFF( convert ) = (U16)(tail - convert);
2137 ARG_SET( convert, data_slot );
2138 /* Store the offset to the first unabsorbed branch in
2139 jump[0], which is otherwise unused by the jump logic.
2140 We use this when dumping a trie and during optimisation. */
2142 trie->jump[0] = (U16)(nextbranch - convert);
2144 /* If the start state is not accepting (meaning there is no empty string/NOTHING)
2145 * and there is a bitmap
2146 * and the first "jump target" node we found leaves enough room
2147 * then convert the TRIE node into a TRIEC node, with the bitmap
2148 * embedded inline in the opcode - this is hypothetically faster.
2150 if ( !trie->states[trie->startstate].wordnum
2152 && ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) )
2154 OP( convert ) = TRIEC;
2155 Copy(trie->bitmap, ((struct regnode_charclass *)convert)->bitmap, ANYOF_BITMAP_SIZE, char);
2156 PerlMemShared_free(trie->bitmap);
2159 OP( convert ) = TRIE;
2161 /* store the type in the flags */
2162 convert->flags = nodetype;
2166 + regarglen[ OP( convert ) ];
2168 /* XXX We really should free up the resource in trie now,
2169 as we won't use them - (which resources?) dmq */
2171 /* needed for dumping*/
2172 DEBUG_r(if (optimize) {
2173 regnode *opt = convert;
2175 while ( ++opt < optimize) {
2176 Set_Node_Offset_Length(opt,0,0);
2179 Try to clean up some of the debris left after the
2182 while( optimize < jumper ) {
2183 mjd_nodelen += Node_Length((optimize));
2184 OP( optimize ) = OPTIMIZED;
2185 Set_Node_Offset_Length(optimize,0,0);
2188 Set_Node_Offset_Length(convert,mjd_offset,mjd_nodelen);
2190 } /* end node insert */
2192 /* Finish populating the prev field of the wordinfo array. Walk back
2193 * from each accept state until we find another accept state, and if
2194 * so, point the first word's .prev field at the second word. If the
2195 * second already has a .prev field set, stop now. This will be the
2196 * case either if we've already processed that word's accept state,
2197 * or that state had multiple words, and the overspill words were
2198 * already linked up earlier.
2205 for (word=1; word <= trie->wordcount; word++) {
2207 if (trie->wordinfo[word].prev)
2209 state = trie->wordinfo[word].accept;
2211 state = prev_states[state];
2214 prev = trie->states[state].wordnum;
2218 trie->wordinfo[word].prev = prev;
2220 Safefree(prev_states);
2224 /* and now dump out the compressed format */
2225 DEBUG_TRIE_COMPILE_r(dump_trie(trie, widecharmap, revcharmap, depth+1));
2227 RExC_rxi->data->data[ data_slot + 1 ] = (void*)widecharmap;
2229 RExC_rxi->data->data[ data_slot + TRIE_WORDS_OFFSET ] = (void*)trie_words;
2230 RExC_rxi->data->data[ data_slot + 3 ] = (void*)revcharmap;
2232 SvREFCNT_dec(revcharmap);
2236 : trie->startstate>1
2242 S_make_trie_failtable(pTHX_ RExC_state_t *pRExC_state, regnode *source, regnode *stclass, U32 depth)
2244 /* The Trie is constructed and compressed now so we can build a fail array if it's needed
2246 This is basically the Aho-Corasick algorithm. Its from exercise 3.31 and 3.32 in the
2247 "Red Dragon" -- Compilers, principles, techniques, and tools. Aho, Sethi, Ullman 1985/88
2250 We find the fail state for each state in the trie, this state is the longest proper
2251 suffix of the current state's 'word' that is also a proper prefix of another word in our
2252 trie. State 1 represents the word '' and is thus the default fail state. This allows
2253 the DFA not to have to restart after its tried and failed a word at a given point, it
2254 simply continues as though it had been matching the other word in the first place.
2256 'abcdgu'=~/abcdefg|cdgu/
2257 When we get to 'd' we are still matching the first word, we would encounter 'g' which would
2258 fail, which would bring us to the state representing 'd' in the second word where we would
2259 try 'g' and succeed, proceeding to match 'cdgu'.
2261 /* add a fail transition */
2262 const U32 trie_offset = ARG(source);
2263 reg_trie_data *trie=(reg_trie_data *)RExC_rxi->data->data[trie_offset];
2265 const U32 ucharcount = trie->uniquecharcount;
2266 const U32 numstates = trie->statecount;
2267 const U32 ubound = trie->lasttrans + ucharcount;
2271 U32 base = trie->states[ 1 ].trans.base;
2274 const U32 data_slot = add_data( pRExC_state, 1, "T" );
2275 GET_RE_DEBUG_FLAGS_DECL;
2277 PERL_ARGS_ASSERT_MAKE_TRIE_FAILTABLE;
2279 PERL_UNUSED_ARG(depth);
2283 ARG_SET( stclass, data_slot );
2284 aho = (reg_ac_data *) PerlMemShared_calloc( 1, sizeof(reg_ac_data) );
2285 RExC_rxi->data->data[ data_slot ] = (void*)aho;
2286 aho->trie=trie_offset;
2287 aho->states=(reg_trie_state *)PerlMemShared_malloc( numstates * sizeof(reg_trie_state) );
2288 Copy( trie->states, aho->states, numstates, reg_trie_state );
2289 Newxz( q, numstates, U32);
2290 aho->fail = (U32 *) PerlMemShared_calloc( numstates, sizeof(U32) );
2293 /* initialize fail[0..1] to be 1 so that we always have
2294 a valid final fail state */
2295 fail[ 0 ] = fail[ 1 ] = 1;
2297 for ( charid = 0; charid < ucharcount ; charid++ ) {
2298 const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 );
2300 q[ q_write ] = newstate;
2301 /* set to point at the root */
2302 fail[ q[ q_write++ ] ]=1;
2305 while ( q_read < q_write) {
2306 const U32 cur = q[ q_read++ % numstates ];
2307 base = trie->states[ cur ].trans.base;
2309 for ( charid = 0 ; charid < ucharcount ; charid++ ) {
2310 const U32 ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 );
2312 U32 fail_state = cur;
2315 fail_state = fail[ fail_state ];
2316 fail_base = aho->states[ fail_state ].trans.base;
2317 } while ( !TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 ) );
2319 fail_state = TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 );
2320 fail[ ch_state ] = fail_state;
2321 if ( !aho->states[ ch_state ].wordnum && aho->states[ fail_state ].wordnum )
2323 aho->states[ ch_state ].wordnum = aho->states[ fail_state ].wordnum;
2325 q[ q_write++ % numstates] = ch_state;
2329 /* restore fail[0..1] to 0 so that we "fall out" of the AC loop
2330 when we fail in state 1, this allows us to use the
2331 charclass scan to find a valid start char. This is based on the principle
2332 that theres a good chance the string being searched contains lots of stuff
2333 that cant be a start char.
2335 fail[ 0 ] = fail[ 1 ] = 0;
2336 DEBUG_TRIE_COMPILE_r({
2337 PerlIO_printf(Perl_debug_log,
2338 "%*sStclass Failtable (%"UVuf" states): 0",
2339 (int)(depth * 2), "", (UV)numstates
2341 for( q_read=1; q_read<numstates; q_read++ ) {
2342 PerlIO_printf(Perl_debug_log, ", %"UVuf, (UV)fail[q_read]);
2344 PerlIO_printf(Perl_debug_log, "\n");
2347 /*RExC_seen |= REG_SEEN_TRIEDFA;*/
2352 * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2.
2353 * These need to be revisited when a newer toolchain becomes available.
2355 #if defined(__sparc64__) && defined(__GNUC__)
2356 # if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
2357 # undef SPARC64_GCC_WORKAROUND
2358 # define SPARC64_GCC_WORKAROUND 1
2362 #define DEBUG_PEEP(str,scan,depth) \
2363 DEBUG_OPTIMISE_r({if (scan){ \
2364 SV * const mysv=sv_newmortal(); \
2365 regnode *Next = regnext(scan); \
2366 regprop(RExC_rx, mysv, scan); \
2367 PerlIO_printf(Perl_debug_log, "%*s" str ">%3d: %s (%d)\n", \
2368 (int)depth*2, "", REG_NODE_NUM(scan), SvPV_nolen_const(mysv),\
2369 Next ? (REG_NODE_NUM(Next)) : 0 ); \
2376 #define JOIN_EXACT(scan,min,flags) \
2377 if (PL_regkind[OP(scan)] == EXACT) \
2378 join_exact(pRExC_state,(scan),(min),(flags),NULL,depth+1)
2381 S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, I32 *min, U32 flags,regnode *val, U32 depth) {
2382 /* Merge several consecutive EXACTish nodes into one. */
2383 regnode *n = regnext(scan);
2385 regnode *next = scan + NODE_SZ_STR(scan);
2389 regnode *stop = scan;
2390 GET_RE_DEBUG_FLAGS_DECL;
2392 PERL_UNUSED_ARG(depth);
2395 PERL_ARGS_ASSERT_JOIN_EXACT;
2396 #ifndef EXPERIMENTAL_INPLACESCAN
2397 PERL_UNUSED_ARG(flags);
2398 PERL_UNUSED_ARG(val);
2400 DEBUG_PEEP("join",scan,depth);
2402 /* Skip NOTHING, merge EXACT*. */
2404 ( PL_regkind[OP(n)] == NOTHING ||
2405 (stringok && (OP(n) == OP(scan))))
2407 && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
2409 if (OP(n) == TAIL || n > next)
2411 if (PL_regkind[OP(n)] == NOTHING) {
2412 DEBUG_PEEP("skip:",n,depth);
2413 NEXT_OFF(scan) += NEXT_OFF(n);
2414 next = n + NODE_STEP_REGNODE;
2421 else if (stringok) {
2422 const unsigned int oldl = STR_LEN(scan);
2423 regnode * const nnext = regnext(n);
2425 DEBUG_PEEP("merg",n,depth);
2428 if (oldl + STR_LEN(n) > U8_MAX)
2430 NEXT_OFF(scan) += NEXT_OFF(n);
2431 STR_LEN(scan) += STR_LEN(n);
2432 next = n + NODE_SZ_STR(n);
2433 /* Now we can overwrite *n : */
2434 Move(STRING(n), STRING(scan) + oldl, STR_LEN(n), char);
2442 #ifdef EXPERIMENTAL_INPLACESCAN
2443 if (flags && !NEXT_OFF(n)) {
2444 DEBUG_PEEP("atch", val, depth);
2445 if (reg_off_by_arg[OP(n)]) {
2446 ARG_SET(n, val - n);
2449 NEXT_OFF(n) = val - n;
2455 #define GREEK_SMALL_LETTER_IOTA_WITH_DIALYTIKA_AND_TONOS 0x0390
2456 #define IOTA_D_T GREEK_SMALL_LETTER_IOTA_WITH_DIALYTIKA_AND_TONOS
2457 #define GREEK_SMALL_LETTER_UPSILON_WITH_DIALYTIKA_AND_TONOS 0x03B0
2458 #define UPSILON_D_T GREEK_SMALL_LETTER_UPSILON_WITH_DIALYTIKA_AND_TONOS
2461 && ( OP(scan) == EXACTF || OP(scan) == EXACTFU)
2462 && ( STR_LEN(scan) >= 6 ) )
2465 Two problematic code points in Unicode casefolding of EXACT nodes:
2467 U+0390 - GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
2468 U+03B0 - GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
2474 U+03B9 U+0308 U+0301 0xCE 0xB9 0xCC 0x88 0xCC 0x81
2475 U+03C5 U+0308 U+0301 0xCF 0x85 0xCC 0x88 0xCC 0x81
2477 This means that in case-insensitive matching (or "loose matching",
2478 as Unicode calls it), an EXACTF of length six (the UTF-8 encoded byte
2479 length of the above casefolded versions) can match a target string
2480 of length two (the byte length of UTF-8 encoded U+0390 or U+03B0).
2481 This would rather mess up the minimum length computation.
2483 What we'll do is to look for the tail four bytes, and then peek
2484 at the preceding two bytes to see whether we need to decrease
2485 the minimum length by four (six minus two).
2487 Thanks to the design of UTF-8, there cannot be false matches:
2488 A sequence of valid UTF-8 bytes cannot be a subsequence of
2489 another valid sequence of UTF-8 bytes.
2492 char * const s0 = STRING(scan), *s, *t;
2493 char * const s1 = s0 + STR_LEN(scan) - 1;
2494 char * const s2 = s1 - 4;
2495 #ifdef EBCDIC /* RD tunifold greek 0390 and 03B0 */
2496 const char t0[] = "\xaf\x49\xaf\x42";
2498 const char t0[] = "\xcc\x88\xcc\x81";
2500 const char * const t1 = t0 + 3;
2503 s < s2 && (t = ninstr(s, s1, t0, t1));
2506 if (((U8)t[-1] == 0x68 && (U8)t[-2] == 0xB4) ||
2507 ((U8)t[-1] == 0x46 && (U8)t[-2] == 0xB5))
2509 if (((U8)t[-1] == 0xB9 && (U8)t[-2] == 0xCE) ||
2510 ((U8)t[-1] == 0x85 && (U8)t[-2] == 0xCF))
2518 n = scan + NODE_SZ_STR(scan);
2520 if (PL_regkind[OP(n)] != NOTHING || OP(n) == NOTHING) {
2527 DEBUG_OPTIMISE_r(if (merged){DEBUG_PEEP("finl",scan,depth)});
2531 /* REx optimizer. Converts nodes into quicker variants "in place".
2532 Finds fixed substrings. */
2534 /* Stops at toplevel WHILEM as well as at "last". At end *scanp is set
2535 to the position after last scanned or to NULL. */
2537 #define INIT_AND_WITHP \
2538 assert(!and_withp); \
2539 Newx(and_withp,1,struct regnode_charclass_class); \
2540 SAVEFREEPV(and_withp)
2542 /* this is a chain of data about sub patterns we are processing that
2543 need to be handled separately/specially in study_chunk. Its so
2544 we can simulate recursion without losing state. */
2546 typedef struct scan_frame {
2547 regnode *last; /* last node to process in this frame */
2548 regnode *next; /* next node to process when last is reached */
2549 struct scan_frame *prev; /*previous frame*/
2550 I32 stop; /* what stopparen do we use */
2554 #define SCAN_COMMIT(s, data, m) scan_commit(s, data, m, is_inf)
2556 #define CASE_SYNST_FNC(nAmE) \
2558 if (flags & SCF_DO_STCLASS_AND) { \
2559 for (value = 0; value < 256; value++) \
2560 if (!is_ ## nAmE ## _cp(value)) \
2561 ANYOF_BITMAP_CLEAR(data->start_class, value); \
2564 for (value = 0; value < 256; value++) \
2565 if (is_ ## nAmE ## _cp(value)) \
2566 ANYOF_BITMAP_SET(data->start_class, value); \
2570 if (flags & SCF_DO_STCLASS_AND) { \
2571 for (value = 0; value < 256; value++) \
2572 if (is_ ## nAmE ## _cp(value)) \
2573 ANYOF_BITMAP_CLEAR(data->start_class, value); \
2576 for (value = 0; value < 256; value++) \
2577 if (!is_ ## nAmE ## _cp(value)) \
2578 ANYOF_BITMAP_SET(data->start_class, value); \
2585 S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
2586 I32 *minlenp, I32 *deltap,
2591 struct regnode_charclass_class *and_withp,
2592 U32 flags, U32 depth)
2593 /* scanp: Start here (read-write). */
2594 /* deltap: Write maxlen-minlen here. */
2595 /* last: Stop before this one. */
2596 /* data: string data about the pattern */
2597 /* stopparen: treat close N as END */
2598 /* recursed: which subroutines have we recursed into */
2599 /* and_withp: Valid if flags & SCF_DO_STCLASS_OR */
2602 I32 min = 0, pars = 0, code;
2603 regnode *scan = *scanp, *next;
2605 int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
2606 int is_inf_internal = 0; /* The studied chunk is infinite */
2607 I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
2608 scan_data_t data_fake;
2609 SV *re_trie_maxbuff = NULL;
2610 regnode *first_non_open = scan;
2611 I32 stopmin = I32_MAX;
2612 scan_frame *frame = NULL;
2613 GET_RE_DEBUG_FLAGS_DECL;
2615 PERL_ARGS_ASSERT_STUDY_CHUNK;
2618 StructCopy(&zero_scan_data, &data_fake, scan_data_t);
2622 while (first_non_open && OP(first_non_open) == OPEN)
2623 first_non_open=regnext(first_non_open);
2628 while ( scan && OP(scan) != END && scan < last ){
2629 /* Peephole optimizer: */
2630 DEBUG_STUDYDATA("Peep:", data,depth);
2631 DEBUG_PEEP("Peep",scan,depth);
2632 JOIN_EXACT(scan,&min,0);
2634 /* Follow the next-chain of the current node and optimize
2635 away all the NOTHINGs from it. */
2636 if (OP(scan) != CURLYX) {
2637 const int max = (reg_off_by_arg[OP(scan)]
2639 /* I32 may be smaller than U16 on CRAYs! */
2640 : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
2641 int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
2645 /* Skip NOTHING and LONGJMP. */
2646 while ((n = regnext(n))
2647 && ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
2648 || ((OP(n) == LONGJMP) && (noff = ARG(n))))
2649 && off + noff < max)
2651 if (reg_off_by_arg[OP(scan)])
2654 NEXT_OFF(scan) = off;
2659 /* The principal pseudo-switch. Cannot be a switch, since we
2660 look into several different things. */
2661 if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
2662 || OP(scan) == IFTHEN) {
2663 next = regnext(scan);
2665 /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
2667 if (OP(next) == code || code == IFTHEN) {
2668 /* NOTE - There is similar code to this block below for handling
2669 TRIE nodes on a re-study. If you change stuff here check there
2671 I32 max1 = 0, min1 = I32_MAX, num = 0;
2672 struct regnode_charclass_class accum;
2673 regnode * const startbranch=scan;
2675 if (flags & SCF_DO_SUBSTR)
2676 SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot merge strings after this. */
2677 if (flags & SCF_DO_STCLASS)
2678 cl_init_zero(pRExC_state, &accum);
2680 while (OP(scan) == code) {
2681 I32 deltanext, minnext, f = 0, fake;
2682 struct regnode_charclass_class this_class;
2685 data_fake.flags = 0;
2687 data_fake.whilem_c = data->whilem_c;
2688 data_fake.last_closep = data->last_closep;
2691 data_fake.last_closep = &fake;
2693 data_fake.pos_delta = delta;
2694 next = regnext(scan);
2695 scan = NEXTOPER(scan);
2697 scan = NEXTOPER(scan);
2698 if (flags & SCF_DO_STCLASS) {
2699 cl_init(pRExC_state, &this_class);
2700 data_fake.start_class = &this_class;
2701 f = SCF_DO_STCLASS_AND;
2703 if (flags & SCF_WHILEM_VISITED_POS)
2704 f |= SCF_WHILEM_VISITED_POS;
2706 /* we suppose the run is continuous, last=next...*/
2707 minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
2709 stopparen, recursed, NULL, f,depth+1);
2712 if (max1 < minnext + deltanext)
2713 max1 = minnext + deltanext;
2714 if (deltanext == I32_MAX)
2715 is_inf = is_inf_internal = 1;
2717 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
2719 if (data_fake.flags & SCF_SEEN_ACCEPT) {
2720 if ( stopmin > minnext)
2721 stopmin = min + min1;
2722 flags &= ~SCF_DO_SUBSTR;
2724 data->flags |= SCF_SEEN_ACCEPT;
2727 if (data_fake.flags & SF_HAS_EVAL)
2728 data->flags |= SF_HAS_EVAL;
2729 data->whilem_c = data_fake.whilem_c;
2731 if (flags & SCF_DO_STCLASS)
2732 cl_or(pRExC_state, &accum, &this_class);
2734 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
2736 if (flags & SCF_DO_SUBSTR) {
2737 data->pos_min += min1;
2738 data->pos_delta += max1 - min1;
2739 if (max1 != min1 || is_inf)
2740 data->longest = &(data->longest_float);
2743 delta += max1 - min1;
2744 if (flags & SCF_DO_STCLASS_OR) {
2745 cl_or(pRExC_state, data->start_class, &accum);
2747 cl_and(data->start_class, and_withp);
2748 flags &= ~SCF_DO_STCLASS;
2751 else if (flags & SCF_DO_STCLASS_AND) {
2753 cl_and(data->start_class, &accum);
2754 flags &= ~SCF_DO_STCLASS;
2757 /* Switch to OR mode: cache the old value of
2758 * data->start_class */
2760 StructCopy(data->start_class, and_withp,
2761 struct regnode_charclass_class);
2762 flags &= ~SCF_DO_STCLASS_AND;
2763 StructCopy(&accum, data->start_class,
2764 struct regnode_charclass_class);
2765 flags |= SCF_DO_STCLASS_OR;
2766 data->start_class->flags |= ANYOF_EOS;
2770 if (PERL_ENABLE_TRIE_OPTIMISATION && OP( startbranch ) == BRANCH ) {
2773 Assuming this was/is a branch we are dealing with: 'scan' now
2774 points at the item that follows the branch sequence, whatever
2775 it is. We now start at the beginning of the sequence and look
2782 which would be constructed from a pattern like /A|LIST|OF|WORDS/
2784 If we can find such a subsequence we need to turn the first
2785 element into a trie and then add the subsequent branch exact
2786 strings to the trie.
2790 1. patterns where the whole set of branches can be converted.
2792 2. patterns where only a subset can be converted.
2794 In case 1 we can replace the whole set with a single regop
2795 for the trie. In case 2 we need to keep the start and end
2798 'BRANCH EXACT; BRANCH EXACT; BRANCH X'
2799 becomes BRANCH TRIE; BRANCH X;
2801 There is an additional case, that being where there is a
2802 common prefix, which gets split out into an EXACT like node
2803 preceding the TRIE node.
2805 If x(1..n)==tail then we can do a simple trie, if not we make
2806 a "jump" trie, such that when we match the appropriate word
2807 we "jump" to the appropriate tail node. Essentially we turn
2808 a nested if into a case structure of sorts.
2813 if (!re_trie_maxbuff) {
2814 re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
2815 if (!SvIOK(re_trie_maxbuff))
2816 sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
2818 if ( SvIV(re_trie_maxbuff)>=0 ) {
2820 regnode *first = (regnode *)NULL;
2821 regnode *last = (regnode *)NULL;
2822 regnode *tail = scan;
2827 SV * const mysv = sv_newmortal(); /* for dumping */
2829 /* var tail is used because there may be a TAIL
2830 regop in the way. Ie, the exacts will point to the
2831 thing following the TAIL, but the last branch will
2832 point at the TAIL. So we advance tail. If we
2833 have nested (?:) we may have to move through several
2837 while ( OP( tail ) == TAIL ) {
2838 /* this is the TAIL generated by (?:) */
2839 tail = regnext( tail );
2844 regprop(RExC_rx, mysv, tail );
2845 PerlIO_printf( Perl_debug_log, "%*s%s%s\n",
2846 (int)depth * 2 + 2, "",
2847 "Looking for TRIE'able sequences. Tail node is: ",
2848 SvPV_nolen_const( mysv )
2854 step through the branches, cur represents each
2855 branch, noper is the first thing to be matched
2856 as part of that branch and noper_next is the
2857 regnext() of that node. if noper is an EXACT
2858 and noper_next is the same as scan (our current
2859 position in the regex) then the EXACT branch is
2860 a possible optimization target. Once we have
2861 two or more consecutive such branches we can
2862 create a trie of the EXACT's contents and stich
2863 it in place. If the sequence represents all of
2864 the branches we eliminate the whole thing and
2865 replace it with a single TRIE. If it is a
2866 subsequence then we need to stitch it in. This
2867 means the first branch has to remain, and needs
2868 to be repointed at the item on the branch chain
2869 following the last branch optimized. This could
2870 be either a BRANCH, in which case the
2871 subsequence is internal, or it could be the
2872 item following the branch sequence in which
2873 case the subsequence is at the end.
2877 /* dont use tail as the end marker for this traverse */
2878 for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) {
2879 regnode * const noper = NEXTOPER( cur );
2880 #if defined(DEBUGGING) || defined(NOJUMPTRIE)
2881 regnode * const noper_next = regnext( noper );
2885 regprop(RExC_rx, mysv, cur);
2886 PerlIO_printf( Perl_debug_log, "%*s- %s (%d)",
2887 (int)depth * 2 + 2,"", SvPV_nolen_const( mysv ), REG_NODE_NUM(cur) );
2889 regprop(RExC_rx, mysv, noper);
2890 PerlIO_printf( Perl_debug_log, " -> %s",
2891 SvPV_nolen_const(mysv));
2894 regprop(RExC_rx, mysv, noper_next );
2895 PerlIO_printf( Perl_debug_log,"\t=> %s\t",
2896 SvPV_nolen_const(mysv));
2898 PerlIO_printf( Perl_debug_log, "(First==%d,Last==%d,Cur==%d)\n",
2899 REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur) );
2901 if ( (((first && optype!=NOTHING) ? OP( noper ) == optype
2902 : PL_regkind[ OP( noper ) ] == EXACT )
2903 || OP(noper) == NOTHING )
2905 && noper_next == tail
2910 if ( !first || optype == NOTHING ) {
2911 if (!first) first = cur;
2912 optype = OP( noper );
2918 Currently we do not believe that the trie logic can
2919 handle case insensitive matching properly when the
2920 pattern is not unicode (thus forcing unicode semantics).
2922 If/when this is fixed the following define can be swapped
2923 in below to fully enable trie logic.
2925 #define TRIE_TYPE_IS_SAFE 1
2928 #define TRIE_TYPE_IS_SAFE (UTF || optype==EXACT)
2930 if ( last && TRIE_TYPE_IS_SAFE ) {
2931 make_trie( pRExC_state,
2932 startbranch, first, cur, tail, count,
2935 if ( PL_regkind[ OP( noper ) ] == EXACT
2937 && noper_next == tail
2942 optype = OP( noper );
2952 regprop(RExC_rx, mysv, cur);
2953 PerlIO_printf( Perl_debug_log,
2954 "%*s- %s (%d) <SCAN FINISHED>\n", (int)depth * 2 + 2,
2955 "", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
2959 if ( last && TRIE_TYPE_IS_SAFE ) {
2960 made= make_trie( pRExC_state, startbranch, first, scan, tail, count, optype, depth+1 );
2961 #ifdef TRIE_STUDY_OPT
2962 if ( ((made == MADE_EXACT_TRIE &&
2963 startbranch == first)
2964 || ( first_non_open == first )) &&
2966 flags |= SCF_TRIE_RESTUDY;
2967 if ( startbranch == first
2970 RExC_seen &=~REG_TOP_LEVEL_BRANCHES;
2980 else if ( code == BRANCHJ ) { /* single branch is optimized. */
2981 scan = NEXTOPER(NEXTOPER(scan));
2982 } else /* single branch is optimized. */
2983 scan = NEXTOPER(scan);
2985 } else if (OP(scan) == SUSPEND || OP(scan) == GOSUB || OP(scan) == GOSTART) {
2986 scan_frame *newframe = NULL;
2991 if (OP(scan) != SUSPEND) {
2992 /* set the pointer */
2993 if (OP(scan) == GOSUB) {
2995 RExC_recurse[ARG2L(scan)] = scan;
2996 start = RExC_open_parens[paren-1];
2997 end = RExC_close_parens[paren-1];
3000 start = RExC_rxi->program + 1;
3004 Newxz(recursed, (((RExC_npar)>>3) +1), U8);
3005 SAVEFREEPV(recursed);
3007 if (!PAREN_TEST(recursed,paren+1)) {
3008 PAREN_SET(recursed,paren+1);
3009 Newx(newframe,1,scan_frame);
3011 if (flags & SCF_DO_SUBSTR) {
3012 SCAN_COMMIT(pRExC_state,data,minlenp);
3013 data->longest = &(data->longest_float);
3015 is_inf = is_inf_internal = 1;
3016 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3017 cl_anything(pRExC_state, data->start_class);
3018 flags &= ~SCF_DO_STCLASS;
3021 Newx(newframe,1,scan_frame);
3024 end = regnext(scan);
3029 SAVEFREEPV(newframe);
3030 newframe->next = regnext(scan);
3031 newframe->last = last;
3032 newframe->stop = stopparen;
3033 newframe->prev = frame;
3043 else if (OP(scan) == EXACT) {
3044 I32 l = STR_LEN(scan);
3047 const U8 * const s = (U8*)STRING(scan);
3048 l = utf8_length(s, s + l);
3049 uc = utf8_to_uvchr(s, NULL);
3051 uc = *((U8*)STRING(scan));
3054 if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
3055 /* The code below prefers earlier match for fixed
3056 offset, later match for variable offset. */
3057 if (data->last_end == -1) { /* Update the start info. */
3058 data->last_start_min = data->pos_min;
3059 data->last_start_max = is_inf
3060 ? I32_MAX : data->pos_min + data->pos_delta;
3062 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
3064 SvUTF8_on(data->last_found);
3066 SV * const sv = data->last_found;
3067 MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
3068 mg_find(sv, PERL_MAGIC_utf8) : NULL;
3069 if (mg && mg->mg_len >= 0)
3070 mg->mg_len += utf8_length((U8*)STRING(scan),
3071 (U8*)STRING(scan)+STR_LEN(scan));
3073 data->last_end = data->pos_min + l;
3074 data->pos_min += l; /* As in the first entry. */
3075 data->flags &= ~SF_BEFORE_EOL;
3077 if (flags & SCF_DO_STCLASS_AND) {
3078 /* Check whether it is compatible with what we know already! */
3082 /* If compatible, we or it in below. It is compatible if is
3083 * in the bitmp and either 1) its bit or its fold is set, or 2)
3084 * it's for a locale. Even if there isn't unicode semantics
3085 * here, at runtime there may be because of matching against a
3086 * utf8 string, so accept a possible false positive for
3087 * latin1-range folds */
3089 (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
3090 && !ANYOF_BITMAP_TEST(data->start_class, uc)
3091 && (!(data->start_class->flags & ANYOF_LOC_NONBITMAP_FOLD)
3092 || !ANYOF_BITMAP_TEST(data->start_class, PL_fold_latin1[uc])))
3095 ANYOF_CLASS_ZERO(data->start_class);
3096 ANYOF_BITMAP_ZERO(data->start_class);
3098 ANYOF_BITMAP_SET(data->start_class, uc);
3099 data->start_class->flags &= ~ANYOF_EOS;
3101 data->start_class->flags &= ~ANYOF_UNICODE_ALL;
3103 else if (flags & SCF_DO_STCLASS_OR) {
3104 /* false positive possible if the class is case-folded */
3106 ANYOF_BITMAP_SET(data->start_class, uc);
3108 data->start_class->flags |= ANYOF_UNICODE_ALL;
3109 data->start_class->flags &= ~ANYOF_EOS;
3110 cl_and(data->start_class, and_withp);
3112 flags &= ~SCF_DO_STCLASS;
3114 else if (PL_regkind[OP(scan)] == EXACT) { /* But OP != EXACT! */
3115 I32 l = STR_LEN(scan);
3116 UV uc = *((U8*)STRING(scan));
3118 /* Search for fixed substrings supports EXACT only. */
3119 if (flags & SCF_DO_SUBSTR) {
3121 SCAN_COMMIT(pRExC_state, data, minlenp);
3124 const U8 * const s = (U8 *)STRING(scan);
3125 l = utf8_length(s, s + l);
3126 uc = utf8_to_uvchr(s, NULL);
3129 if (flags & SCF_DO_SUBSTR)
3131 if (flags & SCF_DO_STCLASS_AND) {
3132 /* Check whether it is compatible with what we know already! */
3135 (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
3136 && !ANYOF_BITMAP_TEST(data->start_class, uc)
3137 && !ANYOF_BITMAP_TEST(data->start_class, PL_fold_latin1[uc])))
3141 ANYOF_CLASS_ZERO(data->start_class);
3142 ANYOF_BITMAP_ZERO(data->start_class);
3144 ANYOF_BITMAP_SET(data->start_class, uc);
3145 data->start_class->flags &= ~ANYOF_EOS;
3146 data->start_class->flags |= ANYOF_LOC_NONBITMAP_FOLD;
3147 if (OP(scan) == EXACTFL) {
3148 data->start_class->flags |= ANYOF_LOCALE;
3152 /* Also set the other member of the fold pair. In case
3153 * that unicode semantics is called for at runtime, use
3154 * the full latin1 fold. (Can't do this for locale,
3155 * because not known until runtime */
3156 ANYOF_BITMAP_SET(data->start_class, PL_fold_latin1[uc]);
3160 else if (flags & SCF_DO_STCLASS_OR) {
3161 if (data->start_class->flags & ANYOF_LOC_NONBITMAP_FOLD) {
3162 /* false positive possible if the class is case-folded.
3163 Assume that the locale settings are the same... */
3165 ANYOF_BITMAP_SET(data->start_class, uc);
3166 if (OP(scan) != EXACTFL) {
3168 /* And set the other member of the fold pair, but
3169 * can't do that in locale because not known until
3171 ANYOF_BITMAP_SET(data->start_class,
3172 PL_fold_latin1[uc]);
3175 data->start_class->flags &= ~ANYOF_EOS;
3177 cl_and(data->start_class, and_withp);
3179 flags &= ~SCF_DO_STCLASS;
3181 else if (REGNODE_VARIES(OP(scan))) {
3182 I32 mincount, maxcount, minnext, deltanext, fl = 0;
3183 I32 f = flags, pos_before = 0;
3184 regnode * const oscan = scan;
3185 struct regnode_charclass_class this_class;
3186 struct regnode_charclass_class *oclass = NULL;
3187 I32 next_is_eval = 0;
3189 switch (PL_regkind[OP(scan)]) {
3190 case WHILEM: /* End of (?:...)* . */
3191 scan = NEXTOPER(scan);
3194 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
3195 next = NEXTOPER(scan);
3196 if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
3198 maxcount = REG_INFTY;
3199 next = regnext(scan);
3200 scan = NEXTOPER(scan);
3204 if (flags & SCF_DO_SUBSTR)
3209 if (flags & SCF_DO_STCLASS) {
3211 maxcount = REG_INFTY;
3212 next = regnext(scan);
3213 scan = NEXTOPER(scan);
3216 is_inf = is_inf_internal = 1;
3217 scan = regnext(scan);
3218 if (flags & SCF_DO_SUBSTR) {
3219 SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot extend fixed substrings */
3220 data->longest = &(data->longest_float);
3222 goto optimize_curly_tail;
3224 if (stopparen>0 && (OP(scan)==CURLYN || OP(scan)==CURLYM)
3225 && (scan->flags == stopparen))
3230 mincount = ARG1(scan);
3231 maxcount = ARG2(scan);
3233 next = regnext(scan);
3234 if (OP(scan) == CURLYX) {
3235 I32 lp = (data ? *(data->last_closep) : 0);
3236 scan->flags = ((lp <= (I32)U8_MAX) ? (U8)lp : U8_MAX);
3238 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3239 next_is_eval = (OP(scan) == EVAL);
3241 if (flags & SCF_DO_SUBSTR) {
3242 if (mincount == 0) SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot extend fixed substrings */
3243 pos_before = data->pos_min;
3247 data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
3249 data->flags |= SF_IS_INF;
3251 if (flags & SCF_DO_STCLASS) {
3252 cl_init(pRExC_state, &this_class);
3253 oclass = data->start_class;
3254 data->start_class = &this_class;
3255 f |= SCF_DO_STCLASS_AND;
3256 f &= ~SCF_DO_STCLASS_OR;
3258 /* Exclude from super-linear cache processing any {n,m}
3259 regops for which the combination of input pos and regex
3260 pos is not enough information to determine if a match
3263 For example, in the regex /foo(bar\s*){4,8}baz/ with the
3264 regex pos at the \s*, the prospects for a match depend not
3265 only on the input position but also on how many (bar\s*)
3266 repeats into the {4,8} we are. */
3267 if ((mincount > 1) || (maxcount > 1 && maxcount != REG_INFTY))
3268 f &= ~SCF_WHILEM_VISITED_POS;
3270 /* This will finish on WHILEM, setting scan, or on NULL: */
3271 minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
3272 last, data, stopparen, recursed, NULL,
3274 ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
3276 if (flags & SCF_DO_STCLASS)
3277 data->start_class = oclass;
3278 if (mincount == 0 || minnext == 0) {
3279 if (flags & SCF_DO_STCLASS_OR) {
3280 cl_or(pRExC_state, data->start_class, &this_class);
3282 else if (flags & SCF_DO_STCLASS_AND) {
3283 /* Switch to OR mode: cache the old value of
3284 * data->start_class */
3286 StructCopy(data->start_class, and_withp,
3287 struct regnode_charclass_class);
3288 flags &= ~SCF_DO_STCLASS_AND;
3289 StructCopy(&this_class, data->start_class,
3290 struct regnode_charclass_class);
3291 flags |= SCF_DO_STCLASS_OR;
3292 data->start_class->flags |= ANYOF_EOS;
3294 } else { /* Non-zero len */
3295 if (flags & SCF_DO_STCLASS_OR) {
3296 cl_or(pRExC_state, data->start_class, &this_class);
3297 cl_and(data->start_class, and_withp);
3299 else if (flags & SCF_DO_STCLASS_AND)
3300 cl_and(data->start_class, &this_class);
3301 flags &= ~SCF_DO_STCLASS;
3303 if (!scan) /* It was not CURLYX, but CURLY. */
3305 if ( /* ? quantifier ok, except for (?{ ... }) */
3306 (next_is_eval || !(mincount == 0 && maxcount == 1))
3307 && (minnext == 0) && (deltanext == 0)
3308 && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
3309 && maxcount <= REG_INFTY/3) /* Complement check for big count */
3311 ckWARNreg(RExC_parse,
3312 "Quantifier unexpected on zero-length expression");
3315 min += minnext * mincount;
3316 is_inf_internal |= ((maxcount == REG_INFTY
3317 && (minnext + deltanext) > 0)
3318 || deltanext == I32_MAX);
3319 is_inf |= is_inf_internal;
3320 delta += (minnext + deltanext) * maxcount - minnext * mincount;
3322 /* Try powerful optimization CURLYX => CURLYN. */
3323 if ( OP(oscan) == CURLYX && data
3324 && data->flags & SF_IN_PAR
3325 && !(data->flags & SF_HAS_EVAL)
3326 && !deltanext && minnext == 1 ) {
3327 /* Try to optimize to CURLYN. */
3328 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
3329 regnode * const nxt1 = nxt;
3336 if (!REGNODE_SIMPLE(OP(nxt))
3337 && !(PL_regkind[OP(nxt)] == EXACT
3338 && STR_LEN(nxt) == 1))
3344 if (OP(nxt) != CLOSE)
3346 if (RExC_open_parens) {
3347 RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
3348 RExC_close_parens[ARG(nxt1)-1]=nxt+2; /*close->while*/
3350 /* Now we know that nxt2 is the only contents: */
3351 oscan->flags = (U8)ARG(nxt);
3353 OP(nxt1) = NOTHING; /* was OPEN. */
3356 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
3357 NEXT_OFF(nxt1+ 1) = 0; /* just for consistency. */
3358 NEXT_OFF(nxt2) = 0; /* just for consistency with CURLY. */
3359 OP(nxt) = OPTIMIZED; /* was CLOSE. */
3360 OP(nxt + 1) = OPTIMIZED; /* was count. */
3361 NEXT_OFF(nxt+ 1) = 0; /* just for consistency. */
3366 /* Try optimization CURLYX => CURLYM. */
3367 if ( OP(oscan) == CURLYX && data
3368 && !(data->flags & SF_HAS_PAR)
3369 && !(data->flags & SF_HAS_EVAL)
3370 && !deltanext /* atom is fixed width */
3371 && minnext != 0 /* CURLYM can't handle zero width */
3373 /* XXXX How to optimize if data == 0? */
3374 /* Optimize to a simpler form. */
3375 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
3379 while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
3380 && (OP(nxt2) != WHILEM))
3382 OP(nxt2) = SUCCEED; /* Whas WHILEM */
3383 /* Need to optimize away parenths. */
3384 if ((data->flags & SF_IN_PAR) && OP(nxt) == CLOSE) {
3385 /* Set the parenth number. */
3386 regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
3388 oscan->flags = (U8)ARG(nxt);
3389 if (RExC_open_parens) {
3390 RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
3391 RExC_close_parens[ARG(nxt1)-1]=nxt2+1; /*close->NOTHING*/
3393 OP(nxt1) = OPTIMIZED; /* was OPEN. */
3394 OP(nxt) = OPTIMIZED; /* was CLOSE. */
3397 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
3398 OP(nxt + 1) = OPTIMIZED; /* was count. */
3399 NEXT_OFF(nxt1 + 1) = 0; /* just for consistency. */
3400 NEXT_OFF(nxt + 1) = 0; /* just for consistency. */
3403 while ( nxt1 && (OP(nxt1) != WHILEM)) {
3404 regnode *nnxt = regnext(nxt1);
3406 if (reg_off_by_arg[OP(nxt1)])
3407 ARG_SET(nxt1, nxt2 - nxt1);
3408 else if (nxt2 - nxt1 < U16_MAX)
3409 NEXT_OFF(nxt1) = nxt2 - nxt1;
3411 OP(nxt) = NOTHING; /* Cannot beautify */
3416 /* Optimize again: */
3417 study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt,
3418 NULL, stopparen, recursed, NULL, 0,depth+1);
3423 else if ((OP(oscan) == CURLYX)
3424 && (flags & SCF_WHILEM_VISITED_POS)
3425 /* See the comment on a similar expression above.
3426 However, this time it's not a subexpression
3427 we care about, but the expression itself. */
3428 && (maxcount == REG_INFTY)
3429 && data && ++data->whilem_c < 16) {
3430 /* This stays as CURLYX, we can put the count/of pair. */
3431 /* Find WHILEM (as in regexec.c) */
3432 regnode *nxt = oscan + NEXT_OFF(oscan);
3434 if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
3436 PREVOPER(nxt)->flags = (U8)(data->whilem_c
3437 | (RExC_whilem_seen << 4)); /* On WHILEM */
3439 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
3441 if (flags & SCF_DO_SUBSTR) {
3442 SV *last_str = NULL;
3443 int counted = mincount != 0;
3445 if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
3446 #if defined(SPARC64_GCC_WORKAROUND)
3449 const char *s = NULL;
3452 if (pos_before >= data->last_start_min)
3455 b = data->last_start_min;
3458 s = SvPV_const(data->last_found, l);
3459 old = b - data->last_start_min;
3462 I32 b = pos_before >= data->last_start_min
3463 ? pos_before : data->last_start_min;
3465 const char * const s = SvPV_const(data->last_found, l);
3466 I32 old = b - data->last_start_min;
3470 old = utf8_hop((U8*)s, old) - (U8*)s;
3472 /* Get the added string: */
3473 last_str = newSVpvn_utf8(s + old, l, UTF);
3474 if (deltanext == 0 && pos_before == b) {
3475 /* What was added is a constant string */
3477 SvGROW(last_str, (mincount * l) + 1);
3478 repeatcpy(SvPVX(last_str) + l,
3479 SvPVX_const(last_str), l, mincount - 1);
3480 SvCUR_set(last_str, SvCUR(last_str) * mincount);
3481 /* Add additional parts. */
3482 SvCUR_set(data->last_found,
3483 SvCUR(data->last_found) - l);
3484 sv_catsv(data->last_found, last_str);
3486 SV * sv = data->last_found;
3488 SvUTF8(sv) && SvMAGICAL(sv) ?
3489 mg_find(sv, PERL_MAGIC_utf8) : NULL;
3490 if (mg && mg->mg_len >= 0)
3491 mg->mg_len += CHR_SVLEN(last_str) - l;
3493 data->last_end += l * (mincount - 1);
3496 /* start offset must point into the last copy */
3497 data->last_start_min += minnext * (mincount - 1);
3498 data->last_start_max += is_inf ? I32_MAX
3499 : (maxcount - 1) * (minnext + data->pos_delta);
3502 /* It is counted once already... */
3503 data->pos_min += minnext * (mincount - counted);
3504 data->pos_delta += - counted * deltanext +
3505 (minnext + deltanext) * maxcount - minnext * mincount;
3506 if (mincount != maxcount) {
3507 /* Cannot extend fixed substrings found inside
3509 SCAN_COMMIT(pRExC_state,data,minlenp);
3510 if (mincount && last_str) {
3511 SV * const sv = data->last_found;
3512 MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
3513 mg_find(sv, PERL_MAGIC_utf8) : NULL;
3517 sv_setsv(sv, last_str);
3518 data->last_end = data->pos_min;
3519 data->last_start_min =
3520 data->pos_min - CHR_SVLEN(last_str);
3521 data->last_start_max = is_inf
3523 : data->pos_min + data->pos_delta
3524 - CHR_SVLEN(last_str);
3526 data->longest = &(data->longest_float);
3528 SvREFCNT_dec(last_str);
3530 if (data && (fl & SF_HAS_EVAL))
3531 data->flags |= SF_HAS_EVAL;
3532 optimize_curly_tail:
3533 if (OP(oscan) != CURLYX) {
3534 while (PL_regkind[OP(next = regnext(oscan))] == NOTHING
3536 NEXT_OFF(oscan) += NEXT_OFF(next);
3539 default: /* REF, ANYOFV, and CLUMP only? */
3540 if (flags & SCF_DO_SUBSTR) {
3541 SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot expect anything... */
3542 data->longest = &(data->longest_float);
3544 is_inf = is_inf_internal = 1;
3545 if (flags & SCF_DO_STCLASS_OR)
3546 cl_anything(pRExC_state, data->start_class);
3547 flags &= ~SCF_DO_STCLASS;
3551 else if (OP(scan) == LNBREAK) {
3552 if (flags & SCF_DO_STCLASS) {
3554 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
3555 if (flags & SCF_DO_STCLASS_AND) {
3556 for (value = 0; value < 256; value++)
3557 if (!is_VERTWS_cp(value))
3558 ANYOF_BITMAP_CLEAR(data->start_class, value);
3561 for (value = 0; value < 256; value++)
3562 if (is_VERTWS_cp(value))
3563 ANYOF_BITMAP_SET(data->start_class, value);
3565 if (flags & SCF_DO_STCLASS_OR)
3566 cl_and(data->start_class, and_withp);
3567 flags &= ~SCF_DO_STCLASS;
3571 if (flags & SCF_DO_SUBSTR) {
3572 SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot expect anything... */
3574 data->pos_delta += 1;
3575 data->longest = &(data->longest_float);
3578 else if (OP(scan) == FOLDCHAR) {
3579 int d = ARG(scan) == LATIN_SMALL_LETTER_SHARP_S ? 1 : 2;
3580 flags &= ~SCF_DO_STCLASS;
3583 if (flags & SCF_DO_SUBSTR) {
3584 SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot expect anything... */
3586 data->pos_delta += d;
3587 data->longest = &(data->longest_float);
3590 else if (REGNODE_SIMPLE(OP(scan))) {
3593 if (flags & SCF_DO_SUBSTR) {
3594 SCAN_COMMIT(pRExC_state,data,minlenp);
3598 if (flags & SCF_DO_STCLASS) {
3599 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
3601 /* Some of the logic below assumes that switching
3602 locale on will only add false positives. */
3603 switch (PL_regkind[OP(scan)]) {
3607 /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
3608 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3609 cl_anything(pRExC_state, data->start_class);
3612 if (OP(scan) == SANY)
3614 if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
3615 value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
3616 || ANYOF_CLASS_TEST_ANY_SET(data->start_class));
3617 cl_anything(pRExC_state, data->start_class);
3619 if (flags & SCF_DO_STCLASS_AND || !value)
3620 ANYOF_BITMAP_CLEAR(data->start_class,'\n');
3623 if (flags & SCF_DO_STCLASS_AND)
3624 cl_and(data->start_class,
3625 (struct regnode_charclass_class*)scan);
3627 cl_or(pRExC_state, data->start_class,
3628 (struct regnode_charclass_class*)scan);
3631 if (flags & SCF_DO_STCLASS_AND) {
3632 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3633 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
3634 if (FLAGS(scan) & USE_UNI) {
3635 for (value = 0; value < 256; value++) {
3636 if (!isWORDCHAR_L1(value)) {
3637 ANYOF_BITMAP_CLEAR(data->start_class, value);
3641 for (value = 0; value < 256; value++) {
3642 if (!isALNUM(value)) {
3643 ANYOF_BITMAP_CLEAR(data->start_class, value);
3650 if (data->start_class->flags & ANYOF_LOCALE)
3651 ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
3652 else if (FLAGS(scan) & USE_UNI) {
3653 for (value = 0; value < 256; value++) {
3654 if (isWORDCHAR_L1(value)) {
3655 ANYOF_BITMAP_SET(data->start_class, value);
3659 for (value = 0; value < 256; value++) {
3660 if (isALNUM(value)) {
3661 ANYOF_BITMAP_SET(data->start_class, value);
3668 if (flags & SCF_DO_STCLASS_AND) {
3669 if (data->start_class->flags & ANYOF_LOCALE)
3670 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
3673 ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
3674 data->start_class->flags |= ANYOF_LOCALE;
3678 if (flags & SCF_DO_STCLASS_AND) {
3679 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3680 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
3681 if (FLAGS(scan) & USE_UNI) {
3682 for (value = 0; value < 256; value++) {
3683 if (isWORDCHAR_L1(value)) {
3684 ANYOF_BITMAP_CLEAR(data->start_class, value);
3688 for (value = 0; value < 256; value++) {
3689 if (isALNUM(value)) {
3690 ANYOF_BITMAP_CLEAR(data->start_class, value);
3697 if (data->start_class->flags & ANYOF_LOCALE)
3698 ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
3700 for (value = 0; value < 256; value++)
3701 if (!isALNUM(value))
3702 ANYOF_BITMAP_SET(data->start_class, value);
3707 if (flags & SCF_DO_STCLASS_AND) {
3708 if (data->start_class->flags & ANYOF_LOCALE)
3709 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
3712 data->start_class->flags |= ANYOF_LOCALE;
3713 ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
3717 if (flags & SCF_DO_STCLASS_AND) {
3718 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3719 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
3720 if (FLAGS(scan) & USE_UNI) {
3721 for (value = 0; value < 256; value++) {
3722 if (!isSPACE_L1(value)) {
3723 ANYOF_BITMAP_CLEAR(data->start_class, value);
3727 for (value = 0; value < 256; value++) {
3728 if (!isSPACE(value)) {
3729 ANYOF_BITMAP_CLEAR(data->start_class, value);
3736 if (data->start_class->flags & ANYOF_LOCALE) {
3737 ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
3739 else if (FLAGS(scan) & USE_UNI) {
3740 for (value = 0; value < 256; value++) {
3741 if (isSPACE_L1(value)) {
3742 ANYOF_BITMAP_SET(data->start_class, value);
3746 for (value = 0; value < 256; value++) {
3747 if (isSPACE(value)) {
3748 ANYOF_BITMAP_SET(data->start_class, value);
3755 if (flags & SCF_DO_STCLASS_AND) {
3756 if (data->start_class->flags & ANYOF_LOCALE)
3757 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
3760 data->start_class->flags |= ANYOF_LOCALE;
3761 ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
3765 if (flags & SCF_DO_STCLASS_AND) {
3766 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3767 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3768 if (FLAGS(scan) & USE_UNI) {
3769 for (value = 0; value < 256; value++) {
3770 if (isSPACE_L1(value)) {
3771 ANYOF_BITMAP_CLEAR(data->start_class, value);
3775 for (value = 0; value < 256; value++) {
3776 if (isSPACE(value)) {
3777 ANYOF_BITMAP_CLEAR(data->start_class, value);
3784 if (data->start_class->flags & ANYOF_LOCALE)
3785 ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3786 else if (FLAGS(scan) & USE_UNI) {
3787 for (value = 0; value < 256; value++) {
3788 if (!isSPACE_L1(value)) {
3789 ANYOF_BITMAP_SET(data->start_class, value);
3794 for (value = 0; value < 256; value++) {
3795 if (!isSPACE(value)) {
3796 ANYOF_BITMAP_SET(data->start_class, value);
3803 if (flags & SCF_DO_STCLASS_AND) {
3804 if (data->start_class->flags & ANYOF_LOCALE) {
3805 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3806 for (value = 0; value < 256; value++)
3807 if (!isSPACE(value))
3808 ANYOF_BITMAP_CLEAR(data->start_class, value);
3812 data->start_class->flags |= ANYOF_LOCALE;
3813 ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3817 if (flags & SCF_DO_STCLASS_AND) {
3818 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
3819 for (value = 0; value < 256; value++)
3820 if (!isDIGIT(value))
https://perl5.git.perl.org / perl5.git / blob