This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Updated escaping code. utf8 regex debug output improvements
[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 ); \
ab3bbdeb 757 if (UTF) SvUTF8_on(tmp); \
3dab1dad
YO
758 av_push( TRIE_REVCHARMAP(trie), tmp ); \
759 } STMT_END
a3621e74
YO
760
761#define TRIE_READ_CHAR STMT_START { \
07be1b83 762 wordlen++; \
a3621e74
YO
763 if ( UTF ) { \
764 if ( folder ) { \
765 if ( foldlen > 0 ) { \
766 uvc = utf8n_to_uvuni( scan, UTF8_MAXLEN, &len, uniflags ); \
767 foldlen -= len; \
768 scan += len; \
769 len = 0; \
770 } else { \
e1ec3a88 771 uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
a3621e74
YO
772 uvc = to_uni_fold( uvc, foldbuf, &foldlen ); \
773 foldlen -= UNISKIP( uvc ); \
774 scan = foldbuf + UNISKIP( uvc ); \
775 } \
776 } else { \
e1ec3a88 777 uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
a3621e74
YO
778 } \
779 } else { \
780 uvc = (U32)*uc; \
781 len = 1; \
782 } \
783} STMT_END
784
785
786#define TRIE_LIST_ITEM(state,idx) (trie->states[state].trans.list)[ idx ]
787#define TRIE_LIST_CUR(state) ( TRIE_LIST_ITEM( state, 0 ).forid )
788#define TRIE_LIST_LEN(state) ( TRIE_LIST_ITEM( state, 0 ).newstate )
789#define TRIE_LIST_USED(idx) ( trie->states[state].trans.list ? (TRIE_LIST_CUR( idx ) - 1) : 0 )
790
791#define TRIE_LIST_PUSH(state,fid,ns) STMT_START { \
792 if ( TRIE_LIST_CUR( state ) >=TRIE_LIST_LEN( state ) ) { \
793 TRIE_LIST_LEN( state ) *= 2; \
794 Renew( trie->states[ state ].trans.list, \
795 TRIE_LIST_LEN( state ), reg_trie_trans_le ); \
796 } \
797 TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).forid = fid; \
798 TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).newstate = ns; \
799 TRIE_LIST_CUR( state )++; \
800} STMT_END
801
802#define TRIE_LIST_NEW(state) STMT_START { \
a02a5408 803 Newxz( trie->states[ state ].trans.list, \
a3621e74
YO
804 4, reg_trie_trans_le ); \
805 TRIE_LIST_CUR( state ) = 1; \
806 TRIE_LIST_LEN( state ) = 4; \
807} STMT_END
808
07be1b83
YO
809#define TRIE_HANDLE_WORD(state) STMT_START { \
810 if ( !trie->states[ state ].wordnum ) { \
811 /* we haven't inserted this word into the structure yet. */ \
812 if (trie->wordlen) \
813 trie->wordlen[ curword ] = wordlen; \
3dab1dad
YO
814 trie->states[ state ].wordnum = ++curword; \
815 DEBUG_r({ \
816 /* store the word for dumping */ \
817 SV* tmp; \
07be1b83
YO
818 if (OP(noper) != NOTHING) \
819 tmp = newSVpvn(STRING(noper), STR_LEN(noper)); \
3dab1dad 820 else \
07be1b83 821 tmp = newSVpvn( "", 0 ); \
3dab1dad
YO
822 if ( UTF ) SvUTF8_on( tmp ); \
823 av_push( trie->words, tmp ); \
824 }); \
825 } else { \
826 NOOP; /* It's a dupe. So ignore it. */ \
827 } \
828} STMT_END
829
830#ifdef DEBUGGING
07be1b83 831/*
3dab1dad
YO
832 dump_trie(trie)
833 dump_trie_interim_list(trie,next_alloc)
834 dump_trie_interim_table(trie,next_alloc)
835
836 These routines dump out a trie in a somewhat readable format.
07be1b83
YO
837 The _interim_ variants are used for debugging the interim
838 tables that are used to generate the final compressed
839 representation which is what dump_trie expects.
840
3dab1dad
YO
841 Part of the reason for their existance is to provide a form
842 of documentation as to how the different representations function.
07be1b83
YO
843
844*/
3dab1dad
YO
845
846/*
847 dump_trie(trie)
848 Dumps the final compressed table form of the trie to Perl_debug_log.
849 Used for debugging make_trie().
850*/
851
852STATIC void
853S_dump_trie(pTHX_ const struct _reg_trie_data *trie,U32 depth)
854{
855 U32 state;
ab3bbdeb
YO
856 SV *sv=sv_newmortal();
857 int colwidth= trie->widecharmap ? 6 : 4;
3dab1dad
YO
858 GET_RE_DEBUG_FLAGS_DECL;
859
ab3bbdeb 860
3dab1dad
YO
861 PerlIO_printf( Perl_debug_log, "%*sChar : %-6s%-6s%-4s ",
862 (int)depth * 2 + 2,"",
863 "Match","Base","Ofs" );
864
865 for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
be8e71aa 866 SV ** const tmp = av_fetch( trie->revcharmap, state, 0);
3dab1dad 867 if ( tmp ) {
ab3bbdeb
YO
868 PerlIO_printf( Perl_debug_log, "%*s",
869 colwidth,
870 pv_pretty(sv, (U8*)SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
871 PL_colors[0], PL_colors[1],
872 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
873 PERL_PV_ESCAPE_FIRSTCHAR
874 )
875 );
3dab1dad
YO
876 }
877 }
878 PerlIO_printf( Perl_debug_log, "\n%*sState|-----------------------",
879 (int)depth * 2 + 2,"");
880
881 for( state = 0 ; state < trie->uniquecharcount ; state++ )
ab3bbdeb 882 PerlIO_printf( Perl_debug_log, "%.*s", colwidth, "--------");
3dab1dad
YO
883 PerlIO_printf( Perl_debug_log, "\n");
884
885 for( state = 1 ; state < TRIE_LASTSTATE(trie) ; state++ ) {
be8e71aa 886 const U32 base = trie->states[ state ].trans.base;
3dab1dad
YO
887
888 PerlIO_printf( Perl_debug_log, "%*s#%4"UVXf"|", (int)depth * 2 + 2,"", (UV)state);
889
890 if ( trie->states[ state ].wordnum ) {
891 PerlIO_printf( Perl_debug_log, " W%4X", trie->states[ state ].wordnum );
892 } else {
893 PerlIO_printf( Perl_debug_log, "%6s", "" );
894 }
895
896 PerlIO_printf( Perl_debug_log, " @%4"UVXf" ", (UV)base );
897
898 if ( base ) {
899 U32 ofs = 0;
900
901 while( ( base + ofs < trie->uniquecharcount ) ||
902 ( base + ofs - trie->uniquecharcount < trie->lasttrans
903 && trie->trans[ base + ofs - trie->uniquecharcount ].check != state))
904 ofs++;
905
906 PerlIO_printf( Perl_debug_log, "+%2"UVXf"[ ", (UV)ofs);
907
908 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
909 if ( ( base + ofs >= trie->uniquecharcount ) &&
910 ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
911 trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
912 {
ab3bbdeb
YO
913 PerlIO_printf( Perl_debug_log, "%*"UVXf,
914 colwidth,
3dab1dad
YO
915 (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next );
916 } else {
ab3bbdeb 917 PerlIO_printf( Perl_debug_log, "%*s",colwidth," ." );
3dab1dad
YO
918 }
919 }
920
921 PerlIO_printf( Perl_debug_log, "]");
922
923 }
924 PerlIO_printf( Perl_debug_log, "\n" );
925 }
926}
927/*
928 dump_trie_interim_list(trie,next_alloc)
929 Dumps a fully constructed but uncompressed trie in list form.
930 List tries normally only are used for construction when the number of
931 possible chars (trie->uniquecharcount) is very high.
932 Used for debugging make_trie().
933*/
934STATIC void
935S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, U32 next_alloc,U32 depth)
936{
937 U32 state;
ab3bbdeb
YO
938 SV *sv=sv_newmortal();
939 int colwidth= trie->widecharmap ? 6 : 4;
3dab1dad
YO
940 GET_RE_DEBUG_FLAGS_DECL;
941 /* print out the table precompression. */
ab3bbdeb
YO
942 PerlIO_printf( Perl_debug_log, "%*sState :Word | Transition Data\n%*s%s",
943 (int)depth * 2 + 2,"", (int)depth * 2 + 2,"",
944 "------:-----+-----------------\n" );
3dab1dad
YO
945
946 for( state=1 ; state < next_alloc ; state ++ ) {
947 U16 charid;
948
ab3bbdeb 949 PerlIO_printf( Perl_debug_log, "%*s %4"UVXf" :",
3dab1dad
YO
950 (int)depth * 2 + 2,"", (UV)state );
951 if ( ! trie->states[ state ].wordnum ) {
952 PerlIO_printf( Perl_debug_log, "%5s| ","");
953 } else {
954 PerlIO_printf( Perl_debug_log, "W%4x| ",
955 trie->states[ state ].wordnum
956 );
957 }
958 for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
be8e71aa 959 SV ** const tmp = av_fetch( trie->revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0);
ab3bbdeb
YO
960 if ( tmp ) {
961 PerlIO_printf( Perl_debug_log, "%*s:%3X=%4"UVXf" | ",
962 colwidth,
963 pv_pretty(sv, (U8*)SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
964 PL_colors[0], PL_colors[1],
965 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
966 PERL_PV_ESCAPE_FIRSTCHAR
967 ) ,
3dab1dad
YO
968 TRIE_LIST_ITEM(state,charid).forid,
969 (UV)TRIE_LIST_ITEM(state,charid).newstate
970 );
971 }
ab3bbdeb
YO
972 }
973 PerlIO_printf( Perl_debug_log, "\n");
3dab1dad
YO
974 }
975}
976
977/*
978 dump_trie_interim_table(trie,next_alloc)
979 Dumps a fully constructed but uncompressed trie in table form.
980 This is the normal DFA style state transition table, with a few
981 twists to facilitate compression later.
982 Used for debugging make_trie().
983*/
984STATIC void
985S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, U32 next_alloc, U32 depth)
986{
987 U32 state;
988 U16 charid;
ab3bbdeb
YO
989 SV *sv=sv_newmortal();
990 int colwidth= trie->widecharmap ? 6 : 4;
3dab1dad
YO
991 GET_RE_DEBUG_FLAGS_DECL;
992
993 /*
994 print out the table precompression so that we can do a visual check
995 that they are identical.
996 */
997
998 PerlIO_printf( Perl_debug_log, "%*sChar : ",(int)depth * 2 + 2,"" );
999
1000 for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
be8e71aa 1001 SV ** const tmp = av_fetch( trie->revcharmap, charid, 0);
3dab1dad 1002 if ( tmp ) {
ab3bbdeb
YO
1003 PerlIO_printf( Perl_debug_log, "%*s",
1004 colwidth,
1005 pv_pretty(sv, (U8*)SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
1006 PL_colors[0], PL_colors[1],
1007 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
1008 PERL_PV_ESCAPE_FIRSTCHAR
1009 )
1010 );
3dab1dad
YO
1011 }
1012 }
1013
1014 PerlIO_printf( Perl_debug_log, "\n%*sState+-",(int)depth * 2 + 2,"" );
1015
1016 for( charid=0 ; charid < trie->uniquecharcount ; charid++ ) {
ab3bbdeb 1017 PerlIO_printf( Perl_debug_log, "%.*s", colwidth,"--------");
3dab1dad
YO
1018 }
1019
1020 PerlIO_printf( Perl_debug_log, "\n" );
1021
1022 for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
1023
1024 PerlIO_printf( Perl_debug_log, "%*s%4"UVXf" : ",
1025 (int)depth * 2 + 2,"",
1026 (UV)TRIE_NODENUM( state ) );
1027
1028 for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
ab3bbdeb
YO
1029 UV v=(UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next );
1030 if (v)
1031 PerlIO_printf( Perl_debug_log, "%*"UVXf, colwidth, v );
1032 else
1033 PerlIO_printf( Perl_debug_log, "%*s", colwidth, "." );
3dab1dad
YO
1034 }
1035 if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
1036 PerlIO_printf( Perl_debug_log, " (%4"UVXf")\n", (UV)trie->trans[ state ].check );
1037 } else {
1038 PerlIO_printf( Perl_debug_log, " (%4"UVXf") W%4X\n", (UV)trie->trans[ state ].check,
1039 trie->states[ TRIE_NODENUM( state ) ].wordnum );
1040 }
1041 }
07be1b83 1042}
3dab1dad
YO
1043
1044#endif
1045
07be1b83
YO
1046#define TRIE_TRANS_STATE(state,base,ucharcount,charid,special) \
1047 ( ( base + charid >= ucharcount \
1048 && base + charid < ubound \
1049 && state == trie->trans[ base - ucharcount + charid ].check \
1050 && trie->trans[ base - ucharcount + charid ].next ) \
1051 ? trie->trans[ base - ucharcount + charid ].next \
1052 : ( state==1 ? special : 0 ) \
1053 )
3dab1dad 1054
07be1b83
YO
1055STATIC void
1056S_make_trie_failtable(pTHX_ RExC_state_t *pRExC_state, regnode *source, regnode *stclass, U32 depth)
1057{
1058/* The Trie is constructed and compressed now so we can build a fail array now if its needed
1059
1060 This is apparently the Aho-Corasick algorithm. Its from exercise 3.31 and 3.32 in the
1061 "Red Dragon" -- Compilers, principles, techniques, and tools. Aho, Sethi, Ullman 1985/88
1062 ISBN 0-201-10088-6
1063
1064 We find the fail state for each state in the trie, this state is the longest proper
1065 suffix of the current states 'word' that is also a proper prefix of another word in our
1066 trie. State 1 represents the word '' and is the thus the default fail state. This allows
1067 the DFA not to have to restart after its tried and failed a word at a given point, it
1068 simply continues as though it had been matching the other word in the first place.
1069 Consider
1070 'abcdgu'=~/abcdefg|cdgu/
1071 When we get to 'd' we are still matching the first word, we would encounter 'g' which would
1072 fail, which would bring use to the state representing 'd' in the second word where we would
1073 try 'g' and succeed, prodceding to match 'cdgu'.
1074 */
1075 /* add a fail transition */
1076 reg_trie_data *trie=(reg_trie_data *)RExC_rx->data->data[ARG(source)];
1077 U32 *q;
be8e71aa
YO
1078 const U32 ucharcount = trie->uniquecharcount;
1079 const U32 numstates = trie->laststate;
1080 const U32 ubound = trie->lasttrans + ucharcount;
07be1b83
YO
1081 U32 q_read = 0;
1082 U32 q_write = 0;
1083 U32 charid;
1084 U32 base = trie->states[ 1 ].trans.base;
07be1b83
YO
1085 U32 *fail;
1086 reg_ac_data *aho;
1087 const U32 data_slot = add_data( pRExC_state, 1, "T" );
72f13be8 1088 GET_RE_DEBUG_FLAGS_DECL;
f9049ba1
SP
1089#ifndef DEBUGGING
1090 PERL_UNUSED_ARG(depth);
1091#endif
72f13be8 1092
07be1b83
YO
1093
1094 ARG_SET( stclass, data_slot );
1095 Newxz( aho, 1, reg_ac_data );
1096 RExC_rx->data->data[ data_slot ] = (void*)aho;
1097 aho->trie=trie;
1098 aho->states=(reg_trie_state *)savepvn((const char*)trie->states,
1099 (trie->laststate+1)*sizeof(reg_trie_state));
1100 Newxz( q, numstates, U32);
1101 Newxz( aho->fail, numstates, U32 );
283d8f99
YO
1102 aho->refcount = 1;
1103 fail = aho->fail;
07be1b83
YO
1104 fail[ 0 ] = fail[ 1 ] = 1;
1105
1106 for ( charid = 0; charid < ucharcount ; charid++ ) {
be8e71aa
YO
1107 const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 );
1108 if ( newstate ) {
07be1b83
YO
1109 q[ q_write ] = newstate;
1110 /* set to point at the root */
1111 fail[ q[ q_write++ ] ]=1;
1112 }
1113 }
1114 while ( q_read < q_write) {
be8e71aa 1115 const U32 cur = q[ q_read++ % numstates ];
07be1b83
YO
1116 base = trie->states[ cur ].trans.base;
1117
1118 for ( charid = 0 ; charid < ucharcount ; charid++ ) {
be8e71aa
YO
1119 const U32 ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 );
1120 if (ch_state) {
07be1b83
YO
1121 U32 fail_state = cur;
1122 U32 fail_base;
1123 do {
1124 fail_state = fail[ fail_state ];
1125 fail_base = aho->states[ fail_state ].trans.base;
1126 } while ( !TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 ) );
1127
1128 fail_state = TRIE_TRANS_STATE( fail_state, fail_base, ucharcount, charid, 1 );
1129 fail[ ch_state ] = fail_state;
1130 if ( !aho->states[ ch_state ].wordnum && aho->states[ fail_state ].wordnum )
1131 {
1132 aho->states[ ch_state ].wordnum = aho->states[ fail_state ].wordnum;
1133 }
1134 q[ q_write++ % numstates] = ch_state;
1135 }
1136 }
1137 }
1138
1139 DEBUG_TRIE_COMPILE_MORE_r({
1140 PerlIO_printf(Perl_debug_log, "%*sFail: 1", (int)(depth * 2), "");
1141 for( q_read=2; q_read<numstates; q_read++ ) {
1142 PerlIO_printf(Perl_debug_log, ", %"UVuf, fail[q_read]);
1143 }
1144 PerlIO_printf(Perl_debug_log, "\n");
1145 });
1146 Safefree(q);
1147 /*RExC_seen |= REG_SEEN_TRIEDFA;*/
1148}
3dab1dad
YO
1149
1150
1151
a3621e74 1152STATIC I32
3dab1dad 1153S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 flags, U32 depth)
a3621e74 1154{
27da23d5 1155 dVAR;
a3621e74
YO
1156 /* first pass, loop through and scan words */
1157 reg_trie_data *trie;
1158 regnode *cur;
9f7f3913 1159 const U32 uniflags = UTF8_ALLOW_DEFAULT;
a3621e74
YO
1160 STRLEN len = 0;
1161 UV uvc = 0;
1162 U16 curword = 0;
1163 U32 next_alloc = 0;
1164 /* we just use folder as a flag in utf8 */
e1ec3a88 1165 const U8 * const folder = ( flags == EXACTF
a3621e74
YO
1166 ? PL_fold
1167 : ( flags == EXACTFL
1168 ? PL_fold_locale
1169 : NULL
1170 )
1171 );
1172
e1ec3a88 1173 const U32 data_slot = add_data( pRExC_state, 1, "t" );
a3621e74 1174 SV *re_trie_maxbuff;
3dab1dad
YO
1175#ifndef DEBUGGING
1176 /* these are only used during construction but are useful during
8e11feef
RGS
1177 * debugging so we store them in the struct when debugging.
1178 * Wordcount is actually superfluous in debugging as we have
1179 * (AV*)trie->words to use for it, but that's not available when
1180 * not debugging... We could make the macro use the AV during
1181 * debugging though...
1182 */
3dab1dad
YO
1183 U16 trie_wordcount=0;
1184 STRLEN trie_charcount=0;
07be1b83 1185 /*U32 trie_laststate=0;*/
3dab1dad
YO
1186 AV *trie_revcharmap;
1187#endif
a3621e74 1188 GET_RE_DEBUG_FLAGS_DECL;
72f13be8
YO
1189#ifndef DEBUGGING
1190 PERL_UNUSED_ARG(depth);
1191#endif
a3621e74 1192
a02a5408 1193 Newxz( trie, 1, reg_trie_data );
a3621e74 1194 trie->refcount = 1;
3dab1dad 1195 trie->startstate = 1;
a3621e74 1196 RExC_rx->data->data[ data_slot ] = (void*)trie;
a02a5408 1197 Newxz( trie->charmap, 256, U16 );
3dab1dad
YO
1198 if (!(UTF && folder))
1199 Newxz( trie->bitmap, ANYOF_BITMAP_SIZE, char );
a3621e74
YO
1200 DEBUG_r({
1201 trie->words = newAV();
a3621e74 1202 });
3dab1dad 1203 TRIE_REVCHARMAP(trie) = newAV();
a3621e74 1204
0111c4fd 1205 re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
a3621e74 1206 if (!SvIOK(re_trie_maxbuff)) {
0111c4fd 1207 sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
a3621e74 1208 }
3dab1dad
YO
1209 DEBUG_OPTIMISE_r({
1210 PerlIO_printf( Perl_debug_log,
1211 "%*smake_trie start==%d, first==%d, last==%d, tail==%d\n",
1212 (int)depth * 2 + 2, "",
1213 REG_NODE_NUM(startbranch),REG_NODE_NUM(first),
1214 REG_NODE_NUM(last), REG_NODE_NUM(tail));
1215 });
a3621e74
YO
1216 /* -- First loop and Setup --
1217
1218 We first traverse the branches and scan each word to determine if it
1219 contains widechars, and how many unique chars there are, this is
1220 important as we have to build a table with at least as many columns as we
1221 have unique chars.
1222
1223 We use an array of integers to represent the character codes 0..255
1224 (trie->charmap) and we use a an HV* to store unicode characters. We use the
1225 native representation of the character value as the key and IV's for the
1226 coded index.
1227
1228 *TODO* If we keep track of how many times each character is used we can
1229 remap the columns so that the table compression later on is more
1230 efficient in terms of memory by ensuring most common value is in the
1231 middle and the least common are on the outside. IMO this would be better
1232 than a most to least common mapping as theres a decent chance the most
1233 common letter will share a node with the least common, meaning the node
1234 will not be compressable. With a middle is most common approach the worst
1235 case is when we have the least common nodes twice.
1236
1237 */
1238
a3621e74 1239 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
c445ea15 1240 regnode * const noper = NEXTOPER( cur );
e1ec3a88 1241 const U8 *uc = (U8*)STRING( noper );
a28509cc 1242 const U8 * const e = uc + STR_LEN( noper );
a3621e74
YO
1243 STRLEN foldlen = 0;
1244 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
2af232bd 1245 const U8 *scan = (U8*)NULL;
07be1b83 1246 U32 wordlen = 0; /* required init */
3dab1dad 1247 STRLEN chars=0;
a3621e74 1248
3dab1dad
YO
1249 TRIE_WORDCOUNT(trie)++;
1250 if (OP(noper) == NOTHING) {
1251 trie->minlen= 0;
1252 continue;
1253 }
1254 if (trie->bitmap) {
1255 TRIE_BITMAP_SET(trie,*uc);
1256 if ( folder ) TRIE_BITMAP_SET(trie,folder[ *uc ]);
1257 }
a3621e74 1258 for ( ; uc < e ; uc += len ) {
3dab1dad 1259 TRIE_CHARCOUNT(trie)++;
a3621e74 1260 TRIE_READ_CHAR;
3dab1dad 1261 chars++;
a3621e74
YO
1262 if ( uvc < 256 ) {
1263 if ( !trie->charmap[ uvc ] ) {
1264 trie->charmap[ uvc ]=( ++trie->uniquecharcount );
1265 if ( folder )
1266 trie->charmap[ folder[ uvc ] ] = trie->charmap[ uvc ];
3dab1dad 1267 TRIE_STORE_REVCHAR;
a3621e74
YO
1268 }
1269 } else {
1270 SV** svpp;
1271 if ( !trie->widecharmap )
1272 trie->widecharmap = newHV();
1273
1274 svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 1 );
1275
1276 if ( !svpp )
e4584336 1277 Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%"UVXf, uvc );
a3621e74
YO
1278
1279 if ( !SvTRUE( *svpp ) ) {
1280 sv_setiv( *svpp, ++trie->uniquecharcount );
3dab1dad 1281 TRIE_STORE_REVCHAR;
a3621e74
YO
1282 }
1283 }
1284 }
3dab1dad
YO
1285 if( cur == first ) {
1286 trie->minlen=chars;
1287 trie->maxlen=chars;
1288 } else if (chars < trie->minlen) {
1289 trie->minlen=chars;
1290 } else if (chars > trie->maxlen) {
1291 trie->maxlen=chars;
1292 }
1293
a3621e74
YO
1294 } /* end first pass */
1295 DEBUG_TRIE_COMPILE_r(
3dab1dad
YO
1296 PerlIO_printf( Perl_debug_log, "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
1297 (int)depth * 2 + 2,"",
1298 ( trie->widecharmap ? "UTF8" : "NATIVE" ), TRIE_WORDCOUNT(trie),
be8e71aa
YO
1299 (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount,
1300 (int)trie->minlen, (int)trie->maxlen )
a3621e74 1301 );
07be1b83 1302 Newxz( trie->wordlen, TRIE_WORDCOUNT(trie), U32 );
a3621e74
YO
1303
1304 /*
1305 We now know what we are dealing with in terms of unique chars and
1306 string sizes so we can calculate how much memory a naive
0111c4fd
RGS
1307 representation using a flat table will take. If it's over a reasonable
1308 limit (as specified by ${^RE_TRIE_MAXBUF}) we use a more memory
a3621e74
YO
1309 conservative but potentially much slower representation using an array
1310 of lists.
1311
1312 At the end we convert both representations into the same compressed
1313 form that will be used in regexec.c for matching with. The latter
1314 is a form that cannot be used to construct with but has memory
1315 properties similar to the list form and access properties similar
1316 to the table form making it both suitable for fast searches and
1317 small enough that its feasable to store for the duration of a program.
1318
1319 See the comment in the code where the compressed table is produced
1320 inplace from the flat tabe representation for an explanation of how
1321 the compression works.
1322
1323 */
1324
1325
3dab1dad 1326 if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1) > SvIV(re_trie_maxbuff) ) {
a3621e74
YO
1327 /*
1328 Second Pass -- Array Of Lists Representation
1329
1330 Each state will be represented by a list of charid:state records
1331 (reg_trie_trans_le) the first such element holds the CUR and LEN
1332 points of the allocated array. (See defines above).
1333
1334 We build the initial structure using the lists, and then convert
1335 it into the compressed table form which allows faster lookups
1336 (but cant be modified once converted).
a3621e74
YO
1337 */
1338
a3621e74
YO
1339 STRLEN transcount = 1;
1340
3dab1dad 1341 Newxz( trie->states, TRIE_CHARCOUNT(trie) + 2, reg_trie_state );
a3621e74
YO
1342 TRIE_LIST_NEW(1);
1343 next_alloc = 2;
1344
1345 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1346
c445ea15
AL
1347 regnode * const noper = NEXTOPER( cur );
1348 U8 *uc = (U8*)STRING( noper );
1349 const U8 * const e = uc + STR_LEN( noper );
1350 U32 state = 1; /* required init */
1351 U16 charid = 0; /* sanity init */
1352 U8 *scan = (U8*)NULL; /* sanity init */
1353 STRLEN foldlen = 0; /* required init */
07be1b83 1354 U32 wordlen = 0; /* required init */
c445ea15
AL
1355 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1356
3dab1dad 1357 if (OP(noper) != NOTHING) {
c445ea15
AL
1358 for ( ; uc < e ; uc += len ) {
1359
1360 TRIE_READ_CHAR;
1361
1362 if ( uvc < 256 ) {
1363 charid = trie->charmap[ uvc ];
1364 } else {
1365 SV** const svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 0);
1366 if ( !svpp ) {
1367 charid = 0;
1368 } else {
1369 charid=(U16)SvIV( *svpp );
1370 }
1371 }
1372 if ( charid ) {
a3621e74 1373
c445ea15
AL
1374 U16 check;
1375 U32 newstate = 0;
a3621e74 1376
c445ea15
AL
1377 charid--;
1378 if ( !trie->states[ state ].trans.list ) {
1379 TRIE_LIST_NEW( state );
1380 }
1381 for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) {
1382 if ( TRIE_LIST_ITEM( state, check ).forid == charid ) {
1383 newstate = TRIE_LIST_ITEM( state, check ).newstate;
1384 break;
1385 }
1386 }
1387 if ( ! newstate ) {
1388 newstate = next_alloc++;
1389 TRIE_LIST_PUSH( state, charid, newstate );
1390 transcount++;
1391 }
1392 state = newstate;
1393 } else {
1394 Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
a28509cc 1395 }
c445ea15
AL
1396 /* charid is now 0 if we dont know the char read, or nonzero if we do */
1397 }
c445ea15 1398 }
3dab1dad 1399 TRIE_HANDLE_WORD(state);
a3621e74
YO
1400
1401 } /* end second pass */
1402
3dab1dad 1403 TRIE_LASTSTATE(trie) = next_alloc;
a3621e74
YO
1404 Renew( trie->states, next_alloc, reg_trie_state );
1405
3dab1dad
YO
1406 /* and now dump it out before we compress it */
1407 DEBUG_TRIE_COMPILE_MORE_r(
1408 dump_trie_interim_list(trie,next_alloc,depth+1)
a3621e74 1409 );
a3621e74 1410
a02a5408 1411 Newxz( trie->trans, transcount ,reg_trie_trans );
a3621e74
YO
1412 {
1413 U32 state;
a3621e74
YO
1414 U32 tp = 0;
1415 U32 zp = 0;
1416
1417
1418 for( state=1 ; state < next_alloc ; state ++ ) {
1419 U32 base=0;
1420
1421 /*
1422 DEBUG_TRIE_COMPILE_MORE_r(
1423 PerlIO_printf( Perl_debug_log, "tp: %d zp: %d ",tp,zp)
1424 );
1425 */
1426
1427 if (trie->states[state].trans.list) {
1428 U16 minid=TRIE_LIST_ITEM( state, 1).forid;
1429 U16 maxid=minid;
a28509cc 1430 U16 idx;
a3621e74
YO
1431
1432 for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
c445ea15
AL
1433 const U16 forid = TRIE_LIST_ITEM( state, idx).forid;
1434 if ( forid < minid ) {
1435 minid=forid;
1436 } else if ( forid > maxid ) {
1437 maxid=forid;
1438 }
a3621e74
YO
1439 }
1440 if ( transcount < tp + maxid - minid + 1) {
1441 transcount *= 2;
1442 Renew( trie->trans, transcount, reg_trie_trans );
1443 Zero( trie->trans + (transcount / 2), transcount / 2 , reg_trie_trans );
1444 }
1445 base = trie->uniquecharcount + tp - minid;
1446 if ( maxid == minid ) {
1447 U32 set = 0;
1448 for ( ; zp < tp ; zp++ ) {
1449 if ( ! trie->trans[ zp ].next ) {
1450 base = trie->uniquecharcount + zp - minid;
1451 trie->trans[ zp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1452 trie->trans[ zp ].check = state;
1453 set = 1;
1454 break;
1455 }
1456 }
1457 if ( !set ) {
1458 trie->trans[ tp ].next = TRIE_LIST_ITEM( state, 1).newstate;
1459 trie->trans[ tp ].check = state;
1460 tp++;
1461 zp = tp;
1462 }
1463 } else {
1464 for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
c445ea15 1465 const U32 tid = base - trie->uniquecharcount + TRIE_LIST_ITEM( state, idx ).forid;
a3621e74
YO
1466 trie->trans[ tid ].next = TRIE_LIST_ITEM( state, idx ).newstate;
1467 trie->trans[ tid ].check = state;
1468 }
1469 tp += ( maxid - minid + 1 );
1470 }
1471 Safefree(trie->states[ state ].trans.list);
1472 }
1473 /*
1474 DEBUG_TRIE_COMPILE_MORE_r(
1475 PerlIO_printf( Perl_debug_log, " base: %d\n",base);
1476 );
1477 */
1478 trie->states[ state ].trans.base=base;
1479 }
cc601c31 1480 trie->lasttrans = tp + 1;
a3621e74
YO
1481 }
1482 } else {
1483 /*
1484 Second Pass -- Flat Table Representation.
1485
1486 we dont use the 0 slot of either trans[] or states[] so we add 1 to each.
1487 We know that we will need Charcount+1 trans at most to store the data
1488 (one row per char at worst case) So we preallocate both structures
1489 assuming worst case.
1490
1491 We then construct the trie using only the .next slots of the entry
1492 structs.
1493
1494 We use the .check field of the first entry of the node temporarily to
1495 make compression both faster and easier by keeping track of how many non
1496 zero fields are in the node.
1497
1498 Since trans are numbered from 1 any 0 pointer in the table is a FAIL
1499 transition.
1500
1501 There are two terms at use here: state as a TRIE_NODEIDX() which is a
1502 number representing the first entry of the node, and state as a
1503 TRIE_NODENUM() which is the trans number. state 1 is TRIE_NODEIDX(1) and
1504 TRIE_NODENUM(1), state 2 is TRIE_NODEIDX(2) and TRIE_NODENUM(3) if there
1505 are 2 entrys per node. eg:
1506
1507 A B A B
1508 1. 2 4 1. 3 7
1509 2. 0 3 3. 0 5
1510 3. 0 0 5. 0 0
1511 4. 0 0 7. 0 0
1512
1513 The table is internally in the right hand, idx form. However as we also
1514 have to deal with the states array which is indexed by nodenum we have to
1515 use TRIE_NODENUM() to convert.
1516
1517 */
1518
3dab1dad
YO
1519
1520 Newxz( trie->trans, ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1,
a3621e74 1521 reg_trie_trans );
3dab1dad 1522 Newxz( trie->states, TRIE_CHARCOUNT(trie) + 2, reg_trie_state );
a3621e74
YO
1523 next_alloc = trie->uniquecharcount + 1;
1524
3dab1dad 1525
a3621e74
YO
1526 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
1527
c445ea15 1528 regnode * const noper = NEXTOPER( cur );
a28509cc
AL
1529 const U8 *uc = (U8*)STRING( noper );
1530 const U8 * const e = uc + STR_LEN( noper );
a3621e74
YO
1531
1532 U32 state = 1; /* required init */
1533
1534 U16 charid = 0; /* sanity init */
1535 U32 accept_state = 0; /* sanity init */
1536 U8 *scan = (U8*)NULL; /* sanity init */
1537
1538 STRLEN foldlen = 0; /* required init */
07be1b83 1539 U32 wordlen = 0; /* required init */
a3621e74
YO
1540 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1541
3dab1dad 1542 if ( OP(noper) != NOTHING ) {
a3621e74
YO
1543 for ( ; uc < e ; uc += len ) {
1544
1545 TRIE_READ_CHAR;
1546
1547 if ( uvc < 256 ) {
1548 charid = trie->charmap[ uvc ];
1549 } else {
c445ea15
AL
1550 SV* const * const svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 0);
1551 charid = svpp ? (U16)SvIV(*svpp) : 0;
a3621e74
YO
1552 }
1553 if ( charid ) {
1554 charid--;
1555 if ( !trie->trans[ state + charid ].next ) {
1556 trie->trans[ state + charid ].next = next_alloc;
1557 trie->trans[ state ].check++;
1558 next_alloc += trie->uniquecharcount;
1559 }
1560 state = trie->trans[ state + charid ].next;
1561 } else {
e4584336 1562 Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
a3621e74
YO
1563 }
1564 /* charid is now 0 if we dont know the char read, or nonzero if we do */
1565 }
a3621e74 1566 }
3dab1dad
YO
1567 accept_state = TRIE_NODENUM( state );
1568 TRIE_HANDLE_WORD(accept_state);
a3621e74
YO
1569
1570 } /* end second pass */
1571
3dab1dad
YO
1572 /* and now dump it out before we compress it */
1573 DEBUG_TRIE_COMPILE_MORE_r(
1574 dump_trie_interim_table(trie,next_alloc,depth+1)
1575 );
a3621e74 1576
a3621e74
YO
1577 {
1578 /*
1579 * Inplace compress the table.*
1580
1581 For sparse data sets the table constructed by the trie algorithm will
1582 be mostly 0/FAIL transitions or to put it another way mostly empty.
1583 (Note that leaf nodes will not contain any transitions.)
1584
1585 This algorithm compresses the tables by eliminating most such
1586 transitions, at the cost of a modest bit of extra work during lookup:
1587
1588 - Each states[] entry contains a .base field which indicates the
1589 index in the state[] array wheres its transition data is stored.
1590
1591 - If .base is 0 there are no valid transitions from that node.
1592
1593 - If .base is nonzero then charid is added to it to find an entry in
1594 the trans array.
1595
1596 -If trans[states[state].base+charid].check!=state then the
1597 transition is taken to be a 0/Fail transition. Thus if there are fail
1598 transitions at the front of the node then the .base offset will point
1599 somewhere inside the previous nodes data (or maybe even into a node
1600 even earlier), but the .check field determines if the transition is
1601 valid.
1602
1603 The following process inplace converts the table to the compressed
1604 table: We first do not compress the root node 1,and mark its all its
1605 .check pointers as 1 and set its .base pointer as 1 as well. This
1606 allows to do a DFA construction from the compressed table later, and
1607 ensures that any .base pointers we calculate later are greater than
1608 0.
1609
1610 - We set 'pos' to indicate the first entry of the second node.
1611
1612 - We then iterate over the columns of the node, finding the first and
1613 last used entry at l and m. We then copy l..m into pos..(pos+m-l),
1614 and set the .check pointers accordingly, and advance pos
1615 appropriately and repreat for the next node. Note that when we copy
1616 the next pointers we have to convert them from the original
1617 NODEIDX form to NODENUM form as the former is not valid post
1618 compression.
1619
1620 - If a node has no transitions used we mark its base as 0 and do not
1621 advance the pos pointer.
1622
1623 - If a node only has one transition we use a second pointer into the
1624 structure to fill in allocated fail transitions from other states.
1625 This pointer is independent of the main pointer and scans forward
1626 looking for null transitions that are allocated to a state. When it
1627 finds one it writes the single transition into the "hole". If the
1628 pointer doesnt find one the single transition is appeneded as normal.
1629
1630 - Once compressed we can Renew/realloc the structures to release the
1631 excess space.
1632
1633 See "Table-Compression Methods" in sec 3.9 of the Red Dragon,
1634 specifically Fig 3.47 and the associated pseudocode.
1635
1636 demq
1637 */
a3b680e6 1638 const U32 laststate = TRIE_NODENUM( next_alloc );
a28509cc 1639 U32 state, charid;
a3621e74 1640 U32 pos = 0, zp=0;
3dab1dad 1641 TRIE_LASTSTATE(trie) = laststate;
a3621e74
YO
1642
1643 for ( state = 1 ; state < laststate ; state++ ) {
1644 U8 flag = 0;
a28509cc
AL
1645 const U32 stateidx = TRIE_NODEIDX( state );
1646 const U32 o_used = trie->trans[ stateidx ].check;
1647 U32 used = trie->trans[ stateidx ].check;
a3621e74
YO
1648 trie->trans[ stateidx ].check = 0;
1649
1650 for ( charid = 0 ; used && charid < trie->uniquecharcount ; charid++ ) {
1651 if ( flag || trie->trans[ stateidx + charid ].next ) {
1652 if ( trie->trans[ stateidx + charid ].next ) {
1653 if (o_used == 1) {
1654 for ( ; zp < pos ; zp++ ) {
1655 if ( ! trie->trans[ zp ].next ) {
1656 break;
1657 }
1658 }
1659 trie->states[ state ].trans.base = zp + trie->uniquecharcount - charid ;
1660 trie->trans[ zp ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1661 trie->trans[ zp ].check = state;
1662 if ( ++zp > pos ) pos = zp;
1663 break;
1664 }
1665 used--;
1666 }
1667 if ( !flag ) {
1668 flag = 1;
1669 trie->states[ state ].trans.base = pos + trie->uniquecharcount - charid ;
1670 }
1671 trie->trans[ pos ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
1672 trie->trans[ pos ].check = state;
1673 pos++;
1674 }
1675 }
1676 }
cc601c31 1677 trie->lasttrans = pos + 1;
a3621e74
YO
1678 Renew( trie->states, laststate + 1, reg_trie_state);
1679 DEBUG_TRIE_COMPILE_MORE_r(
e4584336 1680 PerlIO_printf( Perl_debug_log,
3dab1dad
YO
1681 "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
1682 (int)depth * 2 + 2,"",
1683 (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1 ),
5d7488b2
AL
1684 (IV)next_alloc,
1685 (IV)pos,
a3621e74
YO
1686 ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
1687 );
1688
1689 } /* end table compress */
1690 }
cc601c31
YO
1691 /* resize the trans array to remove unused space */
1692 Renew( trie->trans, trie->lasttrans, reg_trie_trans);
a3621e74 1693
3dab1dad
YO
1694 /* and now dump out the compressed format */
1695 DEBUG_TRIE_COMPILE_r(
1696 dump_trie(trie,depth+1)
1697 );
07be1b83 1698
3dab1dad
YO
1699 { /* Modify the program and insert the new TRIE node*/
1700 regnode *convert;
1701 U8 nodetype =(U8)(flags & 0xFF);
1702 char *str=NULL;
07be1b83
YO
1703#ifdef DEBUGGING
1704 U32 mjd_offset;
1705 U32 mjd_nodelen;
1706#endif
a3621e74 1707 /*
3dab1dad
YO
1708 This means we convert either the first branch or the first Exact,
1709 depending on whether the thing following (in 'last') is a branch
1710 or not and whther first is the startbranch (ie is it a sub part of
1711 the alternation or is it the whole thing.)
1712 Assuming its a sub part we conver the EXACT otherwise we convert
1713 the whole branch sequence, including the first.
a3621e74 1714 */
3dab1dad
YO
1715 /* Find the node we are going to overwrite */
1716 if ( first == startbranch && OP( last ) != BRANCH ) {
07be1b83 1717 /* whole branch chain */
3dab1dad 1718 convert = first;
07be1b83
YO
1719 DEBUG_r({
1720 const regnode *nop = NEXTOPER( convert );
1721 mjd_offset= Node_Offset((nop));
1722 mjd_nodelen= Node_Length((nop));
1723 });
1724 } else {
1725 /* branch sub-chain */
3dab1dad
YO
1726 convert = NEXTOPER( first );
1727 NEXT_OFF( first ) = (U16)(last - first);
07be1b83
YO
1728 DEBUG_r({
1729 mjd_offset= Node_Offset((convert));
1730 mjd_nodelen= Node_Length((convert));
1731 });
1732 }
1733 DEBUG_OPTIMISE_r(
1734 PerlIO_printf(Perl_debug_log, "%*sMJD offset:%"UVuf" MJD length:%"UVuf"\n",
1735 (int)depth * 2 + 2, "",
1736 mjd_offset,mjd_nodelen)
1737 );
a3621e74 1738
3dab1dad
YO
1739 /* But first we check to see if there is a common prefix we can
1740 split out as an EXACT and put in front of the TRIE node. */
1741 trie->startstate= 1;
1742 if ( trie->bitmap && !trie->widecharmap ) {
1743 U32 state;
1744 DEBUG_OPTIMISE_r(
8e11feef
RGS
1745 PerlIO_printf(Perl_debug_log, "%*sLaststate:%"UVuf"\n",
1746 (int)depth * 2 + 2, "",
1747 TRIE_LASTSTATE(trie))
1748 );
1749 for ( state = 1 ; state < TRIE_LASTSTATE(trie)-1 ; state++ ) {
a3621e74 1750 U32 ofs = 0;
8e11feef
RGS
1751 I32 idx = -1;
1752 U32 count = 0;
1753 const U32 base = trie->states[ state ].trans.base;
a3621e74 1754
3dab1dad 1755 if ( trie->states[state].wordnum )
8e11feef 1756 count = 1;
a3621e74 1757
8e11feef 1758 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
cc601c31
YO
1759 if ( ( base + ofs >= trie->uniquecharcount ) &&
1760 ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
a3621e74
YO
1761 trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
1762 {
3dab1dad 1763 if ( ++count > 1 ) {
8e11feef 1764 SV **tmp = av_fetch( TRIE_REVCHARMAP(trie), ofs, 0);
07be1b83 1765 const U8 *ch = (U8*)SvPV_nolen_const( *tmp );
8e11feef 1766 if ( state == 1 ) break;
3dab1dad
YO
1767 if ( count == 2 ) {
1768 Zero(trie->bitmap, ANYOF_BITMAP_SIZE, char);
1769 DEBUG_OPTIMISE_r(
8e11feef
RGS
1770 PerlIO_printf(Perl_debug_log,
1771 "%*sNew Start State=%"UVuf" Class: [",
1772 (int)depth * 2 + 2, "",
3dab1dad 1773 state));
be8e71aa
YO
1774 if (idx >= 0) {
1775 SV ** const tmp = av_fetch( TRIE_REVCHARMAP(trie), idx, 0);
1776 const U8 * const ch = (U8*)SvPV_nolen_const( *tmp );
8e11feef 1777
3dab1dad 1778 TRIE_BITMAP_SET(trie,*ch);
8e11feef
RGS
1779 if ( folder )
1780 TRIE_BITMAP_SET(trie, folder[ *ch ]);
3dab1dad 1781 DEBUG_OPTIMISE_r(
07be1b83 1782 PerlIO_printf(Perl_debug_log, (char*)ch)
3dab1dad 1783 );
8e11feef
RGS
1784 }
1785 }
1786 TRIE_BITMAP_SET(trie,*ch);
1787 if ( folder )
1788 TRIE_BITMAP_SET(trie,folder[ *ch ]);
1789 DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"%s", ch));
1790 }
1791 idx = ofs;
1792 }
3dab1dad
YO
1793 }
1794 if ( count == 1 ) {
1795 SV **tmp = av_fetch( TRIE_REVCHARMAP(trie), idx, 0);
8e11feef 1796 const char *ch = SvPV_nolen_const( *tmp );
3dab1dad 1797 DEBUG_OPTIMISE_r(
8e11feef
RGS
1798 PerlIO_printf( Perl_debug_log,
1799 "%*sPrefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
1800 (int)depth * 2 + 2, "",
1801 state, idx, ch)
3dab1dad
YO
1802 );
1803 if ( state==1 ) {
1804 OP( convert ) = nodetype;
1805 str=STRING(convert);
1806 STR_LEN(convert)=0;
1807 }
1808 *str++=*ch;
1809 STR_LEN(convert)++;
a3621e74 1810
8e11feef 1811 } else {
f9049ba1 1812#ifdef DEBUGGING
8e11feef
RGS
1813 if (state>1)
1814 DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"]\n"));
f9049ba1 1815#endif
8e11feef
RGS
1816 break;
1817 }
1818 }
3dab1dad 1819 if (str) {
8e11feef 1820 regnode *n = convert+NODE_SZ_STR(convert);
07be1b83 1821 NEXT_OFF(convert) = NODE_SZ_STR(convert);
8e11feef 1822 trie->startstate = state;
07be1b83
YO
1823 trie->minlen -= (state - 1);
1824 trie->maxlen -= (state - 1);
1825 DEBUG_r({
1826 regnode *fix = convert;
1827 mjd_nodelen++;
1828 Set_Node_Offset_Length(convert, mjd_offset, state - 1);
1829 while( ++fix < n ) {
1830 Set_Node_Offset_Length(fix, 0, 0);
1831 }
1832 });
8e11feef
RGS
1833 if (trie->maxlen) {
1834 convert = n;
1835 } else {
3dab1dad
YO
1836 NEXT_OFF(convert) = (U16)(tail - convert);
1837 }
1838 }
1839 }
1840 if ( trie->maxlen ) {
1841 OP( convert ) = TRIE;
8e11feef
RGS
1842 NEXT_OFF( convert ) = (U16)(tail - convert);
1843 ARG_SET( convert, data_slot );
a3621e74 1844
3dab1dad
YO
1845 /* store the type in the flags */
1846 convert->flags = nodetype;
1847 /* XXX We really should free up the resource in trie now, as we wont use them */
1848 }
a3621e74
YO
1849 /* needed for dumping*/
1850 DEBUG_r({
1851 regnode *optimize = convert + NODE_STEP_REGNODE + regarglen[ TRIE ];
07be1b83
YO
1852 regnode *opt = convert;
1853 while (++opt<optimize) {
1854 Set_Node_Offset_Length(opt,0,0);
1855 }
a3621e74
YO
1856 /* We now need to mark all of the space originally used by the
1857 branches as optimized away. This keeps the dumpuntil from
1858 throwing a wobbly as it doesnt use regnext() to traverse the
1859 opcodes.
07be1b83 1860 We also "fix" the offsets
a3621e74
YO
1861 */
1862 while( optimize < last ) {
07be1b83 1863 mjd_nodelen += Node_Length((optimize));
a3621e74 1864 OP( optimize ) = OPTIMIZED;
07be1b83 1865 Set_Node_Offset_Length(optimize,0,0);
a3621e74
YO
1866 optimize++;
1867 }
07be1b83 1868 Set_Node_Offset_Length(convert,mjd_offset,mjd_nodelen);
a3621e74
YO
1869 });
1870 } /* end node insert */
07be1b83 1871#ifndef DEBUGGING
6e8b4190 1872 SvREFCNT_dec(TRIE_REVCHARMAP(trie));
07be1b83 1873#endif
a3621e74
YO
1874 return 1;
1875}
1876
a3621e74 1877/*
5d1c421c
JH
1878 * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2.
1879 * These need to be revisited when a newer toolchain becomes available.
1880 */
1881#if defined(__sparc64__) && defined(__GNUC__)
1882# if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
1883# undef SPARC64_GCC_WORKAROUND
1884# define SPARC64_GCC_WORKAROUND 1
1885# endif
1886#endif
1887
07be1b83
YO
1888#define DEBUG_PEEP(str,scan,depth) \
1889 DEBUG_OPTIMISE_r({ \
1890 SV * const mysv=sv_newmortal(); \
1891 regnode *Next = regnext(scan); \
1892 regprop(RExC_rx, mysv, scan); \
1893 PerlIO_printf(Perl_debug_log, "%*s" str ">%3d: %s [%d]\n", \
1894 (int)depth*2, "", REG_NODE_NUM(scan), SvPV_nolen_const(mysv),\
1895 Next ? (REG_NODE_NUM(Next)) : 0 ); \
1896 });
1897
1898#define JOIN_EXACT(scan,min,flags) \
1899 if (PL_regkind[OP(scan)] == EXACT) \
1900 join_exact(pRExC_state,(scan),(min),(flags),NULL,depth+1)
1901
be8e71aa 1902STATIC U32
07be1b83
YO
1903S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, I32 *min, U32 flags,regnode *val, U32 depth) {
1904 /* Merge several consecutive EXACTish nodes into one. */
1905 regnode *n = regnext(scan);
1906 U32 stringok = 1;
1907 regnode *next = scan + NODE_SZ_STR(scan);
1908 U32 merged = 0;
1909 U32 stopnow = 0;
1910#ifdef DEBUGGING
1911 regnode *stop = scan;
72f13be8 1912 GET_RE_DEBUG_FLAGS_DECL;
f9049ba1 1913#else
d47053eb
RGS
1914 PERL_UNUSED_ARG(depth);
1915#endif
1916#ifndef EXPERIMENTAL_INPLACESCAN
f9049ba1
SP
1917 PERL_UNUSED_ARG(flags);
1918 PERL_UNUSED_ARG(val);
07be1b83 1919#endif
07be1b83
YO
1920 DEBUG_PEEP("join",scan,depth);
1921
1922 /* Skip NOTHING, merge EXACT*. */
1923 while (n &&
1924 ( PL_regkind[OP(n)] == NOTHING ||
1925 (stringok && (OP(n) == OP(scan))))
1926 && NEXT_OFF(n)
1927 && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
1928
1929 if (OP(n) == TAIL || n > next)
1930 stringok = 0;
1931 if (PL_regkind[OP(n)] == NOTHING) {
07be1b83
YO
1932 DEBUG_PEEP("skip:",n,depth);
1933 NEXT_OFF(scan) += NEXT_OFF(n);
1934 next = n + NODE_STEP_REGNODE;
1935#ifdef DEBUGGING
1936 if (stringok)
1937 stop = n;
1938#endif
1939 n = regnext(n);
1940 }
1941 else if (stringok) {
1942 const int oldl = STR_LEN(scan);
1943 regnode * const nnext = regnext(n);
1944
1945 DEBUG_PEEP("merg",n,depth);
1946
1947 merged++;
1948 if (oldl + STR_LEN(n) > U8_MAX)
1949 break;
1950 NEXT_OFF(scan) += NEXT_OFF(n);
1951 STR_LEN(scan) += STR_LEN(n);
1952 next = n + NODE_SZ_STR(n);
1953 /* Now we can overwrite *n : */
1954 Move(STRING(n), STRING(scan) + oldl, STR_LEN(n), char);
1955#ifdef DEBUGGING
1956 stop = next - 1;
1957#endif
1958 n = nnext;
1959 if (stopnow) break;
1960 }
1961
d47053eb
RGS
1962#ifdef EXPERIMENTAL_INPLACESCAN
1963 if (flags && !NEXT_OFF(n)) {
1964 DEBUG_PEEP("atch", val, depth);
1965 if (reg_off_by_arg[OP(n)]) {
1966 ARG_SET(n, val - n);
1967 }
1968 else {
1969 NEXT_OFF(n) = val - n;
1970 }
1971 stopnow = 1;
1972 }
07be1b83
YO
1973#endif
1974 }
1975
1976 if (UTF && ( OP(scan) == EXACTF ) && ( STR_LEN(scan) >= 6 ) ) {
1977 /*
1978 Two problematic code points in Unicode casefolding of EXACT nodes:
1979
1980 U+0390 - GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
1981 U+03B0 - GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
1982
1983 which casefold to
1984
1985 Unicode UTF-8
1986
1987 U+03B9 U+0308 U+0301 0xCE 0xB9 0xCC 0x88 0xCC 0x81
1988 U+03C5 U+0308 U+0301 0xCF 0x85 0xCC 0x88 0xCC 0x81
1989
1990 This means that in case-insensitive matching (or "loose matching",
1991 as Unicode calls it), an EXACTF of length six (the UTF-8 encoded byte
1992 length of the above casefolded versions) can match a target string
1993 of length two (the byte length of UTF-8 encoded U+0390 or U+03B0).
1994 This would rather mess up the minimum length computation.
1995
1996 What we'll do is to look for the tail four bytes, and then peek
1997 at the preceding two bytes to see whether we need to decrease
1998 the minimum length by four (six minus two).
1999
2000 Thanks to the design of UTF-8, there cannot be false matches:
2001 A sequence of valid UTF-8 bytes cannot be a subsequence of
2002 another valid sequence of UTF-8 bytes.
2003
2004 */
2005 char * const s0 = STRING(scan), *s, *t;
2006 char * const s1 = s0 + STR_LEN(scan) - 1;
2007 char * const s2 = s1 - 4;
2008 const char t0[] = "\xcc\x88\xcc\x81";
2009 const char * const t1 = t0 + 3;
2010
2011 for (s = s0 + 2;
2012 s < s2 && (t = ninstr(s, s1, t0, t1));
2013 s = t + 4) {
2014 if (((U8)t[-1] == 0xB9 && (U8)t[-2] == 0xCE) ||
2015 ((U8)t[-1] == 0x85 && (U8)t[-2] == 0xCF))
2016 *min -= 4;
2017 }
2018 }
2019
2020#ifdef DEBUGGING
2021 /* Allow dumping */
2022 n = scan + NODE_SZ_STR(scan);
2023 while (n <= stop) {
2024 if (PL_regkind[OP(n)] != NOTHING || OP(n) == NOTHING) {
2025 OP(n) = OPTIMIZED;
2026 NEXT_OFF(n) = 0;
2027 }
2028 n++;
2029 }
2030#endif
2031 DEBUG_OPTIMISE_r(if (merged){DEBUG_PEEP("finl",scan,depth)});
2032 return stopnow;
2033}
2034
653099ff
GS
2035/* REx optimizer. Converts nodes into quickier variants "in place".
2036 Finds fixed substrings. */
2037
a0288114 2038/* Stops at toplevel WHILEM as well as at "last". At end *scanp is set
c277df42
IZ
2039 to the position after last scanned or to NULL. */
2040
07be1b83
YO
2041
2042
76e3520e 2043STATIC I32
9a957fbc
AL
2044S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
2045 regnode *last, scan_data_t *data, U32 flags, U32 depth)
c277df42
IZ
2046 /* scanp: Start here (read-write). */
2047 /* deltap: Write maxlen-minlen here. */
2048 /* last: Stop before this one. */
2049{
97aff369 2050 dVAR;
c277df42
IZ
2051 I32 min = 0, pars = 0, code;
2052 regnode *scan = *scanp, *next;
2053 I32 delta = 0;
2054 int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
aca2d497 2055 int is_inf_internal = 0; /* The studied chunk is infinite */
c277df42
IZ
2056 I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
2057 scan_data_t data_fake;
653099ff 2058 struct regnode_charclass_class and_with; /* Valid if flags & SCF_DO_STCLASS_OR */
a3621e74
YO
2059 SV *re_trie_maxbuff = NULL;
2060
2061 GET_RE_DEBUG_FLAGS_DECL;
13a24bad
YO
2062#ifdef DEBUGGING
2063 StructCopy(&zero_scan_data, &data_fake, scan_data_t);
2064#endif
b81d288d 2065
c277df42
IZ
2066 while (scan && OP(scan) != END && scan < last) {
2067 /* Peephole optimizer: */
07be1b83 2068 DEBUG_PEEP("Peep",scan,depth);
a3621e74 2069
07be1b83 2070 JOIN_EXACT(scan,&min,0);
a3621e74 2071
653099ff
GS
2072 /* Follow the next-chain of the current node and optimize
2073 away all the NOTHINGs from it. */
c277df42 2074 if (OP(scan) != CURLYX) {
a3b680e6 2075 const int max = (reg_off_by_arg[OP(scan)]
048cfca1
GS
2076 ? I32_MAX
2077 /* I32 may be smaller than U16 on CRAYs! */
2078 : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
c277df42
IZ
2079 int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
2080 int noff;
2081 regnode *n = scan;
b81d288d 2082
c277df42
IZ
2083 /* Skip NOTHING and LONGJMP. */
2084 while ((n = regnext(n))
3dab1dad 2085 && ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
c277df42
IZ
2086 || ((OP(n) == LONGJMP) && (noff = ARG(n))))
2087 && off + noff < max)
2088 off += noff;
2089 if (reg_off_by_arg[OP(scan)])
2090 ARG(scan) = off;
b81d288d 2091 else
c277df42
IZ
2092 NEXT_OFF(scan) = off;
2093 }
a3621e74 2094
07be1b83 2095
3dab1dad 2096
653099ff
GS
2097 /* The principal pseudo-switch. Cannot be a switch, since we
2098 look into several different things. */
b81d288d 2099 if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
c277df42
IZ
2100 || OP(scan) == IFTHEN || OP(scan) == SUSPEND) {
2101 next = regnext(scan);
2102 code = OP(scan);
a3621e74 2103 /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
b81d288d
AB
2104
2105 if (OP(next) == code || code == IFTHEN || code == SUSPEND) {
c277df42 2106 I32 max1 = 0, min1 = I32_MAX, num = 0;
653099ff 2107 struct regnode_charclass_class accum;
d4c19fe8 2108 regnode * const startbranch=scan;
c277df42 2109
653099ff 2110 if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
830247a4 2111 scan_commit(pRExC_state, data); /* Cannot merge strings after this. */
653099ff 2112 if (flags & SCF_DO_STCLASS)
830247a4 2113 cl_init_zero(pRExC_state, &accum);
a3621e74 2114
c277df42 2115 while (OP(scan) == code) {
830247a4 2116 I32 deltanext, minnext, f = 0, fake;
653099ff 2117 struct regnode_charclass_class this_class;
c277df42
IZ
2118
2119 num++;
2120 data_fake.flags = 0;
b81d288d 2121 if (data) {
2c2d71f5 2122 data_fake.whilem_c = data->whilem_c;
cb434fcc
IZ
2123 data_fake.last_closep = data->last_closep;
2124 }
2125 else
2126 data_fake.last_closep = &fake;
c277df42
IZ
2127 next = regnext(scan);
2128 scan = NEXTOPER(scan);
2129 if (code != BRANCH)
2130 scan = NEXTOPER(scan);
653099ff 2131 if (flags & SCF_DO_STCLASS) {
830247a4 2132 cl_init(pRExC_state, &this_class);
653099ff
GS
2133 data_fake.start_class = &this_class;
2134 f = SCF_DO_STCLASS_AND;
b81d288d 2135 }
e1901655
IZ
2136 if (flags & SCF_WHILEM_VISITED_POS)
2137 f |= SCF_WHILEM_VISITED_POS;
a3621e74 2138
653099ff 2139 /* we suppose the run is continuous, last=next...*/
830247a4 2140 minnext = study_chunk(pRExC_state, &scan, &deltanext,
a3621e74 2141 next, &data_fake, f,depth+1);
b81d288d 2142 if (min1 > minnext)
c277df42
IZ
2143 min1 = minnext;
2144 if (max1 < minnext + deltanext)
2145 max1 = minnext + deltanext;
2146 if (deltanext == I32_MAX)
aca2d497 2147 is_inf = is_inf_internal = 1;
c277df42
IZ
2148 scan = next;
2149 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
2150 pars++;
3dab1dad
YO
2151 if (data) {
2152 if (data_fake.flags & SF_HAS_EVAL)
07be1b83 2153 data->flags |= SF_HAS_EVAL;
2c2d71f5 2154 data->whilem_c = data_fake.whilem_c;
3dab1dad 2155 }
653099ff 2156 if (flags & SCF_DO_STCLASS)
830247a4 2157 cl_or(pRExC_state, &accum, &this_class);
b81d288d 2158 if (code == SUSPEND)
c277df42
IZ
2159 break;
2160 }
2161 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
2162 min1 = 0;
2163 if (flags & SCF_DO_SUBSTR) {
2164 data->pos_min += min1;
2165 data->pos_delta += max1 - min1;
2166 if (max1 != min1 || is_inf)
2167 data->longest = &(data->longest_float);
2168 }
2169 min += min1;
2170 delta += max1 - min1;
653099ff 2171 if (flags & SCF_DO_STCLASS_OR) {
830247a4 2172 cl_or(pRExC_state, data->start_class, &accum);
653099ff
GS
2173 if (min1) {
2174 cl_and(data->start_class, &and_with);
2175 flags &= ~SCF_DO_STCLASS;
2176 }
2177 }
2178 else if (flags & SCF_DO_STCLASS_AND) {
de0c8cb8
GS
2179 if (min1) {
2180 cl_and(data->start_class, &accum);
653099ff 2181 flags &= ~SCF_DO_STCLASS;
de0c8cb8
GS
2182 }
2183 else {
b81d288d 2184 /* Switch to OR mode: cache the old value of
de0c8cb8
GS
2185 * data->start_class */
2186 StructCopy(data->start_class, &and_with,
2187 struct regnode_charclass_class);
2188 flags &= ~SCF_DO_STCLASS_AND;
2189 StructCopy(&accum, data->start_class,
2190 struct regnode_charclass_class);
2191 flags |= SCF_DO_STCLASS_OR;
2192 data->start_class->flags |= ANYOF_EOS;
2193 }
653099ff 2194 }
a3621e74
YO
2195
2196 /* demq.
2197
2198 Assuming this was/is a branch we are dealing with: 'scan' now
2199 points at the item that follows the branch sequence, whatever
2200 it is. We now start at the beginning of the sequence and look
2201 for subsequences of
2202
2203 BRANCH->EXACT=>X
2204 BRANCH->EXACT=>X
2205
2206 which would be constructed from a pattern like /A|LIST|OF|WORDS/
2207
2208 If we can find such a subseqence we need to turn the first
2209 element into a trie and then add the subsequent branch exact
2210 strings to the trie.
2211
2212 We have two cases
2213
2214 1. patterns where the whole set of branch can be converted to a trie,
2215
2216 2. patterns where only a subset of the alternations can be
2217 converted to a trie.
2218
2219 In case 1 we can replace the whole set with a single regop
2220 for the trie. In case 2 we need to keep the start and end
2221 branchs so
2222
2223 'BRANCH EXACT; BRANCH EXACT; BRANCH X'
2224 becomes BRANCH TRIE; BRANCH X;
2225
2226 Hypthetically when we know the regex isnt anchored we can
2227 turn a case 1 into a DFA and let it rip... Every time it finds a match
2228 it would just call its tail, no WHILEM/CURLY needed.
2229
2230 */
07be1b83 2231 if (PERL_ENABLE_TRIE_OPTIMISATION) {
3dab1dad 2232 int made=0;
0111c4fd
RGS
2233 if (!re_trie_maxbuff) {
2234 re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
2235 if (!SvIOK(re_trie_maxbuff))
2236 sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
2237 }
a3621e74
YO
2238 if ( SvIV(re_trie_maxbuff)>=0 && OP( startbranch )==BRANCH ) {
2239 regnode *cur;
2240 regnode *first = (regnode *)NULL;
2241 regnode *last = (regnode *)NULL;
2242 regnode *tail = scan;
2243 U8 optype = 0;
2244 U32 count=0;
2245
2246#ifdef DEBUGGING
c445ea15 2247 SV * const mysv = sv_newmortal(); /* for dumping */
a3621e74
YO
2248#endif
2249 /* var tail is used because there may be a TAIL
2250 regop in the way. Ie, the exacts will point to the
2251 thing following the TAIL, but the last branch will
2252 point at the TAIL. So we advance tail. If we
2253 have nested (?:) we may have to move through several
2254 tails.
2255 */
2256
2257 while ( OP( tail ) == TAIL ) {
2258 /* this is the TAIL generated by (?:) */
2259 tail = regnext( tail );
2260 }
2261
3dab1dad 2262
a3621e74 2263 DEBUG_OPTIMISE_r({
32fc9b6a 2264 regprop(RExC_rx, mysv, tail );
3dab1dad
YO
2265 PerlIO_printf( Perl_debug_log, "%*s%s%s\n",
2266 (int)depth * 2 + 2, "",
2267 "Looking for TRIE'able sequences. Tail node is: ",
2268 SvPV_nolen_const( mysv )
a3621e74
YO
2269 );
2270 });
3dab1dad 2271
a3621e74
YO
2272 /*
2273
2274 step through the branches, cur represents each
2275 branch, noper is the first thing to be matched
2276 as part of that branch and noper_next is the
2277 regnext() of that node. if noper is an EXACT
2278 and noper_next is the same as scan (our current
2279 position in the regex) then the EXACT branch is
2280 a possible optimization target. Once we have
2281 two or more consequetive such branches we can
2282 create a trie of the EXACT's contents and stich
2283 it in place. If the sequence represents all of
2284 the branches we eliminate the whole thing and
2285 replace it with a single TRIE. If it is a
2286 subsequence then we need to stitch it in. This
2287 means the first branch has to remain, and needs
2288 to be repointed at the item on the branch chain
2289 following the last branch optimized. This could
2290 be either a BRANCH, in which case the
2291 subsequence is internal, or it could be the
2292 item following the branch sequence in which
2293 case the subsequence is at the end.
2294
2295 */
2296
2297 /* dont use tail as the end marker for this traverse */
2298 for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) {
aec46f14
AL
2299 regnode * const noper = NEXTOPER( cur );
2300 regnode * const noper_next = regnext( noper );
a3621e74 2301
a3621e74 2302 DEBUG_OPTIMISE_r({
32fc9b6a 2303 regprop(RExC_rx, mysv, cur);
3dab1dad
YO
2304 PerlIO_printf( Perl_debug_log, "%*s- %s (%d)",
2305 (int)depth * 2 + 2,"", SvPV_nolen_const( mysv ), REG_NODE_NUM(cur) );
a3621e74 2306
32fc9b6a 2307 regprop(RExC_rx, mysv, noper);
a3621e74 2308 PerlIO_printf( Perl_debug_log, " -> %s",
cfd0369c 2309 SvPV_nolen_const(mysv));
a3621e74
YO
2310
2311 if ( noper_next ) {
32fc9b6a 2312 regprop(RExC_rx, mysv, noper_next );
a3621e74 2313 PerlIO_printf( Perl_debug_log,"\t=> %s\t",
cfd0369c 2314 SvPV_nolen_const(mysv));
a3621e74 2315 }
3dab1dad
YO
2316 PerlIO_printf( Perl_debug_log, "(First==%d,Last==%d,Cur==%d)\n",
2317 REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur) );
a3621e74 2318 });
3dab1dad
YO
2319 if ( (((first && optype!=NOTHING) ? OP( noper ) == optype
2320 : PL_regkind[ OP( noper ) ] == EXACT )
2321 || OP(noper) == NOTHING )
a3621e74
YO
2322 && noper_next == tail && count<U16_MAX)
2323 {
2324 count++;
3dab1dad
YO
2325 if ( !first || optype == NOTHING ) {
2326 if (!first) first = cur;
a3621e74
YO
2327 optype = OP( noper );
2328 } else {
a3621e74 2329 last = cur;
a3621e74
YO
2330 }
2331 } else {
2332 if ( last ) {
3dab1dad 2333 made+=make_trie( pRExC_state, startbranch, first, cur, tail, optype, depth+1 );
a3621e74 2334 }
3dab1dad 2335 if ( PL_regkind[ OP( noper ) ] == EXACT
a3621e74
YO
2336 && noper_next == tail )
2337 {
2338 count = 1;
2339 first = cur;
2340 optype = OP( noper );
2341 } else {
2342 count = 0;
2343 first = NULL;
2344 optype = 0;
2345 }
2346 last = NULL;
2347 }
2348 }
2349 DEBUG_OPTIMISE_r({
32fc9b6a 2350 regprop(RExC_rx, mysv, cur);
a3621e74 2351 PerlIO_printf( Perl_debug_log,
3dab1dad
YO
2352 "%*s- %s (%d) <SCAN FINISHED>\n", (int)depth * 2 + 2,
2353 "", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
a3621e74
YO
2354
2355 });
2356 if ( last ) {
3dab1dad
YO
2357 made+= make_trie( pRExC_state, startbranch, first, scan, tail, optype, depth+1 );
2358#ifdef TRIE_STUDY_OPT
07be1b83
YO
2359 if ( made && startbranch == first ) {
2360 if ( OP(first)!=TRIE )
2361 flags |= SCF_EXACT_TRIE;
2362 else {
2363 regnode *chk=*scanp;
2364 while ( OP( chk ) == OPEN )
2365 chk = regnext( chk );
2366 if (chk==first)
2367 flags |= SCF_EXACT_TRIE;
2368 }
2369 }
3dab1dad 2370#endif
07be1b83 2371 }
a3621e74 2372 }
3dab1dad
YO
2373
2374 } /* do trie */
a0ed51b3 2375 }
a3621e74 2376 else if ( code == BRANCHJ ) { /* single branch is optimized. */
c277df42 2377 scan = NEXTOPER(NEXTOPER(scan));
a3621e74 2378 } else /* single branch is optimized. */
c277df42
IZ
2379 scan = NEXTOPER(scan);
2380 continue;
a0ed51b3
LW
2381 }
2382 else if (OP(scan) == EXACT) {
cd439c50 2383 I32 l = STR_LEN(scan);
c445ea15 2384 UV uc;
a0ed51b3 2385 if (UTF) {
a3b680e6 2386 const U8 * const s = (U8*)STRING(scan);
1aa99e6b 2387 l = utf8_length(s, s + l);
9041c2e3 2388 uc = utf8_to_uvchr(s, NULL);
c445ea15
AL
2389 } else {
2390 uc = *((U8*)STRING(scan));
a0ed51b3
LW
2391 }
2392 min += l;
c277df42 2393 if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
c277df42
IZ
2394 /* The code below prefers earlier match for fixed
2395 offset, later match for variable offset. */
2396 if (data->last_end == -1) { /* Update the start info. */
2397 data->last_start_min = data->pos_min;
2398 data->last_start_max = is_inf
b81d288d 2399 ? I32_MAX : data->pos_min + data->pos_delta;
c277df42 2400 }
cd439c50 2401 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
45f47268
NC
2402 if (UTF)
2403 SvUTF8_on(data->last_found);
0eda9292 2404 {
9a957fbc 2405 SV * const sv = data->last_found;
a28509cc 2406 MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
0eda9292
JH
2407 mg_find(sv, PERL_MAGIC_utf8) : NULL;
2408 if (mg && mg->mg_len >= 0)
5e43f467
JH
2409 mg->mg_len += utf8_length((U8*)STRING(scan),
2410 (U8*)STRING(scan)+STR_LEN(scan));
0eda9292 2411 }
c277df42
IZ
2412 data->last_end = data->pos_min + l;
2413 data->pos_min += l; /* As in the first entry. */
2414 data->flags &= ~SF_BEFORE_EOL;
2415 }
653099ff
GS
2416 if (flags & SCF_DO_STCLASS_AND) {
2417 /* Check whether it is compatible with what we know already! */
2418 int compat = 1;
2419
1aa99e6b 2420 if (uc >= 0x100 ||
516a5887 2421 (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
1aa99e6b 2422 && !ANYOF_BITMAP_TEST(data->start_class, uc)
653099ff 2423 && (!(data->start_class->flags & ANYOF_FOLD)
1aa99e6b 2424 || !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
516a5887 2425 )
653099ff
GS
2426 compat = 0;
2427 ANYOF_CLASS_ZERO(data->start_class);
2428 ANYOF_BITMAP_ZERO(data->start_class);
2429 if (compat)
1aa99e6b 2430 ANYOF_BITMAP_SET(data->start_class, uc);
653099ff 2431 data->start_class->flags &= ~ANYOF_EOS;
9b877dbb
IH
2432 if (uc < 0x100)
2433 data->start_class->flags &= ~ANYOF_UNICODE_ALL;
653099ff
GS
2434 }
2435 else if (flags & SCF_DO_STCLASS_OR) {
2436 /* false positive possible if the class is case-folded */
1aa99e6b 2437 if (uc < 0x100)
9b877dbb
IH
2438 ANYOF_BITMAP_SET(data->start_class, uc);
2439 else
2440 data->start_class->flags |= ANYOF_UNICODE_ALL;
653099ff
GS
2441 data->start_class->flags &= ~ANYOF_EOS;
2442 cl_and(data->start_class, &and_with);
2443 }
2444 flags &= ~SCF_DO_STCLASS;
a0ed51b3 2445 }
3dab1dad 2446 else if (PL_regkind[OP(scan)] == EXACT) { /* But OP != EXACT! */
cd439c50 2447 I32 l = STR_LEN(scan);
1aa99e6b 2448 UV uc = *((U8*)STRING(scan));
653099ff
GS
2449
2450 /* Search for fixed substrings supports EXACT only. */
ecaa9b9c
NC
2451 if (flags & SCF_DO_SUBSTR) {
2452 assert(data);
830247a4 2453 scan_commit(pRExC_state, data);
ecaa9b9c 2454 }
a0ed51b3 2455 if (UTF) {
6136c704 2456 const U8 * const s = (U8 *)STRING(scan);
1aa99e6b 2457 l = utf8_length(s, s + l);
9041c2e3 2458 uc = utf8_to_uvchr(s, NULL);
a0ed51b3
LW
2459 }
2460 min += l;
ecaa9b9c 2461 if (flags & SCF_DO_SUBSTR)
a0ed51b3 2462 data->pos_min += l;
653099ff
GS
2463 if (flags & SCF_DO_STCLASS_AND) {
2464 /* Check whether it is compatible with what we know already! */
2465 int compat = 1;
2466
1aa99e6b 2467 if (uc >= 0x100 ||
516a5887 2468 (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
1aa99e6b 2469 && !ANYOF_BITMAP_TEST(data->start_class, uc)
516a5887 2470 && !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
653099ff
GS
2471 compat = 0;
2472 ANYOF_CLASS_ZERO(data->start_class);
2473 ANYOF_BITMAP_ZERO(data->start_class);
2474 if (compat) {
1aa99e6b 2475 ANYOF_BITMAP_SET(data->start_class, uc);
653099ff
GS
2476 data->start_class->flags &= ~ANYOF_EOS;
2477 data->start_class->flags |= ANYOF_FOLD;
2478 if (OP(scan) == EXACTFL)
2479 data->start_class->flags |= ANYOF_LOCALE;
2480 }
2481 }
2482 else if (flags & SCF_DO_STCLASS_OR) {
2483 if (data->start_class->flags & ANYOF_FOLD) {
2484 /* false positive possible if the class is case-folded.
2485 Assume that the locale settings are the same... */
1aa99e6b
IH
2486 if (uc < 0x100)
2487 ANYOF_BITMAP_SET(data->start_class, uc);
653099ff
GS
2488 data->start_class->flags &= ~ANYOF_EOS;
2489 }
2490 cl_and(data->start_class, &and_with);
2491 }
2492 flags &= ~SCF_DO_STCLASS;
a0ed51b3 2493 }
3dab1dad
YO
2494#ifdef TRIE_STUDY_OPT
2495 else if (OP(scan) == TRIE) {
2496 reg_trie_data *trie=RExC_rx->data->data[ ARG(scan) ];
2497 min += trie->minlen;
07be1b83 2498 delta += (trie->maxlen - trie->minlen);
3dab1dad
YO
2499 flags &= ~SCF_DO_STCLASS; /* xxx */
2500 if (flags & SCF_DO_SUBSTR) {
2501 scan_commit(pRExC_state,data); /* Cannot expect anything... */
2502 data->pos_min += trie->minlen;
07be1b83
YO
2503 data->pos_delta += (trie->maxlen - trie->minlen);
2504 if (trie->maxlen != trie->minlen)
2505 data->longest = &(data->longest_float);
3dab1dad
YO
2506 }
2507 }
2508#endif
bfed75c6 2509 else if (strchr((const char*)PL_varies,OP(scan))) {
9c5ffd7c 2510 I32 mincount, maxcount, minnext, deltanext, fl = 0;
aa7a4b56 2511 I32 f = flags, pos_before = 0;
d4c19fe8 2512 regnode * const oscan = scan;
653099ff
GS
2513 struct regnode_charclass_class this_class;
2514 struct regnode_charclass_class *oclass = NULL;
727f22e3 2515 I32 next_is_eval = 0;
653099ff 2516
3dab1dad 2517 switch (PL_regkind[OP(scan)]) {
653099ff 2518 case WHILEM: /* End of (?:...)* . */
c277df42
IZ
2519 scan = NEXTOPER(scan);
2520 goto finish;
2521 case PLUS:
653099ff 2522 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
c277df42 2523 next = NEXTOPER(scan);
653099ff 2524 if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
b81d288d
AB
2525 mincount = 1;
2526 maxcount = REG_INFTY;
c277df42
IZ
2527 next = regnext(scan);
2528 scan = NEXTOPER(scan);
2529 goto do_curly;
2530 }
2531 }
2532 if (flags & SCF_DO_SUBSTR)
2533 data->pos_min++;
2534 min++;
2535 /* Fall through. */
2536 case STAR:
653099ff
GS
2537 if (flags & SCF_DO_STCLASS) {
2538 mincount = 0;
b81d288d 2539 maxcount = REG_INFTY;
653099ff
GS
2540 next = regnext(scan);
2541 scan = NEXTOPER(scan);
2542 goto do_curly;
2543 }
b81d288d 2544 is_inf = is_inf_internal = 1;
c277df42
IZ
2545 scan = regnext(scan);
2546 if (flags & SCF_DO_SUBSTR) {
830247a4 2547 scan_commit(pRExC_state, data); /* Cannot extend fixed substrings */
c277df42
IZ
2548 data->longest = &(data->longest_float);
2549 }
2550 goto optimize_curly_tail;
2551 case CURLY:
b81d288d 2552 mincount = ARG1(scan);
c277df42
IZ
2553 maxcount = ARG2(scan);
2554 next = regnext(scan);
cb434fcc
IZ
2555 if (OP(scan) == CURLYX) {
2556 I32 lp = (data ? *(data->last_closep) : 0);
a3621e74 2557 scan->flags = ((lp <= U8_MAX) ? (U8)lp : U8_MAX);
cb434fcc 2558 }
c277df42 2559 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
727f22e3 2560 next_is_eval = (OP(scan) == EVAL);
c277df42
IZ
2561 do_curly:
2562 if (flags & SCF_DO_SUBSTR) {
830247a4 2563 if (mincount == 0) scan_commit(pRExC_state,data); /* Cannot extend fixed substrings */
c277df42
IZ
2564 pos_before = data->pos_min;
2565 }
2566 if (data) {
2567 fl = data->flags;
2568 data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
2569 if (is_inf)
2570 data->flags |= SF_IS_INF;
2571 }
653099ff 2572 if (flags & SCF_DO_STCLASS) {
830247a4 2573 cl_init(pRExC_state, &this_class);
653099ff
GS
2574 oclass = data->start_class;
2575 data->start_class = &this_class;
2576 f |= SCF_DO_STCLASS_AND;
2577 f &= ~SCF_DO_STCLASS_OR;
2578 }
e1901655
IZ
2579 /* These are the cases when once a subexpression
2580 fails at a particular position, it cannot succeed
2581 even after backtracking at the enclosing scope.
b81d288d 2582
e1901655
IZ
2583 XXXX what if minimal match and we are at the
2584 initial run of {n,m}? */
2585 if ((mincount != maxcount - 1) && (maxcount != REG_INFTY))
2586 f &= ~SCF_WHILEM_VISITED_POS;
653099ff 2587
c277df42 2588 /* This will finish on WHILEM, setting scan, or on NULL: */
b81d288d 2589 minnext = study_chunk(pRExC_state, &scan, &deltanext, last, data,
a3621e74
YO
2590 (mincount == 0
2591 ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
653099ff
GS
2592
2593 if (flags & SCF_DO_STCLASS)
2594 data->start_class = oclass;
2595 if (mincount == 0 || minnext == 0) {
2596 if (flags & SCF_DO_STCLASS_OR) {
830247a4 2597 cl_or(pRExC_state, data->start_class, &this_class);
653099ff
GS
2598 }
2599 else if (flags & SCF_DO_STCLASS_AND) {
b81d288d 2600 /* Switch to OR mode: cache the old value of
653099ff
GS
2601 * data->start_class */
2602 StructCopy(data->start_class, &and_with,
2603 struct regnode_charclass_class);
2604 flags &= ~SCF_DO_STCLASS_AND;
2605 StructCopy(&this_class, data->start_class,
2606 struct regnode_charclass_class);
2607 flags |= SCF_DO_STCLASS_OR;
2608 data->start_class->flags |= ANYOF_EOS;
2609 }
2610 } else { /* Non-zero len */
2611 if (flags & SCF_DO_STCLASS_OR) {
830247a4 2612 cl_or(pRExC_state, data->start_class, &this_class);
653099ff
GS
2613 cl_and(data->start_class, &and_with);
2614 }
2615 else if (flags & SCF_DO_STCLASS_AND)
2616 cl_and(data->start_class, &this_class);
2617 flags &= ~SCF_DO_STCLASS;
2618 }
c277df42
IZ
2619 if (!scan) /* It was not CURLYX, but CURLY. */
2620 scan = next;
041457d9
DM
2621 if ( /* ? quantifier ok, except for (?{ ... }) */
2622 (next_is_eval || !(mincount == 0 && maxcount == 1))
84037bb0 2623 && (minnext == 0) && (deltanext == 0)
99799961 2624 && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
041457d9
DM
2625 && maxcount <= REG_INFTY/3 /* Complement check for big count */
2626 && ckWARN(WARN_REGEXP))
b45f050a 2627 {
830247a4 2628 vWARN(RExC_parse,
b45f050a
JF
2629 "Quantifier unexpected on zero-length expression");
2630 }
2631
c277df42 2632 min += minnext * mincount;
b81d288d 2633 is_inf_internal |= ((maxcount == REG_INFTY
155aba94
GS
2634 && (minnext + deltanext) > 0)
2635 || deltanext == I32_MAX);
aca2d497 2636 is_inf |= is_inf_internal;
c277df42
IZ
2637 delta += (minnext + deltanext) * maxcount - minnext * mincount;
2638
2639 /* Try powerful optimization CURLYX => CURLYN. */
b81d288d 2640 if ( OP(oscan) == CURLYX && data
c277df42
IZ
2641 && data->flags & SF_IN_PAR
2642 && !(data->flags & SF_HAS_EVAL)
2643 && !deltanext && minnext == 1 ) {
2644 /* Try to optimize to CURLYN. */
2645 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
d4c19fe8 2646 regnode * const nxt1 = nxt;
497b47a8
JH
2647#ifdef DEBUGGING
2648 regnode *nxt2;
2649#endif
c277df42
IZ
2650
2651 /* Skip open. */
2652 nxt = regnext(nxt);
bfed75c6 2653 if (!strchr((const char*)PL_simple,OP(nxt))
3dab1dad 2654 && !(PL_regkind[OP(nxt)] == EXACT
b81d288d 2655 && STR_LEN(nxt) == 1))
c277df42 2656 goto nogo;
497b47a8 2657#ifdef DEBUGGING
c277df42 2658 nxt2 = nxt;
497b47a8 2659#endif
c277df42 2660 nxt = regnext(nxt);
b81d288d 2661 if (OP(nxt) != CLOSE)
c277df42
IZ
2662 goto nogo;
2663 /* Now we know that nxt2 is the only contents: */
eb160463 2664 oscan->flags = (U8)ARG(nxt);
c277df42
IZ
2665 OP(oscan) = CURLYN;
2666 OP(nxt1) = NOTHING; /* was OPEN. */
2667#ifdef DEBUGGING
2668 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
2669 NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
2670 NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */
2671 OP(nxt) = OPTIMIZED; /* was CLOSE. */
2672 OP(nxt + 1) = OPTIMIZED; /* was count. */
2673 NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
b81d288d 2674#endif
c277df42 2675 }
c277df42
IZ
2676 nogo:
2677
2678 /* Try optimization CURLYX => CURLYM. */
b81d288d 2679 if ( OP(oscan) == CURLYX && data
c277df42 2680 && !(data->flags & SF_HAS_PAR)
c277df42 2681 && !(data->flags & SF_HAS_EVAL)
0e788c72
HS
2682 && !deltanext /* atom is fixed width */
2683 && minnext != 0 /* CURLYM can't handle zero width */
2684 ) {
c277df42
IZ
2685 /* XXXX How to optimize if data == 0? */
2686 /* Optimize to a simpler form. */
2687 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
2688 regnode *nxt2;
2689
2690 OP(oscan) = CURLYM;
2691 while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
b81d288d 2692 && (OP(nxt2) != WHILEM))
c277df42
IZ
2693 nxt = nxt2;
2694 OP(nxt2) = SUCCEED; /* Whas WHILEM */
c277df42
IZ
2695 /* Need to optimize away parenths. */
2696 if (data->flags & SF_IN_PAR) {
2697 /* Set the parenth number. */
2698 regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
2699
b81d288d 2700 if (OP(nxt) != CLOSE)
b45f050a 2701 FAIL("Panic opt close");
eb160463 2702 oscan->flags = (U8)ARG(nxt);
c277df42
IZ
2703 OP(nxt1) = OPTIMIZED; /* was OPEN. */
2704 OP(nxt) = OPTIMIZED; /* was CLOSE. */
2705#ifdef DEBUGGING
2706 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
2707 OP(nxt + 1) = OPTIMIZED; /* was count. */
2708 NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
2709 NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
b81d288d 2710#endif
c277df42
IZ
2711#if 0
2712 while ( nxt1 && (OP(nxt1) != WHILEM)) {
2713 regnode *nnxt = regnext(nxt1);
b81d288d 2714
c277df42
IZ
2715 if (nnxt == nxt) {
2716 if (reg_off_by_arg[OP(nxt1)])
2717 ARG_SET(nxt1, nxt2 - nxt1);
2718 else if (nxt2 - nxt1 < U16_MAX)
2719 NEXT_OFF(nxt1) = nxt2 - nxt1;
2720 else
2721 OP(nxt) = NOTHING; /* Cannot beautify */
2722 }
2723 nxt1 = nnxt;
2724 }
2725#endif
2726 /* Optimize again: */
b81d288d 2727 study_chunk(pRExC_state, &nxt1, &deltanext, nxt,
a3621e74 2728 NULL, 0,depth+1);
a0ed51b3
LW
2729 }
2730 else
c277df42 2731 oscan->flags = 0;
c277df42 2732 }
e1901655
IZ
2733 else if ((OP(oscan) == CURLYX)
2734 && (flags & SCF_WHILEM_VISITED_POS)
2735 /* See the comment on a similar expression above.
2736 However, this time it not a subexpression
2737 we care about, but the expression itself. */
2738 && (maxcount == REG_INFTY)
2739 && data && ++data->whilem_c < 16) {
2740 /* This stays as CURLYX, we can put the count/of pair. */
2c2d71f5
JH
2741 /* Find WHILEM (as in regexec.c) */
2742 regnode *nxt = oscan + NEXT_OFF(oscan);
2743
2744 if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
2745 nxt += ARG(nxt);
eb160463
GS
2746 PREVOPER(nxt)->flags = (U8)(data->whilem_c
2747 | (RExC_whilem_seen << 4)); /* On WHILEM */
2c2d71f5 2748 }
b81d288d 2749 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
c277df42
IZ
2750 pars++;
2751 if (flags & SCF_DO_SUBSTR) {
c445ea15 2752 SV *last_str = NULL;
c277df42
IZ
2753 int counted = mincount != 0;
2754
2755 if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
5d1c421c
JH
2756#if defined(SPARC64_GCC_WORKAROUND)
2757 I32 b = 0;
2758 STRLEN l = 0;
cfd0369c 2759 const char *s = NULL;
5d1c421c
JH
2760 I32 old = 0;
2761
2762 if (pos_before >= data->last_start_min)
2763 b = pos_before;
2764 else
2765 b = data->last_start_min;
2766
2767 l = 0;
cfd0369c 2768 s = SvPV_const(data->last_found, l);
5d1c421c
JH
2769 old = b - data->last_start_min;
2770
2771#else
b81d288d 2772 I32 b = pos_before >= data->last_start_min
c277df42
IZ
2773 ? pos_before : data->last_start_min;
2774 STRLEN l;
d4c19fe8 2775 const char * const s = SvPV_const(data->last_found, l);
a0ed51b3 2776 I32 old = b - data->last_start_min;
5d1c421c 2777#endif
a0ed51b3
LW
2778
2779 if (UTF)
2780 old = utf8_hop((U8*)s, old) - (U8*)s;
c277df42 2781
a0ed51b3 2782 l -= old;
c277df42 2783 /* Get the added string: */
79cb57f6 2784 last_str = newSVpvn(s + old, l);
0e933229
IH
2785 if (UTF)
2786 SvUTF8_on(last_str);
c277df42
IZ
2787 if (deltanext == 0 && pos_before == b) {
2788 /* What was added is a constant string */
2789 if (mincount > 1) {
2790 SvGROW(last_str, (mincount * l) + 1);
b81d288d 2791 repeatcpy(SvPVX(last_str) + l,
3f7c398e 2792 SvPVX_const(last_str), l, mincount - 1);
b162af07 2793 SvCUR_set(last_str, SvCUR(last_str) * mincount);
c277df42 2794 /* Add additional parts. */
b81d288d 2795 SvCUR_set(data->last_found,
c277df42
IZ
2796 SvCUR(data->last_found) - l);
2797 sv_catsv(data->last_found, last_str);
0eda9292
JH
2798 {
2799 SV * sv = data->last_found;
2800 MAGIC *mg =
2801 SvUTF8(sv) && SvMAGICAL(sv) ?
2802 mg_find(sv, PERL_MAGIC_utf8) : NULL;
2803 if (mg && mg->mg_len >= 0)
2804 mg->mg_len += CHR_SVLEN(last_str);
2805 }
c277df42
IZ
2806 data->last_end += l * (mincount - 1);
2807 }
2a8d9689
HS
2808 } else {
2809 /* start offset must point into the last copy */
2810 data->last_start_min += minnext * (mincount - 1);
c152dc43
HS
2811 data->last_start_max += is_inf ? I32_MAX
2812 : (maxcount - 1) * (minnext + data->pos_delta);
c277df42
IZ
2813 }
2814 }
2815 /* It is counted once already... */
2816 data->pos_min += minnext * (mincount - counted);
2817 data->pos_delta += - counted * deltanext +
2818 (minnext + deltanext) * maxcount - minnext * mincount;
2819 if (mincount != maxcount) {
653099ff
GS
2820 /* Cannot extend fixed substrings found inside
2821 the group. */
830247a4 2822 scan_commit(pRExC_state,data);
c277df42 2823 if (mincount && last_str) {
d4c19fe8
AL
2824 SV * const sv = data->last_found;
2825 MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
45f47268
NC
2826 mg_find(sv, PERL_MAGIC_utf8) : NULL;
2827
2828 if (mg)
2829 mg->mg_len = -1;
2830 sv_setsv(sv, last_str);
c277df42 2831 data->last_end = data->pos_min;
b81d288d 2832 data->last_start_min =
a0ed51b3 2833 data->pos_min - CHR_SVLEN(last_str);
b81d288d
AB
2834 data->last_start_max = is_inf
2835 ? I32_MAX
c277df42 2836 : data->pos_min + data->pos_delta
a0ed51b3 2837 - CHR_SVLEN(last_str);
c277df42
IZ
2838 }
2839 data->longest = &(data->longest_float);
2840 }
aca2d497 2841 SvREFCNT_dec(last_str);
c277df42 2842 }
405ff068 2843 if (data && (fl & SF_HAS_EVAL))
c277df42
IZ
2844 data->flags |= SF_HAS_EVAL;
2845 optimize_curly_tail:
c277df42 2846 if (OP(oscan) != CURLYX) {
3dab1dad 2847 while (PL_regkind[OP(next = regnext(oscan))] == NOTHING
c277df42
IZ
2848 && NEXT_OFF(next))
2849 NEXT_OFF(oscan) += NEXT_OFF(next);
2850 }
c277df42 2851 continue;
653099ff 2852 default: /* REF and CLUMP only? */
c277df42 2853 if (flags & SCF_DO_SUBSTR) {
830247a4 2854 scan_commit(pRExC_state,data); /* Cannot expect anything... */
c277df42
IZ
2855 data->longest = &(data->longest_float);
2856 }
aca2d497 2857 is_inf = is_inf_internal = 1;
653099ff 2858 if (flags & SCF_DO_STCLASS_OR)
830247a4 2859 cl_anything(pRExC_state, data->start_class);
653099ff 2860 flags &= ~SCF_DO_STCLASS;
c277df42
IZ
2861 break;
2862 }
a0ed51b3 2863 }
bfed75c6 2864 else if (strchr((const char*)PL_simple,OP(scan))) {
9c5ffd7c 2865 int value = 0;
653099ff 2866
c277df42 2867 if (flags & SCF_DO_SUBSTR) {
830247a4 2868 scan_commit(pRExC_state,data);
c277df42
IZ
2869 data->pos_min++;
2870 }
2871 min++;
653099ff
GS
2872 if (flags & SCF_DO_STCLASS) {
2873 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
2874
2875 /* Some of the logic below assumes that switching
2876 locale on will only add false positives. */
3dab1dad 2877 switch (PL_regkind[OP(scan)]) {
653099ff 2878 case SANY:
653099ff
GS
2879 default:
2880 do_default:
2881 /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
2882 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
830247a4 2883 cl_anything(pRExC_state, data->start_class);
653099ff
GS
2884 break;
2885 case REG_ANY:
2886 if (OP(scan) == SANY)
2887 goto do_default;
2888 if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
2889 value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
2890 || (data->start_class->flags & ANYOF_CLASS));
830247a4 2891 cl_anything(pRExC_state, data->start_class);
653099ff
GS
2892 }
2893 if (flags & SCF_DO_STCLASS_AND || !value)
2894 ANYOF_BITMAP_CLEAR(data->start_class,'\n');
2895 break;
2896 case ANYOF:
2897 if (flags & SCF_DO_STCLASS_AND)
2898 cl_and(data->start_class,
2899 (struct regnode_charclass_class*)scan);
2900 else
830247a4 2901 cl_or(pRExC_state, data->start_class,
653099ff
GS
2902 (struct regnode_charclass_class*)scan);
2903 break;
2904 case ALNUM:
2905 if (flags & SCF_DO_STCLASS_AND) {
2906 if (!(data->start_class->flags & ANYOF_LOCALE)) {
2907 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
2908 for (value = 0; value < 256; value++)
2909 if (!isALNUM(value))
2910 ANYOF_BITMAP_CLEAR(data->start_class, value);
2911 }
2912 }
2913 else {
2914 if (data->start_class->flags & ANYOF_LOCALE)
2915 ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
2916 else {
2917 for (value = 0; value < 256; value++)
2918 if (isALNUM(value))
b81d288d 2919 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
2920 }
2921 }
2922 break;
2923 case ALNUML:
2924 if (flags & SCF_DO_STCLASS_AND) {
2925 if (data->start_class->flags & ANYOF_LOCALE)
2926 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
2927 }
2928 else {
2929 ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
2930 data->start_class->flags |= ANYOF_LOCALE;
2931 }
2932 break;
2933 case NALNUM:
2934 if (flags & SCF_DO_STCLASS_AND) {
2935 if (!(data->start_class->flags & ANYOF_LOCALE)) {
2936 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
2937 for (value = 0; value < 256; value++)
2938 if (isALNUM(value))
2939 ANYOF_BITMAP_CLEAR(data->start_class, value);
2940 }
2941 }
2942 else {
2943 if (data->start_class->flags & ANYOF_LOCALE)
2944 ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
2945 else {
2946 for (value = 0; value < 256; value++)
2947 if (!isALNUM(value))
b81d288d 2948 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
2949 }
2950 }
2951 break;
2952 case NALNUML:
2953 if (flags & SCF_DO_STCLASS_AND) {
2954 if (data->start_class->flags & ANYOF_LOCALE)
2955 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
2956 }
2957 else {
2958 data->start_class->flags |= ANYOF_LOCALE;
2959 ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
2960 }
2961 break;
2962 case SPACE:
2963 if (flags & SCF_DO_STCLASS_AND) {
2964 if (!(data->start_class->flags & ANYOF_LOCALE)) {
2965 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
2966 for (value = 0; value < 256; value++)
2967 if (!isSPACE(value))
2968 ANYOF_BITMAP_CLEAR(data->start_class, value);
2969 }
2970 }
2971 else {
2972 if (data->start_class->flags & ANYOF_LOCALE)
2973 ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
2974 else {
2975 for (value = 0; value < 256; value++)
2976 if (isSPACE(value))
b81d288d 2977 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
2978 }
2979 }
2980 break;
2981 case SPACEL:
2982 if (flags & SCF_DO_STCLASS_AND) {
2983 if (data->start_class->flags & ANYOF_LOCALE)
2984 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
2985 }
2986 else {
2987 data->start_class->flags |= ANYOF_LOCALE;
2988 ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
2989 }
2990 break;
2991 case NSPACE:
2992 if (flags & SCF_DO_STCLASS_AND) {
2993 if (!(data->start_class->flags & ANYOF_LOCALE)) {
2994 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
2995 for (value = 0; value < 256; value++)
2996 if (isSPACE(value))
2997 ANYOF_BITMAP_CLEAR(data->start_class, value);
2998 }
2999 }
3000 else {
3001 if (data->start_class->flags & ANYOF_LOCALE)
3002 ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3003 else {
3004 for (value = 0; value < 256; value++)
3005 if (!isSPACE(value))
b81d288d 3006 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
3007 }
3008 }
3009 break;
3010 case NSPACEL:
3011 if (flags & SCF_DO_STCLASS_AND) {
3012 if (data->start_class->flags & ANYOF_LOCALE) {
3013 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3014 for (value = 0; value < 256; value++)
3015 if (!isSPACE(value))
3016 ANYOF_BITMAP_CLEAR(data->start_class, value);
3017 }
3018 }
3019 else {
3020 data->start_class->flags |= ANYOF_LOCALE;
3021 ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3022 }
3023 break;
3024 case DIGIT:
3025 if (flags & SCF_DO_STCLASS_AND) {
3026 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
3027 for (value = 0; value < 256; value++)
3028 if (!isDIGIT(value))
3029 ANYOF_BITMAP_CLEAR(data->start_class, value);
3030 }
3031 else {
3032 if (data->start_class->flags & ANYOF_LOCALE)
3033 ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
3034 else {
3035 for (value = 0; value < 256; value++)
3036 if (isDIGIT(value))
b81d288d 3037 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
3038 }
3039 }
3040 break;
3041 case NDIGIT:
3042 if (flags & SCF_DO_STCLASS_AND) {
3043 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
3044 for (value = 0; value < 256; value++)
3045 if (isDIGIT(value))
3046 ANYOF_BITMAP_CLEAR(data->start_class, value);
3047 }
3048 else {
3049 if (data->start_class->flags & ANYOF_LOCALE)
3050 ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
3051 else {
3052 for (value = 0; value < 256; value++)
3053 if (!isDIGIT(value))
b81d288d 3054 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
3055 }
3056 }
3057 break;
3058 }
3059 if (flags & SCF_DO_STCLASS_OR)
3060 cl_and(data->start_class, &and_with);
3061 flags &= ~SCF_DO_STCLASS;
3062 }
a0ed51b3 3063 }
3dab1dad 3064 else if (PL_regkind[OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
c277df42
IZ
3065 data->flags |= (OP(scan) == MEOL
3066 ? SF_BEFORE_MEOL
3067 : SF_BEFORE_SEOL);
a0ed51b3 3068 }
3dab1dad 3069 else if ( PL_regkind[OP(scan)] == BRANCHJ
653099ff
GS
3070 /* Lookbehind, or need to calculate parens/evals/stclass: */
3071 && (scan->flags || data || (flags & SCF_DO_STCLASS))
c277df42 3072 && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
653099ff 3073 /* Lookahead/lookbehind */
cb434fcc 3074 I32 deltanext, minnext, fake = 0;
c277df42 3075 regnode *nscan;
653099ff
GS
3076 struct regnode_charclass_class intrnl;
3077 int f = 0;
c277df42
IZ
3078
3079 data_fake.flags = 0;
b81d288d 3080 if (data) {
2c2d71f5 3081 data_fake.whilem_c = data->whilem_c;
cb434fcc
IZ
3082 data_fake.last_closep = data->last_closep;
3083 }
3084 else
3085 data_fake.last_closep = &fake;
653099ff
GS
3086 if ( flags & SCF_DO_STCLASS && !scan->flags
3087 && OP(scan) == IFMATCH ) { /* Lookahead */
830247a4 3088 cl_init(pRExC_state, &intrnl);
653099ff 3089 data_fake.start_class = &intrnl;
e1901655 3090 f |= SCF_DO_STCLASS_AND;
653099ff 3091 }
e1901655
IZ
3092 if (flags & SCF_WHILEM_VISITED_POS)
3093 f |= SCF_WHILEM_VISITED_POS;
c277df42
IZ
3094 next = regnext(scan);
3095 nscan = NEXTOPER(NEXTOPER(scan));
a3621e74 3096 minnext = study_chunk(pRExC_state, &nscan, &deltanext, last, &data_fake, f,depth+1);
c277df42
IZ
3097 if (scan->flags) {
3098 if (deltanext) {
9baa0206 3099 vFAIL("Variable length lookbehind not implemented");
a0ed51b3
LW
3100 }
3101 else if (minnext > U8_MAX) {
9baa0206 3102 vFAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
c277df42 3103 }
eb160463 3104 scan->flags = (U8)minnext;
c277df42 3105 }
be8e71aa
YO
3106 if (data) {
3107 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3108 pars++;
3109 if (data_fake.flags & SF_HAS_EVAL)
3110 data->flags |= SF_HAS_EVAL;
2c2d71f5 3111 data->whilem_c = data_fake.whilem_c;
be8e71aa 3112 }
e1901655 3113 if (f & SCF_DO_STCLASS_AND) {
a28509cc 3114 const int was = (data->start_class->flags & ANYOF_EOS);
653099ff
GS
3115
3116 cl_and(data->start_class, &intrnl);
3117 if (was)
3118 data->start_class->flags |= ANYOF_EOS;
3119 }
a0ed51b3
LW
3120 }
3121 else if (OP(scan) == OPEN) {
c277df42 3122 pars++;
a0ed51b3 3123 }
cb434fcc 3124 else if (OP(scan) == CLOSE) {
eb160463 3125 if ((I32)ARG(scan) == is_par) {
cb434fcc 3126 next = regnext(scan);
c277df42 3127
cb434fcc
IZ
3128 if ( next && (OP(next) != WHILEM) && next < last)
3129 is_par = 0; /* Disable optimization */
3130 }
3131 if (data)
3132 *(data->last_closep) = ARG(scan);
a0ed51b3
LW
3133 }
3134 else if (OP(scan) == EVAL) {
c277df42
IZ
3135 if (data)
3136 data->flags |= SF_HAS_EVAL;
3137 }
96776eda 3138 else if (OP(scan) == LOGICAL && scan->flags == 2) { /* Embedded follows */
0f5d15d6 3139 if (flags & SCF_DO_SUBSTR) {
830247a4 3140 scan_commit(pRExC_state,data);
0f5d15d6
IZ
3141 data->longest = &(data->longest_float);
3142 }
3143 is_inf = is_inf_internal = 1;
653099ff 3144 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
830247a4 3145 cl_anything(pRExC_state, data->start_class);
96776eda 3146 flags &= ~SCF_DO_STCLASS;
0f5d15d6 3147 }
c277df42
IZ
3148 /* Else: zero-length, ignore. */
3149 scan = regnext(scan);
3150 }
3151
3152 finish:
3153 *scanp = scan;
aca2d497 3154 *deltap = is_inf_internal ? I32_MAX : delta;
b81d288d 3155 if (flags & SCF_DO_SUBSTR && is_inf)
c277df42
IZ
3156 data->pos_delta = I32_MAX - data->pos_min;
3157 if (is_par > U8_MAX)
3158 is_par = 0;
3159 if (is_par && pars==1 && data) {
3160 data->flags |= SF_IN_PAR;
3161 data->flags &= ~SF_HAS_PAR;
a0ed51b3
LW
3162 }
3163 else if (pars && data) {
c277df42
IZ
3164 data->flags |= SF_HAS_PAR;
3165 data->flags &= ~SF_IN_PAR;
3166 }
653099ff
GS
3167 if (flags & SCF_DO_STCLASS_OR)
3168 cl_and(data->start_class, &and_with);
07be1b83
YO
3169 if (flags & SCF_EXACT_TRIE)
3170 data->flags |= SCF_EXACT_TRIE;
c277df42
IZ
3171 return min;
3172}
3173
76e3520e 3174STATIC I32
5f66b61c 3175S_add_data(RExC_state_t *pRExC_state, I32 n, const char *s)
c277df42 3176{
830247a4 3177 if (RExC_rx->data) {
b81d288d
AB
3178 Renewc(RExC_rx->data,
3179 sizeof(*RExC_rx->data) + sizeof(void*) * (RExC_rx->data->count + n - 1),
c277df42 3180 char, struct reg_data);
830247a4
IZ
3181 Renew(RExC_rx->data->what, RExC_rx->data->count + n, U8);
3182 RExC_rx->data->count += n;
a0ed51b3
LW
3183 }
3184 else {
a02a5408 3185 Newxc(RExC_rx->data, sizeof(*RExC_rx->data) + sizeof(void*) * (n - 1),
c277df42 3186 char, struct reg_data);
a02a5408 3187 Newx(RExC_rx->data->what, n, U8);
830247a4 3188 RExC_rx->data->count = n;
c277df42 3189 }
830247a4
IZ
3190 Copy(s, RExC_rx->data->what + RExC_rx->data->count - n, n, U8);
3191 return RExC_rx->data->count - n;
c277df42
IZ
3192}
3193
76234dfb 3194#ifndef PERL_IN_XSUB_RE
d88dccdf 3195void
864dbfa3 3196Perl_reginitcolors(pTHX)
d88dccdf 3197{
97aff369 3198 dVAR;
1df70142 3199 const char * const s = PerlEnv_getenv("PERL_RE_COLORS");
d88dccdf 3200 if (s) {
1df70142
AL
3201 char *t = savepv(s);
3202 int i = 0;
3203 PL_colors[0] = t;
d88dccdf 3204 while (++i < 6) {
1df70142
AL
3205 t = strchr(t, '\t');
3206 if (t) {
3207 *t = '\0';
3208 PL_colors[i] = ++t;
d88dccdf
IZ
3209 }
3210 else
1df70142 3211 PL_colors[i] = t = (char *)"";
d88dccdf
IZ
3212 }
3213 } else {
1df70142 3214 int i = 0;
b81d288d 3215 while (i < 6)
06b5626a 3216 PL_colors[i++] = (char *)"";
d88dccdf
IZ
3217 }
3218 PL_colorset = 1;
3219}
76234dfb 3220#endif
8615cb43 3221
07be1b83 3222
a687059c 3223/*
e50aee73 3224 - pregcomp - compile a regular expression into internal code
a687059c
LW
3225 *
3226 * We can't allocate space until we know how big the compiled form will be,
3227 * but we can't compile it (and thus know how big it is) until we've got a
3228 * place to put the code. So we cheat: we compile it twice, once with code
3229 * generation turned off and size counting turned on, and once "for real".
3230 * This also means that we don't allocate space until we are sure that the
3231 * thing really will compile successfully, and we never have to move the
3232 * code and thus invalidate pointers into it. (Note that it has to be in
3233 * one piece because free() must be able to free it all.) [NB: not true in perl]
3234 *
3235 * Beware that the optimization-preparation code in here knows about some
3236 * of the structure of the compiled regexp. [I'll say.]
3237 */
3238regexp *
864dbfa3 3239Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
a687059c 3240{
97aff369 3241 dVAR;
a0d0e21e 3242 register regexp *r;
c277df42 3243 regnode *scan;
c277df42 3244 regnode *first;
a0d0e21e 3245 I32 flags;
a0d0e21e
LW
3246 I32 minlen = 0;
3247 I32 sawplus = 0;
3248 I32 sawopen = 0;
2c2d71f5 3249 scan_data_t data;
830247a4 3250 RExC_state_t RExC_state;
be8e71aa 3251 RExC_state_t * const pRExC_state = &RExC_state;
07be1b83
YO
3252#ifdef TRIE_STUDY_OPT
3253 int restudied= 0;
3254 RExC_state_t copyRExC_state;
3255#endif
a0d0e21e 3256
a3621e74
YO
3257 GET_RE_DEBUG_FLAGS_DECL;
3258
a0d0e21e 3259 if (exp == NULL)
c277df42 3260 FAIL("NULL regexp argument");
a0d0e21e 3261
a5961de5 3262 RExC_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
a0ed51b3 3263
5cfc7842 3264 RExC_precomp = exp;
a3621e74
YO
3265 DEBUG_r(if (!PL_colorset) reginitcolors());
3266 DEBUG_COMPILE_r({
ab3bbdeb
YO
3267 SV *dsv= sv_newmortal();
3268 RE_PV_QUOTED_DECL(s, RExC_utf8,
3269 dsv, RExC_precomp, (xend - exp), 60);
3270 PerlIO_printf(Perl_debug_log, "%sCompiling REx%s %s\n",
3271 PL_colors[4],PL_colors[5],s);
a5961de5 3272 });
e2509266 3273 RExC_flags = pm->op_pmflags;
830247a4 3274 RExC_sawback = 0;
bbce6d69 3275
830247a4
IZ
3276 RExC_seen = 0;
3277 RExC_seen_zerolen = *exp == '^' ? -1 : 0;
3278 RExC_seen_evals = 0;
3279 RExC_extralen = 0;
c277df42 3280
bbce6d69 3281 /* First pass: determine size, legality. */
830247a4 3282 RExC_parse = exp;
fac92740 3283 RExC_start = exp;
830247a4
IZ
3284 RExC_end = xend;
3285 RExC_naughty = 0;
3286 RExC_npar = 1;
3287 RExC_size = 0L;
3288 RExC_emit = &PL_regdummy;
3289 RExC_whilem_seen = 0;
85ddcde9
JH
3290#if 0 /* REGC() is (currently) a NOP at the first pass.
3291 * Clever compilers notice this and complain. --jhi */
830247a4 3292 REGC((U8)REG_MAGIC, (char*)RExC_emit);
85ddcde9 3293#endif
3dab1dad
YO
3294 DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "Starting first pass (sizing)\n"));
3295 if (reg(pRExC_state, 0, &flags,1) == NULL) {
c445ea15 3296 RExC_precomp = NULL;
a0d0e21e
LW
3297 return(NULL);
3298 }
3dab1dad
YO
3299 DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "Required "));
3300 DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" nodes ", (IV)RExC_size));
3301 DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "\nStarting second pass (creation)\n"));
07be1b83
YO
3302 DEBUG_PARSE_r({
3303 RExC_lastnum=0;
3304 RExC_lastparse=NULL;
3305 });
c277df42 3306
07be1b83 3307
c277df42
IZ
3308 /* Small enough for pointer-storage convention?
3309 If extralen==0, this means that we will not need long jumps. */
830247a4
IZ
3310 if (RExC_size >= 0x10000L && RExC_extralen)
3311 RExC_size += RExC_extralen;
c277df42 3312 else
830247a4
IZ
3313 RExC_extralen = 0;
3314 if (RExC_whilem_seen > 15)
3315 RExC_whilem_seen = 15;
a0d0e21e 3316
bbce6d69 3317 /* Allocate space and initialize. */
a02a5408 3318 Newxc(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode),
c277df42 3319 char, regexp);
a0d0e21e 3320 if (r == NULL)
b45f050a
JF
3321 FAIL("Regexp out of space");
3322
0f79a09d
GS
3323#ifdef DEBUGGING
3324 /* avoid reading uninitialized memory in DEBUGGING code in study_chunk() */
830247a4 3325 Zero(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode), char);
0f79a09d 3326#endif
c277df42 3327 r->refcnt = 1;
bbce6d69 3328 r->prelen = xend - exp;
5cfc7842 3329 r->precomp = savepvn(RExC_precomp, r->prelen);
cf93c79d 3330 r->subbeg = NULL;
f8c7b90f 3331#ifdef PERL_OLD_COPY_ON_WRITE
c445ea15 3332 r->saved_copy = NULL;
ed252734 3333#endif
cf93c79d 3334 r->reganch = pm->op_pmflags & PMf_COMPILETIME;
830247a4 3335 r->nparens = RExC_npar - 1; /* set early to validate backrefs */
38d1b06f 3336 r->lastparen = 0; /* mg.c reads this. */
4327152a
IZ
3337
3338 r->substrs = 0; /* Useful during FAIL. */
3339 r->startp = 0; /* Useful during FAIL. */
3340 r->endp = 0; /* Useful during FAIL. */
3341
a02a5408 3342 Newxz(r->offsets, 2*RExC_size+1, U32); /* MJD 20001228 */
fac92740 3343 if (r->offsets) {
2af232bd 3344 r->offsets[0] = RExC_size;
fac92740 3345 }
a3621e74 3346 DEBUG_OFFSETS_r(PerlIO_printf(Perl_debug_log,
2af232bd
SPS
3347 "%s %"UVuf" bytes for offset annotations.\n",
3348 r->offsets ? "Got" : "Couldn't get",
392fbf5d 3349 (UV)((2*RExC_size+1) * sizeof(U32))));
fac92740 3350
830247a4 3351 RExC_rx = r;
bbce6d69
PP
3352
3353 /* Second pass: emit code. */
e2509266 3354 RExC_flags = pm->op_pmflags; /* don't let top level (?i) bleed */
830247a4
IZ
3355 RExC_parse = exp;
3356 RExC_end = xend;
3357 RExC_naughty = 0;
3358 RExC_npar = 1;
fac92740 3359 RExC_emit_start = r->program;
830247a4 3360 RExC_emit = r->program;
2cd61cdb 3361 /* Store the count of eval-groups for security checks: */
eb160463 3362 RExC_emit->next_off = (U16)((RExC_seen_evals > U16_MAX) ? U16_MAX : RExC_seen_evals);
830247a4 3363 REGC((U8)REG_MAGIC, (char*) RExC_emit++);
c277df42 3364 r->data = 0;
3dab1dad 3365 if (reg(pRExC_state, 0, &flags,1) == NULL)
a0d0e21e 3366 return(NULL);
07be1b83
YO
3367 /* XXXX To minimize changes to RE engine we always allocate
3368 3-units-long substrs field. */
3369 Newx(r->substrs, 1, struct reg_substr_data);
a0d0e21e 3370
07be1b83
YO
3371reStudy:
3372 Zero(r->substrs, 1, struct reg_substr_data);
3373 StructCopy(&zero_scan_data, &data, scan_data_t);
a3621e74 3374
07be1b83
YO
3375#ifdef TRIE_STUDY_OPT
3376 if ( restudied ) {
3377 DEBUG_OPTIMISE_r(PerlIO_printf(Perl_debug_log,"Restudying\n"));
3378 RExC_state=copyRExC_state;
3379 if (data.longest_fixed)
3380 SvREFCNT_dec(data.longest_fixed);
3381 if (data.longest_float)
3382 SvREFCNT_dec(data.longest_float);
3383 if (data.last_found)
3384 SvREFCNT_dec(data.last_found);
3385 } else {
3386 copyRExC_state=RExC_state;
3387 }
3388#endif
a0d0e21e 3389 /* Dig out information for optimizations. */
cf93c79d 3390 r->reganch = pm->op_pmflags & PMf_COMPILETIME; /* Again? */
e2509266 3391 pm->op_pmflags = RExC_flags;
a0ed51b3 3392 if (UTF)
5ff6fc6d 3393 r->reganch |= ROPT_UTF8; /* Unicode in it? */
c277df42 3394 r->regstclass = NULL;
830247a4 3395 if (RExC_naughty >= 10) /* Probably an expensive pattern. */
a0ed51b3 3396 r->reganch |= ROPT_NAUGHTY;
c277df42 3397 scan = r->program + 1; /* First BRANCH. */
2779dcf1 3398
653099ff 3399 /* XXXX Should not we check for something else? Usually it is OPEN1... */
c277df42 3400 if (OP(scan) != BRANCH) { /* Only one top-level choice. */
c277df42 3401 I32 fake;
c5254dd6 3402 STRLEN longest_float_length, longest_fixed_length;
07be1b83 3403 struct regnode_charclass_class ch_class; /* pointed to by data */
653099ff 3404 int stclass_flag;
07be1b83 3405 I32 last_close = 0; /* pointed to by data */
a0d0e21e
LW
3406
3407 first = scan;
c277df42 3408 /* Skip introductions and multiplicators >= 1. */
a0d0e21e 3409 while ((OP(first) == OPEN && (sawopen = 1)) ||
653099ff 3410 /* An OR of *one* alternative - should not happen now. */
a0d0e21e 3411 (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
07be1b83
YO
3412 /* for now we can't handle lookbehind IFMATCH*/
3413 (OP(first) == IFMATCH && !first->flags) ||
a0d0e21e
LW
3414 (OP(first) == PLUS) ||
3415 (OP(first) == MINMOD) ||
653099ff 3416 /* An {n,m} with n>0 */
07be1b83
YO
3417 (PL_regkind[OP(first)] == CURLY && ARG1(first) > 0) )
3418 {
3419 DEBUG_PEEP("first:",first,0);
a0d0e21e
LW
3420 if (OP(first) == PLUS)
3421 sawplus = 1;
3422 else
3dab1dad 3423 first += regarglen[OP(first)];
07be1b83
YO
3424 if (OP(first) == IFMATCH) {
3425 first = NEXTOPER(first);
3426 first += EXTRA_STEP_2ARGS;
7c167cea 3427 } else /* XXX possible optimisation for /(?=)/ */
07be1b83 3428 first = NEXTOPER(first);
a687059c
LW
3429 }
3430
a0d0e21e
LW
3431 /* Starting-point info. */
3432 again:
07be1b83 3433 /* Ignore EXACT as we deal with it later. */
3dab1dad 3434 if (PL_regkind[OP(first)] == EXACT) {
1aa99e6b 3435 if (OP(first) == EXACT)
6f207bd3 3436 NOOP; /* Empty, get anchored substr later. */
1aa99e6b 3437 else if ((OP(first) == EXACTF || OP(first) == EXACTFL))
b3c9acc1
IZ
3438 r->regstclass = first;
3439 }
07be1b83
YO
3440#ifdef TRIE_STCLASS
3441 else if (OP(first) == TRIE &&
3442 ((reg_trie_data *)r->data->data[ ARG(first) ])->minlen>0)
3443 {
3444 /* this can happen only on restudy */
3445 struct regnode_1 *trie_op;
3446 Newxz(trie_op,1,struct regnode_1);
3447 StructCopy(first,trie_op,struct regnode_1);
3448 make_trie_failtable(pRExC_state, (regnode *)first, (regnode *)trie_op, 0);
3449 r->regstclass = (regnode *)trie_op;
3450 }
3451#endif
bfed75c6 3452 else if (strchr((const char*)PL_simple,OP(first)))
a0d0e21e 3453 r->regstclass = first;
3dab1dad
YO
3454 else if (PL_regkind[OP(first)] == BOUND ||
3455 PL_regkind[OP(first)] == NBOUND)
a0d0e21e 3456 r->regstclass = first;
3dab1dad 3457 else if (PL_regkind[OP(first)] == BOL) {
cad2e5aa
JH
3458 r->reganch |= (OP(first) == MBOL
3459 ? ROPT_ANCH_MBOL
3460 : (OP(first) == SBOL
3461 ? ROPT_ANCH_SBOL
3462 : ROPT_ANCH_BOL));
a0d0e21e 3463 first = NEXTOPER(first);
774d564b
PP
3464 goto again;
3465 }
3466 else if (OP(first) == GPOS) {
3467 r->reganch |= ROPT_ANCH_GPOS;
3468 first = NEXTOPER(first);
3469 goto again;
a0d0e21e 3470 }
e09294f4 3471 else if (!sawopen && (OP(first) == STAR &&
3dab1dad 3472 PL_regkind[OP(NEXTOPER(first))] == REG_ANY) &&
a0d0e21e
LW
3473 !(r->reganch & ROPT_ANCH) )
3474 {
3475 /* turn .* into ^.* with an implied $*=1 */
1df70142
AL
3476 const int type =
3477 (OP(NEXTOPER(first)) == REG_ANY)
3478 ? ROPT_ANCH_MBOL
3479 : ROPT_ANCH_SBOL;
cad2e5aa 3480 r->reganch |= type | ROPT_IMPLICIT;
a0d0e21e 3481 first = NEXTOPER(first);
774d564b 3482 goto again;
a0d0e21e 3483 }
b81d288d 3484 if (sawplus && (!sawopen || !RExC_sawback)
830247a4 3485 && !(RExC_seen & REG_SEEN_EVAL)) /* May examine pos and $& */
cad2e5aa
JH
3486 /* x+ must match at the 1st pos of run of x's */
3487 r->reganch |= ROPT_SKIP;
a0d0e21e 3488
c277df42 3489 /* Scan is after the zeroth branch, first is atomic matcher. */
be8e71aa
YO
3490#ifdef TRIE_STUDY_OPT
3491 DEBUG_COMPILE_r(
3492 if (!restudied)
3493 PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
3494 (IV)(first - scan + 1))
3495 );
3496#else
3497 DEBUG_COMPILE_r(
3498 PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
3499 (IV)(first - scan + 1))
3500 );
3501#endif
3502
3503
a0d0e21e
LW
3504 /*
3505 * If there's something expensive in the r.e., find the
3506 * longest literal string that must appear and make it the
3507 * regmust. Resolve ties in favor of later strings, since
3508 * the regstart check works with the beginning of the r.e.
3509 * and avoiding duplication strengthens checking. Not a
3510 * strong reason, but sufficient in the absence of others.
3511 * [Now we resolve ties in favor of the earlier string if
c277df42 3512 * it happens that c_offset_min has been invalidated, since the
a0d0e21e
LW
3513 * earlier string may buy us something the later one won't.]
3514 */
a0d0e21e 3515 minlen = 0;
a687059c 3516
396482e1
GA
3517 data.longest_fixed = newSVpvs("");
3518 data.longest_float = newSVpvs("");
3519 data.last_found = newSVpvs("");
c277df42
IZ
3520 data.longest = &(data.longest_fixed);
3521 first = scan;
653099ff 3522 if (!r->regstclass) {
830247a4 3523 cl_init(pRExC_state, &ch_class);
653099ff
GS
3524 data.start_class = &ch_class;
3525 stclass_flag = SCF_DO_STCLASS_AND;
3526 } else /* XXXX Check for BOUND? */
3527 stclass_flag = 0;
cb434fcc 3528 data.last_closep = &last_close;
653099ff 3529
830247a4 3530 minlen = study_chunk(pRExC_state, &first, &fake, scan + RExC_size, /* Up to end */
a3621e74 3531 &data, SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag,0);
07be1b83
YO
3532
3533#ifdef TRIE_STUDY_OPT
3534 if ( (data.flags & SCF_EXACT_TRIE) && ! restudied++ ) {
3535 goto reStudy;
3536 }
3537#endif
3538
830247a4 3539 if ( RExC_npar == 1 && data.longest == &(data.longest_fixed)
b81d288d 3540 && data.last_start_min == 0 && data.last_end > 0
830247a4
IZ
3541 && !RExC_seen_zerolen
3542 && (!(RExC_seen & REG_SEEN_GPOS) || (r->reganch & ROPT_ANCH_GPOS)))
c277df42 3543 r->reganch |= ROPT_CHECK_ALL;
830247a4 3544 scan_commit(pRExC_state, &data);
c277df42
IZ
3545 SvREFCNT_dec(data.last_found);
3546
a0ed51b3 3547 longest_float_length = CHR_SVLEN(data.longest_float);
c5254dd6 3548 if (longest_float_length
c277df42
IZ
3549 || (data.flags & SF_FL_BEFORE_EOL
3550 && (!(data.flags & SF_FL_BEFORE_MEOL)
e2509266 3551 || (RExC_flags & PMf_MULTILINE)))) {
cf93c79d
IZ
3552 int t;
3553
a0ed51b3 3554 if (SvCUR(data.longest_fixed) /* ok to leave SvCUR */
aca2d497
IZ
3555 && data.offset_fixed == data.offset_float_min
3556 && SvCUR(data.longest_fixed) == SvCUR(data.longest_float))
3557 goto remove_float; /* As in (a)+. */
3558
33b8afdf
JH
3559 if (SvUTF8(data.longest_float)) {
3560 r->float_utf8 = data.longest_float;
c445ea15 3561 r->float_substr = NULL;
33b8afdf
JH
3562 } else {
3563 r->float_substr = data.longest_float;
c445ea15 3564 r->float_utf8 = NULL;
33b8afdf 3565 }
c277df42
IZ
3566 r->float_min_offset = data.offset_float_min;
3567 r->float_max_offset = data.offset_float_max;
cf93c79d
IZ
3568 t = (data.flags & SF_FL_BEFORE_EOL /* Can't have SEOL and MULTI */
3569 && (!(data.flags & SF_FL_BEFORE_MEOL)
e2509266 3570 || (RExC_flags & PMf_MULTILINE)));
33b8afdf 3571 fbm_compile(data.longest_float, t ? FBMcf_TAIL : 0);
a0ed51b3
LW
3572 }
3573 else {
aca2d497 3574 remove_float:
c445ea15 3575 r->float_substr = r->float_utf8 = NULL;
c277df42 3576 SvREFCNT_dec(data.longest_float);
c5254dd6 3577 longest_float_length = 0;
a0d0e21e 3578 }
c277df42 3579
a0ed51b3 3580 longest_fixed_length = CHR_SVLEN(data.longest_fixed);
c5254dd6 3581 if (longest_fixed_length
c277df42
IZ
3582 || (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
3583 && (!(data.flags & SF_FIX_BEFORE_MEOL)
e2509266 3584 || (RExC_flags & PMf_MULTILINE)))) {
cf93c79d
IZ
3585 int t;
3586
33b8afdf
JH
3587 if (SvUTF8(data.longest_fixed)) {
3588 r->anchored_utf8 = data.longest_fixed;
c445ea15 3589 r->anchored_substr = NULL;
33b8afdf
JH
3590 } else {
3591 r->anchored_substr = data.longest_fixed;
c445ea15 3592 r->anchored_utf8 = NULL;
33b8afdf 3593 }
c277df42 3594 r->anchored_offset = data.offset_fixed;
cf93c79d
IZ
3595 t = (data.flags & SF_FIX_BEFORE_EOL /* Can't have SEOL and MULTI */
3596 && (!(data.flags & SF_FIX_BEFORE_MEOL)
e2509266 3597 || (RExC_flags & PMf_MULTILINE)));
33b8afdf 3598 fbm_compile(data.longest_fixed, t ? FBMcf_TAIL : 0);
a0ed51b3
LW
3599 }
3600 else {
c445ea15 3601 r->anchored_substr = r->anchored_utf8 = NULL;
c277df42 3602 SvREFCNT_dec(data.longest_fixed);
c5254dd6 3603 longest_fixed_length = 0;
a0d0e21e 3604 }
b81d288d 3605 if (r->regstclass
ffc61ed2 3606 && (OP(r->regstclass) == REG_ANY || OP(r->regstclass) == SANY))
653099ff 3607 r->regstclass = NULL;
33b8afdf
JH
3608 if ((!(r->anchored_substr || r->anchored_utf8) || r->anchored_offset)
3609 && stclass_flag
653099ff 3610 && !(data.start_class->flags & ANYOF_EOS)
eb160463
GS
3611 && !cl_is_anything(data.start_class))
3612 {
1df70142 3613 const I32 n = add_data(pRExC_state, 1, "f");
653099ff 3614
a02a5408 3615 Newx(RExC_rx->data->data[n], 1,
653099ff
GS
3616 struct regnode_charclass_class);
3617 StructCopy(data.start_class,
830247a4 3618 (struct regnode_charclass_class*)RExC_rx->data->data[n],
653099ff 3619 struct regnode_charclass_class);
830247a4 3620 r->regstclass = (regnode*)RExC_rx->data->data[n];
653099ff 3621 r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */
a3621e74 3622 DEBUG_COMPILE_r({ SV *sv = sv_newmortal();
32fc9b6a 3623 regprop(r, sv, (regnode*)data.start_class);
9c5ffd7c 3624 PerlIO_printf(Perl_debug_log,
a0288114 3625 "synthetic stclass \"%s\".\n",
3f7c398e 3626 SvPVX_const(sv));});
653099ff 3627 }
c277df42
IZ
3628
3629 /* A temporary algorithm prefers floated substr to fixed one to dig more info. */
c5254dd6 3630 if (longest_fixed_length > longest_float_length) {
c277df42 3631 r->check_substr = r->anchored_substr;
33b8afdf 3632 r->check_utf8 = r->anchored_utf8;
c277df42
IZ
3633 r->check_offset_min = r->check_offset_max = r->anchored_offset;
3634 if (r->reganch & ROPT_ANCH_SINGLE)
3635 r->reganch |= ROPT_NOSCAN;
a0ed51b3
LW
3636 }
3637 else {
c277df42 3638 r->check_substr = r->float_substr;
33b8afdf 3639 r->check_utf8 = r->float_utf8;
c277df42
IZ
3640 r->check_offset_min = data.offset_float_min;
3641 r->check_offset_max = data.offset_float_max;