This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PATCH: Add =encoding directive to non-latin READMEs
[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)
e2e6a0f1 159#define RExC_nestroot (pRExC_state->nestroot)
830247a4
IZ
160#define RExC_extralen (pRExC_state->extralen)
161#define RExC_seen_zerolen (pRExC_state->seen_zerolen)
162#define RExC_seen_evals (pRExC_state->seen_evals)
1aa99e6b 163#define RExC_utf8 (pRExC_state->utf8)
fc8cd66c 164#define RExC_charnames (pRExC_state->charnames)
40d049e4
YO
165#define RExC_open_parens (pRExC_state->open_parens)
166#define RExC_close_parens (pRExC_state->close_parens)
167#define RExC_opend (pRExC_state->opend)
81714fb9 168#define RExC_paren_names (pRExC_state->paren_names)
40d049e4
YO
169#define RExC_recurse (pRExC_state->recurse)
170#define RExC_recurse_count (pRExC_state->recurse_count)
830247a4 171
a687059c
LW
172#define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?')
173#define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
174 ((*s) == '{' && regcurly(s)))
a687059c 175
35c8bce7
LW
176#ifdef SPSTART
177#undef SPSTART /* dratted cpp namespace... */
178#endif
a687059c
LW
179/*
180 * Flags to be passed up and down.
181 */
a687059c 182#define WORST 0 /* Worst case. */
821b33a5 183#define HASWIDTH 0x1 /* Known to match non-null strings. */
a0d0e21e
LW
184#define SIMPLE 0x2 /* Simple enough to be STAR/PLUS operand. */
185#define SPSTART 0x4 /* Starts with * or +. */
186#define TRYAGAIN 0x8 /* Weeded out a declaration. */
a687059c 187
3dab1dad
YO
188#define REG_NODE_NUM(x) ((x) ? (int)((x)-RExC_emit_start) : -1)
189
07be1b83
YO
190/* whether trie related optimizations are enabled */
191#if PERL_ENABLE_EXTENDED_TRIE_OPTIMISATION
192#define TRIE_STUDY_OPT
786e8c11 193#define FULL_TRIE_STUDY
07be1b83
YO
194#define TRIE_STCLASS
195#endif
1de06328
YO
196
197
40d049e4
YO
198
199#define PBYTE(u8str,paren) ((U8*)(u8str))[(paren) >> 3]
200#define PBITVAL(paren) (1 << ((paren) & 7))
201#define PAREN_TEST(u8str,paren) ( PBYTE(u8str,paren) & PBITVAL(paren))
202#define PAREN_SET(u8str,paren) PBYTE(u8str,paren) |= PBITVAL(paren)
203#define PAREN_UNSET(u8str,paren) PBYTE(u8str,paren) &= (~PBITVAL(paren))
204
205
1de06328
YO
206/* About scan_data_t.
207
208 During optimisation we recurse through the regexp program performing
209 various inplace (keyhole style) optimisations. In addition study_chunk
210 and scan_commit populate this data structure with information about
211 what strings MUST appear in the pattern. We look for the longest
212 string that must appear for at a fixed location, and we look for the
213 longest string that may appear at a floating location. So for instance
214 in the pattern:
215
216 /FOO[xX]A.*B[xX]BAR/
217
218 Both 'FOO' and 'A' are fixed strings. Both 'B' and 'BAR' are floating
219 strings (because they follow a .* construct). study_chunk will identify
220 both FOO and BAR as being the longest fixed and floating strings respectively.
221
222 The strings can be composites, for instance
223
224 /(f)(o)(o)/
225
226 will result in a composite fixed substring 'foo'.
227
228 For each string some basic information is maintained:
229
230 - offset or min_offset
231 This is the position the string must appear at, or not before.
232 It also implicitly (when combined with minlenp) tells us how many
233 character must match before the string we are searching.
234 Likewise when combined with minlenp and the length of the string
235 tells us how many characters must appear after the string we have
236 found.
237
238 - max_offset
239 Only used for floating strings. This is the rightmost point that
240 the string can appear at. Ifset to I32 max it indicates that the
241 string can occur infinitely far to the right.
242
243 - minlenp
244 A pointer to the minimum length of the pattern that the string
245 was found inside. This is important as in the case of positive
246 lookahead or positive lookbehind we can have multiple patterns
247 involved. Consider
248
249 /(?=FOO).*F/
250
251 The minimum length of the pattern overall is 3, the minimum length
252 of the lookahead part is 3, but the minimum length of the part that
253 will actually match is 1. So 'FOO's minimum length is 3, but the
254 minimum length for the F is 1. This is important as the minimum length
255 is used to determine offsets in front of and behind the string being
256 looked for. Since strings can be composites this is the length of the
257 pattern at the time it was commited with a scan_commit. Note that
258 the length is calculated by study_chunk, so that the minimum lengths
259 are not known until the full pattern has been compiled, thus the
260 pointer to the value.
261
262 - lookbehind
263
264 In the case of lookbehind the string being searched for can be
265 offset past the start point of the final matching string.
266 If this value was just blithely removed from the min_offset it would
267 invalidate some of the calculations for how many chars must match
268 before or after (as they are derived from min_offset and minlen and
269 the length of the string being searched for).
270 When the final pattern is compiled and the data is moved from the
271 scan_data_t structure into the regexp structure the information
272 about lookbehind is factored in, with the information that would
273 have been lost precalculated in the end_shift field for the
274 associated string.
275
276 The fields pos_min and pos_delta are used to store the minimum offset
277 and the delta to the maximum offset at the current point in the pattern.
278
279*/
2c2d71f5
JH
280
281typedef struct scan_data_t {
1de06328
YO
282 /*I32 len_min; unused */
283 /*I32 len_delta; unused */
2c2d71f5
JH
284 I32 pos_min;
285 I32 pos_delta;
286 SV *last_found;
1de06328 287 I32 last_end; /* min value, <0 unless valid. */
2c2d71f5
JH
288 I32 last_start_min;
289 I32 last_start_max;
1de06328
YO
290 SV **longest; /* Either &l_fixed, or &l_float. */
291 SV *longest_fixed; /* longest fixed string found in pattern */
292 I32 offset_fixed; /* offset where it starts */
293 I32 *minlen_fixed; /* pointer to the minlen relevent to the string */
294 I32 lookbehind_fixed; /* is the position of the string modfied by LB */
295 SV *longest_float; /* longest floating string found in pattern */
296 I32 offset_float_min; /* earliest point in string it can appear */
297 I32 offset_float_max; /* latest point in string it can appear */
298 I32 *minlen_float; /* pointer to the minlen relevent to the string */
299 I32 lookbehind_float; /* is the position of the string modified by LB */
2c2d71f5
JH
300 I32 flags;
301 I32 whilem_c;
cb434fcc 302 I32 *last_closep;
653099ff 303 struct regnode_charclass_class *start_class;
2c2d71f5
JH
304} scan_data_t;
305
a687059c 306/*
e50aee73 307 * Forward declarations for pregcomp()'s friends.
a687059c 308 */
a0d0e21e 309
27da23d5 310static const scan_data_t zero_scan_data =
1de06328 311 { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ,0};
c277df42
IZ
312
313#define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
07be1b83
YO
314#define SF_BEFORE_SEOL 0x0001
315#define SF_BEFORE_MEOL 0x0002
c277df42
IZ
316#define SF_FIX_BEFORE_EOL (SF_FIX_BEFORE_SEOL|SF_FIX_BEFORE_MEOL)
317#define SF_FL_BEFORE_EOL (SF_FL_BEFORE_SEOL|SF_FL_BEFORE_MEOL)
318
09b7f37c
CB
319#ifdef NO_UNARY_PLUS
320# define SF_FIX_SHIFT_EOL (0+2)
321# define SF_FL_SHIFT_EOL (0+4)
322#else
323# define SF_FIX_SHIFT_EOL (+2)
324# define SF_FL_SHIFT_EOL (+4)
325#endif
c277df42
IZ
326
327#define SF_FIX_BEFORE_SEOL (SF_BEFORE_SEOL << SF_FIX_SHIFT_EOL)
328#define SF_FIX_BEFORE_MEOL (SF_BEFORE_MEOL << SF_FIX_SHIFT_EOL)
329
330#define SF_FL_BEFORE_SEOL (SF_BEFORE_SEOL << SF_FL_SHIFT_EOL)
331#define SF_FL_BEFORE_MEOL (SF_BEFORE_MEOL << SF_FL_SHIFT_EOL) /* 0x20 */
07be1b83
YO
332#define SF_IS_INF 0x0040
333#define SF_HAS_PAR 0x0080
334#define SF_IN_PAR 0x0100
335#define SF_HAS_EVAL 0x0200
336#define SCF_DO_SUBSTR 0x0400
653099ff
GS
337#define SCF_DO_STCLASS_AND 0x0800
338#define SCF_DO_STCLASS_OR 0x1000
339#define SCF_DO_STCLASS (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR)
e1901655 340#define SCF_WHILEM_VISITED_POS 0x2000
c277df42 341
786e8c11 342#define SCF_TRIE_RESTUDY 0x4000 /* Do restudy? */
e2e6a0f1 343#define SCF_SEEN_ACCEPT 0x8000
07be1b83 344
eb160463 345#define UTF (RExC_utf8 != 0)
bbe252da
YO
346#define LOC ((RExC_flags & RXf_PMf_LOCALE) != 0)
347#define FOLD ((RExC_flags & RXf_PMf_FOLD) != 0)
a0ed51b3 348
ffc61ed2 349#define OOB_UNICODE 12345678
93733859 350#define OOB_NAMEDCLASS -1
b8c5462f 351
a0ed51b3
LW
352#define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
353#define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
354
8615cb43 355
b45f050a
JF
356/* length of regex to show in messages that don't mark a position within */
357#define RegexLengthToShowInErrorMessages 127
358
359/*
360 * If MARKER[12] are adjusted, be sure to adjust the constants at the top
361 * of t/op/regmesg.t, the tests in t/op/re_tests, and those in
362 * op/pragma/warn/regcomp.
363 */
7253e4e3
RK
364#define MARKER1 "<-- HERE" /* marker as it appears in the description */
365#define MARKER2 " <-- HERE " /* marker as it appears within the regex */
b81d288d 366
7253e4e3 367#define REPORT_LOCATION " in regex; marked by " MARKER1 " in m/%.*s" MARKER2 "%s/"
b45f050a
JF
368
369/*
370 * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
371 * arg. Show regex, up to a maximum length. If it's too long, chop and add
372 * "...".
373 */
58e23c8d 374#define _FAIL(code) STMT_START { \
bfed75c6 375 const char *ellipses = ""; \
ccb2c380
MP
376 IV len = RExC_end - RExC_precomp; \
377 \
378 if (!SIZE_ONLY) \
379 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
380 if (len > RegexLengthToShowInErrorMessages) { \
381 /* chop 10 shorter than the max, to ensure meaning of "..." */ \
382 len = RegexLengthToShowInErrorMessages - 10; \
383 ellipses = "..."; \
384 } \
58e23c8d 385 code; \
ccb2c380 386} STMT_END
8615cb43 387
58e23c8d
YO
388#define FAIL(msg) _FAIL( \
389 Perl_croak(aTHX_ "%s in regex m/%.*s%s/", \
390 msg, (int)len, RExC_precomp, ellipses))
391
392#define FAIL2(msg,arg) _FAIL( \
393 Perl_croak(aTHX_ msg " in regex m/%.*s%s/", \
394 arg, (int)len, RExC_precomp, ellipses))
395
b45f050a 396/*
b45f050a
JF
397 * Simple_vFAIL -- like FAIL, but marks the current location in the scan
398 */
ccb2c380 399#define Simple_vFAIL(m) STMT_START { \
a28509cc 400 const IV offset = RExC_parse - RExC_precomp; \
ccb2c380
MP
401 Perl_croak(aTHX_ "%s" REPORT_LOCATION, \
402 m, (int)offset, RExC_precomp, RExC_precomp + offset); \
403} STMT_END
b45f050a
JF
404
405/*
406 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL()
407 */
ccb2c380
MP
408#define vFAIL(m) STMT_START { \
409 if (!SIZE_ONLY) \
410 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
411 Simple_vFAIL(m); \
412} STMT_END
b45f050a
JF
413
414/*
415 * Like Simple_vFAIL(), but accepts two arguments.
416 */
ccb2c380 417#define Simple_vFAIL2(m,a1) STMT_START { \
a28509cc 418 const IV offset = RExC_parse - RExC_precomp; \
ccb2c380
MP
419 S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, \
420 (int)offset, RExC_precomp, RExC_precomp + offset); \
421} STMT_END
b45f050a
JF
422
423/*
424 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL2().
425 */
ccb2c380
MP
426#define vFAIL2(m,a1) STMT_START { \
427 if (!SIZE_ONLY) \
428 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
429 Simple_vFAIL2(m, a1); \
430} STMT_END
b45f050a
JF
431
432
433/*
434 * Like Simple_vFAIL(), but accepts three arguments.
435 */
ccb2c380 436#define Simple_vFAIL3(m, a1, a2) STMT_START { \
a28509cc 437 const IV offset = RExC_parse - RExC_precomp; \
ccb2c380
MP
438 S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, \
439 (int)offset, RExC_precomp, RExC_precomp + offset); \
440} STMT_END
b45f050a
JF
441
442/*
443 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL3().
444 */
ccb2c380
MP
445#define vFAIL3(m,a1,a2) STMT_START { \
446 if (!SIZE_ONLY) \
447 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
448 Simple_vFAIL3(m, a1, a2); \
449} STMT_END
b45f050a
JF
450
451/*
452 * Like Simple_vFAIL(), but accepts four arguments.
453 */
ccb2c380 454#define Simple_vFAIL4(m, a1, a2, a3) STMT_START { \
a28509cc 455 const IV offset = RExC_parse - RExC_precomp; \
ccb2c380
MP
456 S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3, \
457 (int)offset, RExC_precomp, RExC_precomp + offset); \
458} STMT_END
b45f050a 459
ccb2c380 460#define vWARN(loc,m) STMT_START { \
a28509cc 461 const IV offset = loc - RExC_precomp; \
ccb2c380
MP
462 Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s" REPORT_LOCATION, \
463 m, (int)offset, RExC_precomp, RExC_precomp + offset); \
464} STMT_END
465
466#define vWARNdep(loc,m) STMT_START { \
a28509cc 467 const IV offset = loc - RExC_precomp; \
ccb2c380
MP
468 Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP), \
469 "%s" REPORT_LOCATION, \
470 m, (int)offset, RExC_precomp, RExC_precomp + offset); \
471} STMT_END
472
473
474#define vWARN2(loc, m, a1) STMT_START { \
a28509cc 475 const IV offset = loc - RExC_precomp; \
ccb2c380
MP
476 Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
477 a1, (int)offset, RExC_precomp, RExC_precomp + offset); \
478} STMT_END
479
480#define vWARN3(loc, m, a1, a2) STMT_START { \
a28509cc 481 const IV offset = loc - RExC_precomp; \
ccb2c380
MP
482 Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
483 a1, a2, (int)offset, RExC_precomp, RExC_precomp + offset); \
484} STMT_END
485
486#define vWARN4(loc, m, a1, a2, a3) STMT_START { \
a28509cc 487 const IV offset = loc - RExC_precomp; \
ccb2c380
MP
488 Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
489 a1, a2, a3, (int)offset, RExC_precomp, RExC_precomp + offset); \
490} STMT_END
491
492#define vWARN5(loc, m, a1, a2, a3, a4) STMT_START { \
a28509cc 493 const IV offset = loc - RExC_precomp; \
ccb2c380
MP
494 Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \
495 a1, a2, a3, a4, (int)offset, RExC_precomp, RExC_precomp + offset); \
496} STMT_END
9d1d55b5 497
8615cb43 498
cd439c50 499/* Allow for side effects in s */
ccb2c380
MP
500#define REGC(c,s) STMT_START { \
501 if (!SIZE_ONLY) *(s) = (c); else (void)(s); \
502} STMT_END
cd439c50 503
fac92740
MJD
504/* Macros for recording node offsets. 20001227 mjd@plover.com
505 * Nodes are numbered 1, 2, 3, 4. Node #n's position is recorded in
506 * element 2*n-1 of the array. Element #2n holds the byte length node #n.
507 * Element 0 holds the number n.
07be1b83 508 * Position is 1 indexed.
fac92740
MJD
509 */
510
ccb2c380
MP
511#define Set_Node_Offset_To_R(node,byte) STMT_START { \
512 if (! SIZE_ONLY) { \
513 MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n", \
2a49f0f5 514 __LINE__, (int)(node), (int)(byte))); \
ccb2c380 515 if((node) < 0) { \
551405c4 516 Perl_croak(aTHX_ "value of node is %d in Offset macro", (int)(node)); \
ccb2c380
MP
517 } else { \
518 RExC_offsets[2*(node)-1] = (byte); \
519 } \
520 } \
521} STMT_END
522
523#define Set_Node_Offset(node,byte) \
524 Set_Node_Offset_To_R((node)-RExC_emit_start, (byte)-RExC_start)
525#define Set_Cur_Node_Offset Set_Node_Offset(RExC_emit, RExC_parse)
526
527#define Set_Node_Length_To_R(node,len) STMT_START { \
528 if (! SIZE_ONLY) { \
529 MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n", \
551405c4 530 __LINE__, (int)(node), (int)(len))); \
ccb2c380 531 if((node) < 0) { \
551405c4 532 Perl_croak(aTHX_ "value of node is %d in Length macro", (int)(node)); \
ccb2c380
MP
533 } else { \
534 RExC_offsets[2*(node)] = (len); \
535 } \
536 } \
537} STMT_END
538
539#define Set_Node_Length(node,len) \
540 Set_Node_Length_To_R((node)-RExC_emit_start, len)
541#define Set_Cur_Node_Length(len) Set_Node_Length(RExC_emit, len)
542#define Set_Node_Cur_Length(node) \
543 Set_Node_Length(node, RExC_parse - parse_start)
fac92740
MJD
544
545/* Get offsets and lengths */
546#define Node_Offset(n) (RExC_offsets[2*((n)-RExC_emit_start)-1])
547#define Node_Length(n) (RExC_offsets[2*((n)-RExC_emit_start)])
548
07be1b83
YO
549#define Set_Node_Offset_Length(node,offset,len) STMT_START { \
550 Set_Node_Offset_To_R((node)-RExC_emit_start, (offset)); \
551 Set_Node_Length_To_R((node)-RExC_emit_start, (len)); \
552} STMT_END
553
554
555#if PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS
556#define EXPERIMENTAL_INPLACESCAN
557#endif
558
304ee84b
YO
559#define DEBUG_STUDYDATA(str,data,depth) \
560DEBUG_OPTIMISE_MORE_r(if(data){ \
1de06328 561 PerlIO_printf(Perl_debug_log, \
304ee84b
YO
562 "%*s" str "Pos:%"IVdf"/%"IVdf \
563 " Flags: 0x%"UVXf" Whilem_c: %"IVdf" Lcp: %"IVdf" %s", \
1de06328
YO
564 (int)(depth)*2, "", \
565 (IV)((data)->pos_min), \
566 (IV)((data)->pos_delta), \
304ee84b 567 (UV)((data)->flags), \
1de06328 568 (IV)((data)->whilem_c), \
304ee84b
YO
569 (IV)((data)->last_closep ? *((data)->last_closep) : -1), \
570 is_inf ? "INF " : "" \
1de06328
YO
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
304ee84b 600S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, I32 *minlenp, int is_inf)
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 617 }
304ee84b 618 else { /* *data->longest == data->longest_float */
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);
304ee84b 623 if (is_inf || (U32)data->offset_float_max > (U32)I32_MAX)
9051bda5 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;
304ee84b 645 DEBUG_STUDYDATA("cl_anything: ",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
304ee84b
YO
2351
2352#define SCAN_COMMIT(s, data, m) scan_commit(s, data, m, is_inf)
2353
76e3520e 2354STATIC I32
40d049e4 2355S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
1de06328 2356 I32 *minlenp, I32 *deltap,
40d049e4
YO
2357 regnode *last,
2358 scan_data_t *data,
2359 I32 stopparen,
2360 U8* recursed,
2361 struct regnode_charclass_class *and_withp,
2362 U32 flags, U32 depth)
c277df42
IZ
2363 /* scanp: Start here (read-write). */
2364 /* deltap: Write maxlen-minlen here. */
2365 /* last: Stop before this one. */
40d049e4
YO
2366 /* data: string data about the pattern */
2367 /* stopparen: treat close N as END */
2368 /* recursed: which subroutines have we recursed into */
2369 /* and_withp: Valid if flags & SCF_DO_STCLASS_OR */
c277df42 2370{
97aff369 2371 dVAR;
c277df42
IZ
2372 I32 min = 0, pars = 0, code;
2373 regnode *scan = *scanp, *next;
2374 I32 delta = 0;
2375 int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
aca2d497 2376 int is_inf_internal = 0; /* The studied chunk is infinite */
c277df42
IZ
2377 I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
2378 scan_data_t data_fake;
a3621e74 2379 SV *re_trie_maxbuff = NULL;
786e8c11 2380 regnode *first_non_open = scan;
e2e6a0f1 2381 I32 stopmin = I32_MAX;
8aa23a47
YO
2382 scan_frame *frame = NULL;
2383
a3621e74 2384 GET_RE_DEBUG_FLAGS_DECL;
8aa23a47 2385
13a24bad 2386#ifdef DEBUGGING
40d049e4 2387 StructCopy(&zero_scan_data, &data_fake, scan_data_t);
13a24bad 2388#endif
40d049e4 2389
786e8c11 2390 if ( depth == 0 ) {
40d049e4 2391 while (first_non_open && OP(first_non_open) == OPEN)
786e8c11
YO
2392 first_non_open=regnext(first_non_open);
2393 }
2394
b81d288d 2395
8aa23a47
YO
2396 fake_study_recurse:
2397 while ( scan && OP(scan) != END && scan < last ){
2398 /* Peephole optimizer: */
304ee84b 2399 DEBUG_STUDYDATA("Peep:", data,depth);
8aa23a47
YO
2400 DEBUG_PEEP("Peep",scan,depth);
2401 JOIN_EXACT(scan,&min,0);
2402
2403 /* Follow the next-chain of the current node and optimize
2404 away all the NOTHINGs from it. */
2405 if (OP(scan) != CURLYX) {
2406 const int max = (reg_off_by_arg[OP(scan)]
2407 ? I32_MAX
2408 /* I32 may be smaller than U16 on CRAYs! */
2409 : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
2410 int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
2411 int noff;
2412 regnode *n = scan;
2413
2414 /* Skip NOTHING and LONGJMP. */
2415 while ((n = regnext(n))
2416 && ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
2417 || ((OP(n) == LONGJMP) && (noff = ARG(n))))
2418 && off + noff < max)
2419 off += noff;
2420 if (reg_off_by_arg[OP(scan)])
2421 ARG(scan) = off;
2422 else
2423 NEXT_OFF(scan) = off;
2424 }
a3621e74 2425
c277df42 2426
8aa23a47
YO
2427
2428 /* The principal pseudo-switch. Cannot be a switch, since we
2429 look into several different things. */
2430 if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
2431 || OP(scan) == IFTHEN) {
2432 next = regnext(scan);
2433 code = OP(scan);
2434 /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
2435
2436 if (OP(next) == code || code == IFTHEN) {
2437 /* NOTE - There is similar code to this block below for handling
2438 TRIE nodes on a re-study. If you change stuff here check there
2439 too. */
2440 I32 max1 = 0, min1 = I32_MAX, num = 0;
2441 struct regnode_charclass_class accum;
2442 regnode * const startbranch=scan;
2443
2444 if (flags & SCF_DO_SUBSTR)
304ee84b 2445 SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot merge strings after this. */
8aa23a47
YO
2446 if (flags & SCF_DO_STCLASS)
2447 cl_init_zero(pRExC_state, &accum);
2448
2449 while (OP(scan) == code) {
2450 I32 deltanext, minnext, f = 0, fake;
2451 struct regnode_charclass_class this_class;
2452
2453 num++;
2454 data_fake.flags = 0;
2455 if (data) {
2456 data_fake.whilem_c = data->whilem_c;
2457 data_fake.last_closep = data->last_closep;
2458 }
2459 else
2460 data_fake.last_closep = &fake;
58e23c8d
YO
2461
2462 data_fake.pos_delta = delta;
8aa23a47
YO
2463 next = regnext(scan);
2464 scan = NEXTOPER(scan);
2465 if (code != BRANCH)
c277df42 2466 scan = NEXTOPER(scan);
8aa23a47
YO
2467 if (flags & SCF_DO_STCLASS) {
2468 cl_init(pRExC_state, &this_class);
2469 data_fake.start_class = &this_class;
2470 f = SCF_DO_STCLASS_AND;
58e23c8d 2471 }
8aa23a47
YO
2472 if (flags & SCF_WHILEM_VISITED_POS)
2473 f |= SCF_WHILEM_VISITED_POS;
2474
2475 /* we suppose the run is continuous, last=next...*/
2476 minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
2477 next, &data_fake,
2478 stopparen, recursed, NULL, f,depth+1);
2479 if (min1 > minnext)
2480 min1 = minnext;
2481 if (max1 < minnext + deltanext)
2482 max1 = minnext + deltanext;
2483 if (deltanext == I32_MAX)
2484 is_inf = is_inf_internal = 1;
2485 scan = next;
2486 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
2487 pars++;
2488 if (data_fake.flags & SCF_SEEN_ACCEPT) {
2489 if ( stopmin > minnext)
2490 stopmin = min + min1;
2491 flags &= ~SCF_DO_SUBSTR;
2492 if (data)
2493 data->flags |= SCF_SEEN_ACCEPT;
2494 }
2495 if (data) {
2496 if (data_fake.flags & SF_HAS_EVAL)
2497 data->flags |= SF_HAS_EVAL;
2498 data->whilem_c = data_fake.whilem_c;
3dab1dad 2499 }
8aa23a47
YO
2500 if (flags & SCF_DO_STCLASS)
2501 cl_or(pRExC_state, &accum, &this_class);
2502 }
2503 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
2504 min1 = 0;
2505 if (flags & SCF_DO_SUBSTR) {
2506 data->pos_min += min1;
2507 data->pos_delta += max1 - min1;
2508 if (max1 != min1 || is_inf)
2509 data->longest = &(data->longest_float);
2510 }
2511 min += min1;
2512 delta += max1 - min1;
2513 if (flags & SCF_DO_STCLASS_OR) {
2514 cl_or(pRExC_state, data->start_class, &accum);
2515 if (min1) {
2516 cl_and(data->start_class, and_withp);
2517 flags &= ~SCF_DO_STCLASS;
653099ff 2518 }
8aa23a47
YO
2519 }
2520 else if (flags & SCF_DO_STCLASS_AND) {
2521 if (min1) {
2522 cl_and(data->start_class, &accum);
2523 flags &= ~SCF_DO_STCLASS;
de0c8cb8 2524 }
8aa23a47
YO
2525 else {
2526 /* Switch to OR mode: cache the old value of
2527 * data->start_class */
2528 INIT_AND_WITHP;
2529 StructCopy(data->start_class, and_withp,
2530 struct regnode_charclass_class);
2531 flags &= ~SCF_DO_STCLASS_AND;
2532 StructCopy(&accum, data->start_class,
2533 struct regnode_charclass_class);
2534 flags |= SCF_DO_STCLASS_OR;
2535 data->start_class->flags |= ANYOF_EOS;
de0c8cb8 2536 }
8aa23a47 2537 }
a3621e74 2538
8aa23a47
YO
2539 if (PERL_ENABLE_TRIE_OPTIMISATION && OP( startbranch ) == BRANCH ) {
2540 /* demq.
a3621e74 2541
8aa23a47
YO
2542 Assuming this was/is a branch we are dealing with: 'scan' now
2543 points at the item that follows the branch sequence, whatever
2544 it is. We now start at the beginning of the sequence and look
2545 for subsequences of
a3621e74 2546
8aa23a47
YO
2547 BRANCH->EXACT=>x1
2548 BRANCH->EXACT=>x2
2549 tail
a3621e74 2550
8aa23a47 2551 which would be constructed from a pattern like /A|LIST|OF|WORDS/
a3621e74 2552
8aa23a47
YO
2553 If we can find such a subseqence we need to turn the first
2554 element into a trie and then add the subsequent branch exact
2555 strings to the trie.
a3621e74 2556
8aa23a47 2557 We have two cases
a3621e74 2558
8aa23a47 2559 1. patterns where the whole set of branch can be converted.
a3621e74 2560
8aa23a47 2561 2. patterns where only a subset can be converted.
a3621e74 2562
8aa23a47
YO
2563 In case 1 we can replace the whole set with a single regop
2564 for the trie. In case 2 we need to keep the start and end
2565 branchs so
a3621e74 2566
8aa23a47
YO
2567 'BRANCH EXACT; BRANCH EXACT; BRANCH X'
2568 becomes BRANCH TRIE; BRANCH X;
786e8c11 2569
8aa23a47
YO
2570 There is an additional case, that being where there is a
2571 common prefix, which gets split out into an EXACT like node
2572 preceding the TRIE node.
a3621e74 2573
8aa23a47
YO
2574 If x(1..n)==tail then we can do a simple trie, if not we make
2575 a "jump" trie, such that when we match the appropriate word
2576 we "jump" to the appopriate tail node. Essentailly we turn
2577 a nested if into a case structure of sorts.
b515a41d 2578
8aa23a47
YO
2579 */
2580
2581 int made=0;
2582 if (!re_trie_maxbuff) {
2583 re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
2584 if (!SvIOK(re_trie_maxbuff))
2585 sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
2586 }
2587 if ( SvIV(re_trie_maxbuff)>=0 ) {
2588 regnode *cur;
2589 regnode *first = (regnode *)NULL;
2590 regnode *last = (regnode *)NULL;
2591 regnode *tail = scan;
2592 U8 optype = 0;
2593 U32 count=0;
a3621e74
YO
2594
2595#ifdef DEBUGGING
8aa23a47 2596 SV * const mysv = sv_newmortal(); /* for dumping */
a3621e74 2597#endif
8aa23a47
YO
2598 /* var tail is used because there may be a TAIL
2599 regop in the way. Ie, the exacts will point to the
2600 thing following the TAIL, but the last branch will
2601 point at the TAIL. So we advance tail. If we
2602 have nested (?:) we may have to move through several
2603 tails.
2604 */
2605
2606 while ( OP( tail ) == TAIL ) {
2607 /* this is the TAIL generated by (?:) */
2608 tail = regnext( tail );
2609 }
a3621e74 2610
8aa23a47
YO
2611
2612 DEBUG_OPTIMISE_r({
2613 regprop(RExC_rx, mysv, tail );
2614 PerlIO_printf( Perl_debug_log, "%*s%s%s\n",
2615 (int)depth * 2 + 2, "",
2616 "Looking for TRIE'able sequences. Tail node is: ",
2617 SvPV_nolen_const( mysv )
2618 );
2619 });
2620
2621 /*
2622
2623 step through the branches, cur represents each
2624 branch, noper is the first thing to be matched
2625 as part of that branch and noper_next is the
2626 regnext() of that node. if noper is an EXACT
2627 and noper_next is the same as scan (our current
2628 position in the regex) then the EXACT branch is
2629 a possible optimization target. Once we have
2630 two or more consequetive such branches we can
2631 create a trie of the EXACT's contents and stich
2632 it in place. If the sequence represents all of
2633 the branches we eliminate the whole thing and
2634 replace it with a single TRIE. If it is a
2635 subsequence then we need to stitch it in. This
2636 means the first branch has to remain, and needs
2637 to be repointed at the item on the branch chain
2638 following the last branch optimized. This could
2639 be either a BRANCH, in which case the
2640 subsequence is internal, or it could be the
2641 item following the branch sequence in which
2642 case the subsequence is at the end.
2643
2644 */
2645
2646 /* dont use tail as the end marker for this traverse */
2647 for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) {
2648 regnode * const noper = NEXTOPER( cur );
b515a41d 2649#if defined(DEBUGGING) || defined(NOJUMPTRIE)
8aa23a47 2650 regnode * const noper_next = regnext( noper );
b515a41d
YO
2651#endif
2652
8aa23a47
YO
2653 DEBUG_OPTIMISE_r({
2654 regprop(RExC_rx, mysv, cur);
2655 PerlIO_printf( Perl_debug_log, "%*s- %s (%d)",
2656 (int)depth * 2 + 2,"", SvPV_nolen_const( mysv ), REG_NODE_NUM(cur) );
2657
2658 regprop(RExC_rx, mysv, noper);
2659 PerlIO_printf( Perl_debug_log, " -> %s",
2660 SvPV_nolen_const(mysv));
2661
2662 if ( noper_next ) {
2663 regprop(RExC_rx, mysv, noper_next );
2664 PerlIO_printf( Perl_debug_log,"\t=> %s\t",
2665 SvPV_nolen_const(mysv));
2666 }
2667 PerlIO_printf( Perl_debug_log, "(First==%d,Last==%d,Cur==%d)\n",
2668 REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur) );
2669 });
2670 if ( (((first && optype!=NOTHING) ? OP( noper ) == optype
2671 : PL_regkind[ OP( noper ) ] == EXACT )
2672 || OP(noper) == NOTHING )
786e8c11 2673#ifdef NOJUMPTRIE
8aa23a47 2674 && noper_next == tail
786e8c11 2675#endif
8aa23a47
YO
2676 && count < U16_MAX)
2677 {
2678 count++;
2679 if ( !first || optype == NOTHING ) {
2680 if (!first) first = cur;
2681 optype = OP( noper );
2682 } else {
2683 last = cur;
2684 }
2685 } else {
2686 if ( last ) {
2687 make_trie( pRExC_state,
2688 startbranch, first, cur, tail, count,
2689 optype, depth+1 );
2690 }
2691 if ( PL_regkind[ OP( noper ) ] == EXACT
786e8c11 2692#ifdef NOJUMPTRIE
8aa23a47 2693 && noper_next == tail
786e8c11 2694#endif
8aa23a47
YO
2695 ){
2696 count = 1;
2697 first = cur;
2698 optype = OP( noper );
2699 } else {
2700 count = 0;
2701 first = NULL;
2702 optype = 0;
2703 }
2704 last = NULL;
2705 }
2706 }
2707 DEBUG_OPTIMISE_r({
2708 regprop(RExC_rx, mysv, cur);
2709 PerlIO_printf( Perl_debug_log,
2710 "%*s- %s (%d) <SCAN FINISHED>\n", (int)depth * 2 + 2,
2711 "", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
2712
2713 });
2714 if ( last ) {
2715 made= make_trie( pRExC_state, startbranch, first, scan, tail, count, optype, depth+1 );
3dab1dad 2716#ifdef TRIE_STUDY_OPT
8aa23a47
YO
2717 if ( ((made == MADE_EXACT_TRIE &&
2718 startbranch == first)
2719 || ( first_non_open == first )) &&
2720 depth==0 ) {
2721 flags |= SCF_TRIE_RESTUDY;
2722 if ( startbranch == first
2723 && scan == tail )
2724 {
2725 RExC_seen &=~REG_TOP_LEVEL_BRANCHES;
2726 }
2727 }
3dab1dad 2728#endif
8aa23a47
YO
2729 }
2730 }
2731
2732 } /* do trie */
2733
653099ff 2734 }
8aa23a47
YO
2735 else if ( code == BRANCHJ ) { /* single branch is optimized. */
2736 scan = NEXTOPER(NEXTOPER(scan));
2737 } else /* single branch is optimized. */
2738 scan = NEXTOPER(scan);
2739 continue;
2740 } else if (OP(scan) == SUSPEND || OP(scan) == GOSUB || OP(scan) == GOSTART) {
2741 scan_frame *newframe = NULL;
2742 I32 paren;
2743 regnode *start;
2744 regnode *end;
2745
2746 if (OP(scan) != SUSPEND) {
2747 /* set the pointer */
2748 if (OP(scan) == GOSUB) {
2749 paren = ARG(scan);
2750 RExC_recurse[ARG2L(scan)] = scan;
2751 start = RExC_open_parens[paren-1];
2752 end = RExC_close_parens[paren-1];
2753 } else {
2754 paren = 0;
f8fc2ecf 2755 start = RExC_rxi->program + 1;
8aa23a47
YO
2756 end = RExC_opend;
2757 }
2758 if (!recursed) {
2759 Newxz(recursed, (((RExC_npar)>>3) +1), U8);
2760 SAVEFREEPV(recursed);
2761 }
2762 if (!PAREN_TEST(recursed,paren+1)) {
2763 PAREN_SET(recursed,paren+1);
2764 Newx(newframe,1,scan_frame);
2765 } else {
2766 if (flags & SCF_DO_SUBSTR) {
304ee84b 2767 SCAN_COMMIT(pRExC_state,data,minlenp);
8aa23a47
YO
2768 data->longest = &(data->longest_float);
2769 }
2770 is_inf = is_inf_internal = 1;
2771 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
2772 cl_anything(pRExC_state, data->start_class);
2773 flags &= ~SCF_DO_STCLASS;
2774 }
2775 } else {
2776 Newx(newframe,1,scan_frame);
2777 paren = stopparen;
2778 start = scan+2;
2779 end = regnext(scan);
2780 }
2781 if (newframe) {
2782 assert(start);
2783 assert(end);
2784 SAVEFREEPV(newframe);
2785 newframe->next = regnext(scan);
2786 newframe->last = last;
2787 newframe->stop = stopparen;
2788 newframe->prev = frame;
2789
2790 frame = newframe;
2791 scan = start;
2792 stopparen = paren;
2793 last = end;
2794
2795 continue;
2796 }
2797 }
2798 else if (OP(scan) == EXACT) {
2799 I32 l = STR_LEN(scan);
2800 UV uc;
2801 if (UTF) {
2802 const U8 * const s = (U8*)STRING(scan);
2803 l = utf8_length(s, s + l);
2804 uc = utf8_to_uvchr(s, NULL);
2805 } else {
2806 uc = *((U8*)STRING(scan));
2807 }
2808 min += l;
2809 if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
2810 /* The code below prefers earlier match for fixed
2811 offset, later match for variable offset. */
2812 if (data->last_end == -1) { /* Update the start info. */
2813 data->last_start_min = data->pos_min;
2814 data->last_start_max = is_inf
2815 ? I32_MAX : data->pos_min + data->pos_delta;
b515a41d 2816 }
8aa23a47
YO
2817 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
2818 if (UTF)
2819 SvUTF8_on(data->last_found);
2820 {
2821 SV * const sv = data->last_found;
2822 MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
2823 mg_find(sv, PERL_MAGIC_utf8) : NULL;
2824 if (mg && mg->mg_len >= 0)
2825 mg->mg_len += utf8_length((U8*)STRING(scan),
2826 (U8*)STRING(scan)+STR_LEN(scan));
b515a41d 2827 }
8aa23a47
YO
2828 data->last_end = data->pos_min + l;
2829 data->pos_min += l; /* As in the first entry. */
2830 data->flags &= ~SF_BEFORE_EOL;
2831 }
2832 if (flags & SCF_DO_STCLASS_AND) {
2833 /* Check whether it is compatible with what we know already! */
2834 int compat = 1;
2835
2836 if (uc >= 0x100 ||
2837 (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
2838 && !ANYOF_BITMAP_TEST(data->start_class, uc)
2839 && (!(data->start_class->flags & ANYOF_FOLD)
2840 || !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
2841 )
2842 compat = 0;
2843 ANYOF_CLASS_ZERO(data->start_class);
2844 ANYOF_BITMAP_ZERO(data->start_class);
2845 if (compat)
2846 ANYOF_BITMAP_SET(data->start_class, uc);
2847 data->start_class->flags &= ~ANYOF_EOS;
2848 if (uc < 0x100)
2849 data->start_class->flags &= ~ANYOF_UNICODE_ALL;
2850 }
2851 else if (flags & SCF_DO_STCLASS_OR) {
2852 /* false positive possible if the class is case-folded */
2853 if (uc < 0x100)
2854 ANYOF_BITMAP_SET(data->start_class, uc);
2855 else
2856 data->start_class->flags |= ANYOF_UNICODE_ALL;
2857 data->start_class->flags &= ~ANYOF_EOS;
2858 cl_and(data->start_class, and_withp);
2859 }
2860 flags &= ~SCF_DO_STCLASS;
2861 }
2862 else if (PL_regkind[OP(scan)] == EXACT) { /* But OP != EXACT! */
2863 I32 l = STR_LEN(scan);
2864 UV uc = *((U8*)STRING(scan));
2865
2866 /* Search for fixed substrings supports EXACT only. */
2867 if (flags & SCF_DO_SUBSTR) {
2868 assert(data);
304ee84b 2869 SCAN_COMMIT(pRExC_state, data, minlenp);
8aa23a47
YO
2870 }
2871 if (UTF) {
2872 const U8 * const s = (U8 *)STRING(scan);
2873 l = utf8_length(s, s + l);
2874 uc = utf8_to_uvchr(s, NULL);
2875 }
2876 min += l;
2877 if (flags & SCF_DO_SUBSTR)
2878 data->pos_min += l;
2879 if (flags & SCF_DO_STCLASS_AND) {
2880 /* Check whether it is compatible with what we know already! */
2881 int compat = 1;
2882
2883 if (uc >= 0x100 ||
2884 (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
2885 && !ANYOF_BITMAP_TEST(data->start_class, uc)
2886 && !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
2887 compat = 0;
2888 ANYOF_CLASS_ZERO(data->start_class);
2889 ANYOF_BITMAP_ZERO(data->start_class);
2890 if (compat) {
2891 ANYOF_BITMAP_SET(data->start_class, uc);
653099ff 2892 data->start_class->flags &= ~ANYOF_EOS;
8aa23a47
YO
2893 data->start_class->flags |= ANYOF_FOLD;
2894 if (OP(scan) == EXACTFL)
2895 data->start_class->flags |= ANYOF_LOCALE;
653099ff 2896 }
8aa23a47
YO
2897 }
2898 else if (flags & SCF_DO_STCLASS_OR) {
2899 if (data->start_class->flags & ANYOF_FOLD) {
2900 /* false positive possible if the class is case-folded.
2901 Assume that the locale settings are the same... */
1aa99e6b
IH
2902 if (uc < 0x100)
2903 ANYOF_BITMAP_SET(data->start_class, uc);
653099ff
GS
2904 data->start_class->flags &= ~ANYOF_EOS;
2905 }
8aa23a47 2906 cl_and(data->start_class, and_withp);
653099ff 2907 }
8aa23a47
YO
2908 flags &= ~SCF_DO_STCLASS;
2909 }
2910 else if (strchr((const char*)PL_varies,OP(scan))) {
2911 I32 mincount, maxcount, minnext, deltanext, fl = 0;
2912 I32 f = flags, pos_before = 0;
2913 regnode * const oscan = scan;
2914 struct regnode_charclass_class this_class;
2915 struct regnode_charclass_class *oclass = NULL;
2916 I32 next_is_eval = 0;
2917
2918 switch (PL_regkind[OP(scan)]) {
2919 case WHILEM: /* End of (?:...)* . */
2920 scan = NEXTOPER(scan);
2921 goto finish;
2922 case PLUS:
2923 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
2924 next = NEXTOPER(scan);
2925 if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
2926 mincount = 1;
2927 maxcount = REG_INFTY;
2928 next = regnext(scan);
2929 scan = NEXTOPER(scan);
2930 goto do_curly;
2931 }
2932 }
2933 if (flags & SCF_DO_SUBSTR)
2934 data->pos_min++;
2935 min++;
2936 /* Fall through. */
2937 case STAR:
2938 if (flags & SCF_DO_STCLASS) {
2939 mincount = 0;
2940 maxcount = REG_INFTY;
2941 next = regnext(scan);
2942 scan = NEXTOPER(scan);
2943 goto do_curly;
2944 }
2945 is_inf = is_inf_internal = 1;
2946 scan = regnext(scan);
c277df42 2947 if (flags & SCF_DO_SUBSTR) {
304ee84b 2948 SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot extend fixed substrings */
8aa23a47 2949 data->longest = &(data->longest_float);
c277df42 2950 }
8aa23a47
YO
2951 goto optimize_curly_tail;
2952 case CURLY:
2953 if (stopparen>0 && (OP(scan)==CURLYN || OP(scan)==CURLYM)
2954 && (scan->flags == stopparen))
2955 {
2956 mincount = 1;
2957 maxcount = 1;
2958 } else {
2959 mincount = ARG1(scan);
2960 maxcount = ARG2(scan);
653099ff 2961 }
8aa23a47
YO
2962 next = regnext(scan);
2963 if (OP(scan) == CURLYX) {
2964 I32 lp = (data ? *(data->last_closep) : 0);
2965 scan->flags = ((lp <= (I32)U8_MAX) ? (U8)lp : U8_MAX);
653099ff 2966 }
8aa23a47
YO
2967 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
2968 next_is_eval = (OP(scan) == EVAL);
2969 do_curly:
2970 if (flags & SCF_DO_SUBSTR) {
304ee84b 2971 if (mincount == 0) SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot extend fixed substrings */
8aa23a47 2972 pos_before = data->pos_min;
b45f050a 2973 }
8aa23a47
YO
2974 if (data) {
2975 fl = data->flags;
2976 data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
2977 if (is_inf)
2978 data->flags |= SF_IS_INF;
2979 }
2980 if (flags & SCF_DO_STCLASS) {
2981 cl_init(pRExC_state, &this_class);
2982 oclass = data->start_class;
2983 data->start_class = &this_class;
2984 f |= SCF_DO_STCLASS_AND;
2985 f &= ~SCF_DO_STCLASS_OR;
2986 }
2987 /* These are the cases when once a subexpression
2988 fails at a particular position, it cannot succeed
2989 even after backtracking at the enclosing scope.
2990
2991 XXXX what if minimal match and we are at the
2992 initial run of {n,m}? */
2993 if ((mincount != maxcount - 1) && (maxcount != REG_INFTY))
2994 f &= ~SCF_WHILEM_VISITED_POS;
b45f050a 2995
8aa23a47
YO
2996 /* This will finish on WHILEM, setting scan, or on NULL: */
2997 minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
2998 last, data, stopparen, recursed, NULL,
2999 (mincount == 0
3000 ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
b515a41d 3001
8aa23a47
YO
3002 if (flags & SCF_DO_STCLASS)
3003 data->start_class = oclass;
3004 if (mincount == 0 || minnext == 0) {
3005 if (flags & SCF_DO_STCLASS_OR) {
3006 cl_or(pRExC_state, data->start_class, &this_class);
3007 }
3008 else if (flags & SCF_DO_STCLASS_AND) {
3009 /* Switch to OR mode: cache the old value of
3010 * data->start_class */
3011 INIT_AND_WITHP;
3012 StructCopy(data->start_class, and_withp,
3013 struct regnode_charclass_class);
3014 flags &= ~SCF_DO_STCLASS_AND;
3015 StructCopy(&this_class, data->start_class,
3016 struct regnode_charclass_class);
3017 flags |= SCF_DO_STCLASS_OR;
3018 data->start_class->flags |= ANYOF_EOS;
3019 }
3020 } else { /* Non-zero len */
3021 if (flags & SCF_DO_STCLASS_OR) {
3022 cl_or(pRExC_state, data->start_class, &this_class);
3023 cl_and(data->start_class, and_withp);
3024 }
3025 else if (flags & SCF_DO_STCLASS_AND)
3026 cl_and(data->start_class, &this_class);
3027 flags &= ~SCF_DO_STCLASS;
3028 }
3029 if (!scan) /* It was not CURLYX, but CURLY. */
3030 scan = next;
3031 if ( /* ? quantifier ok, except for (?{ ... }) */
3032 (next_is_eval || !(mincount == 0 && maxcount == 1))
3033 && (minnext == 0) && (deltanext == 0)
3034 && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
3035 && maxcount <= REG_INFTY/3 /* Complement check for big count */
3036 && ckWARN(WARN_REGEXP))
3037 {
3038 vWARN(RExC_parse,
3039 "Quantifier unexpected on zero-length expression");
3040 }
3041
3042 min += minnext * mincount;
3043 is_inf_internal |= ((maxcount == REG_INFTY
3044 && (minnext + deltanext) > 0)
3045 || deltanext == I32_MAX);
3046 is_inf |= is_inf_internal;
3047 delta += (minnext + deltanext) * maxcount - minnext * mincount;
3048
3049 /* Try powerful optimization CURLYX => CURLYN. */
3050 if ( OP(oscan) == CURLYX && data
3051 && data->flags & SF_IN_PAR
3052 && !(data->flags & SF_HAS_EVAL)
3053 && !deltanext && minnext == 1 ) {
3054 /* Try to optimize to CURLYN. */
3055 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
3056 regnode * const nxt1 = nxt;
497b47a8 3057#ifdef DEBUGGING
8aa23a47 3058 regnode *nxt2;
497b47a8 3059#endif
c277df42 3060
8aa23a47
YO
3061 /* Skip open. */
3062 nxt = regnext(nxt);
3063 if (!strchr((const char*)PL_simple,OP(nxt))
3064 && !(PL_regkind[OP(nxt)] == EXACT
3065 && STR_LEN(nxt) == 1))
3066 goto nogo;
497b47a8 3067#ifdef DEBUGGING
8aa23a47 3068 nxt2 = nxt;
497b47a8 3069#endif
8aa23a47
YO
3070 nxt = regnext(nxt);
3071 if (OP(nxt) != CLOSE)
3072 goto nogo;
3073 if (RExC_open_parens) {
3074 RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
3075 RExC_close_parens[ARG(nxt1)-1]=nxt+2; /*close->while*/
3076 }
3077 /* Now we know that nxt2 is the only contents: */
3078 oscan->flags = (U8)ARG(nxt);
3079 OP(oscan) = CURLYN;
3080 OP(nxt1) = NOTHING; /* was OPEN. */
40d049e4 3081
c277df42 3082#ifdef DEBUGGING
8aa23a47
YO
3083 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
3084 NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
3085 NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */
3086 OP(nxt) = OPTIMIZED; /* was CLOSE. */
3087 OP(nxt + 1) = OPTIMIZED; /* was count. */
3088 NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
b81d288d 3089#endif
8aa23a47
YO
3090 }
3091 nogo:
3092
3093 /* Try optimization CURLYX => CURLYM. */
3094 if ( OP(oscan) == CURLYX && data
3095 && !(data->flags & SF_HAS_PAR)
3096 && !(data->flags & SF_HAS_EVAL)
3097 && !deltanext /* atom is fixed width */
3098 && minnext != 0 /* CURLYM can't handle zero width */
3099 ) {
3100 /* XXXX How to optimize if data == 0? */
3101 /* Optimize to a simpler form. */
3102 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
3103 regnode *nxt2;
3104
3105 OP(oscan) = CURLYM;
3106 while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
3107 && (OP(nxt2) != WHILEM))
3108 nxt = nxt2;
3109 OP(nxt2) = SUCCEED; /* Whas WHILEM */
3110 /* Need to optimize away parenths. */
3111 if (data->flags & SF_IN_PAR) {
3112 /* Set the parenth number. */
3113 regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
3114
3115 if (OP(nxt) != CLOSE)
3116 FAIL("Panic opt close");
3117 oscan->flags = (U8)ARG(nxt);
3118 if (RExC_open_parens) {
3119 RExC_open_parens[ARG(nxt1)-1]=oscan; /*open->CURLYM*/
3120 RExC_close_parens[ARG(nxt1)-1]=nxt2+1; /*close->NOTHING*/
40d049e4 3121 }
8aa23a47
YO
3122 OP(nxt1) = OPTIMIZED; /* was OPEN. */
3123 OP(nxt) = OPTIMIZED; /* was CLOSE. */
40d049e4 3124
c277df42 3125#ifdef DEBUGGING
8aa23a47
YO
3126 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
3127 OP(nxt + 1) = OPTIMIZED; /* was count. */
3128 NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
3129 NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
b81d288d 3130#endif
c277df42 3131#if 0
8aa23a47
YO
3132 while ( nxt1 && (OP(nxt1) != WHILEM)) {
3133 regnode *nnxt = regnext(nxt1);
3134
3135 if (nnxt == nxt) {
3136 if (reg_off_by_arg[OP(nxt1)])
3137 ARG_SET(nxt1, nxt2 - nxt1);
3138 else if (nxt2 - nxt1 < U16_MAX)
3139 NEXT_OFF(nxt1) = nxt2 - nxt1;
3140 else
3141 OP(nxt) = NOTHING; /* Cannot beautify */
c277df42 3142 }
8aa23a47 3143 nxt1 = nnxt;
c277df42 3144 }
5d1c421c 3145#endif
8aa23a47
YO
3146 /* Optimize again: */
3147 study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt,
3148 NULL, stopparen, recursed, NULL, 0,depth+1);
3149 }
3150 else
3151 oscan->flags = 0;
3152 }
3153 else if ((OP(oscan) == CURLYX)
3154 && (flags & SCF_WHILEM_VISITED_POS)
3155 /* See the comment on a similar expression above.
3156 However, this time it not a subexpression
3157 we care about, but the expression itself. */
3158 && (maxcount == REG_INFTY)
3159 && data && ++data->whilem_c < 16) {
3160 /* This stays as CURLYX, we can put the count/of pair. */
3161 /* Find WHILEM (as in regexec.c) */
3162 regnode *nxt = oscan + NEXT_OFF(oscan);
3163
3164 if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
3165 nxt += ARG(nxt);
3166 PREVOPER(nxt)->flags = (U8)(data->whilem_c
3167 | (RExC_whilem_seen << 4)); /* On WHILEM */
3168 }
3169 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
3170 pars++;
3171 if (flags & SCF_DO_SUBSTR) {
3172 SV *last_str = NULL;
3173 int counted = mincount != 0;
a0ed51b3 3174
8aa23a47
YO
3175 if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
3176#if defined(SPARC64_GCC_WORKAROUND)
3177 I32 b = 0;
3178 STRLEN l = 0;
3179 const char *s = NULL;
3180 I32 old = 0;
b515a41d 3181
8aa23a47
YO
3182 if (pos_before >= data->last_start_min)
3183 b = pos_before;
3184 else
3185 b = data->last_start_min;
b515a41d 3186
8aa23a47
YO
3187 l = 0;
3188 s = SvPV_const(data->last_found, l);
3189 old = b - data->last_start_min;
3190
3191#else
3192 I32 b = pos_before >= data->last_start_min
3193 ? pos_before : data->last_start_min;
3194 STRLEN l;
3195 const char * const s = SvPV_const(data->last_found, l);
3196 I32 old = b - data->last_start_min;
3197#endif
3198
3199 if (UTF)
3200 old = utf8_hop((U8*)s, old) - (U8*)s;
3201
3202 l -= old;
3203 /* Get the added string: */
3204 last_str = newSVpvn(s + old, l);
3205 if (UTF)
3206 SvUTF8_on(last_str);
3207 if (deltanext == 0 && pos_before == b) {
3208 /* What was added is a constant string */
3209 if (mincount > 1) {
3210 SvGROW(last_str, (mincount * l) + 1);
3211 repeatcpy(SvPVX(last_str) + l,
3212 SvPVX_const(last_str), l, mincount - 1);
3213 SvCUR_set(last_str, SvCUR(last_str) * mincount);
3214 /* Add additional parts. */
3215 SvCUR_set(data->last_found,
3216 SvCUR(data->last_found) - l);
3217 sv_catsv(data->last_found, last_str);
3218 {
3219 SV * sv = data->last_found;
3220 MAGIC *mg =
3221 SvUTF8(sv) && SvMAGICAL(sv) ?
3222 mg_find(sv, PERL_MAGIC_utf8) : NULL;
3223 if (mg && mg->mg_len >= 0)
3224 mg->mg_len += CHR_SVLEN(last_str);
b515a41d 3225 }
8aa23a47 3226 data->last_end += l * (mincount - 1);
b515a41d 3227 }
8aa23a47
YO
3228 } else {
3229 /* start offset must point into the last copy */
3230 data->last_start_min += minnext * (mincount - 1);
3231 data->last_start_max += is_inf ? I32_MAX
3232 : (maxcount - 1) * (minnext + data->pos_delta);
3233 }
c277df42 3234 }
8aa23a47
YO
3235 /* It is counted once already... */
3236 data->pos_min += minnext * (mincount - counted);
3237 data->pos_delta += - counted * deltanext +
3238 (minnext + deltanext) * maxcount - minnext * mincount;
3239 if (mincount != maxcount) {
3240 /* Cannot extend fixed substrings found inside
3241 the group. */
304ee84b 3242 SCAN_COMMIT(pRExC_state,data,minlenp);
8aa23a47
YO
3243 if (mincount && last_str) {
3244 SV * const sv = data->last_found;
3245 MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
3246 mg_find(sv, PERL_MAGIC_utf8) : NULL;
3247
3248 if (mg)
3249 mg->mg_len = -1;
3250 sv_setsv(sv, last_str);
3251 data->last_end = data->pos_min;
3252 data->last_start_min =
3253 data->pos_min - CHR_SVLEN(last_str);
3254 data->last_start_max = is_inf
3255 ? I32_MAX
3256 : data->pos_min + data->pos_delta
3257 - CHR_SVLEN(last_str);
3258 }
3259 data->longest = &(data->longest_float);
3260 }
3261 SvREFCNT_dec(last_str);
c277df42 3262 }
8aa23a47
YO
3263 if (data && (fl & SF_HAS_EVAL))
3264 data->flags |= SF_HAS_EVAL;
3265 optimize_curly_tail:
3266 if (OP(oscan) != CURLYX) {
3267 while (PL_regkind[OP(next = regnext(oscan))] == NOTHING
3268 && NEXT_OFF(next))
3269 NEXT_OFF(oscan) += NEXT_OFF(next);
3270 }
3271 continue;
3272 default: /* REF and CLUMP only? */
3273 if (flags & SCF_DO_SUBSTR) {
304ee84b 3274 SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot expect anything... */
8aa23a47
YO
3275 data->longest = &(data->longest_float);
3276 }
3277 is_inf = is_inf_internal = 1;
3278 if (flags & SCF_DO_STCLASS_OR)
3279 cl_anything(pRExC_state, data->start_class);
3280 flags &= ~SCF_DO_STCLASS;
3281 break;
c277df42 3282 }
8aa23a47
YO
3283 }
3284 else if (strchr((const char*)PL_simple,OP(scan))) {
3285 int value = 0;
653099ff 3286
8aa23a47 3287 if (flags & SCF_DO_SUBSTR) {
304ee84b 3288 SCAN_COMMIT(pRExC_state,data,minlenp);
8aa23a47
YO
3289 data->pos_min++;
3290 }
3291 min++;
3292 if (flags & SCF_DO_STCLASS) {
3293 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
b515a41d 3294
8aa23a47
YO
3295 /* Some of the logic below assumes that switching
3296 locale on will only add false positives. */
3297 switch (PL_regkind[OP(scan)]) {
3298 case SANY:
3299 default:
3300 do_default:
3301 /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
3302 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
3303 cl_anything(pRExC_state, data->start_class);
3304 break;
3305 case REG_ANY:
3306 if (OP(scan) == SANY)
3307 goto do_default;
3308 if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
3309 value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
3310 || (data->start_class->flags & ANYOF_CLASS));
3311 cl_anything(pRExC_state, data->start_class);
653099ff 3312 }
8aa23a47
YO
3313 if (flags & SCF_DO_STCLASS_AND || !value)
3314 ANYOF_BITMAP_CLEAR(data->start_class,'\n');
3315 break;
3316 case ANYOF:
3317 if (flags & SCF_DO_STCLASS_AND)
3318 cl_and(data->start_class,
3319 (struct regnode_charclass_class*)scan);
653099ff 3320 else
8aa23a47
YO
3321 cl_or(pRExC_state, data->start_class,
3322 (struct regnode_charclass_class*)scan);
3323 break;
3324 case ALNUM:
3325 if (flags & SCF_DO_STCLASS_AND) {
3326 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3327 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
3328 for (value = 0; value < 256; value++)
3329 if (!isALNUM(value))
3330 ANYOF_BITMAP_CLEAR(data->start_class, value);
3331 }
653099ff 3332 }
8aa23a47
YO
3333 else {
3334 if (data->start_class->flags & ANYOF_LOCALE)
3335 ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
3336 else {
3337 for (value = 0; value < 256; value++)
3338 if (isALNUM(value))
3339 ANYOF_BITMAP_SET(data->start_class, value);
653099ff 3340 }
8aa23a47
YO
3341 }
3342 break;
3343 case ALNUML:
3344 if (flags & SCF_DO_STCLASS_AND) {
3345 if (data->start_class->flags & ANYOF_LOCALE)
3346 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
3347 }
3348 else {
3349 ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
3350 data->start_class->flags |= ANYOF_LOCALE;
3351 }
3352 break;
3353 case NALNUM:
3354 if (flags & SCF_DO_STCLASS_AND) {
3355 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3356 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
3357 for (value = 0; value < 256; value++)
3358 if (isALNUM(value))
3359 ANYOF_BITMAP_CLEAR(data->start_class, value);
653099ff
GS
3360 }
3361 }
8aa23a47
YO
3362 else {
3363 if (data->start_class->flags & ANYOF_LOCALE)
3364 ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
3365 else {
3366 for (value = 0; value < 256; value++)
3367 if (!isALNUM(value))
3368 ANYOF_BITMAP_SET(data->start_class, value);
3369 }
653099ff 3370 }
8aa23a47
YO
3371 break;
3372 case NALNUML:
3373 if (flags & SCF_DO_STCLASS_AND) {
3374 if (data->start_class->flags & ANYOF_LOCALE)
3375 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
653099ff 3376 }
8aa23a47
YO
3377 else {
3378 data->start_class->flags |= ANYOF_LOCALE;
3379 ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
3380 }
3381 break;
3382 case SPACE:
3383 if (flags & SCF_DO_STCLASS_AND) {
3384 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3385 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
3386 for (value = 0; value < 256; value++)
3387 if (!isSPACE(value))
3388 ANYOF_BITMAP_CLEAR(data->start_class, value);
653099ff
GS
3389 }
3390 }
8aa23a47
YO
3391 else {
3392 if (data->start_class->flags & ANYOF_LOCALE)
3393 ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
3394 else {
3395 for (value = 0; value < 256; value++)
3396 if (isSPACE(value))
3397 ANYOF_BITMAP_SET(data->start_class, value);
3398 }
653099ff 3399 }
8aa23a47
YO
3400 break;
3401 case SPACEL:
3402 if (flags & SCF_DO_STCLASS_AND) {
3403 if (data->start_class->flags & ANYOF_LOCALE)
3404 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
3405 }
3406 else {
3407 data->start_class->flags |= ANYOF_LOCALE;
3408 ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
3409 }
3410 break;
3411 case NSPACE:
3412 if (flags & SCF_DO_STCLASS_AND) {
3413 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3414 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3415 for (value = 0; value < 256; value++)
3416 if (isSPACE(value))
3417 ANYOF_BITMAP_CLEAR(data->start_class, value);
653099ff 3418 }
8aa23a47
YO
3419 }
3420 else {
3421 if (data->start_class->flags & ANYOF_LOCALE)
3422 ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3423 else {
3424 for (value = 0; value < 256; value++)
3425 if (!isSPACE(value))
3426 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
3427 }
3428 }
8aa23a47
YO
3429 break;
3430 case NSPACEL:
3431 if (flags & SCF_DO_STCLASS_AND) {
3432 if (data->start_class->flags & ANYOF_LOCALE) {
3433 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3434 for (value = 0; value < 256; value++)
3435 if (!isSPACE(value))
3436 ANYOF_BITMAP_CLEAR(data->start_class, value);
3437 }
653099ff 3438 }
8aa23a47
YO
3439 else {
3440 data->start_class->flags |= ANYOF_LOCALE;
3441 ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3442 }
3443 break;
3444 case DIGIT:
3445 if (flags & SCF_DO_STCLASS_AND) {
3446 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
3447 for (value = 0; value < 256; value++)
3448 if (!isDIGIT(value))
3449 ANYOF_BITMAP_CLEAR(data->start_class, value);
3450 }
3451 else {
3452 if (data->start_class->flags & ANYOF_LOCALE)
3453 ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
3454 else {
3455 for (value = 0; value < 256; value++)
3456 if (isDIGIT(value))
3457 ANYOF_BITMAP_SET(data->start_class, value);
3458 }
3459 }
3460 break;
3461 case NDIGIT:
3462 if (flags & SCF_DO_STCLASS_AND) {
3463 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
3464 for (value = 0; value < 256; value++)
3465 if (isDIGIT(value))
3466 ANYOF_BITMAP_CLEAR(data->start_class, value);
3467 }
3468 else {
3469 if (data->start_class->flags & ANYOF_LOCALE)
3470 ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
3471 else {
3472 for (value = 0; value < 256; value++)
3473 if (!isDIGIT(value))
3474 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
3475 }
3476 }
8aa23a47
YO
3477 break;
3478 }
3479 if (flags & SCF_DO_STCLASS_OR)
3480 cl_and(data->start_class, and_withp);
3481 flags &= ~SCF_DO_STCLASS;
3482 }
3483 }
3484 else if (PL_regkind[OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
3485 data->flags |= (OP(scan) == MEOL
3486 ? SF_BEFORE_MEOL
3487 : SF_BEFORE_SEOL);
3488 }
3489 else if ( PL_regkind[OP(scan)] == BRANCHJ
3490 /* Lookbehind, or need to calculate parens/evals/stclass: */
3491 && (scan->flags || data || (flags & SCF_DO_STCLASS))
3492 && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
3493 if ( !PERL_ENABLE_POSITIVE_ASSERTION_STUDY
3494 || OP(scan) == UNLESSM )
3495 {
3496 /* Negative Lookahead/lookbehind
3497 In this case we can't do fixed string optimisation.
3498 */
1de06328 3499
8aa23a47
YO
3500 I32 deltanext, minnext, fake = 0;
3501 regnode *nscan;
3502 struct regnode_charclass_class intrnl;
3503 int f = 0;
1de06328 3504
8aa23a47
YO
3505 data_fake.flags = 0;
3506 if (data) {
3507 data_fake.whilem_c = data->whilem_c;
3508 data_fake.last_closep = data->last_closep;
c277df42 3509 }
8aa23a47
YO
3510 else
3511 data_fake.last_closep = &fake;
58e23c8d 3512 data_fake.pos_delta = delta;
8aa23a47
YO
3513 if ( flags & SCF_DO_STCLASS && !scan->flags
3514 && OP(scan) == IFMATCH ) { /* Lookahead */
3515 cl_init(pRExC_state, &intrnl);
3516 data_fake.start_class = &intrnl;
3517 f |= SCF_DO_STCLASS_AND;
3518 }
3519 if (flags & SCF_WHILEM_VISITED_POS)
3520 f |= SCF_WHILEM_VISITED_POS;
3521 next = regnext(scan);
3522 nscan = NEXTOPER(NEXTOPER(scan));
3523 minnext = study_chunk(pRExC_state, &nscan, minlenp, &deltanext,
3524 last, &data_fake, stopparen, recursed, NULL, f, depth+1);
3525 if (scan->flags) {
3526 if (deltanext) {
58e23c8d 3527 FAIL("Variable length lookbehind not implemented");
8aa23a47
YO
3528 }
3529 else if (minnext > (I32)U8_MAX) {
58e23c8d 3530 FAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
8aa23a47
YO
3531 }
3532 scan->flags = (U8)minnext;
3533 }
3534 if (data) {
3535 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3536 pars++;
3537 if (data_fake.flags & SF_HAS_EVAL)
3538 data->flags |= SF_HAS_EVAL;
3539 data->whilem_c = data_fake.whilem_c;
3540 }
3541 if (f & SCF_DO_STCLASS_AND) {
3542 const int was = (data->start_class->flags & ANYOF_EOS);
3543
3544 cl_and(data->start_class, &intrnl);
3545 if (was)
3546 data->start_class->flags |= ANYOF_EOS;
3547 }
cb434fcc 3548 }
8aa23a47
YO
3549#if PERL_ENABLE_POSITIVE_ASSERTION_STUDY
3550 else {
3551 /* Positive Lookahead/lookbehind
3552 In this case we can do fixed string optimisation,
3553 but we must be careful about it. Note in the case of
3554 lookbehind the positions will be offset by the minimum
3555 length of the pattern, something we won't know about
3556 until after the recurse.
3557 */
3558 I32 deltanext, fake = 0;
3559 regnode *nscan;
3560 struct regnode_charclass_class intrnl;
3561 int f = 0;
3562 /* We use SAVEFREEPV so that when the full compile
3563 is finished perl will clean up the allocated
3564 minlens when its all done. This was we don't
3565 have to worry about freeing them when we know
3566 they wont be used, which would be a pain.
3567 */
3568 I32 *minnextp;
3569 Newx( minnextp, 1, I32 );
3570 SAVEFREEPV(minnextp);
3571
3572 if (data) {
3573 StructCopy(data, &data_fake, scan_data_t);
3574 if ((flags & SCF_DO_SUBSTR) && data->last_found) {
3575 f |= SCF_DO_SUBSTR;
3576 if (scan->flags)
304ee84b 3577 SCAN_COMMIT(pRExC_state, &data_fake,minlenp);
8aa23a47
YO
3578 data_fake.last_found=newSVsv(data->last_found);
3579 }
3580 }
3581 else
3582 data_fake.last_closep = &fake;
3583 data_fake.flags = 0;
58e23c8d 3584 data_fake.pos_delta = delta;
8aa23a47
YO
3585 if (is_inf)
3586 data_fake.flags |= SF_IS_INF;
3587 if ( flags & SCF_DO_STCLASS && !scan->flags
3588 && OP(scan) == IFMATCH ) { /* Lookahead */
3589 cl_init(pRExC_state, &intrnl);
3590 data_fake.start_class = &intrnl;
3591 f |= SCF_DO_STCLASS_AND;
3592 }
3593 if (flags & SCF_WHILEM_VISITED_POS)
3594 f |= SCF_WHILEM_VISITED_POS;
3595 next = regnext(scan);
3596 nscan = NEXTOPER(NEXTOPER(scan));
3597
3598 *minnextp = study_chunk(pRExC_state, &nscan, minnextp, &deltanext,
3599 last, &data_fake, stopparen, recursed, NULL, f,depth+1);
3600 if (scan->flags) {
3601 if (deltanext) {
58e23c8d 3602 FAIL("Variable length lookbehind not implemented");
8aa23a47
YO
3603 }
3604 else if (*minnextp > (I32)U8_MAX) {
58e23c8d 3605 FAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
8aa23a47
YO
3606 }
3607 scan->flags = (U8)*minnextp;
3608 }
3609
3610 *minnextp += min;
3611
3612 if (f & SCF_DO_STCLASS_AND) {
3613 const int was = (data->start_class->flags & ANYOF_EOS);
3614
3615 cl_and(data->start_class, &intrnl);
3616 if (was)
3617 data->start_class->flags |= ANYOF_EOS;
3618 }
3619 if (data) {
3620 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3621 pars++;
3622 if (data_fake.flags & SF_HAS_EVAL)
3623 data->flags |= SF_HAS_EVAL;
3624 data->whilem_c = data_fake.whilem_c;
3625 if ((flags & SCF_DO_SUBSTR) && data_fake.last_found) {
3626 if (RExC_rx->minlen<*minnextp)
3627 RExC_rx->minlen=*minnextp;
304ee84b 3628 SCAN_COMMIT(pRExC_state, &data_fake, minnextp);
8aa23a47
YO
3629 SvREFCNT_dec(data_fake.last_found);
3630
3631 if ( data_fake.minlen_fixed != minlenp )
3632 {
3633 data->offset_fixed= data_fake.offset_fixed;
3634 data->minlen_fixed= data_fake.minlen_fixed;
3635 data->lookbehind_fixed+= scan->flags;
3636 }
3637 if ( data_fake.minlen_float != minlenp )
3638 {
3639 data->minlen_float= data_fake.minlen_float;
3640 data->offset_float_min=data_fake.offset_float_min;
3641 data->offset_float_max=data_fake.offset_float_max;
3642 data->lookbehind_float+= scan->flags;
3643 }
3644 }
3645 }
3646
3647
40d049e4 3648 }
8aa23a47
YO
3649#endif
3650 }
3651 else if (OP(scan) == OPEN) {
3652 if (stopparen != (I32)ARG(scan))
3653 pars++;
3654 }
3655 else if (OP(scan) == CLOSE) {
3656 if (stopparen == (I32)ARG(scan)) {
3657 break;
3658 }
3659 if ((I32)ARG(scan) == is_par) {
3660 next = regnext(scan);
b515a41d 3661
8aa23a47
YO
3662 if ( next && (OP(next) != WHILEM) && next < last)
3663 is_par = 0; /* Disable optimization */
40d049e4 3664 }
8aa23a47
YO
3665 if (data)
3666 *(data->last_closep) = ARG(scan);
3667 }
3668 else if (OP(scan) == EVAL) {
c277df42
IZ
3669 if (data)
3670 data->flags |= SF_HAS_EVAL;
8aa23a47
YO
3671 }
3672 else if ( PL_regkind[OP(scan)] == ENDLIKE ) {
3673 if (flags & SCF_DO_SUBSTR) {
304ee84b 3674 SCAN_COMMIT(pRExC_state,data,minlenp);
8aa23a47 3675 flags &= ~SCF_DO_SUBSTR;
40d049e4 3676 }
8aa23a47
YO
3677 if (data && OP(scan)==ACCEPT) {
3678 data->flags |= SCF_SEEN_ACCEPT;
3679 if (stopmin > min)
3680 stopmin = min;
e2e6a0f1 3681 }
8aa23a47
YO
3682 }
3683 else if (OP(scan) == LOGICAL && scan->flags == 2) /* Embedded follows */
3684 {
0f5d15d6 3685 if (flags & SCF_DO_SUBSTR) {
304ee84b 3686 SCAN_COMMIT(pRExC_state,data,minlenp);
0f5d15d6
IZ
3687 data->longest = &(data->longest_float);
3688 }
3689 is_inf = is_inf_internal = 1;
653099ff 3690 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
830247a4 3691 cl_anything(pRExC_state, data->start_class);
96776eda 3692 flags &= ~SCF_DO_STCLASS;
8aa23a47 3693 }
58e23c8d 3694 else if (OP(scan) == GPOS) {
bbe252da 3695 if (!(RExC_rx->extflags & RXf_GPOS_FLOAT) &&
58e23c8d
YO
3696 !(delta || is_inf || (data && data->pos_delta)))
3697 {
bbe252da
YO
3698 if (!(RExC_rx->extflags & RXf_ANCH) && (flags & SCF_DO_SUBSTR))
3699 RExC_rx->extflags |= RXf_ANCH_GPOS;
58e23c8d
YO
3700 if (RExC_rx->gofs < (U32)min)
3701 RExC_rx->gofs = min;
3702 } else {
bbe252da 3703 RExC_rx->extflags |= RXf_GPOS_FLOAT;
58e23c8d
YO
3704 RExC_rx->gofs = 0;
3705 }
3706 }
786e8c11 3707#ifdef TRIE_STUDY_OPT
40d049e4 3708#ifdef FULL_TRIE_STUDY
8aa23a47
YO
3709 else if (PL_regkind[OP(scan)] == TRIE) {
3710 /* NOTE - There is similar code to this block above for handling
3711 BRANCH nodes on the initial study. If you change stuff here
3712 check there too. */
3713 regnode *trie_node= scan;
3714 regnode *tail= regnext(scan);
f8fc2ecf 3715 reg_trie_data *trie = (reg_trie_data*)RExC_rxi->data->data[ ARG(scan) ];
8aa23a47
YO
3716 I32 max1 = 0, min1 = I32_MAX;
3717 struct regnode_charclass_class accum;
3718
3719 if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
304ee84b 3720 SCAN_COMMIT(pRExC_state, data,minlenp); /* Cannot merge strings after this. */
8aa23a47
YO
3721 if (flags & SCF_DO_STCLASS)
3722 cl_init_zero(pRExC_state, &accum);
3723
3724 if (!trie->jump) {
3725 min1= trie->minlen;
3726 max1= trie->maxlen;
3727 } else {
3728 const regnode *nextbranch= NULL;
3729 U32 word;
3730
3731 for ( word=1 ; word <= trie->wordcount ; word++)
3732 {
3733 I32 deltanext=0, minnext=0, f = 0, fake;
3734 struct regnode_charclass_class this_class;
3735
3736 data_fake.flags = 0;
3737 if (data) {
3738 data_fake.whilem_c = data->whilem_c;
3739 data_fake.last_closep = data->last_closep;
3740 }
3741 else
3742 data_fake.last_closep = &fake;
58e23c8d 3743 data_fake.pos_delta = delta;
8aa23a47
YO
3744 if (flags & SCF_DO_STCLASS) {
3745 cl_init(pRExC_state, &this_class);
3746 data_fake.start_class = &this_class;
3747 f = SCF_DO_STCLASS_AND;
3748 }
3749 if (flags & SCF_WHILEM_VISITED_POS)
3750 f |= SCF_WHILEM_VISITED_POS;
3751
3752 if (trie->jump[word]) {
3753 if (!nextbranch)
3754 nextbranch = trie_node + trie->jump[0];
3755 scan= trie_node + trie->jump[word];
3756 /* We go from the jump point to the branch that follows
3757 it. Note this means we need the vestigal unused branches
3758 even though they arent otherwise used.
3759 */
3760 minnext = study_chunk(pRExC_state, &scan, minlenp,
3761 &deltanext, (regnode *)nextbranch, &data_fake,
3762 stopparen, recursed, NULL, f,depth+1);
3763 }
3764 if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH)
3765 nextbranch= regnext((regnode*)nextbranch);
3766
3767 if (min1 > (I32)(minnext + trie->minlen))
3768 min1 = minnext + trie->minlen;
3769 if (max1 < (I32)(minnext + deltanext + trie->maxlen))
3770 max1 = minnext + deltanext + trie->maxlen;
3771 if (deltanext == I32_MAX)
3772 is_inf = is_inf_internal = 1;
3773
3774 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3775 pars++;
3776 if (data_fake.flags & SCF_SEEN_ACCEPT) {
3777 if ( stopmin > min + min1)
3778 stopmin = min + min1;
3779 flags &= ~SCF_DO_SUBSTR;
3780 if (data)
3781 data->flags |= SCF_SEEN_ACCEPT;
3782 }
3783 if (data) {
3784 if (data_fake.flags & SF_HAS_EVAL)
3785 data->flags |= SF_HAS_EVAL;
3786 data->whilem_c = data_fake.whilem_c;
3787 }
3788 if (flags & SCF_DO_STCLASS)
3789 cl_or(pRExC_state, &accum, &this_class);
3790 }
3791 }
3792 if (flags & SCF_DO_SUBSTR) {
3793 data->pos_min += min1;
3794 data->pos_delta += max1 - min1;
3795 if (max1 != min1 || is_inf)
3796 data->longest = &(data->longest_float);
3797 }
3798 min += min1;
3799 delta += max1 - min1;
3800 if (flags & SCF_DO_STCLASS_OR) {
3801 cl_or(pRExC_state, data->start_class, &accum);
3802 if (min1) {
3803 cl_and(data->start_class, and_withp);
3804 flags &= ~SCF_DO_STCLASS;
3805 }
3806 }
3807 else if (flags & SCF_DO_STCLASS_AND) {
3808 if (min1) {
3809 cl_and(data->start_class, &accum);
3810 flags &= ~SCF_DO_STCLASS;
3811 }
3812 else {
3813 /* Switch to OR mode: cache the old value of
3814 * data->start_class */
3815 INIT_AND_WITHP;
3816 StructCopy(data->start_class, and_withp,
3817 struct regnode_charclass_class);
3818 flags &= ~SCF_DO_STCLASS_AND;
3819 StructCopy(&accum, data->start_class,
3820 struct regnode_charclass_class);
3821 flags |= SCF_DO_STCLASS_OR;
3822 data->start_class->flags |= ANYOF_EOS;
3823 }