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