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