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