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