This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #40239] New hints file for MidnightBSD
[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;
10edeb5d 515 if (!ANYOF_BITMAP_TESTALLSET((const void*)cl))
f8bef550 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,
ddc5bc0f 870 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
ab3bbdeb
YO
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,
ddc5bc0f 963 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
ab3bbdeb
YO
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,
ddc5bc0f 1005 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
ab3bbdeb
YO
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;
e294cc5d
JH
2008#ifdef EBCDIC /* RD tunifold greek 0390 and 03B0 */
2009 const char t0[] = "\xaf\x49\xaf\x42";
2010#else
07be1b83 2011 const char t0[] = "\xcc\x88\xcc\x81";
e294cc5d 2012#endif
07be1b83
YO
2013 const char * const t1 = t0 + 3;
2014
2015 for (s = s0 + 2;
2016 s < s2 && (t = ninstr(s, s1, t0, t1));
2017 s = t + 4) {
e294cc5d
JH
2018#ifdef EBCDIC
2019 if (((U8)t[-1] == 0x68 && (U8)t[-2] == 0xB4) ||
2020 ((U8)t[-1] == 0x46 && (U8)t[-2] == 0xB5))
2021#else
07be1b83
YO
2022 if (((U8)t[-1] == 0xB9 && (U8)t[-2] == 0xCE) ||
2023 ((U8)t[-1] == 0x85 && (U8)t[-2] == 0xCF))
e294cc5d 2024#endif
07be1b83
YO
2025 *min -= 4;
2026 }
2027 }
2028
2029#ifdef DEBUGGING
2030 /* Allow dumping */
2031 n = scan + NODE_SZ_STR(scan);
2032 while (n <= stop) {
2033 if (PL_regkind[OP(n)] != NOTHING || OP(n) == NOTHING) {
2034 OP(n) = OPTIMIZED;
2035 NEXT_OFF(n) = 0;
2036 }
2037 n++;
2038 }
2039#endif
2040 DEBUG_OPTIMISE_r(if (merged){DEBUG_PEEP("finl",scan,depth)});
2041 return stopnow;
2042}
2043
653099ff
GS
2044/* REx optimizer. Converts nodes into quickier variants "in place".
2045 Finds fixed substrings. */
2046
a0288114 2047/* Stops at toplevel WHILEM as well as at "last". At end *scanp is set
c277df42
IZ
2048 to the position after last scanned or to NULL. */
2049
07be1b83
YO
2050
2051
76e3520e 2052STATIC I32
9a957fbc
AL
2053S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
2054 regnode *last, scan_data_t *data, U32 flags, U32 depth)
c277df42
IZ
2055 /* scanp: Start here (read-write). */
2056 /* deltap: Write maxlen-minlen here. */
2057 /* last: Stop before this one. */
2058{
97aff369 2059 dVAR;
c277df42
IZ
2060 I32 min = 0, pars = 0, code;
2061 regnode *scan = *scanp, *next;
2062 I32 delta = 0;
2063 int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
aca2d497 2064 int is_inf_internal = 0; /* The studied chunk is infinite */
c277df42
IZ
2065 I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
2066 scan_data_t data_fake;
653099ff 2067 struct regnode_charclass_class and_with; /* Valid if flags & SCF_DO_STCLASS_OR */
a3621e74
YO
2068 SV *re_trie_maxbuff = NULL;
2069
2070 GET_RE_DEBUG_FLAGS_DECL;
13a24bad
YO
2071#ifdef DEBUGGING
2072 StructCopy(&zero_scan_data, &data_fake, scan_data_t);
2073#endif
b81d288d 2074
c277df42
IZ
2075 while (scan && OP(scan) != END && scan < last) {
2076 /* Peephole optimizer: */
07be1b83 2077 DEBUG_PEEP("Peep",scan,depth);
a3621e74 2078
07be1b83 2079 JOIN_EXACT(scan,&min,0);
a3621e74 2080
653099ff
GS
2081 /* Follow the next-chain of the current node and optimize
2082 away all the NOTHINGs from it. */
c277df42 2083 if (OP(scan) != CURLYX) {
a3b680e6 2084 const int max = (reg_off_by_arg[OP(scan)]
048cfca1
GS
2085 ? I32_MAX
2086 /* I32 may be smaller than U16 on CRAYs! */
2087 : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
c277df42
IZ
2088 int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
2089 int noff;
2090 regnode *n = scan;
b81d288d 2091
c277df42
IZ
2092 /* Skip NOTHING and LONGJMP. */
2093 while ((n = regnext(n))
3dab1dad 2094 && ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
c277df42
IZ
2095 || ((OP(n) == LONGJMP) && (noff = ARG(n))))
2096 && off + noff < max)
2097 off += noff;
2098 if (reg_off_by_arg[OP(scan)])
2099 ARG(scan) = off;
b81d288d 2100 else
c277df42
IZ
2101 NEXT_OFF(scan) = off;
2102 }
a3621e74 2103
07be1b83 2104
3dab1dad 2105
653099ff
GS
2106 /* The principal pseudo-switch. Cannot be a switch, since we
2107 look into several different things. */
b81d288d 2108 if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
c277df42
IZ
2109 || OP(scan) == IFTHEN || OP(scan) == SUSPEND) {
2110 next = regnext(scan);
2111 code = OP(scan);
a3621e74 2112 /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
b81d288d
AB
2113
2114 if (OP(next) == code || code == IFTHEN || code == SUSPEND) {
c277df42 2115 I32 max1 = 0, min1 = I32_MAX, num = 0;
653099ff 2116 struct regnode_charclass_class accum;
d4c19fe8 2117 regnode * const startbranch=scan;
c277df42 2118
653099ff 2119 if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
830247a4 2120 scan_commit(pRExC_state, data); /* Cannot merge strings after this. */
653099ff 2121 if (flags & SCF_DO_STCLASS)
830247a4 2122 cl_init_zero(pRExC_state, &accum);
a3621e74 2123
c277df42 2124 while (OP(scan) == code) {
830247a4 2125 I32 deltanext, minnext, f = 0, fake;
653099ff 2126 struct regnode_charclass_class this_class;
c277df42
IZ
2127
2128 num++;
2129 data_fake.flags = 0;
b81d288d 2130 if (data) {
2c2d71f5 2131 data_fake.whilem_c = data->whilem_c;
cb434fcc
IZ
2132 data_fake.last_closep = data->last_closep;
2133 }
2134 else
2135 data_fake.last_closep = &fake;
c277df42
IZ
2136 next = regnext(scan);
2137 scan = NEXTOPER(scan);
2138 if (code != BRANCH)
2139 scan = NEXTOPER(scan);
653099ff 2140 if (flags & SCF_DO_STCLASS) {
830247a4 2141 cl_init(pRExC_state, &this_class);
653099ff
GS
2142 data_fake.start_class = &this_class;
2143 f = SCF_DO_STCLASS_AND;
b81d288d 2144 }
e1901655
IZ
2145 if (flags & SCF_WHILEM_VISITED_POS)
2146 f |= SCF_WHILEM_VISITED_POS;
a3621e74 2147
653099ff 2148 /* we suppose the run is continuous, last=next...*/
830247a4 2149 minnext = study_chunk(pRExC_state, &scan, &deltanext,
a3621e74 2150 next, &data_fake, f,depth+1);
b81d288d 2151 if (min1 > minnext)
c277df42
IZ
2152 min1 = minnext;
2153 if (max1 < minnext + deltanext)
2154 max1 = minnext + deltanext;
2155 if (deltanext == I32_MAX)
aca2d497 2156 is_inf = is_inf_internal = 1;
c277df42
IZ
2157 scan = next;
2158 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
2159 pars++;
3dab1dad
YO
2160 if (data) {
2161 if (data_fake.flags & SF_HAS_EVAL)
07be1b83 2162 data->flags |= SF_HAS_EVAL;
2c2d71f5 2163 data->whilem_c = data_fake.whilem_c;
3dab1dad 2164 }
653099ff 2165 if (flags & SCF_DO_STCLASS)
830247a4 2166 cl_or(pRExC_state, &accum, &this_class);
b81d288d 2167 if (code == SUSPEND)
c277df42
IZ
2168 break;
2169 }
2170 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
2171 min1 = 0;
2172 if (flags & SCF_DO_SUBSTR) {
2173 data->pos_min += min1;
2174 data->pos_delta += max1 - min1;
2175 if (max1 != min1 || is_inf)
2176 data->longest = &(data->longest_float);
2177 }
2178 min += min1;
2179 delta += max1 - min1;
653099ff 2180 if (flags & SCF_DO_STCLASS_OR) {
830247a4 2181 cl_or(pRExC_state, data->start_class, &accum);
653099ff
GS
2182 if (min1) {
2183 cl_and(data->start_class, &and_with);
2184 flags &= ~SCF_DO_STCLASS;
2185 }
2186 }
2187 else if (flags & SCF_DO_STCLASS_AND) {
de0c8cb8
GS
2188 if (min1) {
2189 cl_and(data->start_class, &accum);
653099ff 2190 flags &= ~SCF_DO_STCLASS;
de0c8cb8
GS
2191 }
2192 else {
b81d288d 2193 /* Switch to OR mode: cache the old value of
de0c8cb8
GS
2194 * data->start_class */
2195 StructCopy(data->start_class, &and_with,
2196 struct regnode_charclass_class);
2197 flags &= ~SCF_DO_STCLASS_AND;
2198 StructCopy(&accum, data->start_class,
2199 struct regnode_charclass_class);
2200 flags |= SCF_DO_STCLASS_OR;
2201 data->start_class->flags |= ANYOF_EOS;
2202 }
653099ff 2203 }
a3621e74
YO
2204
2205 /* demq.
2206
2207 Assuming this was/is a branch we are dealing with: 'scan' now
2208 points at the item that follows the branch sequence, whatever
2209 it is. We now start at the beginning of the sequence and look
2210 for subsequences of
2211
2212 BRANCH->EXACT=>X
2213 BRANCH->EXACT=>X
2214
2215 which would be constructed from a pattern like /A|LIST|OF|WORDS/
2216
2217 If we can find such a subseqence we need to turn the first
2218 element into a trie and then add the subsequent branch exact
2219 strings to the trie.
2220
2221 We have two cases
2222
2223 1. patterns where the whole set of branch can be converted to a trie,
2224
2225 2. patterns where only a subset of the alternations can be
2226 converted to a trie.
2227
2228 In case 1 we can replace the whole set with a single regop
2229 for the trie. In case 2 we need to keep the start and end
2230 branchs so
2231
2232 'BRANCH EXACT; BRANCH EXACT; BRANCH X'
2233 becomes BRANCH TRIE; BRANCH X;
2234
2235 Hypthetically when we know the regex isnt anchored we can
2236 turn a case 1 into a DFA and let it rip... Every time it finds a match
2237 it would just call its tail, no WHILEM/CURLY needed.
2238
2239 */
07be1b83 2240 if (PERL_ENABLE_TRIE_OPTIMISATION) {
3dab1dad 2241 int made=0;
0111c4fd
RGS
2242 if (!re_trie_maxbuff) {
2243 re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
2244 if (!SvIOK(re_trie_maxbuff))
2245 sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
2246 }
a3621e74
YO
2247 if ( SvIV(re_trie_maxbuff)>=0 && OP( startbranch )==BRANCH ) {
2248 regnode *cur;
2249 regnode *first = (regnode *)NULL;
2250 regnode *last = (regnode *)NULL;
2251 regnode *tail = scan;
2252 U8 optype = 0;
2253 U32 count=0;
2254
2255#ifdef DEBUGGING
c445ea15 2256 SV * const mysv = sv_newmortal(); /* for dumping */
a3621e74
YO
2257#endif
2258 /* var tail is used because there may be a TAIL
2259 regop in the way. Ie, the exacts will point to the
2260 thing following the TAIL, but the last branch will
2261 point at the TAIL. So we advance tail. If we
2262 have nested (?:) we may have to move through several
2263 tails.
2264 */
2265
2266 while ( OP( tail ) == TAIL ) {
2267 /* this is the TAIL generated by (?:) */
2268 tail = regnext( tail );
2269 }
2270
3dab1dad 2271
a3621e74 2272 DEBUG_OPTIMISE_r({
32fc9b6a 2273 regprop(RExC_rx, mysv, tail );
3dab1dad
YO
2274 PerlIO_printf( Perl_debug_log, "%*s%s%s\n",
2275 (int)depth * 2 + 2, "",
2276 "Looking for TRIE'able sequences. Tail node is: ",
2277 SvPV_nolen_const( mysv )
a3621e74
YO
2278 );
2279 });
3dab1dad 2280
a3621e74
YO
2281 /*
2282
2283 step through the branches, cur represents each
2284 branch, noper is the first thing to be matched
2285 as part of that branch and noper_next is the
2286 regnext() of that node. if noper is an EXACT
2287 and noper_next is the same as scan (our current
2288 position in the regex) then the EXACT branch is
2289 a possible optimization target. Once we have
2290 two or more consequetive such branches we can
2291 create a trie of the EXACT's contents and stich
2292 it in place. If the sequence represents all of
2293 the branches we eliminate the whole thing and
2294 replace it with a single TRIE. If it is a
2295 subsequence then we need to stitch it in. This
2296 means the first branch has to remain, and needs
2297 to be repointed at the item on the branch chain
2298 following the last branch optimized. This could
2299 be either a BRANCH, in which case the
2300 subsequence is internal, or it could be the
2301 item following the branch sequence in which
2302 case the subsequence is at the end.
2303
2304 */
2305
2306 /* dont use tail as the end marker for this traverse */
2307 for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) {
aec46f14
AL
2308 regnode * const noper = NEXTOPER( cur );
2309 regnode * const noper_next = regnext( noper );
a3621e74 2310
a3621e74 2311 DEBUG_OPTIMISE_r({
32fc9b6a 2312 regprop(RExC_rx, mysv, cur);
3dab1dad
YO
2313 PerlIO_printf( Perl_debug_log, "%*s- %s (%d)",
2314 (int)depth * 2 + 2,"", SvPV_nolen_const( mysv ), REG_NODE_NUM(cur) );
a3621e74 2315
32fc9b6a 2316 regprop(RExC_rx, mysv, noper);
a3621e74 2317 PerlIO_printf( Perl_debug_log, " -> %s",
cfd0369c 2318 SvPV_nolen_const(mysv));
a3621e74
YO
2319
2320 if ( noper_next ) {
32fc9b6a 2321 regprop(RExC_rx, mysv, noper_next );
a3621e74 2322 PerlIO_printf( Perl_debug_log,"\t=> %s\t",
cfd0369c 2323 SvPV_nolen_const(mysv));
a3621e74 2324 }
3dab1dad
YO
2325 PerlIO_printf( Perl_debug_log, "(First==%d,Last==%d,Cur==%d)\n",
2326 REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur) );
a3621e74 2327 });
3dab1dad
YO
2328 if ( (((first && optype!=NOTHING) ? OP( noper ) == optype
2329 : PL_regkind[ OP( noper ) ] == EXACT )
2330 || OP(noper) == NOTHING )
a3621e74
YO
2331 && noper_next == tail && count<U16_MAX)
2332 {
2333 count++;
3dab1dad
YO
2334 if ( !first || optype == NOTHING ) {
2335 if (!first) first = cur;
a3621e74
YO
2336 optype = OP( noper );
2337 } else {
a3621e74 2338 last = cur;
a3621e74
YO
2339 }
2340 } else {
2341 if ( last ) {
3dab1dad 2342 made+=make_trie( pRExC_state, startbranch, first, cur, tail, optype, depth+1 );
a3621e74 2343 }
3dab1dad 2344 if ( PL_regkind[ OP( noper ) ] == EXACT
a3621e74
YO
2345 && noper_next == tail )
2346 {
2347 count = 1;
2348 first = cur;
2349 optype = OP( noper );
2350 } else {
2351 count = 0;
2352 first = NULL;
2353 optype = 0;
2354 }
2355 last = NULL;
2356 }
2357 }
2358 DEBUG_OPTIMISE_r({
32fc9b6a 2359 regprop(RExC_rx, mysv, cur);
a3621e74 2360 PerlIO_printf( Perl_debug_log,
3dab1dad
YO
2361 "%*s- %s (%d) <SCAN FINISHED>\n", (int)depth * 2 + 2,
2362 "", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
a3621e74
YO
2363
2364 });
2365 if ( last ) {
3dab1dad
YO
2366 made+= make_trie( pRExC_state, startbranch, first, scan, tail, optype, depth+1 );
2367#ifdef TRIE_STUDY_OPT
07be1b83
YO
2368 if ( made && startbranch == first ) {
2369 if ( OP(first)!=TRIE )
2370 flags |= SCF_EXACT_TRIE;
2371 else {
2372 regnode *chk=*scanp;
2373 while ( OP( chk ) == OPEN )
2374 chk = regnext( chk );
2375 if (chk==first)
2376 flags |= SCF_EXACT_TRIE;
2377 }
2378 }
3dab1dad 2379#endif
07be1b83 2380 }
a3621e74 2381 }
3dab1dad
YO
2382
2383 } /* do trie */
a0ed51b3 2384 }
a3621e74 2385 else if ( code == BRANCHJ ) { /* single branch is optimized. */
c277df42 2386 scan = NEXTOPER(NEXTOPER(scan));
a3621e74 2387 } else /* single branch is optimized. */
c277df42
IZ
2388 scan = NEXTOPER(scan);
2389 continue;
a0ed51b3
LW
2390 }
2391 else if (OP(scan) == EXACT) {
cd439c50 2392 I32 l = STR_LEN(scan);
c445ea15 2393 UV uc;
a0ed51b3 2394 if (UTF) {
a3b680e6 2395 const U8 * const s = (U8*)STRING(scan);
1aa99e6b 2396 l = utf8_length(s, s + l);
9041c2e3 2397 uc = utf8_to_uvchr(s, NULL);
c445ea15
AL
2398 } else {
2399 uc = *((U8*)STRING(scan));
a0ed51b3
LW
2400 }
2401 min += l;
c277df42 2402 if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
c277df42
IZ
2403 /* The code below prefers earlier match for fixed
2404 offset, later match for variable offset. */
2405 if (data->last_end == -1) { /* Update the start info. */
2406 data->last_start_min = data->pos_min;
2407 data->last_start_max = is_inf
b81d288d 2408 ? I32_MAX : data->pos_min + data->pos_delta;
c277df42 2409 }
cd439c50 2410 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
45f47268
NC
2411 if (UTF)
2412 SvUTF8_on(data->last_found);
0eda9292 2413 {
9a957fbc 2414 SV * const sv = data->last_found;
a28509cc 2415 MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
0eda9292
JH
2416 mg_find(sv, PERL_MAGIC_utf8) : NULL;
2417 if (mg && mg->mg_len >= 0)
5e43f467
JH
2418 mg->mg_len += utf8_length((U8*)STRING(scan),
2419 (U8*)STRING(scan)+STR_LEN(scan));
0eda9292 2420 }
c277df42
IZ
2421 data->last_end = data->pos_min + l;
2422 data->pos_min += l; /* As in the first entry. */
2423 data->flags &= ~SF_BEFORE_EOL;
2424 }
653099ff
GS
2425 if (flags & SCF_DO_STCLASS_AND) {
2426 /* Check whether it is compatible with what we know already! */
2427 int compat = 1;
2428
1aa99e6b 2429 if (uc >= 0x100 ||
516a5887 2430 (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
1aa99e6b 2431 && !ANYOF_BITMAP_TEST(data->start_class, uc)
653099ff 2432 && (!(data->start_class->flags & ANYOF_FOLD)
1aa99e6b 2433 || !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
516a5887 2434 )
653099ff
GS
2435 compat = 0;
2436 ANYOF_CLASS_ZERO(data->start_class);
2437 ANYOF_BITMAP_ZERO(data->start_class);
2438 if (compat)
1aa99e6b 2439 ANYOF_BITMAP_SET(data->start_class, uc);
653099ff 2440 data->start_class->flags &= ~ANYOF_EOS;
9b877dbb
IH
2441 if (uc < 0x100)
2442 data->start_class->flags &= ~ANYOF_UNICODE_ALL;
653099ff
GS
2443 }
2444 else if (flags & SCF_DO_STCLASS_OR) {
2445 /* false positive possible if the class is case-folded */
1aa99e6b 2446 if (uc < 0x100)
9b877dbb
IH
2447 ANYOF_BITMAP_SET(data->start_class, uc);
2448 else
2449 data->start_class->flags |= ANYOF_UNICODE_ALL;
653099ff
GS
2450 data->start_class->flags &= ~ANYOF_EOS;
2451 cl_and(data->start_class, &and_with);
2452 }
2453 flags &= ~SCF_DO_STCLASS;
a0ed51b3 2454 }
3dab1dad 2455 else if (PL_regkind[OP(scan)] == EXACT) { /* But OP != EXACT! */
cd439c50 2456 I32 l = STR_LEN(scan);
1aa99e6b 2457 UV uc = *((U8*)STRING(scan));
653099ff
GS
2458
2459 /* Search for fixed substrings supports EXACT only. */
ecaa9b9c
NC
2460 if (flags & SCF_DO_SUBSTR) {
2461 assert(data);
830247a4 2462 scan_commit(pRExC_state, data);
ecaa9b9c 2463 }
a0ed51b3 2464 if (UTF) {
6136c704 2465 const U8 * const s = (U8 *)STRING(scan);
1aa99e6b 2466 l = utf8_length(s, s + l);
9041c2e3 2467 uc = utf8_to_uvchr(s, NULL);
a0ed51b3
LW
2468 }
2469 min += l;
ecaa9b9c 2470 if (flags & SCF_DO_SUBSTR)
a0ed51b3 2471 data->pos_min += l;
653099ff
GS
2472 if (flags & SCF_DO_STCLASS_AND) {
2473 /* Check whether it is compatible with what we know already! */
2474 int compat = 1;
2475
1aa99e6b 2476 if (uc >= 0x100 ||
516a5887 2477 (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
1aa99e6b 2478 && !ANYOF_BITMAP_TEST(data->start_class, uc)
516a5887 2479 && !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
653099ff
GS
2480 compat = 0;
2481 ANYOF_CLASS_ZERO(data->start_class);
2482 ANYOF_BITMAP_ZERO(data->start_class);
2483 if (compat) {
1aa99e6b 2484 ANYOF_BITMAP_SET(data->start_class, uc);
653099ff
GS
2485 data->start_class->flags &= ~ANYOF_EOS;
2486 data->start_class->flags |= ANYOF_FOLD;
2487 if (OP(scan) == EXACTFL)
2488 data->start_class->flags |= ANYOF_LOCALE;
2489 }
2490 }
2491 else if (flags & SCF_DO_STCLASS_OR) {
2492 if (data->start_class->flags & ANYOF_FOLD) {
2493 /* false positive possible if the class is case-folded.
2494 Assume that the locale settings are the same... */
1aa99e6b
IH
2495 if (uc < 0x100)
2496 ANYOF_BITMAP_SET(data->start_class, uc);
653099ff
GS
2497 data->start_class->flags &= ~ANYOF_EOS;
2498 }
2499 cl_and(data->start_class, &and_with);
2500 }
2501 flags &= ~SCF_DO_STCLASS;
a0ed51b3 2502 }
3dab1dad
YO
2503#ifdef TRIE_STUDY_OPT
2504 else if (OP(scan) == TRIE) {
10edeb5d 2505 reg_trie_data *trie = (reg_trie_data*)RExC_rx->data->data[ ARG(scan) ];
3dab1dad 2506 min += trie->minlen;
07be1b83 2507 delta += (trie->maxlen - trie->minlen);
3dab1dad
YO
2508 flags &= ~SCF_DO_STCLASS; /* xxx */
2509 if (flags & SCF_DO_SUBSTR) {
2510 scan_commit(pRExC_state,data); /* Cannot expect anything... */
2511 data->pos_min += trie->minlen;
07be1b83
YO
2512 data->pos_delta += (trie->maxlen - trie->minlen);
2513 if (trie->maxlen != trie->minlen)
2514 data->longest = &(data->longest_float);
3dab1dad
YO
2515 }
2516 }
2517#endif
bfed75c6 2518 else if (strchr((const char*)PL_varies,OP(scan))) {
9c5ffd7c 2519 I32 mincount, maxcount, minnext, deltanext, fl = 0;
aa7a4b56 2520 I32 f = flags, pos_before = 0;
d4c19fe8 2521 regnode * const oscan = scan;
653099ff
GS
2522 struct regnode_charclass_class this_class;
2523 struct regnode_charclass_class *oclass = NULL;
727f22e3 2524 I32 next_is_eval = 0;
653099ff 2525
3dab1dad 2526 switch (PL_regkind[OP(scan)]) {
653099ff 2527 case WHILEM: /* End of (?:...)* . */
c277df42
IZ
2528 scan = NEXTOPER(scan);
2529 goto finish;
2530 case PLUS:
653099ff 2531 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
c277df42 2532 next = NEXTOPER(scan);
653099ff 2533 if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
b81d288d
AB
2534 mincount = 1;
2535 maxcount = REG_INFTY;
c277df42
IZ
2536 next = regnext(scan);
2537 scan = NEXTOPER(scan);
2538 goto do_curly;
2539 }
2540 }
2541 if (flags & SCF_DO_SUBSTR)
2542 data->pos_min++;
2543 min++;
2544 /* Fall through. */
2545 case STAR:
653099ff
GS
2546 if (flags & SCF_DO_STCLASS) {
2547 mincount = 0;
b81d288d 2548 maxcount = REG_INFTY;
653099ff
GS
2549 next = regnext(scan);
2550 scan = NEXTOPER(scan);
2551 goto do_curly;
2552 }
b81d288d 2553 is_inf = is_inf_internal = 1;
c277df42
IZ
2554 scan = regnext(scan);
2555 if (flags & SCF_DO_SUBSTR) {
830247a4 2556 scan_commit(pRExC_state, data); /* Cannot extend fixed substrings */
c277df42
IZ
2557 data->longest = &(data->longest_float);
2558 }
2559 goto optimize_curly_tail;
2560 case CURLY:
b81d288d 2561 mincount = ARG1(scan);
c277df42
IZ
2562 maxcount = ARG2(scan);
2563 next = regnext(scan);
cb434fcc
IZ
2564 if (OP(scan) == CURLYX) {
2565 I32 lp = (data ? *(data->last_closep) : 0);
a3621e74 2566 scan->flags = ((lp <= U8_MAX) ? (U8)lp : U8_MAX);
cb434fcc 2567 }
c277df42 2568 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
727f22e3 2569 next_is_eval = (OP(scan) == EVAL);
c277df42
IZ
2570 do_curly:
2571 if (flags & SCF_DO_SUBSTR) {
830247a4 2572 if (mincount == 0) scan_commit(pRExC_state,data); /* Cannot extend fixed substrings */
c277df42
IZ
2573 pos_before = data->pos_min;
2574 }
2575 if (data) {
2576 fl = data->flags;
2577 data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
2578 if (is_inf)
2579 data->flags |= SF_IS_INF;
2580 }
653099ff 2581 if (flags & SCF_DO_STCLASS) {
830247a4 2582 cl_init(pRExC_state, &this_class);
653099ff
GS
2583 oclass = data->start_class;
2584 data->start_class = &this_class;
2585 f |= SCF_DO_STCLASS_AND;
2586 f &= ~SCF_DO_STCLASS_OR;
2587 }
e1901655
IZ
2588 /* These are the cases when once a subexpression
2589 fails at a particular position, it cannot succeed
2590 even after backtracking at the enclosing scope.
b81d288d 2591
e1901655
IZ
2592 XXXX what if minimal match and we are at the
2593 initial run of {n,m}? */
2594 if ((mincount != maxcount - 1) && (maxcount != REG_INFTY))
2595 f &= ~SCF_WHILEM_VISITED_POS;
653099ff 2596
c277df42 2597 /* This will finish on WHILEM, setting scan, or on NULL: */
b81d288d 2598 minnext = study_chunk(pRExC_state, &scan, &deltanext, last, data,
a3621e74
YO
2599 (mincount == 0
2600 ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
653099ff
GS
2601
2602 if (flags & SCF_DO_STCLASS)
2603 data->start_class = oclass;
2604 if (mincount == 0 || minnext == 0) {
2605 if (flags & SCF_DO_STCLASS_OR) {
830247a4 2606 cl_or(pRExC_state, data->start_class, &this_class);
653099ff
GS
2607 }
2608 else if (flags & SCF_DO_STCLASS_AND) {
b81d288d 2609 /* Switch to OR mode: cache the old value of
653099ff
GS
2610 * data->start_class */
2611 StructCopy(data->start_class, &and_with,
2612 struct regnode_charclass_class);
2613 flags &= ~SCF_DO_STCLASS_AND;
2614 StructCopy(&this_class, data->start_class,
2615 struct regnode_charclass_class);
2616 flags |= SCF_DO_STCLASS_OR;
2617 data->start_class->flags |= ANYOF_EOS;
2618 }
2619 } else { /* Non-zero len */
2620 if (flags & SCF_DO_STCLASS_OR) {
830247a4 2621 cl_or(pRExC_state, data->start_class, &this_class);
653099ff
GS
2622 cl_and(data->start_class, &and_with);
2623 }
2624 else if (flags & SCF_DO_STCLASS_AND)
2625 cl_and(data->start_class, &this_class);
2626 flags &= ~SCF_DO_STCLASS;
2627 }
c277df42
IZ
2628 if (!scan) /* It was not CURLYX, but CURLY. */
2629 scan = next;
041457d9
DM
2630 if ( /* ? quantifier ok, except for (?{ ... }) */
2631 (next_is_eval || !(mincount == 0 && maxcount == 1))
84037bb0 2632 && (minnext == 0) && (deltanext == 0)
99799961 2633 && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
041457d9
DM
2634 && maxcount <= REG_INFTY/3 /* Complement check for big count */
2635 && ckWARN(WARN_REGEXP))
b45f050a 2636 {
830247a4 2637 vWARN(RExC_parse,
b45f050a
JF
2638 "Quantifier unexpected on zero-length expression");
2639 }
2640
c277df42 2641 min += minnext * mincount;
b81d288d 2642 is_inf_internal |= ((maxcount == REG_INFTY
155aba94
GS
2643 && (minnext + deltanext) > 0)
2644 || deltanext == I32_MAX);
aca2d497 2645 is_inf |= is_inf_internal;
c277df42
IZ
2646 delta += (minnext + deltanext) * maxcount - minnext * mincount;
2647
2648 /* Try powerful optimization CURLYX => CURLYN. */
b81d288d 2649 if ( OP(oscan) == CURLYX && data
c277df42
IZ
2650 && data->flags & SF_IN_PAR
2651 && !(data->flags & SF_HAS_EVAL)
2652 && !deltanext && minnext == 1 ) {
2653 /* Try to optimize to CURLYN. */
2654 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
d4c19fe8 2655 regnode * const nxt1 = nxt;
497b47a8
JH
2656#ifdef DEBUGGING
2657 regnode *nxt2;
2658#endif
c277df42
IZ
2659
2660 /* Skip open. */
2661 nxt = regnext(nxt);
bfed75c6 2662 if (!strchr((const char*)PL_simple,OP(nxt))
3dab1dad 2663 && !(PL_regkind[OP(nxt)] == EXACT
b81d288d 2664 && STR_LEN(nxt) == 1))
c277df42 2665 goto nogo;
497b47a8 2666#ifdef DEBUGGING
c277df42 2667 nxt2 = nxt;
497b47a8 2668#endif
c277df42 2669 nxt = regnext(nxt);
b81d288d 2670 if (OP(nxt) != CLOSE)
c277df42
IZ
2671 goto nogo;
2672 /* Now we know that nxt2 is the only contents: */
eb160463 2673 oscan->flags = (U8)ARG(nxt);
c277df42
IZ
2674 OP(oscan) = CURLYN;
2675 OP(nxt1) = NOTHING; /* was OPEN. */
2676#ifdef DEBUGGING
2677 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
2678 NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
2679 NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */
2680 OP(nxt) = OPTIMIZED; /* was CLOSE. */
2681 OP(nxt + 1) = OPTIMIZED; /* was count. */
2682 NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
b81d288d 2683#endif
c277df42 2684 }
c277df42
IZ
2685 nogo:
2686
2687 /* Try optimization CURLYX => CURLYM. */
b81d288d 2688 if ( OP(oscan) == CURLYX && data
c277df42 2689 && !(data->flags & SF_HAS_PAR)
c277df42 2690 && !(data->flags & SF_HAS_EVAL)
0e788c72
HS
2691 && !deltanext /* atom is fixed width */
2692 && minnext != 0 /* CURLYM can't handle zero width */
2693 ) {
c277df42
IZ
2694 /* XXXX How to optimize if data == 0? */
2695 /* Optimize to a simpler form. */
2696 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
2697 regnode *nxt2;
2698
2699 OP(oscan) = CURLYM;
2700 while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
b81d288d 2701 && (OP(nxt2) != WHILEM))
c277df42
IZ
2702 nxt = nxt2;
2703 OP(nxt2) = SUCCEED; /* Whas WHILEM */
c277df42
IZ
2704 /* Need to optimize away parenths. */
2705 if (data->flags & SF_IN_PAR) {
2706 /* Set the parenth number. */
2707 regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
2708
b81d288d 2709 if (OP(nxt) != CLOSE)
b45f050a 2710 FAIL("Panic opt close");
eb160463 2711 oscan->flags = (U8)ARG(nxt);
c277df42
IZ
2712 OP(nxt1) = OPTIMIZED; /* was OPEN. */
2713 OP(nxt) = OPTIMIZED; /* was CLOSE. */
2714#ifdef DEBUGGING
2715 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
2716 OP(nxt + 1) = OPTIMIZED; /* was count. */
2717 NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
2718 NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
b81d288d 2719#endif
c277df42
IZ
2720#if 0
2721 while ( nxt1 && (OP(nxt1) != WHILEM)) {
2722 regnode *nnxt = regnext(nxt1);
b81d288d 2723
c277df42
IZ
2724 if (nnxt == nxt) {
2725 if (reg_off_by_arg[OP(nxt1)])
2726 ARG_SET(nxt1, nxt2 - nxt1);
2727 else if (nxt2 - nxt1 < U16_MAX)
2728 NEXT_OFF(nxt1) = nxt2 - nxt1;
2729 else
2730 OP(nxt) = NOTHING; /* Cannot beautify */
2731 }
2732 nxt1 = nnxt;
2733 }
2734#endif
2735 /* Optimize again: */
b81d288d 2736 study_chunk(pRExC_state, &nxt1, &deltanext, nxt,
a3621e74 2737 NULL, 0,depth+1);
a0ed51b3
LW
2738 }
2739 else
c277df42 2740 oscan->flags = 0;
c277df42 2741 }
e1901655
IZ
2742 else if ((OP(oscan) == CURLYX)
2743 && (flags & SCF_WHILEM_VISITED_POS)
2744 /* See the comment on a similar expression above.
2745 However, this time it not a subexpression
2746 we care about, but the expression itself. */
2747 && (maxcount == REG_INFTY)
2748 && data && ++data->whilem_c < 16) {
2749 /* This stays as CURLYX, we can put the count/of pair. */
2c2d71f5
JH
2750 /* Find WHILEM (as in regexec.c) */
2751 regnode *nxt = oscan + NEXT_OFF(oscan);
2752
2753 if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
2754 nxt += ARG(nxt);
eb160463
GS
2755 PREVOPER(nxt)->flags = (U8)(data->whilem_c
2756 | (RExC_whilem_seen << 4)); /* On WHILEM */
2c2d71f5 2757 }
b81d288d 2758 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
c277df42
IZ
2759 pars++;
2760 if (flags & SCF_DO_SUBSTR) {
c445ea15 2761 SV *last_str = NULL;
c277df42
IZ
2762 int counted = mincount != 0;
2763
2764 if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
5d1c421c
JH
2765#if defined(SPARC64_GCC_WORKAROUND)
2766 I32 b = 0;
2767 STRLEN l = 0;
cfd0369c 2768 const char *s = NULL;
5d1c421c
JH
2769 I32 old = 0;
2770
2771 if (pos_before >= data->last_start_min)
2772 b = pos_before;
2773 else
2774 b = data->last_start_min;
2775
2776 l = 0;
cfd0369c 2777 s = SvPV_const(data->last_found, l);
5d1c421c
JH
2778 old = b - data->last_start_min;
2779
2780#else
b81d288d 2781 I32 b = pos_before >= data->last_start_min
c277df42
IZ
2782 ? pos_before : data->last_start_min;
2783 STRLEN l;
d4c19fe8 2784 const char * const s = SvPV_const(data->last_found, l);
a0ed51b3 2785 I32 old = b - data->last_start_min;
5d1c421c 2786#endif
a0ed51b3
LW
2787
2788 if (UTF)
2789 old = utf8_hop((U8*)s, old) - (U8*)s;
c277df42 2790
a0ed51b3 2791 l -= old;
c277df42 2792 /* Get the added string: */
79cb57f6 2793 last_str = newSVpvn(s + old, l);
0e933229
IH
2794 if (UTF)
2795 SvUTF8_on(last_str);
c277df42
IZ
2796 if (deltanext == 0 && pos_before == b) {
2797 /* What was added is a constant string */
2798 if (mincount > 1) {
2799 SvGROW(last_str, (mincount * l) + 1);
b81d288d 2800 repeatcpy(SvPVX(last_str) + l,
3f7c398e 2801 SvPVX_const(last_str), l, mincount - 1);
b162af07 2802 SvCUR_set(last_str, SvCUR(last_str) * mincount);
c277df42 2803 /* Add additional parts. */
b81d288d 2804 SvCUR_set(data->last_found,
c277df42
IZ
2805 SvCUR(data->last_found) - l);
2806 sv_catsv(data->last_found, last_str);
0eda9292
JH
2807 {
2808 SV * sv = data->last_found;
2809 MAGIC *mg =
2810 SvUTF8(sv) && SvMAGICAL(sv) ?
2811 mg_find(sv, PERL_MAGIC_utf8) : NULL;
2812 if (mg && mg->mg_len >= 0)
2813 mg->mg_len += CHR_SVLEN(last_str);
2814 }
c277df42
IZ
2815 data->last_end += l * (mincount - 1);
2816 }
2a8d9689
HS
2817 } else {
2818 /* start offset must point into the last copy */
2819 data->last_start_min += minnext * (mincount - 1);
c152dc43
HS
2820 data->last_start_max += is_inf ? I32_MAX
2821 : (maxcount - 1) * (minnext + data->pos_delta);
c277df42
IZ
2822 }
2823 }
2824 /* It is counted once already... */
2825 data->pos_min += minnext * (mincount - counted);
2826 data->pos_delta += - counted * deltanext +
2827 (minnext + deltanext) * maxcount - minnext * mincount;
2828 if (mincount != maxcount) {
653099ff
GS
2829 /* Cannot extend fixed substrings found inside
2830 the group. */
830247a4 2831 scan_commit(pRExC_state,data);
c277df42 2832 if (mincount && last_str) {
d4c19fe8
AL
2833 SV * const sv = data->last_found;
2834 MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
45f47268
NC
2835 mg_find(sv, PERL_MAGIC_utf8) : NULL;
2836
2837 if (mg)
2838 mg->mg_len = -1;
2839 sv_setsv(sv, last_str);
c277df42 2840 data->last_end = data->pos_min;
b81d288d 2841 data->last_start_min =
a0ed51b3 2842 data->pos_min - CHR_SVLEN(last_str);
b81d288d
AB
2843 data->last_start_max = is_inf
2844 ? I32_MAX
c277df42 2845 : data->pos_min + data->pos_delta
a0ed51b3 2846 - CHR_SVLEN(last_str);
c277df42
IZ
2847 }
2848 data->longest = &(data->longest_float);
2849 }
aca2d497 2850 SvREFCNT_dec(last_str);
c277df42 2851 }
405ff068 2852 if (data && (fl & SF_HAS_EVAL))
c277df42
IZ
2853 data->flags |= SF_HAS_EVAL;
2854 optimize_curly_tail:
c277df42 2855 if (OP(oscan) != CURLYX) {
3dab1dad 2856 while (PL_regkind[OP(next = regnext(oscan))] == NOTHING
c277df42
IZ
2857 && NEXT_OFF(next))
2858 NEXT_OFF(oscan) += NEXT_OFF(next);
2859 }
c277df42 2860 continue;
653099ff 2861 default: /* REF and CLUMP only? */
c277df42 2862 if (flags & SCF_DO_SUBSTR) {
830247a4 2863 scan_commit(pRExC_state,data); /* Cannot expect anything... */
c277df42
IZ
2864 data->longest = &(data->longest_float);
2865 }
aca2d497 2866 is_inf = is_inf_internal = 1;
653099ff 2867 if (flags & SCF_DO_STCLASS_OR)
830247a4 2868 cl_anything(pRExC_state, data->start_class);
653099ff 2869 flags &= ~SCF_DO_STCLASS;
c277df42
IZ
2870 break;
2871 }
a0ed51b3 2872 }
bfed75c6 2873 else if (strchr((const char*)PL_simple,OP(scan))) {
9c5ffd7c 2874 int value = 0;
653099ff 2875
c277df42 2876 if (flags & SCF_DO_SUBSTR) {
830247a4 2877 scan_commit(pRExC_state,data);
c277df42
IZ
2878 data->pos_min++;
2879 }
2880 min++;
653099ff
GS
2881 if (flags & SCF_DO_STCLASS) {
2882 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
2883
2884 /* Some of the logic below assumes that switching
2885 locale on will only add false positives. */
3dab1dad 2886 switch (PL_regkind[OP(scan)]) {
653099ff 2887 case SANY:
653099ff
GS
2888 default:
2889 do_default:
2890 /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
2891 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
830247a4 2892 cl_anything(pRExC_state, data->start_class);
653099ff
GS
2893 break;
2894 case REG_ANY:
2895 if (OP(scan) == SANY)
2896 goto do_default;
2897 if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
2898 value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
2899 || (data->start_class->flags & ANYOF_CLASS));
830247a4 2900 cl_anything(pRExC_state, data->start_class);
653099ff
GS
2901 }
2902 if (flags & SCF_DO_STCLASS_AND || !value)
2903 ANYOF_BITMAP_CLEAR(data->start_class,'\n');
2904 break;
2905 case ANYOF:
2906 if (flags & SCF_DO_STCLASS_AND)
2907 cl_and(data->start_class,
2908 (struct regnode_charclass_class*)scan);
2909 else
830247a4 2910 cl_or(pRExC_state, data->start_class,
653099ff
GS
2911 (struct regnode_charclass_class*)scan);
2912 break;
2913 case ALNUM:
2914 if (flags & SCF_DO_STCLASS_AND) {
2915 if (!(data->start_class->flags & ANYOF_LOCALE)) {
2916 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
2917 for (value = 0; value < 256; value++)
2918 if (!isALNUM(value))
2919 ANYOF_BITMAP_CLEAR(data->start_class, value);
2920 }
2921 }
2922 else {
2923 if (data->start_class->flags & ANYOF_LOCALE)
2924 ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
2925 else {
2926 for (value = 0; value < 256; value++)
2927 if (isALNUM(value))
b81d288d 2928 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
2929 }
2930 }
2931 break;
2932 case ALNUML:
2933 if (flags & SCF_DO_STCLASS_AND) {
2934 if (data->start_class->flags & ANYOF_LOCALE)
2935 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
2936 }
2937 else {
2938 ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
2939 data->start_class->flags |= ANYOF_LOCALE;
2940 }
2941 break;
2942 case NALNUM:
2943 if (flags & SCF_DO_STCLASS_AND) {
2944 if (!(data->start_class->flags & ANYOF_LOCALE)) {
2945 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
2946 for (value = 0; value < 256; value++)
2947 if (isALNUM(value))
2948 ANYOF_BITMAP_CLEAR(data->start_class, value);
2949 }
2950 }
2951 else {
2952 if (data->start_class->flags & ANYOF_LOCALE)
2953 ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
2954 else {
2955 for (value = 0; value < 256; value++)
2956 if (!isALNUM(value))
b81d288d 2957 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
2958 }
2959 }
2960 break;
2961 case NALNUML:
2962 if (flags & SCF_DO_STCLASS_AND) {
2963 if (data->start_class->flags & ANYOF_LOCALE)
2964 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
2965 }
2966 else {
2967 data->start_class->flags |= ANYOF_LOCALE;
2968 ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
2969 }
2970 break;
2971 case SPACE:
2972 if (flags & SCF_DO_STCLASS_AND) {
2973 if (!(data->start_class->flags & ANYOF_LOCALE)) {
2974 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
2975 for (value = 0; value < 256; value++)
2976 if (!isSPACE(value))
2977 ANYOF_BITMAP_CLEAR(data->start_class, value);
2978 }
2979 }
2980 else {
2981 if (data->start_class->flags & ANYOF_LOCALE)
2982 ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
2983 else {
2984 for (value = 0; value < 256; value++)
2985 if (isSPACE(value))
b81d288d 2986 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
2987 }
2988 }
2989 break;
2990 case SPACEL:
2991 if (flags & SCF_DO_STCLASS_AND) {
2992 if (data->start_class->flags & ANYOF_LOCALE)
2993 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
2994 }
2995 else {
2996 data->start_class->flags |= ANYOF_LOCALE;
2997 ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
2998 }
2999 break;
3000 case NSPACE:
3001 if (flags & SCF_DO_STCLASS_AND) {
3002 if (!(data->start_class->flags & ANYOF_LOCALE)) {
3003 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3004 for (value = 0; value < 256; value++)
3005 if (isSPACE(value))
3006 ANYOF_BITMAP_CLEAR(data->start_class, value);
3007 }
3008 }
3009 else {
3010 if (data->start_class->flags & ANYOF_LOCALE)
3011 ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3012 else {
3013 for (value = 0; value < 256; value++)
3014 if (!isSPACE(value))
b81d288d 3015 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
3016 }
3017 }
3018 break;
3019 case NSPACEL:
3020 if (flags & SCF_DO_STCLASS_AND) {
3021 if (data->start_class->flags & ANYOF_LOCALE) {
3022 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
3023 for (value = 0; value < 256; value++)
3024 if (!isSPACE(value))
3025 ANYOF_BITMAP_CLEAR(data->start_class, value);
3026 }
3027 }
3028 else {
3029 data->start_class->flags |= ANYOF_LOCALE;
3030 ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
3031 }
3032 break;
3033 case DIGIT:
3034 if (flags & SCF_DO_STCLASS_AND) {
3035 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
3036 for (value = 0; value < 256; value++)
3037 if (!isDIGIT(value))
3038 ANYOF_BITMAP_CLEAR(data->start_class, value);
3039 }
3040 else {
3041 if (data->start_class->flags & ANYOF_LOCALE)
3042 ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
3043 else {
3044 for (value = 0; value < 256; value++)
3045 if (isDIGIT(value))
b81d288d 3046 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
3047 }
3048 }
3049 break;
3050 case NDIGIT:
3051 if (flags & SCF_DO_STCLASS_AND) {
3052 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
3053 for (value = 0; value < 256; value++)
3054 if (isDIGIT(value))
3055 ANYOF_BITMAP_CLEAR(data->start_class, value);
3056 }
3057 else {
3058 if (data->start_class->flags & ANYOF_LOCALE)
3059 ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
3060 else {
3061 for (value = 0; value < 256; value++)
3062 if (!isDIGIT(value))
b81d288d 3063 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
3064 }
3065 }
3066 break;
3067 }
3068 if (flags & SCF_DO_STCLASS_OR)
3069 cl_and(data->start_class, &and_with);
3070 flags &= ~SCF_DO_STCLASS;
3071 }
a0ed51b3 3072 }
3dab1dad 3073 else if (PL_regkind[OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
c277df42
IZ
3074 data->flags |= (OP(scan) == MEOL
3075 ? SF_BEFORE_MEOL
3076 : SF_BEFORE_SEOL);
a0ed51b3 3077 }
3dab1dad 3078 else if ( PL_regkind[OP(scan)] == BRANCHJ
653099ff
GS
3079 /* Lookbehind, or need to calculate parens/evals/stclass: */
3080 && (scan->flags || data || (flags & SCF_DO_STCLASS))
c277df42 3081 && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
653099ff 3082 /* Lookahead/lookbehind */
cb434fcc 3083 I32 deltanext, minnext, fake = 0;
c277df42 3084 regnode *nscan;
653099ff
GS
3085 struct regnode_charclass_class intrnl;
3086 int f = 0;
c277df42
IZ
3087
3088 data_fake.flags = 0;
b81d288d 3089 if (data) {
2c2d71f5 3090 data_fake.whilem_c = data->whilem_c;
cb434fcc
IZ
3091 data_fake.last_closep = data->last_closep;
3092 }
3093 else
3094 data_fake.last_closep = &fake;
653099ff
GS
3095 if ( flags & SCF_DO_STCLASS && !scan->flags
3096 && OP(scan) == IFMATCH ) { /* Lookahead */
830247a4 3097 cl_init(pRExC_state, &intrnl);
653099ff 3098 data_fake.start_class = &intrnl;
e1901655 3099 f |= SCF_DO_STCLASS_AND;
653099ff 3100 }
e1901655
IZ
3101 if (flags & SCF_WHILEM_VISITED_POS)
3102 f |= SCF_WHILEM_VISITED_POS;
c277df42
IZ
3103 next = regnext(scan);
3104 nscan = NEXTOPER(NEXTOPER(scan));
a3621e74 3105 minnext = study_chunk(pRExC_state, &nscan, &deltanext, last, &data_fake, f,depth+1);
c277df42
IZ
3106 if (scan->flags) {
3107 if (deltanext) {
9baa0206 3108 vFAIL("Variable length lookbehind not implemented");
a0ed51b3
LW
3109 }
3110 else if (minnext > U8_MAX) {
9baa0206 3111 vFAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
c277df42 3112 }
eb160463 3113 scan->flags = (U8)minnext;
c277df42 3114 }
be8e71aa
YO
3115 if (data) {
3116 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
3117 pars++;
3118 if (data_fake.flags & SF_HAS_EVAL)
3119 data->flags |= SF_HAS_EVAL;
2c2d71f5 3120 data->whilem_c = data_fake.whilem_c;
be8e71aa 3121 }
e1901655 3122 if (f & SCF_DO_STCLASS_AND) {
a28509cc 3123 const int was = (data->start_class->flags & ANYOF_EOS);
653099ff
GS
3124
3125 cl_and(data->start_class, &intrnl);
3126 if (was)
3127 data->start_class->flags |= ANYOF_EOS;
3128 }
a0ed51b3
LW
3129 }
3130 else if (OP(scan) == OPEN) {
c277df42 3131 pars++;
a0ed51b3 3132 }
cb434fcc 3133 else if (OP(scan) == CLOSE) {
eb160463 3134 if ((I32)ARG(scan) == is_par) {
cb434fcc 3135 next = regnext(scan);
c277df42 3136
cb434fcc
IZ
3137 if ( next && (OP(next) != WHILEM) && next < last)
3138 is_par = 0; /* Disable optimization */
3139 }
3140 if (data)
3141 *(data->last_closep) = ARG(scan);
a0ed51b3
LW
3142 }
3143 else if (OP(scan) == EVAL) {
c277df42
IZ
3144 if (data)
3145 data->flags |= SF_HAS_EVAL;
3146 }
96776eda 3147 else if (OP(scan) == LOGICAL && scan->flags == 2) { /* Embedded follows */
0f5d15d6 3148 if (flags & SCF_DO_SUBSTR) {
830247a4 3149 scan_commit(pRExC_state,data);
0f5d15d6
IZ
3150 data->longest = &(data->longest_float);
3151 }
3152 is_inf = is_inf_internal = 1;
653099ff 3153 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
830247a4 3154 cl_anything(pRExC_state, data->start_class);
96776eda 3155 flags &= ~SCF_DO_STCLASS;
0f5d15d6 3156 }
c277df42
IZ
3157 /* Else: zero-length, ignore. */
3158 scan = regnext(scan);
3159 }
3160
3161 finish:
3162 *scanp = scan;
aca2d497 3163 *deltap = is_inf_internal ? I32_MAX : delta;
b81d288d 3164 if (flags & SCF_DO_SUBSTR && is_inf)
c277df42
IZ
3165 data->pos_delta = I32_MAX - data->pos_min;
3166 if (is_par > U8_MAX)
3167 is_par = 0;
3168 if (is_par && pars==1 && data) {
3169 data->flags |= SF_IN_PAR;
3170 data->flags &= ~SF_HAS_PAR;
a0ed51b3
LW
3171 }
3172 else if (pars && data) {
c277df42
IZ
3173 data->flags |= SF_HAS_PAR;
3174 data->flags &= ~SF_IN_PAR;
3175 }
653099ff
GS
3176 if (flags & SCF_DO_STCLASS_OR)
3177 cl_and(data->start_class, &and_with);
07be1b83
YO
3178 if (flags & SCF_EXACT_TRIE)
3179 data->flags |= SCF_EXACT_TRIE;
c277df42
IZ
3180 return min;
3181}
3182
76e3520e 3183STATIC I32
5f66b61c 3184S_add_data(RExC_state_t *pRExC_state, I32 n, const char *s)
c277df42 3185{
830247a4 3186 if (RExC_rx->data) {
b81d288d
AB
3187 Renewc(RExC_rx->data,
3188 sizeof(*RExC_rx->data) + sizeof(void*) * (RExC_rx->data->count + n - 1),
c277df42 3189 char, struct reg_data);
830247a4
IZ
3190 Renew(RExC_rx->data->what, RExC_rx->data->count + n, U8);
3191 RExC_rx->data->count += n;
a0ed51b3
LW
3192 }
3193 else {
a02a5408 3194 Newxc(RExC_rx->data, sizeof(*RExC_rx->data) + sizeof(void*) * (n - 1),
c277df42 3195 char, struct reg_data);
a02a5408 3196 Newx(RExC_rx->data->what, n, U8);
830247a4 3197 RExC_rx->data->count = n;
c277df42 3198 }
830247a4
IZ
3199 Copy(s, RExC_rx->data->what + RExC_rx->data->count - n, n, U8);
3200 return RExC_rx->data->count - n;
c277df42
IZ
3201}
3202
76234dfb 3203#ifndef PERL_IN_XSUB_RE
d88dccdf 3204void
864dbfa3 3205Perl_reginitcolors(pTHX)
d88dccdf 3206{
97aff369 3207 dVAR;
1df70142 3208 const char * const s = PerlEnv_getenv("PERL_RE_COLORS");
d88dccdf 3209 if (s) {
1df70142
AL
3210 char *t = savepv(s);
3211 int i = 0;
3212 PL_colors[0] = t;
d88dccdf 3213 while (++i < 6) {
1df70142
AL
3214 t = strchr(t, '\t');
3215 if (t) {
3216 *t = '\0';
3217 PL_colors[i] = ++t;
d88dccdf
IZ
3218 }
3219 else
1df70142 3220 PL_colors[i] = t = (char *)"";
d88dccdf
IZ
3221 }
3222 } else {
1df70142 3223 int i = 0;
b81d288d 3224 while (i < 6)
06b5626a 3225 PL_colors[i++] = (char *)"";
d88dccdf
IZ
3226 }
3227 PL_colorset = 1;
3228}
76234dfb 3229#endif
8615cb43 3230
07be1b83 3231
a687059c 3232/*
e50aee73 3233 - pregcomp - compile a regular expression into internal code
a687059c
LW
3234 *
3235 * We can't allocate space until we know how big the compiled form will be,
3236 * but we can't compile it (and thus know how big it is) until we've got a
3237 * place to put the code. So we cheat: we compile it twice, once with code
3238 * generation turned off and size counting turned on, and once "for real".
3239 * This also means that we don't allocate space until we are sure that the
3240 * thing really will compile successfully, and we never have to move the
3241 * code and thus invalidate pointers into it. (Note that it has to be in
3242 * one piece because free() must be able to free it all.) [NB: not true in perl]
3243 *
3244 * Beware that the optimization-preparation code in here knows about some
3245 * of the structure of the compiled regexp. [I'll say.]
3246 */
3247regexp *
864dbfa3 3248Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
a687059c 3249{
97aff369 3250 dVAR;
a0d0e21e 3251 register regexp *r;
c277df42 3252 regnode *scan;
c277df42 3253 regnode *first;
a0d0e21e 3254 I32 flags;
a0d0e21e
LW
3255 I32 minlen = 0;
3256 I32 sawplus = 0;
3257 I32 sawopen = 0;
2c2d71f5 3258 scan_data_t data;
830247a4 3259 RExC_state_t RExC_state;
be8e71aa 3260 RExC_state_t * const pRExC_state = &RExC_state;
07be1b83
YO
3261#ifdef TRIE_STUDY_OPT
3262 int restudied= 0;
3263 RExC_state_t copyRExC_state;
3264#endif
a0d0e21e 3265
a3621e74
YO
3266 GET_RE_DEBUG_FLAGS_DECL;
3267
a0d0e21e 3268 if (exp == NULL)
c277df42 3269 FAIL("NULL regexp argument");
a0d0e21e 3270
a5961de5 3271 RExC_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
a0ed51b3 3272
5cfc7842 3273 RExC_precomp = exp;
a3621e74
YO
3274 DEBUG_r(if (!PL_colorset) reginitcolors());
3275 DEBUG_COMPILE_r({
ab3bbdeb
YO
3276 SV *dsv= sv_newmortal();
3277 RE_PV_QUOTED_DECL(s, RExC_utf8,
3278 dsv, RExC_precomp, (xend - exp), 60);
3279 PerlIO_printf(Perl_debug_log, "%sCompiling REx%s %s\n",
3280 PL_colors[4],PL_colors[5],s);
a5961de5 3281 });
e2509266 3282 RExC_flags = pm->op_pmflags;
830247a4 3283 RExC_sawback = 0;
bbce6d69 3284
830247a4
IZ
3285 RExC_seen = 0;
3286 RExC_seen_zerolen = *exp == '^' ? -1 : 0;
3287 RExC_seen_evals = 0;
3288 RExC_extralen = 0;
c277df42 3289
bbce6d69 3290 /* First pass: determine size, legality. */
830247a4 3291 RExC_parse = exp;
fac92740 3292 RExC_start = exp;
830247a4
IZ
3293 RExC_end = xend;
3294 RExC_naughty = 0;
3295 RExC_npar = 1;
3296 RExC_size = 0L;
3297 RExC_emit = &PL_regdummy;
3298 RExC_whilem_seen = 0;
85ddcde9
JH
3299#if 0 /* REGC() is (currently) a NOP at the first pass.
3300 * Clever compilers notice this and complain. --jhi */
830247a4 3301 REGC((U8)REG_MAGIC, (char*)RExC_emit);
85ddcde9 3302#endif
3dab1dad
YO
3303 DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "Starting first pass (sizing)\n"));
3304 if (reg(pRExC_state, 0, &flags,1) == NULL) {
c445ea15 3305 RExC_precomp = NULL;
a0d0e21e
LW
3306 return(NULL);
3307 }
3dab1dad
YO
3308 DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "Required "));
3309 DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" nodes ", (IV)RExC_size));
3310 DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "\nStarting second pass (creation)\n"));
07be1b83
YO
3311 DEBUG_PARSE_r({
3312 RExC_lastnum=0;
3313 RExC_lastparse=NULL;
3314 });
c277df42 3315
07be1b83 3316
c277df42
IZ
3317 /* Small enough for pointer-storage convention?
3318 If extralen==0, this means that we will not need long jumps. */
830247a4
IZ
3319 if (RExC_size >= 0x10000L && RExC_extralen)
3320 RExC_size += RExC_extralen;
c277df42 3321 else
830247a4
IZ
3322 RExC_extralen = 0;
3323 if (RExC_whilem_seen > 15)
3324 RExC_whilem_seen = 15;
a0d0e21e 3325
bbce6d69 3326 /* Allocate space and initialize. */
a02a5408 3327 Newxc(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode),
c277df42 3328 char, regexp);
a0d0e21e 3329 if (r == NULL)
b45f050a
JF
3330 FAIL("Regexp out of space");
3331
0f79a09d
GS
3332#ifdef DEBUGGING
3333 /* avoid reading uninitialized memory in DEBUGGING code in study_chunk() */
830247a4 3334 Zero(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode), char);
0f79a09d 3335#endif
c277df42 3336 r->refcnt = 1;
bbce6d69 3337 r->prelen = xend - exp;
5cfc7842 3338 r->precomp = savepvn(RExC_precomp, r->prelen);
cf93c79d 3339 r->subbeg = NULL;
f8c7b90f 3340#ifdef PERL_OLD_COPY_ON_WRITE
c445ea15 3341 r->saved_copy = NULL;
ed252734 3342#endif
cf93c79d 3343 r->reganch = pm->op_pmflags & PMf_COMPILETIME;
830247a4 3344 r->nparens = RExC_npar - 1; /* set early to validate backrefs */
38d1b06f 3345 r->lastparen = 0; /* mg.c reads this. */
4327152a
IZ
3346
3347 r->substrs = 0; /* Useful during FAIL. */
3348 r->startp = 0; /* Useful during FAIL. */
3349 r->endp = 0; /* Useful during FAIL. */
3350
a02a5408 3351 Newxz(r->offsets, 2*RExC_size+1, U32); /* MJD 20001228 */
fac92740 3352 if (r->offsets) {
2af232bd 3353 r->offsets[0] = RExC_size;
fac92740 3354 }
a3621e74 3355 DEBUG_OFFSETS_r(PerlIO_printf(Perl_debug_log,
2af232bd
SS
3356 "%s %"UVuf" bytes for offset annotations.\n",
3357 r->offsets ? "Got" : "Couldn't get",
392fbf5d 3358 (UV)((2*RExC_size+1) * sizeof(U32))));
fac92740 3359
830247a4 3360 RExC_rx = r;
bbce6d69 3361
3362 /* Second pass: emit code. */
e2509266 3363 RExC_flags = pm->op_pmflags; /* don't let top level (?i) bleed */
830247a4
IZ
3364 RExC_parse = exp;
3365 RExC_end = xend;
3366 RExC_naughty = 0;
3367 RExC_npar = 1;
fac92740 3368 RExC_emit_start = r->program;
830247a4 3369 RExC_emit = r->program;
2cd61cdb 3370 /* Store the count of eval-groups for security checks: */
eb160463 3371 RExC_emit->next_off = (U16)((RExC_seen_evals > U16_MAX) ? U16_MAX : RExC_seen_evals);
830247a4 3372 REGC((U8)REG_MAGIC, (char*) RExC_emit++);
c277df42 3373 r->data = 0;
3dab1dad 3374 if (reg(pRExC_state, 0, &flags,1) == NULL)
a0d0e21e 3375 return(NULL);
07be1b83
YO
3376 /* XXXX To minimize changes to RE engine we always allocate
3377 3-units-long substrs field. */
3378 Newx(r->substrs, 1, struct reg_substr_data);
a0d0e21e 3379
07be1b83
YO
3380reStudy:
3381 Zero(r->substrs, 1, struct reg_substr_data);
3382 StructCopy(&zero_scan_data, &data, scan_data_t);
a3621e74 3383
07be1b83
YO
3384#ifdef TRIE_STUDY_OPT
3385 if ( restudied ) {
3386 DEBUG_OPTIMISE_r(PerlIO_printf(Perl_debug_log,"Restudying\n"));
3387 RExC_state=copyRExC_state;
3388 if (data.longest_fixed)
3389 SvREFCNT_dec(data.longest_fixed);
3390 if (data.longest_float)
3391 SvREFCNT_dec(data.longest_float);
3392 if (data.last_found)
3393 SvREFCNT_dec(data.last_found);
3394 } else {
3395 copyRExC_state=RExC_state;
3396 }
3397#endif
a0d0e21e 3398 /* Dig out information for optimizations. */
cf93c79d 3399 r->reganch = pm->op_pmflags & PMf_COMPILETIME; /* Again? */
e2509266 3400 pm->op_pmflags = RExC_flags;
a0ed51b3 3401 if (UTF)
5ff6fc6d 3402 r->reganch |= ROPT_UTF8; /* Unicode in it? */
c277df42 3403 r->regstclass = NULL;
830247a4 3404 if (RExC_naughty >= 10) /* Probably an expensive pattern. */
a0ed51b3 3405 r->reganch |= ROPT_NAUGHTY;
c277df42 3406 scan = r->program + 1; /* First BRANCH. */
2779dcf1 3407
653099ff 3408 /* XXXX Should not we check for something else? Usually it is OPEN1... */
c277df42 3409 if (OP(scan) != BRANCH) { /* Only one top-level choice. */
c277df42 3410 I32 fake;
c5254dd6 3411 STRLEN longest_float_length, longest_fixed_length;
07be1b83 3412 struct regnode_charclass_class ch_class; /* pointed to by data */
653099ff 3413 int stclass_flag;
07be1b83 3414 I32 last_close = 0; /* pointed to by data */
a0d0e21e
LW
3415
3416 first = scan;
c277df42 3417 /* Skip introductions and multiplicators >= 1. */
a0d0e21e 3418 while ((OP(first) == OPEN && (sawopen = 1)) ||
653099ff 3419 /* An OR of *one* alternative - should not happen now. */
a0d0e21e 3420 (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
07be1b83
YO
3421 /* for now we can't handle lookbehind IFMATCH*/
3422 (OP(first) == IFMATCH && !first->flags) ||
a0d0e21e
LW
3423 (OP(first) == PLUS) ||
3424 (OP(first) == MINMOD) ||
653099ff 3425 /* An {n,m} with n>0 */
07be1b83
YO
3426 (PL_regkind[OP(first)] == CURLY && ARG1(first) > 0) )
3427 {
3428 DEBUG_PEEP("first:",first,0);
a0d0e21e
LW
3429 if (OP(first) == PLUS)
3430 sawplus = 1;
3431 else
3dab1dad 3432 first += regarglen[OP(first)];
07be1b83
YO
3433 if (OP(first) == IFMATCH) {
3434 first = NEXTOPER(first);
3435 first += EXTRA_STEP_2ARGS;
7c167cea 3436 } else /* XXX possible optimisation for /(?=)/ */
07be1b83 3437 first = NEXTOPER(first);
a687059c
LW
3438 }
3439
a0d0e21e
LW
3440 /* Starting-point info. */
3441 again:
07be1b83 3442 /* Ignore EXACT as we deal with it later. */
3dab1dad 3443 if (PL_regkind[OP(first)] == EXACT) {
1aa99e6b 3444 if (OP(first) == EXACT)
6f207bd3 3445 NOOP; /* Empty, get anchored substr later. */
1aa99e6b 3446 else if ((OP(first) == EXACTF || OP(first) == EXACTFL))
b3c9acc1
IZ
3447 r->regstclass = first;
3448 }
07be1b83
YO
3449#ifdef TRIE_STCLASS
3450 else if (OP(first) == TRIE &&
3451 ((reg_trie_data *)r->data->data[ ARG(first) ])->minlen>0)
3452 {
3453 /* this can happen only on restudy */
3454 struct regnode_1 *trie_op;
3455 Newxz(trie_op,1,struct regnode_1);
3456 StructCopy(first,trie_op,struct regnode_1);
3457 make_trie_failtable(pRExC_state, (regnode *)first, (regnode *)trie_op, 0);
3458 r->regstclass = (regnode *)trie_op;
3459 }
3460#endif
bfed75c6 3461 else if (strchr((const char*)PL_simple,OP(first)))
a0d0e21e 3462 r->regstclass = first;
3dab1dad
YO
3463 else if (PL_regkind[OP(first)] == BOUND ||
3464 PL_regkind[OP(first)] == NBOUND)
a0d0e21e 3465 r->regstclass = first;
3dab1dad 3466 else if (PL_regkind[OP(first)] == BOL) {
cad2e5aa
JH
3467 r->reganch |= (OP(first) == MBOL
3468 ? ROPT_ANCH_MBOL
3469 : (OP(first) == SBOL
3470 ? ROPT_ANCH_SBOL
3471 : ROPT_ANCH_BOL));
a0d0e21e 3472 first = NEXTOPER(first);
774d564b 3473 goto again;
3474 }
3475 else if (OP(first) == GPOS) {
3476 r->reganch |= ROPT_ANCH_GPOS;
3477 first = NEXTOPER(first);
3478 goto again;
a0d0e21e 3479 }
e09294f4 3480 else if (!sawopen && (OP(first) == STAR &&
3dab1dad 3481 PL_regkind[OP(NEXTOPER(first))] == REG_ANY) &&
a0d0e21e
LW
3482 !(r->reganch & ROPT_ANCH) )
3483 {
3484 /* turn .* into ^.* with an implied $*=1 */
1df70142
AL
3485 const int type =
3486 (OP(NEXTOPER(first)) == REG_ANY)
3487 ? ROPT_ANCH_MBOL
3488 : ROPT_ANCH_SBOL;
cad2e5aa 3489 r->reganch |= type | ROPT_IMPLICIT;
a0d0e21e 3490 first = NEXTOPER(first);
774d564b 3491 goto again;
a0d0e21e 3492 }
b81d288d 3493 if (sawplus && (!sawopen || !RExC_sawback)
830247a4 3494 && !(RExC_seen & REG_SEEN_EVAL)) /* May examine pos and $& */
cad2e5aa
JH
3495 /* x+ must match at the 1st pos of run of x's */
3496 r->reganch |= ROPT_SKIP;
a0d0e21e 3497
c277df42 3498 /* Scan is after the zeroth branch, first is atomic matcher. */
be8e71aa
YO
3499#ifdef TRIE_STUDY_OPT
3500 DEBUG_COMPILE_r(
3501 if (!restudied)
3502 PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
3503 (IV)(first - scan + 1))
3504 );
3505#else
3506 DEBUG_COMPILE_r(
3507 PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
3508 (IV)(first - scan + 1))
3509 );
3510#endif
3511
3512
a0d0e21e
LW
3513 /*
3514 * If there's something expensive in the r.e., find the
3515 * longest literal string that must appear and make it the
3516 * regmust. Resolve ties in favor of later strings, since
3517 * the regstart check works with the beginning of the r.e.
3518 * and avoiding duplication strengthens checking. Not a
3519 * strong reason, but sufficient in the absence of others.
3520 * [Now we resolve ties in favor of the earlier string if
c277df42 3521 * it happens that c_offset_min has been invalidated, since the
a0d0e21e
LW
3522 * earlier string may buy us something the later one won't.]
3523 */
a0d0e21e 3524 minlen = 0;
a687059c 3525
396482e1
GA
3526 data.longest_fixed = newSVpvs("");
3527 data.longest_float = newSVpvs("");
3528 data.last_found = newSVpvs("");
c277df42
IZ
3529 data.longest = &(data.longest_fixed);
3530 first = scan;
653099ff 3531 if (!r->regstclass) {
830247a4 3532 cl_init(pRExC_state, &ch_class);
653099ff
GS
3533 data.start_class = &ch_class;
3534 stclass_flag = SCF_DO_STCLASS_AND;
3535 } else /* XXXX Check for BOUND? */
3536 stclass_flag = 0;
cb434fcc 3537 data.last_closep = &last_close;
653099ff 3538
830247a4 3539 minlen = study_chunk(pRExC_state, &first, &fake, scan + RExC_size, /* Up to end */
a3621e74 3540 &data, SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag,0);
07be1b83
YO
3541
3542#ifdef TRIE_STUDY_OPT
3543 if ( (data.flags & SCF_EXACT_TRIE) && ! restudied++ ) {
3544 goto reStudy;
3545 }
3546#endif
3547
830247a4 3548 if ( RExC_npar == 1 && data.longest == &(data.longest_fixed)
b81d288d 3549 && data.last_start_min == 0 && data.last_end > 0
830247a4
IZ
3550 && !RExC_seen_zerolen
3551 && (!(RExC_seen & REG_SEEN_GPOS) || (r->reganch & ROPT_ANCH_GPOS)))
c277df42 3552 r->reganch |= ROPT_CHECK_ALL;
830247a4 3553 scan_commit(pRExC_state, &data);
c277df42
IZ
3554 SvREFCNT_dec(data.last_found);
3555
a0ed51b3 3556 longest_float_length = CHR_SVLEN(data.longest_float);
c5254dd6 3557 if (longest_float_length
c277df42
IZ
3558 || (data.flags & SF_FL_BEFORE_EOL
3559 && (!(data.flags & SF_FL_BEFORE_MEOL)
e2509266 3560 || (RExC_flags & PMf_MULTILINE)))) {
cf93c79d
IZ
3561 int t;
3562
a0ed51b3 3563 if (SvCUR(data.longest_fixed) /* ok to leave SvCUR */
aca2d497
IZ
3564 && data.offset_fixed == data.offset_float_min
3565 && SvCUR(data.longest_fixed) == SvCUR(data.longest_float))
3566 goto remove_float; /* As in (a)+. */
3567
33b8afdf
JH
3568 if (SvUTF8(data.longest_float)) {
3569 r->float_utf8 = data.longest_float;
c445ea15 3570 r->float_substr = NULL;
33b8afdf
JH
3571 } else {
3572 r->float_substr = data.longest_float;
c445ea15 3573 r->float_utf8 = NULL;
33b8afdf 3574 }
c277df42
IZ
3575 r->float_min_offset = data.offset_float_min;
3576 r->float_max_offset = data.offset_float_max;
cf93c79d
IZ
3577 t = (data.flags & SF_FL_BEFORE_EOL /* Can't have SEOL and MULTI */
3578 && (!(data.flags & SF_FL_BEFORE_MEOL)
e2509266 3579 || (RExC_flags & PMf_MULTILINE)));
33b8afdf 3580 fbm_compile(data.longest_float, t ? FBMcf_TAIL : 0);
a0ed51b3
LW
3581 }
3582 else {
aca2d497 3583 remove_float:
c445ea15 3584 r->float_substr = r->float_utf8 = NULL;
c277df42 3585 SvREFCNT_dec(data.longest_float);
c5254dd6 3586 longest_float_length = 0;
a0d0e21e 3587 }
c277df42 3588
a0ed51b3 3589 longest_fixed_length = CHR_SVLEN(data.longest_fixed);
c5254dd6 3590 if (longest_fixed_length
c277df42
IZ
3591 || (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
3592 && (!(data.flags & SF_FIX_BEFORE_MEOL)
e2509266 3593 || (RExC_flags & PMf_MULTILINE)))) {
cf93c79d
IZ
3594 int t;
3595
33b8afdf
JH
3596 if (SvUTF8(data.longest_fixed)) {
3597 r->anchored_utf8 = data.longest_fixed;
c445ea15 3598 r->anchored_substr = NULL;
33b8afdf
JH
3599 } else {
3600 r->anchored_substr = data.longest_fixed;
c445ea15 3601 r->anchored_utf8 = NULL;
33b8afdf 3602 }
c277df42 3603 r->anchored_offset = data.offset_fixed;
cf93c79d
IZ
3604 t = (data.flags & SF_FIX_BEFORE_EOL /* Can't have SEOL and MULTI */
3605 && (!(data.flags & SF_FIX_BEFORE_MEOL)
e2509266 3606 || (RExC_flags & PMf_MULTILINE)));
33b8afdf 3607 fbm_compile(data.longest_fixed, t ? FBMcf_TAIL : 0);
a0ed51b3
LW
3608 }
3609 else {
c445ea15 3610 r->anchored_substr = r->anchored_utf8 = NULL;
c277df42 3611 SvREFCNT_dec(data.longest_fixed);
c5254dd6 3612 longest_fixed_length = 0;
a0d0e21e 3613 }
b81d288d 3614 if (r->regstclass
ffc61ed2 3615 && (OP(r->regstclass) == REG_ANY || OP(r->regstclass) == SANY))
653099ff 3616 r->regstclass = NULL;
33b8afdf
JH
3617 if ((!(r->anchored_substr || r->anchored_utf8) || r->anchored_offset)
3618 && stclass_flag
653099ff 3619 && !(data.start_class->flags & ANYOF_EOS)
eb160463
GS
3620 && !cl_is_anything(data.start_class))
3621 {
1df70142 3622 const I32 n = add_data(pRExC_state, 1, "f");
653099ff 3623
a02a5408 3624 Newx(RExC_rx->data->data[n], 1,
653099ff
GS
3625 struct regnode_charclass_class);
3626 StructCopy(data.start_class,
830247a4 3627 (struct regnode_charclass_class*)RExC_rx->data->data[n],
653099ff 3628 struct regnode_charclass_class);
830247a4 3629 r->regstclass = (regnode*)RExC_rx->data->data[n];
653099ff 3630 r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */
a3621e74 3631 DEBUG_COMPILE_r({ SV *sv = sv_newmortal();
32fc9b6a 3632 regprop(r, sv, (regnode*)data.start_class);
9c5ffd7c 3633 PerlIO_printf(Perl_debug_log,
a0288114 3634 "synthetic stclass \"%s\".\n",
3f7c398e 3635 SvPVX_const(sv));});
653099ff 3636 }