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