This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: problem with (?p{}) [PATCH 5.005_5*]
[perl5.git] / regexec.c
CommitLineData
a0d0e21e
LW
1/* regexec.c
2 */
3
4/*
5 * "One Ring to rule them all, One Ring to find them..."
6 */
7
a687059c
LW
8/* NOTE: this is derived from Henry Spencer's regexp code, and should not
9 * confused with the original package (see point 3 below). Thanks, Henry!
10 */
11
12/* Additional note: this code is very heavily munged from Henry's version
13 * in places. In some spots I've traded clarity for efficiency, so don't
14 * blame Henry for some of the lack of readability.
15 */
16
e50aee73
AD
17/* The names of the functions have been changed from regcomp and
18 * regexec to pregcomp and pregexec in order to avoid conflicts
19 * with the POSIX routines of the same names.
20*/
21
b9d5759e
AD
22#ifdef PERL_EXT_RE_BUILD
23/* need to replace pregcomp et al, so enable that */
24# ifndef PERL_IN_XSUB_RE
25# define PERL_IN_XSUB_RE
26# endif
27/* need access to debugger hooks */
28# ifndef DEBUGGING
29# define DEBUGGING
30# endif
31#endif
32
33#ifdef PERL_IN_XSUB_RE
d06ea78c 34/* We *really* need to overwrite these symbols: */
56953603
IZ
35# define Perl_regexec_flags my_regexec
36# define Perl_regdump my_regdump
37# define Perl_regprop my_regprop
d06ea78c
GS
38/* *These* symbols are masked to allow static link. */
39# define Perl_pregexec my_pregexec
56953603
IZ
40#endif
41
f0fcb552 42/*SUPPRESS 112*/
a687059c 43/*
e50aee73 44 * pregcomp and pregexec -- regsub and regerror are not used in perl
a687059c
LW
45 *
46 * Copyright (c) 1986 by University of Toronto.
47 * Written by Henry Spencer. Not derived from licensed software.
48 *
49 * Permission is granted to anyone to use this software for any
50 * purpose on any computer system, and to redistribute it freely,
51 * subject to the following restrictions:
52 *
53 * 1. The author is not responsible for the consequences of use of
54 * this software, no matter how awful, even if they arise
55 * from defects in it.
56 *
57 * 2. The origin of this software must not be misrepresented, either
58 * by explicit claim or by omission.
59 *
60 * 3. Altered versions must be plainly marked as such, and must not
61 * be misrepresented as being the original software.
62 *
63 **** Alterations to Henry's code are...
64 ****
a0ed51b3 65 **** Copyright (c) 1991-1998, Larry Wall
a687059c 66 ****
9ef589d8
LW
67 **** You may distribute under the terms of either the GNU General Public
68 **** License or the Artistic License, as specified in the README file.
a687059c
LW
69 *
70 * Beware that some of this code is subtly aware of the way operator
71 * precedence is structured in regular expressions. Serious changes in
72 * regular-expression syntax might require a total rethink.
73 */
74#include "EXTERN.h"
75#include "perl.h"
0f5d15d6
IZ
76typedef MAGIC *my_magic;
77
a687059c
LW
78#include "regcomp.h"
79
c277df42
IZ
80#define RF_tainted 1 /* tainted information used? */
81#define RF_warned 2 /* warned about big count? */
ce862d02 82#define RF_evaled 4 /* Did an EVAL with setting? */
a0ed51b3
LW
83#define RF_utf8 8 /* String contains multibyte chars? */
84
85#define UTF (PL_reg_flags & RF_utf8)
ce862d02
IZ
86
87#define RS_init 1 /* eval environment created */
88#define RS_set 2 /* replsv value is set */
c277df42 89
a687059c
LW
90#ifndef STATIC
91#define STATIC static
92#endif
93
76e3520e 94#ifndef PERL_OBJECT
a0d0e21e
LW
95typedef I32 CHECKPOINT;
96
c277df42
IZ
97/*
98 * Forwards.
99 */
100
101static I32 regmatch _((regnode *prog));
102static I32 regrepeat _((regnode *p, I32 max));
103static I32 regrepeat_hard _((regnode *p, I32 max, I32 *lp));
104static I32 regtry _((regexp *prog, char *startpos));
ae5c130c 105
c277df42 106static bool reginclass _((char *p, I32 c));
a0ed51b3 107static bool reginclassutf8 _((regnode *f, U8* p));
55497cff
PP
108static CHECKPOINT regcppush _((I32 parenfloor));
109static char * regcppop _((void));
76e3520e 110#endif
a0ed51b3 111
ae5c130c 112#define REGINCLASS(p,c) (*(p) ? reginclass(p,c) : ANYOF_TEST(p,c))
a0ed51b3
LW
113#define REGINCLASSUTF8(f,p) (ARG1(f) ? reginclassutf8(f,p) : swash_fetch((SV*)PL_regdata->data[ARG2(f)],p))
114
115#define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
116#define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
117
dfe13c55
GS
118#ifndef PERL_OBJECT
119static U8 * reghop _((U8 *pos, I32 off));
120static U8 * reghopmaybe _((U8 *pos, I32 off));
121#endif
122#define reghop_c(pos,off) ((char*)reghop((U8*)pos, off))
123#define reghopmaybe_c(pos,off) ((char*)reghopmaybe((U8*)pos, off))
124#define HOP(pos,off) (UTF ? reghop((U8*)pos, off) : (U8*)(pos + off))
125#define HOPMAYBE(pos,off) (UTF ? reghopmaybe((U8*)pos, off) : (U8*)(pos + off))
126#define HOPc(pos,off) ((char*)HOP(pos,off))
127#define HOPMAYBEc(pos,off) ((char*)HOPMAYBE(pos,off))
a0d0e21e 128
76e3520e 129STATIC CHECKPOINT
8ac85365 130regcppush(I32 parenfloor)
a0d0e21e 131{
11343788 132 dTHR;
3280af22
NIS
133 int retval = PL_savestack_ix;
134 int i = (PL_regsize - parenfloor) * 4;
a0d0e21e
LW
135 int p;
136
137 SSCHECK(i + 5);
3280af22
NIS
138 for (p = PL_regsize; p > parenfloor; p--) {
139 SSPUSHPTR(PL_regendp[p]);
140 SSPUSHPTR(PL_regstartp[p]);
141 SSPUSHPTR(PL_reg_start_tmp[p]);
a0d0e21e
LW
142 SSPUSHINT(p);
143 }
3280af22
NIS
144 SSPUSHINT(PL_regsize);
145 SSPUSHINT(*PL_reglastparen);
146 SSPUSHPTR(PL_reginput);
a0d0e21e
LW
147 SSPUSHINT(i + 3);
148 SSPUSHINT(SAVEt_REGCONTEXT);
149 return retval;
150}
151
c277df42 152/* These are needed since we do not localize EVAL nodes: */
c3464db5
DD
153# define REGCP_SET DEBUG_r(PerlIO_printf(Perl_debug_log, \
154 " Setting an EVAL scope, savestack=%i\n", \
3280af22 155 PL_savestack_ix)); lastcp = PL_savestack_ix
c3464db5 156
3280af22 157# define REGCP_UNWIND DEBUG_r(lastcp != PL_savestack_ix ? \
c3464db5
DD
158 PerlIO_printf(Perl_debug_log, \
159 " Clearing an EVAL scope, savestack=%i..%i\n", \
3280af22 160 lastcp, PL_savestack_ix) : 0); regcpblow(lastcp)
c277df42 161
76e3520e 162STATIC char *
8ac85365 163regcppop(void)
a0d0e21e 164{
11343788 165 dTHR;
a0d0e21e
LW
166 I32 i = SSPOPINT;
167 U32 paren = 0;
168 char *input;
169 char *tmps;
170 assert(i == SAVEt_REGCONTEXT);
171 i = SSPOPINT;
172 input = (char *) SSPOPPTR;
3280af22
NIS
173 *PL_reglastparen = SSPOPINT;
174 PL_regsize = SSPOPINT;
c277df42 175 for (i -= 3; i > 0; i -= 4) {
a0d0e21e 176 paren = (U32)SSPOPINT;
3280af22
NIS
177 PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
178 PL_regstartp[paren] = (char *) SSPOPPTR;
a0d0e21e 179 tmps = (char*)SSPOPPTR;
3280af22
NIS
180 if (paren <= *PL_reglastparen)
181 PL_regendp[paren] = tmps;
c277df42 182 DEBUG_r(
c3464db5
DD
183 PerlIO_printf(Perl_debug_log,
184 " restoring \\%d to %d(%d)..%d%s\n",
3280af22
NIS
185 paren, PL_regstartp[paren] - PL_regbol,
186 PL_reg_start_tmp[paren] - PL_regbol,
187 PL_regendp[paren] - PL_regbol,
188 (paren > *PL_reglastparen ? "(no)" : ""));
c277df42 189 );
a0d0e21e 190 }
c277df42 191 DEBUG_r(
3280af22 192 if (*PL_reglastparen + 1 <= PL_regnpar) {
c3464db5
DD
193 PerlIO_printf(Perl_debug_log,
194 " restoring \\%d..\\%d to undef\n",
3280af22 195 *PL_reglastparen + 1, PL_regnpar);
c277df42
IZ
196 }
197 );
3280af22
NIS
198 for (paren = *PL_reglastparen + 1; paren <= PL_regnpar; paren++) {
199 if (paren > PL_regsize)
200 PL_regstartp[paren] = Nullch;
201 PL_regendp[paren] = Nullch;
a0d0e21e
LW
202 }
203 return input;
204}
205
0f5d15d6
IZ
206STATIC char *
207regcp_set_to(I32 ss)
208{
209 I32 tmp = PL_savestack_ix;
210
211 PL_savestack_ix = ss;
212 regcppop();
213 PL_savestack_ix = tmp;
214}
215
216typedef struct re_cc_state
217{
218 I32 ss;
219 regnode *node;
220 struct re_cc_state *prev;
221 CURCUR *cc;
222 regexp *re;
223} re_cc_state;
224
c277df42 225#define regcpblow(cp) LEAVE_SCOPE(cp)
a0d0e21e 226
a687059c 227/*
e50aee73 228 * pregexec and friends
a687059c
LW
229 */
230
231/*
c277df42 232 - pregexec - match a regexp against a string
a687059c 233 */
c277df42 234I32
c3464db5
DD
235pregexec(register regexp *prog, char *stringarg, register char *strend,
236 char *strbeg, I32 minend, SV *screamer, U32 nosave)
c277df42
IZ
237/* strend: pointer to null at end of string */
238/* strbeg: real beginning of string */
239/* minend: end of match must be >=minend after stringarg. */
240/* nosave: For optimizations. */
241{
242 return
243 regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
244 nosave ? 0 : REXEC_COPY_STR);
245}
0f5d15d6
IZ
246
247STATIC void
248cache_re(regexp *prog)
249{
250 PL_regprecomp = prog->precomp; /* Needed for FAIL. */
251#ifdef DEBUGGING
252 PL_regprogram = prog->program;
253#endif
254 PL_regnpar = prog->nparens;
255 PL_regdata = prog->data;
256 PL_reg_re = prog;
257}
c277df42 258
a687059c 259/*
c277df42 260 - regexec_flags - match a regexp against a string
a687059c 261 */
79072805 262I32
c3464db5
DD
263regexec_flags(register regexp *prog, char *stringarg, register char *strend,
264 char *strbeg, I32 minend, SV *screamer, void *data, U32 flags)
c277df42
IZ
265/* strend: pointer to null at end of string */
266/* strbeg: real beginning of string */
267/* minend: end of match must be >=minend after stringarg. */
268/* data: May be used for some additional optimizations. */
269/* nosave: For optimizations. */
a687059c 270{
5c0ca799 271 dTHR;
a0d0e21e 272 register char *s;
c277df42 273 register regnode *c;
a0d0e21e
LW
274 register char *startpos = stringarg;
275 register I32 tmp;
c277df42 276 I32 minlen; /* must match at least this many chars */
a0d0e21e
LW
277 I32 dontbother = 0; /* how many characters not to try at end */
278 CURCUR cc;
c277df42 279 I32 start_shift = 0; /* Offset of the start to find
a0ed51b3
LW
280 constant substr. */ /* CC */
281 I32 end_shift = 0; /* Same for the end. */ /* CC */
c277df42
IZ
282 I32 scream_pos = -1; /* Internal iterator of scream. */
283 char *scream_olds;
3280af22 284 SV* oreplsv = GvSV(PL_replgv);
a687059c 285
a0d0e21e 286 cc.cur = 0;
4633a7c4 287 cc.oldcc = 0;
3280af22 288 PL_regcc = &cc;
a0d0e21e 289
0f5d15d6 290 cache_re(prog);
a0d0e21e 291#ifdef DEBUGGING
3280af22 292 PL_regnarrate = PL_debug & 512;
a0d0e21e
LW
293#endif
294
295 /* Be paranoid... */
296 if (prog == NULL || startpos == NULL) {
297 croak("NULL regexp parameter");
298 return 0;
299 }
300
c277df42
IZ
301 minlen = prog->minlen;
302 if (strend - startpos < minlen) goto phooey;
303
a0d0e21e 304 if (startpos == strbeg) /* is ^ valid at stringarg? */
3280af22 305 PL_regprev = '\n';
a0d0e21e 306 else {
a0ed51b3 307 PL_regprev = (U32)stringarg[-1];
3280af22
NIS
308 if (!PL_multiline && PL_regprev == '\n')
309 PL_regprev = '\0'; /* force ^ to NOT match */
a0d0e21e 310 }
bbce6d69 311
a0d0e21e
LW
312 /* Check validity of program. */
313 if (UCHARAT(prog->program) != MAGIC) {
314 FAIL("corrupted regexp program");
315 }
316
3280af22
NIS
317 PL_reg_flags = 0;
318 PL_reg_eval_set = 0;
a0d0e21e 319
a0ed51b3
LW
320 if (prog->reganch & ROPT_UTF8)
321 PL_reg_flags |= RF_utf8;
322
323 /* Mark beginning of line for ^ and lookbehind. */
324 PL_regbol = startpos;
325 PL_bostr = strbeg;
326
327 /* Mark end of line for $ (and such) */
328 PL_regeol = strend;
329
330 /* see how far we have to get to not match where we matched before */
331 PL_regtill = startpos+minend;
332
0f5d15d6
IZ
333 /* We start without call_cc context. */
334 PL_reg_call_cc = 0;
335
a0d0e21e
LW
336 /* If there is a "must appear" string, look for it. */
337 s = startpos;
c277df42
IZ
338 if (!(flags & REXEC_CHECKED)
339 && prog->check_substr != Nullsv &&
774d564b 340 !(prog->reganch & ROPT_ANCH_GPOS) &&
c277df42 341 (!(prog->reganch & (ROPT_ANCH_BOL | ROPT_ANCH_MBOL))
3280af22 342 || (PL_multiline && prog->check_substr == prog->anchored_substr)) )
a0d0e21e 343 {
a0ed51b3
LW
344 char *t;
345 start_shift = prog->check_offset_min; /* okay to underestimate on CC */
c277df42 346 /* Should be nonnegative! */
a0ed51b3 347 end_shift = minlen - start_shift - CHR_SVLEN(prog->check_substr);
c277df42 348 if (screamer) {
3280af22 349 if (PL_screamfirst[BmRARE(prog->check_substr)] >= 0)
c277df42
IZ
350 s = screaminstr(screamer, prog->check_substr,
351 start_shift + (stringarg - strbeg),
352 end_shift, &scream_pos, 0);
a0d0e21e
LW
353 else
354 s = Nullch;
c277df42 355 scream_olds = s;
0a12ae7d 356 }
a0d0e21e 357 else
c277df42
IZ
358 s = fbm_instr((unsigned char*)s + start_shift,
359 (unsigned char*)strend - end_shift,
411d5715 360 prog->check_substr, 0);
a0d0e21e 361 if (!s) {
c277df42 362 ++BmUSEFUL(prog->check_substr); /* hooray */
a0d0e21e 363 goto phooey; /* not present */
a0ed51b3
LW
364 }
365 else if (s - stringarg > prog->check_offset_max &&
366 (UTF
dfe13c55 367 ? ((t = reghopmaybe_c(s, -(prog->check_offset_max))) && t >= stringarg)
a0ed51b3
LW
368 : (t = s - prog->check_offset_max) != 0
369 )
370 )
371 {
c277df42 372 ++BmUSEFUL(prog->check_substr); /* hooray/2 */
a0ed51b3
LW
373 s = t;
374 }
375 else if (!(prog->reganch & ROPT_NAUGHTY)
c277df42
IZ
376 && --BmUSEFUL(prog->check_substr) < 0
377 && prog->check_substr == prog->float_substr) { /* boo */
378 SvREFCNT_dec(prog->check_substr);
379 prog->check_substr = Nullsv; /* disable */
380 prog->float_substr = Nullsv; /* clear */
a0d0e21e 381 s = startpos;
a0ed51b3
LW
382 }
383 else
384 s = startpos;
a0d0e21e 385 }
a687059c 386
c277df42
IZ
387 DEBUG_r(
388 PerlIO_printf(Perl_debug_log,
8d300b32
GS
389 "%sMatching%s `%s%.60s%s%s' against `%s%.*s%s%s'\n",
390 PL_colors[4],PL_colors[5],PL_colors[0],
391 prog->precomp,
392 PL_colors[1],
c277df42 393 (strlen(prog->precomp) > 60 ? "..." : ""),
8d300b32 394 PL_colors[0],
c277df42 395 (strend - startpos > 60 ? 60 : strend - startpos),
8d300b32 396 startpos, PL_colors[1],
c277df42
IZ
397 (strend - startpos > 60 ? "..." : ""))
398 );
399
a0d0e21e 400 /* Simplest case: anchored match need be tried only once. */
774d564b 401 /* [unless only anchor is BOL and multiline is set] */
a0d0e21e
LW
402 if (prog->reganch & ROPT_ANCH) {
403 if (regtry(prog, startpos))
404 goto got_it;
774d564b 405 else if (!(prog->reganch & ROPT_ANCH_GPOS) &&
3280af22 406 (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
c277df42 407 || (prog->reganch & ROPT_ANCH_MBOL)))
774d564b 408 {
a0d0e21e
LW
409 if (minlen)
410 dontbother = minlen - 1;
dfe13c55 411 strend = HOPc(strend, -dontbother);
a0d0e21e
LW
412 /* for multiline we only have to try after newlines */
413 if (s > startpos)
414 s--;
415 while (s < strend) {
a0ed51b3 416 if (*s++ == '\n') { /* don't need utf8skip here */
a0d0e21e
LW
417 if (s < strend && regtry(prog, s))
418 goto got_it;
419 }
35c8bce7 420 }
35c8bce7 421 }
a0d0e21e
LW
422 goto phooey;
423 }
35c8bce7 424
a0d0e21e 425 /* Messy cases: unanchored match. */
c277df42
IZ
426 if (prog->anchored_substr && prog->reganch & ROPT_SKIP) {
427 /* we have /x+whatever/ */
428 /* it must be a one character string */
429 char ch = SvPVX(prog->anchored_substr)[0];
a0ed51b3
LW
430 if (UTF) {
431 while (s < strend) {
432 if (*s == ch) {
433 if (regtry(prog, s)) goto got_it;
434 s += UTF8SKIP(s);
435 while (s < strend && *s == ch)
436 s += UTF8SKIP(s);
437 }
438 s += UTF8SKIP(s);
439 }
440 }
441 else {
442 while (s < strend) {
443 if (*s == ch) {
444 if (regtry(prog, s)) goto got_it;
c277df42 445 s++;
a0ed51b3
LW
446 while (s < strend && *s == ch)
447 s++;
448 }
449 s++;
a0d0e21e 450 }
a687059c 451 }
c277df42
IZ
452 }
453 /*SUPPRESS 560*/
454 else if (prog->anchored_substr != Nullsv
455 || (prog->float_substr != Nullsv
456 && prog->float_max_offset < strend - s)) {
457 SV *must = prog->anchored_substr
458 ? prog->anchored_substr : prog->float_substr;
459 I32 back_max =
460 prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset;
461 I32 back_min =
462 prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset;
463 I32 delta = back_max - back_min;
dfe13c55 464 char *last = HOPc(strend, 0-(CHR_SVLEN(must) + back_min)); /* Cannot start after this */
a0ed51b3
LW
465 char *last1; /* Last position checked before */
466
467 if (s > PL_bostr)
dfe13c55 468 last1 = HOPc(s, -1);
a0ed51b3
LW
469 else
470 last1 = s - 1; /* bogus */
c277df42
IZ
471
472 /* XXXX check_substr already used to find `s', can optimize if
473 check_substr==must. */
474 scream_pos = -1;
475 dontbother = end_shift;
dfe13c55 476 strend = HOPc(strend, -dontbother);
c277df42
IZ
477 while ( (s <= last) &&
478 (screamer
dfe13c55 479 ? (s = screaminstr(screamer, must, HOPc(s, back_min) - strbeg,
c277df42 480 end_shift, &scream_pos, 0))
a0ed51b3 481 : (s = fbm_instr((unsigned char*)HOP(s, back_min),
411d5715 482 (unsigned char*)strend, must, 0))) ) {
dfe13c55
GS
483 if (HOPc(s, -back_max) > last1) {
484 last1 = HOPc(s, -back_min);
485 s = HOPc(s, -back_max);
a0ed51b3
LW
486 }
487 else {
dfe13c55 488 char *t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
c277df42 489
dfe13c55 490 last1 = HOPc(s, -back_min);
c277df42 491 s = t;
a0d0e21e 492 }
a0ed51b3
LW
493 if (UTF) {
494 while (s <= last1) {
495 if (regtry(prog, s))
496 goto got_it;
497 s += UTF8SKIP(s);
498 }
499 }
500 else {
501 while (s <= last1) {
502 if (regtry(prog, s))
503 goto got_it;
504 s++;
505 }
a0d0e21e
LW
506 }
507 }
508 goto phooey;
a0ed51b3
LW
509 }
510 else if (c = prog->regstclass) {
a0d0e21e 511 I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
a0ed51b3 512 char *cc;
a687059c 513
a0d0e21e
LW
514 if (minlen)
515 dontbother = minlen - 1;
dfe13c55 516 strend = HOPc(strend, -dontbother); /* don't bother with what can't match */
a0d0e21e
LW
517 tmp = 1;
518 /* We know what class it must start with. */
519 switch (OP(c)) {
a0ed51b3
LW
520 case ANYOFUTF8:
521 cc = (char *) OPERAND(c);
522 while (s < strend) {
523 if (REGINCLASSUTF8(c, (U8*)s)) {
524 if (tmp && regtry(prog, s))
525 goto got_it;
526 else
527 tmp = doevery;
528 }
529 else
530 tmp = 1;
531 s += UTF8SKIP(s);
532 }
533 break;
a0d0e21e 534 case ANYOF:
a0ed51b3 535 cc = (char *) OPERAND(c);
a0d0e21e 536 while (s < strend) {
a0ed51b3 537 if (REGINCLASS(cc, *s)) {
a0d0e21e
LW
538 if (tmp && regtry(prog, s))
539 goto got_it;
540 else
541 tmp = doevery;
a687059c 542 }
a0d0e21e
LW
543 else
544 tmp = 1;
545 s++;
546 }
547 break;
bbce6d69 548 case BOUNDL:
3280af22 549 PL_reg_flags |= RF_tainted;
bbce6d69 550 /* FALL THROUGH */
a0d0e21e 551 case BOUND:
a0ed51b3
LW
552 if (minlen) {
553 dontbother++;
554 strend -= 1;
555 }
3280af22 556 tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev;
95bac841 557 tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
a0d0e21e 558 while (s < strend) {
95bac841 559 if (tmp == !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
a0d0e21e
LW
560 tmp = !tmp;
561 if (regtry(prog, s))
562 goto got_it;
a687059c 563 }
a0d0e21e
LW
564 s++;
565 }
566 if ((minlen || tmp) && regtry(prog,s))
567 goto got_it;
568 break;
a0ed51b3
LW
569 case BOUNDLUTF8:
570 PL_reg_flags |= RF_tainted;
571 /* FALL THROUGH */
572 case BOUNDUTF8:
573 if (minlen) {
574 dontbother++;
dfe13c55 575 strend = reghop_c(strend, -1);
a0ed51b3 576 }
dfe13c55 577 tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : PL_regprev;
a0ed51b3
LW
578 tmp = ((OP(c) == BOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
579 while (s < strend) {
dfe13c55
GS
580 if (tmp == !(OP(c) == BOUND ?
581 swash_fetch(PL_utf8_alnum, (U8*)s) :
582 isALNUM_LC_utf8((U8*)s)))
583 {
a0ed51b3
LW
584 tmp = !tmp;
585 if (regtry(prog, s))
586 goto got_it;
587 }
588 s += UTF8SKIP(s);
589 }
590 if ((minlen || tmp) && regtry(prog,s))
591 goto got_it;
592 break;
bbce6d69 593 case NBOUNDL:
3280af22 594 PL_reg_flags |= RF_tainted;
bbce6d69 595 /* FALL THROUGH */
a0d0e21e 596 case NBOUND:
a0ed51b3
LW
597 if (minlen) {
598 dontbother++;
599 strend -= 1;
600 }
3280af22 601 tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev;
95bac841 602 tmp = ((OP(c) == NBOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
a0d0e21e 603 while (s < strend) {
95bac841 604 if (tmp == !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
a0d0e21e
LW
605 tmp = !tmp;
606 else if (regtry(prog, s))
607 goto got_it;
608 s++;
609 }
610 if ((minlen || !tmp) && regtry(prog,s))
611 goto got_it;
612 break;
a0ed51b3
LW
613 case NBOUNDLUTF8:
614 PL_reg_flags |= RF_tainted;
615 /* FALL THROUGH */
616 case NBOUNDUTF8:
617 if (minlen) {
618 dontbother++;
dfe13c55 619 strend = reghop_c(strend, -1);
a0ed51b3 620 }
dfe13c55 621 tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : PL_regprev;
a0ed51b3
LW
622 tmp = ((OP(c) == NBOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
623 while (s < strend) {
dfe13c55
GS
624 if (tmp == !(OP(c) == NBOUND ?
625 swash_fetch(PL_utf8_alnum, (U8*)s) :
626 isALNUM_LC_utf8((U8*)s)))
a0ed51b3
LW
627 tmp = !tmp;
628 else if (regtry(prog, s))
629 goto got_it;
630 s += UTF8SKIP(s);
631 }
632 if ((minlen || !tmp) && regtry(prog,s))
633 goto got_it;
634 break;
a0d0e21e
LW
635 case ALNUM:
636 while (s < strend) {
bbce6d69
PP
637 if (isALNUM(*s)) {
638 if (tmp && regtry(prog, s))
639 goto got_it;
640 else
641 tmp = doevery;
642 }
643 else
644 tmp = 1;
645 s++;
646 }
647 break;
a0ed51b3
LW
648 case ALNUMUTF8:
649 while (s < strend) {
dfe13c55 650 if (swash_fetch(PL_utf8_alnum, (U8*)s)) {
a0ed51b3
LW
651 if (tmp && regtry(prog, s))
652 goto got_it;
653 else
654 tmp = doevery;
655 }
656 else
657 tmp = 1;
658 s += UTF8SKIP(s);
659 }
660 break;
bbce6d69 661 case ALNUML:
3280af22 662 PL_reg_flags |= RF_tainted;
bbce6d69
PP
663 while (s < strend) {
664 if (isALNUM_LC(*s)) {
a0d0e21e
LW
665 if (tmp && regtry(prog, s))
666 goto got_it;
a687059c 667 else
a0d0e21e
LW
668 tmp = doevery;
669 }
670 else
671 tmp = 1;
672 s++;
673 }
674 break;
a0ed51b3
LW
675 case ALNUMLUTF8:
676 PL_reg_flags |= RF_tainted;
677 while (s < strend) {
dfe13c55 678 if (isALNUM_LC_utf8((U8*)s)) {
a0ed51b3
LW
679 if (tmp && regtry(prog, s))
680 goto got_it;
681 else
682 tmp = doevery;
683 }
684 else
685 tmp = 1;
686 s += UTF8SKIP(s);
687 }
688 break;
a0d0e21e
LW
689 case NALNUM:
690 while (s < strend) {
bbce6d69
PP
691 if (!isALNUM(*s)) {
692 if (tmp && regtry(prog, s))
693 goto got_it;
694 else
695 tmp = doevery;
696 }
697 else
698 tmp = 1;
699 s++;
700 }
701 break;
a0ed51b3
LW
702 case NALNUMUTF8:
703 while (s < strend) {
dfe13c55 704 if (!swash_fetch(PL_utf8_alnum, (U8*)s)) {
a0ed51b3
LW
705 if (tmp && regtry(prog, s))
706 goto got_it;
707 else
708 tmp = doevery;
709 }
710 else
711 tmp = 1;
712 s += UTF8SKIP(s);
713 }
714 break;
bbce6d69 715 case NALNUML:
3280af22 716 PL_reg_flags |= RF_tainted;
bbce6d69
PP
717 while (s < strend) {
718 if (!isALNUM_LC(*s)) {
a0d0e21e
LW
719 if (tmp && regtry(prog, s))
720 goto got_it;
a687059c 721 else
a0d0e21e 722 tmp = doevery;
a687059c 723 }
a0d0e21e
LW
724 else
725 tmp = 1;
726 s++;
727 }
728 break;
a0ed51b3
LW
729 case NALNUMLUTF8:
730 PL_reg_flags |= RF_tainted;
731 while (s < strend) {
dfe13c55 732 if (!isALNUM_LC_utf8((U8*)s)) {
a0ed51b3
LW
733 if (tmp && regtry(prog, s))
734 goto got_it;
735 else
736 tmp = doevery;
737 }
738 else
739 tmp = 1;
740 s += UTF8SKIP(s);
741 }
742 break;
a0d0e21e
LW
743 case SPACE:
744 while (s < strend) {
745 if (isSPACE(*s)) {
746 if (tmp && regtry(prog, s))
747 goto got_it;
748 else
749 tmp = doevery;
2304df62 750 }
a0d0e21e
LW
751 else
752 tmp = 1;
753 s++;
754 }
755 break;
a0ed51b3
LW
756 case SPACEUTF8:
757 while (s < strend) {
dfe13c55 758 if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s)) {
a0ed51b3
LW
759 if (tmp && regtry(prog, s))
760 goto got_it;
761 else
762 tmp = doevery;
763 }
764 else
765 tmp = 1;
766 s += UTF8SKIP(s);
767 }
768 break;
bbce6d69 769 case SPACEL:
3280af22 770 PL_reg_flags |= RF_tainted;
bbce6d69
PP
771 while (s < strend) {
772 if (isSPACE_LC(*s)) {
773 if (tmp && regtry(prog, s))
774 goto got_it;
775 else
776 tmp = doevery;
777 }
778 else
779 tmp = 1;
780 s++;
781 }
782 break;
a0ed51b3
LW
783 case SPACELUTF8:
784 PL_reg_flags |= RF_tainted;
785 while (s < strend) {
dfe13c55 786 if (*s == ' ' || isSPACE_LC_utf8((U8*)s)) {
a0ed51b3
LW
787 if (tmp && regtry(prog, s))
788 goto got_it;
789 else
790 tmp = doevery;
791 }
792 else
793 tmp = 1;
794 s += UTF8SKIP(s);
795 }
796 break;
a0d0e21e
LW
797 case NSPACE:
798 while (s < strend) {
799 if (!isSPACE(*s)) {
800 if (tmp && regtry(prog, s))
801 goto got_it;
802 else
803 tmp = doevery;
a687059c 804 }
a0d0e21e
LW
805 else
806 tmp = 1;
807 s++;
808 }
809 break;
a0ed51b3
LW
810 case NSPACEUTF8:
811 while (s < strend) {
dfe13c55 812 if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s))) {
a0ed51b3
LW
813 if (tmp && regtry(prog, s))
814 goto got_it;
815 else
816 tmp = doevery;
817 }
818 else
819 tmp = 1;
820 s += UTF8SKIP(s);
821 }
822 break;
bbce6d69 823 case NSPACEL:
3280af22 824 PL_reg_flags |= RF_tainted;
bbce6d69
PP
825 while (s < strend) {
826 if (!isSPACE_LC(*s)) {
827 if (tmp && regtry(prog, s))
828 goto got_it;
829 else
830 tmp = doevery;
831 }
832 else
833 tmp = 1;
834 s++;
835 }
836 break;
a0ed51b3
LW
837 case NSPACELUTF8:
838 PL_reg_flags |= RF_tainted;
839 while (s < strend) {
dfe13c55 840 if (!(*s == ' ' || isSPACE_LC_utf8((U8*)s))) {
a0ed51b3
LW
841 if (tmp && regtry(prog, s))
842 goto got_it;
843 else
844 tmp = doevery;
845 }
846 else
847 tmp = 1;
848 s += UTF8SKIP(s);
849 }
850 break;
a0d0e21e
LW
851 case DIGIT:
852 while (s < strend) {
853 if (isDIGIT(*s)) {
854 if (tmp && regtry(prog, s))
855 goto got_it;
856 else
857 tmp = doevery;
2b69d0c2 858 }
a0d0e21e
LW
859 else
860 tmp = 1;
861 s++;
862 }
863 break;
a0ed51b3
LW
864 case DIGITUTF8:
865 while (s < strend) {
dfe13c55 866 if (swash_fetch(PL_utf8_digit,(U8*)s)) {
a0ed51b3
LW
867 if (tmp && regtry(prog, s))
868 goto got_it;
869 else
870 tmp = doevery;
871 }
872 else
873 tmp = 1;
874 s += UTF8SKIP(s);
875 }
876 break;
a0d0e21e
LW
877 case NDIGIT:
878 while (s < strend) {
879 if (!isDIGIT(*s)) {
880 if (tmp && regtry(prog, s))
881 goto got_it;
882 else
883 tmp = doevery;
a687059c 884 }
a0d0e21e
LW
885 else
886 tmp = 1;
887 s++;
888 }
889 break;
a0ed51b3
LW
890 case NDIGITUTF8:
891 while (s < strend) {
dfe13c55 892 if (!swash_fetch(PL_utf8_digit,(U8*)s)) {
a0ed51b3
LW
893 if (tmp && regtry(prog, s))
894 goto got_it;
895 else
896 tmp = doevery;
897 }
898 else
899 tmp = 1;
900 s += UTF8SKIP(s);
901 }
902 break;
a687059c 903 }
a0d0e21e
LW
904 }
905 else {
c277df42
IZ
906 dontbother = 0;
907 if (prog->float_substr != Nullsv) { /* Trim the end. */
908 char *last;
909 I32 oldpos = scream_pos;
910
911 if (screamer) {
912 last = screaminstr(screamer, prog->float_substr, s - strbeg,
913 end_shift, &scream_pos, 1); /* last one */
914 if (!last) {
915 last = scream_olds; /* Only one occurence. */
916 }
a0ed51b3
LW
917 }
918 else {
c277df42
IZ
919 STRLEN len;
920 char *little = SvPV(prog->float_substr, len);
19b4f81a
JPC
921 if (len)
922 last = rninstr(s, strend, little, little + len);
923 else
924 last = strend; /* matching `$' */
c277df42
IZ
925 }
926 if (last == NULL) goto phooey; /* Should not happen! */
19b4f81a 927 dontbother = strend - last + prog->float_min_offset;
c277df42
IZ
928 }
929 if (minlen && (dontbother < minlen))
a0d0e21e 930 dontbother = minlen - 1;
a0ed51b3 931 strend -= dontbother; /* this one's always in bytes! */
a0d0e21e 932 /* We don't know much -- general case. */
a0ed51b3
LW
933 if (UTF) {
934 for (;;) {
84df6dba 935 if (regtry(prog, s))
a0ed51b3 936 goto got_it;
a0ed51b3
LW
937 if (s >= strend)
938 break;
939 s += UTF8SKIP(s);
940 };
941 }
942 else {
943 do {
944 if (regtry(prog, s))
945 goto got_it;
946 } while (s++ < strend);
947 }
a0d0e21e
LW
948 }
949
950 /* Failure. */
951 goto phooey;
a687059c 952
a0d0e21e
LW
953got_it:
954 prog->subbeg = strbeg;
19b4f81a 955 prog->subend = PL_regeol; /* strend may have been modified */
3280af22 956 RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
5f05dabc
PP
957
958 /* make sure $`, $&, $', and $digit will work later */
c277df42
IZ
959 if (strbeg != prog->subbase) { /* second+ //g match. */
960 if (!(flags & REXEC_COPY_STR)) {
137443ea
PP
961 if (prog->subbase) {
962 Safefree(prog->subbase);
963 prog->subbase = Nullch;
964 }
965 }
966 else {
19b4f81a 967 I32 i = PL_regeol - startpos + (stringarg - strbeg);
137443ea
PP
968 s = savepvn(strbeg, i);
969 Safefree(prog->subbase);
970 prog->subbase = s;
971 prog->subbeg = prog->subbase;
972 prog->subend = prog->subbase + i;
973 s = prog->subbase + (stringarg - strbeg);
974 for (i = 0; i <= prog->nparens; i++) {
975 if (prog->endp[i]) {
976 prog->startp[i] = s + (prog->startp[i] - startpos);
977 prog->endp[i] = s + (prog->endp[i] - startpos);
978 }
a0d0e21e
LW
979 }
980 }
a0d0e21e 981 }
ce862d02 982 /* Preserve the current value of $^R */
3280af22
NIS
983 if (oreplsv != GvSV(PL_replgv)) {
984 sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
ce862d02
IZ
985 restored, the value remains
986 the same. */
987 }
a0d0e21e
LW
988 return 1;
989
990phooey:
a0d0e21e 991 return 0;
a687059c
LW
992}
993
994/*
995 - regtry - try match at specific point
996 */
76e3520e 997STATIC I32 /* 0 failure, 1 success */
8ac85365 998regtry(regexp *prog, char *startpos)
a687059c 999{
c277df42 1000 dTHR;
a0d0e21e
LW
1001 register I32 i;
1002 register char **sp;
1003 register char **ep;
c277df42 1004 CHECKPOINT lastcp;
a0d0e21e 1005
3280af22
NIS
1006 if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
1007 PL_reg_eval_set = RS_init;
ce862d02 1008 DEBUG_r(DEBUG_s(
c3464db5 1009 PerlIO_printf(Perl_debug_log, " setting stack tmpbase at %i\n",
3280af22 1010 PL_stack_sp - PL_stack_base);
ce862d02
IZ
1011 ));
1012 SAVEINT(cxstack[cxstack_ix].blk_oldsp);
3280af22 1013 cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
ce862d02
IZ
1014 /* Otherwise OP_NEXTSTATE will free whatever on stack now. */
1015 SAVETMPS;
1016 /* Apparently this is not needed, judging by wantarray. */
1017 /* SAVEINT(cxstack[cxstack_ix].blk_gimme);
1018 cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
1019 }
3280af22
NIS
1020 PL_reginput = startpos;
1021 PL_regstartp = prog->startp;
1022 PL_regendp = prog->endp;
1023 PL_reglastparen = &prog->lastparen;
a0d0e21e 1024 prog->lastparen = 0;
3280af22
NIS
1025 PL_regsize = 0;
1026 if (PL_reg_start_tmpl <= prog->nparens) {
1027 PL_reg_start_tmpl = prog->nparens*3/2 + 3;
1028 if(PL_reg_start_tmp)
1029 Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
c277df42 1030 else
3280af22 1031 New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*);
c277df42 1032 }
a0d0e21e
LW
1033
1034 sp = prog->startp;
1035 ep = prog->endp;
1036 if (prog->nparens) {
1037 for (i = prog->nparens; i >= 0; i--) {
1038 *sp++ = NULL;
1039 *ep++ = NULL;
a687059c 1040 }
a0d0e21e 1041 }
c277df42 1042 REGCP_SET;
7e5428c5 1043 if (regmatch(prog->program + 1)) {
a0d0e21e 1044 prog->startp[0] = startpos;
3280af22 1045 prog->endp[0] = PL_reginput;
a0d0e21e
LW
1046 return 1;
1047 }
c277df42
IZ
1048 REGCP_UNWIND;
1049 return 0;
a687059c
LW
1050}
1051
1052/*
1053 - regmatch - main matching routine
1054 *
1055 * Conceptually the strategy is simple: check to see whether the current
1056 * node matches, call self recursively to see whether the rest matches,
1057 * and then act accordingly. In practice we make some effort to avoid
1058 * recursion, in particular by going through "ordinary" nodes (that don't
1059 * need to know whether the rest of the match failed) by a loop instead of
1060 * by recursion.
1061 */
1062/* [lwall] I've hoisted the register declarations to the outer block in order to
1063 * maybe save a little bit of pushing and popping on the stack. It also takes
1064 * advantage of machines that use a register save mask on subroutine entry.
1065 */
76e3520e 1066STATIC I32 /* 0 failure, 1 success */
c277df42 1067regmatch(regnode *prog)
a687059c 1068{
c277df42
IZ
1069 dTHR;
1070 register regnode *scan; /* Current node. */
1071 regnode *next; /* Next node. */
1072 regnode *inner; /* Next node in internal branch. */
c3464db5
DD
1073 register I32 nextchr; /* renamed nextchr - nextchar colides with
1074 function of same name */
a0d0e21e
LW
1075 register I32 n; /* no or next */
1076 register I32 ln; /* len or last */
1077 register char *s; /* operand or save */
3280af22 1078 register char *locinput = PL_reginput;
c277df42
IZ
1079 register I32 c1, c2, paren; /* case fold search, parenth */
1080 int minmod = 0, sw = 0, logical = 0;
4633a7c4 1081#ifdef DEBUGGING
3280af22 1082 PL_regindent++;
4633a7c4 1083#endif
a0d0e21e 1084
a0ed51b3 1085 /* Note that nextchr is a byte even in UTF */
76e3520e 1086 nextchr = UCHARAT(locinput);
a0d0e21e
LW
1087 scan = prog;
1088 while (scan != NULL) {
c277df42 1089#define sayNO_L (logical ? (logical = 0, sw = 0, goto cont) : sayNO)
a687059c 1090#ifdef DEBUGGING
c277df42
IZ
1091# define sayYES goto yes
1092# define sayNO goto no
1093# define saySAME(x) if (x) goto yes; else goto no
1094# define REPORT_CODE_OFF 24
4633a7c4 1095#else
c277df42
IZ
1096# define sayYES return 1
1097# define sayNO return 0
1098# define saySAME(x) return x
a687059c 1099#endif
c277df42
IZ
1100 DEBUG_r( {
1101 SV *prop = sv_newmortal();
3280af22 1102 int docolor = *PL_colors[0];
c277df42 1103 int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
3280af22
NIS
1104 int l = (PL_regeol - locinput > taill ? taill : PL_regeol - locinput);
1105 int pref_len = (locinput - PL_bostr > (5 + taill) - l
1106 ? (5 + taill) - l : locinput - PL_bostr);
8d300b32 1107 int pref0_len = pref_len - (locinput - PL_reginput);
c277df42 1108
3280af22
NIS
1109 if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
1110 l = ( PL_regeol - locinput > (5 + taill) - pref_len
1111 ? (5 + taill) - pref_len : PL_regeol - locinput);
8d300b32
GS
1112 if (pref0_len < 0)
1113 pref0_len = 0;
c277df42
IZ
1114 regprop(prop, scan);
1115 PerlIO_printf(Perl_debug_log,
8d300b32 1116 "%4i <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n",
3280af22 1117 locinput - PL_bostr,
8d300b32
GS
1118 PL_colors[4], pref0_len,
1119 locinput - pref_len, PL_colors[5],
1120 PL_colors[2], pref_len - pref0_len,
1121 locinput - pref_len + pref0_len, PL_colors[3],
c277df42 1122 (docolor ? "" : "> <"),
3280af22 1123 PL_colors[0], l, locinput, PL_colors[1],
c277df42
IZ
1124 15 - l - pref_len + 1,
1125 "",
3280af22 1126 scan - PL_regprogram, PL_regindent*2, "",
c277df42
IZ
1127 SvPVX(prop));
1128 } );
a687059c 1129
c277df42 1130 next = scan + NEXT_OFF(scan);
a0d0e21e
LW
1131 if (next == scan)
1132 next = NULL;
a687059c 1133
a0d0e21e
LW
1134 switch (OP(scan)) {
1135 case BOL:
3280af22
NIS
1136 if (locinput == PL_bostr
1137 ? PL_regprev == '\n'
1138 : (PL_multiline &&
1139 (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
a0d0e21e 1140 {
a0ed51b3 1141 /* regtill = regbol; */
a0d0e21e
LW
1142 break;
1143 }
4633a7c4 1144 sayNO;
a0d0e21e 1145 case MBOL:
3280af22
NIS
1146 if (locinput == PL_bostr
1147 ? PL_regprev == '\n'
1148 : ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
a0d0e21e
LW
1149 {
1150 break;
1151 }
4633a7c4 1152 sayNO;
a0d0e21e 1153 case SBOL:
3280af22 1154 if (locinput == PL_regbol && PL_regprev == '\n')
a0d0e21e 1155 break;
4633a7c4 1156 sayNO;
774d564b 1157 case GPOS:
3280af22 1158 if (locinput == PL_regbol)
a0d0e21e 1159 break;
4633a7c4 1160 sayNO;
a0d0e21e 1161 case EOL:
3280af22 1162 if (PL_multiline)
a0d0e21e
LW
1163 goto meol;
1164 else
1165 goto seol;
1166 case MEOL:
1167 meol:
3280af22 1168 if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
4633a7c4 1169 sayNO;
a0d0e21e
LW
1170 break;
1171 case SEOL:
1172 seol:
3280af22 1173 if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
4633a7c4 1174 sayNO;
3280af22 1175 if (PL_regeol - locinput > 1)
4633a7c4 1176 sayNO;
a0d0e21e 1177 break;
b85d18e9 1178 case EOS:
3280af22 1179 if (PL_regeol != locinput)
b85d18e9
IZ
1180 sayNO;
1181 break;
a0ed51b3
LW
1182 case SANYUTF8:
1183 if (nextchr & 0x80) {
a176fa2a 1184 locinput += utf8skip[nextchr];
a0ed51b3
LW
1185 if (locinput > PL_regeol)
1186 sayNO;
1187 nextchr = UCHARAT(locinput);
1188 break;
1189 }
1190 if (!nextchr && locinput >= PL_regeol)
1191 sayNO;
1192 nextchr = UCHARAT(++locinput);
1193 break;
a0d0e21e 1194 case SANY:
3280af22 1195 if (!nextchr && locinput >= PL_regeol)
4633a7c4 1196 sayNO;
76e3520e 1197 nextchr = UCHARAT(++locinput);
a0d0e21e 1198 break;
a0ed51b3
LW
1199 case ANYUTF8:
1200 if (nextchr & 0x80) {
a176fa2a 1201 locinput += utf8skip[nextchr];
a0ed51b3
LW
1202 if (locinput > PL_regeol)
1203 sayNO;
1204 nextchr = UCHARAT(locinput);
1205 break;
1206 }
1207 if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
1208 sayNO;
1209 nextchr = UCHARAT(++locinput);
1210 break;
a0d0e21e 1211 case ANY:
3280af22 1212 if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
4633a7c4 1213 sayNO;
76e3520e 1214 nextchr = UCHARAT(++locinput);
a0d0e21e 1215 break;
bbce6d69 1216 case EXACT:
161b471a 1217 s = (char *) OPERAND(scan);
c277df42 1218 ln = UCHARAT(s++);
a0d0e21e 1219 /* Inline the first character, for speed. */
76e3520e 1220 if (UCHARAT(s) != nextchr)
4633a7c4 1221 sayNO;
3280af22 1222 if (PL_regeol - locinput < ln)
4633a7c4 1223 sayNO;
36477c24 1224 if (ln > 1 && memNE(s, locinput, ln))
4633a7c4 1225 sayNO;
a0d0e21e 1226 locinput += ln;
76e3520e 1227 nextchr = UCHARAT(locinput);
bbce6d69
PP
1228 break;
1229 case EXACTFL:
3280af22 1230 PL_reg_flags |= RF_tainted;
bbce6d69
PP
1231 /* FALL THROUGH */
1232 case EXACTF:
161b471a 1233 s = (char *) OPERAND(scan);
c277df42 1234 ln = UCHARAT(s++);
a0ed51b3
LW
1235
1236 if (UTF) {
1237 char *l = locinput;
1238 char *e = s + ln;
1239 c1 = OP(scan) == EXACTF;
1240 while (s < e) {
1241 if (l >= PL_regeol)
1242 sayNO;
dfe13c55
GS
1243 if (utf8_to_uv((U8*)s, 0) != (c1 ?
1244 toLOWER_utf8((U8*)l) :
1245 toLOWER_LC_utf8((U8*)l)))
1246 {
a0ed51b3 1247 sayNO;
dfe13c55 1248 }
a0ed51b3
LW
1249 s += UTF8SKIP(s);
1250 l += UTF8SKIP(l);
1251 }
1252 locinput = l;
1253 nextchr = UCHARAT(locinput);
1254 break;
1255 }
1256
bbce6d69 1257 /* Inline the first character, for speed. */
76e3520e 1258 if (UCHARAT(s) != nextchr &&
bbce6d69 1259 UCHARAT(s) != ((OP(scan) == EXACTF)
76e3520e 1260 ? fold : fold_locale)[nextchr])
bbce6d69 1261 sayNO;
3280af22 1262 if (PL_regeol - locinput < ln)
bbce6d69 1263 sayNO;
5f05dabc
PP
1264 if (ln > 1 && (OP(scan) == EXACTF
1265 ? ibcmp(s, locinput, ln)
1266 : ibcmp_locale(s, locinput, ln)))
bbce6d69
PP
1267 sayNO;
1268 locinput += ln;
76e3520e 1269 nextchr = UCHARAT(locinput);
a0d0e21e 1270 break;
a0ed51b3
LW
1271 case ANYOFUTF8:
1272 s = (char *) OPERAND(scan);
1273 if (!REGINCLASSUTF8(scan, (U8*)locinput))
1274 sayNO;
1275 if (locinput >= PL_regeol)
1276 sayNO;
a176fa2a 1277 locinput += utf8skip[nextchr];
a0ed51b3
LW
1278 nextchr = UCHARAT(locinput);
1279 break;
a0d0e21e 1280 case ANYOF:
161b471a 1281 s = (char *) OPERAND(scan);
76e3520e
GS
1282 if (nextchr < 0)
1283 nextchr = UCHARAT(locinput);
873ef191 1284 if (!REGINCLASS(s, nextchr))
4633a7c4 1285 sayNO;
3280af22 1286 if (!nextchr && locinput >= PL_regeol)
4633a7c4 1287 sayNO;
76e3520e 1288 nextchr = UCHARAT(++locinput);
a0d0e21e 1289 break;
bbce6d69 1290 case ALNUML:
3280af22 1291 PL_reg_flags |= RF_tainted;
bbce6d69 1292 /* FALL THROUGH */
a0d0e21e 1293 case ALNUM:
76e3520e 1294 if (!nextchr)
4633a7c4 1295 sayNO;
bbce6d69 1296 if (!(OP(scan) == ALNUM
76e3520e 1297 ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
4633a7c4 1298 sayNO;
76e3520e 1299 nextchr = UCHARAT(++locinput);
a0d0e21e 1300 break;
a0ed51b3
LW
1301 case ALNUMLUTF8:
1302 PL_reg_flags |= RF_tainted;
1303 /* FALL THROUGH */
1304 case ALNUMUTF8:
1305 if (!nextchr)
1306 sayNO;
1307 if (nextchr & 0x80) {
1308 if (!(OP(scan) == ALNUMUTF8
dfe13c55
GS
1309 ? swash_fetch(PL_utf8_alnum, (U8*)locinput)
1310 : isALNUM_LC_utf8((U8*)locinput)))
1311 {
a0ed51b3 1312 sayNO;
dfe13c55 1313 }
a176fa2a 1314 locinput += utf8skip[nextchr];
a0ed51b3
LW
1315 nextchr = UCHARAT(locinput);
1316 break;
1317 }
1318 if (!(OP(scan) == ALNUMUTF8
1319 ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
1320 sayNO;
1321 nextchr = UCHARAT(++locinput);
1322 break;
bbce6d69 1323 case NALNUML:
3280af22 1324 PL_reg_flags |= RF_tainted;
bbce6d69 1325 /* FALL THROUGH */
a0d0e21e 1326 case NALNUM:
3280af22 1327 if (!nextchr && locinput >= PL_regeol)
4633a7c4 1328 sayNO;
bbce6d69 1329 if (OP(scan) == NALNUM
76e3520e 1330 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
4633a7c4 1331 sayNO;
76e3520e 1332 nextchr = UCHARAT(++locinput);
a0d0e21e 1333 break;
a0ed51b3
LW
1334 case NALNUMLUTF8:
1335 PL_reg_flags |= RF_tainted;
1336 /* FALL THROUGH */
1337 case NALNUMUTF8:
1338 if (!nextchr && locinput >= PL_regeol)
1339 sayNO;
1340 if (nextchr & 0x80) {
1341 if (OP(scan) == NALNUMUTF8
dfe13c55
GS
1342 ? swash_fetch(PL_utf8_alnum, (U8*)locinput)
1343 : isALNUM_LC_utf8((U8*)locinput))
1344 {
a0ed51b3 1345 sayNO;
dfe13c55 1346 }
a176fa2a 1347 locinput += utf8skip[nextchr];
a0ed51b3
LW
1348 nextchr = UCHARAT(locinput);
1349 break;
1350 }
1351 if (OP(scan) == NALNUMUTF8
1352 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
1353 sayNO;
1354 nextchr = UCHARAT(++locinput);
1355 break;
bbce6d69
PP
1356 case BOUNDL:
1357 case NBOUNDL:
3280af22 1358 PL_reg_flags |= RF_tainted;
bbce6d69 1359 /* FALL THROUGH */
a0d0e21e 1360 case BOUND:
bbce6d69
PP
1361 case NBOUND:
1362 /* was last char in word? */
3280af22 1363 ln = (locinput != PL_regbol) ? UCHARAT(locinput - 1) : PL_regprev;
bbce6d69
PP
1364 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
1365 ln = isALNUM(ln);
76e3520e 1366 n = isALNUM(nextchr);
bbce6d69
PP
1367 }
1368 else {
1369 ln = isALNUM_LC(ln);
76e3520e 1370 n = isALNUM_LC(nextchr);
bbce6d69 1371 }
95bac841 1372 if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL))
4633a7c4 1373 sayNO;
a0d0e21e 1374 break;
a0ed51b3
LW
1375 case BOUNDLUTF8:
1376 case NBOUNDLUTF8:
1377 PL_reg_flags |= RF_tainted;
1378 /* FALL THROUGH */
1379 case BOUNDUTF8:
1380 case NBOUNDUTF8:
1381 /* was last char in word? */
dfe13c55
GS
1382 ln = (locinput != PL_regbol)
1383 ? utf8_to_uv(reghop((U8*)locinput, -1), 0) : PL_regprev;
a0ed51b3
LW
1384 if (OP(scan) == BOUNDUTF8 || OP(scan) == NBOUNDUTF8) {
1385 ln = isALNUM_uni(ln);
dfe13c55 1386 n = swash_fetch(PL_utf8_alnum, (U8*)locinput);
a0ed51b3
LW
1387 }
1388 else {
1389 ln = isALNUM_LC_uni(ln);
dfe13c55 1390 n = isALNUM_LC_utf8((U8*)locinput);
a0ed51b3
LW
1391 }
1392 if (((!ln) == (!n)) == (OP(scan) == BOUNDUTF8 || OP(scan) == BOUNDLUTF8))
1393 sayNO;
1394 break;
bbce6d69 1395 case SPACEL:
3280af22 1396 PL_reg_flags |= RF_tainted;
bbce6d69 1397 /* FALL THROUGH */
a0d0e21e 1398 case SPACE:
3280af22 1399 if (!nextchr && locinput >= PL_regeol)
4633a7c4 1400 sayNO;
bbce6d69 1401 if (!(OP(scan) == SPACE
76e3520e 1402 ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
4633a7c4 1403 sayNO;
76e3520e 1404 nextchr = UCHARAT(++locinput);
a0d0e21e 1405 break;
a0ed51b3
LW
1406 case SPACELUTF8:
1407 PL_reg_flags |= RF_tainted;
1408 /* FALL THROUGH */
1409 case SPACEUTF8:
1410 if (!nextchr && locinput >= PL_regeol)
1411 sayNO;
1412 if (nextchr & 0x80) {
1413 if (!(OP(scan) == SPACEUTF8
dfe13c55
GS
1414 ? swash_fetch(PL_utf8_space,(U8*)locinput)
1415 : isSPACE_LC_utf8((U8*)locinput)))
1416 {
a0ed51b3 1417 sayNO;
dfe13c55 1418 }
a176fa2a 1419 locinput += utf8skip[nextchr];
a0ed51b3
LW
1420 nextchr = UCHARAT(locinput);
1421 break;
1422 }
1423 if (!(OP(scan) == SPACEUTF8
1424 ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
1425 sayNO;
1426 nextchr = UCHARAT(++locinput);
1427 break;
bbce6d69 1428 case NSPACEL:
3280af22 1429 PL_reg_flags |= RF_tainted;
bbce6d69 1430 /* FALL THROUGH */
a0d0e21e 1431 case NSPACE:
76e3520e 1432 if (!nextchr)
4633a7c4 1433 sayNO;
bbce6d69 1434 if (OP(scan) == SPACE
76e3520e 1435 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
4633a7c4 1436 sayNO;
76e3520e 1437 nextchr = UCHARAT(++locinput);
a0d0e21e 1438 break;
a0ed51b3
LW
1439 case NSPACELUTF8:
1440 PL_reg_flags |= RF_tainted;
1441 /* FALL THROUGH */
1442 case NSPACEUTF8:
1443 if (!nextchr)
1444 sayNO;
1445 if (nextchr & 0x80) {
1446 if (OP(scan) == NSPACEUTF8
dfe13c55
GS
1447 ? swash_fetch(PL_utf8_space,(U8*)locinput)
1448 : isSPACE_LC_utf8((U8*)locinput))
1449 {
a0ed51b3 1450 sayNO;
dfe13c55 1451 }
a176fa2a 1452 locinput += utf8skip[nextchr];
a0ed51b3
LW
1453 nextchr = UCHARAT(locinput);
1454 break;
1455 }
1456 if (OP(scan) == NSPACEUTF8
1457 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
1458 sayNO;
1459 nextchr = UCHARAT(++locinput);
1460 break;
a0d0e21e 1461 case DIGIT:
76e3520e 1462 if (!isDIGIT(nextchr))
4633a7c4 1463 sayNO;
76e3520e 1464 nextchr = UCHARAT(++locinput);
a0d0e21e 1465 break;
a0ed51b3
LW
1466 case DIGITUTF8:
1467 if (nextchr & 0x80) {
dfe13c55 1468 if (!(swash_fetch(PL_utf8_digit,(U8*)locinput)))
a0ed51b3 1469 sayNO;
a176fa2a 1470 locinput += utf8skip[nextchr];
a0ed51b3
LW
1471 nextchr = UCHARAT(locinput);
1472 break;
1473 }
1474 if (!isDIGIT(nextchr))
1475 sayNO;
1476 nextchr = UCHARAT(++locinput);
1477 break;
a0d0e21e 1478 case NDIGIT:
3280af22 1479 if (!nextchr && locinput >= PL_regeol)
4633a7c4 1480 sayNO;
76e3520e 1481 if (isDIGIT(nextchr))
4633a7c4 1482 sayNO;
76e3520e 1483 nextchr = UCHARAT(++locinput);
a0d0e21e 1484 break;
a0ed51b3
LW
1485 case NDIGITUTF8:
1486 if (!nextchr && locinput >= PL_regeol)
1487 sayNO;
1488 if (nextchr & 0x80) {
dfe13c55 1489 if (swash_fetch(PL_utf8_digit,(U8*)locinput))
a0ed51b3 1490 sayNO;
a176fa2a 1491 locinput += utf8skip[nextchr];
a0ed51b3
LW
1492 nextchr = UCHARAT(locinput);
1493 break;
1494 }
1495 if (isDIGIT(nextchr))
1496 sayNO;
1497 nextchr = UCHARAT(++locinput);
1498 break;
1499 case CLUMP:
dfe13c55 1500 if (locinput >= PL_regeol || swash_fetch(PL_utf8_mark,(U8*)locinput))
a0ed51b3 1501 sayNO;
a176fa2a 1502 locinput += utf8skip[nextchr];
dfe13c55 1503 while (locinput < PL_regeol && swash_fetch(PL_utf8_mark,(U8*)locinput))
a0ed51b3
LW
1504 locinput += UTF8SKIP(locinput);
1505 if (locinput > PL_regeol)
1506 sayNO;
1507 nextchr = UCHARAT(locinput);
1508 break;
c8756f30 1509 case REFFL:
3280af22 1510 PL_reg_flags |= RF_tainted;
c8756f30 1511 /* FALL THROUGH */
c277df42 1512 case REF:
c8756f30 1513 case REFF:
c277df42 1514 n = ARG(scan); /* which paren pair */
3280af22
NIS
1515 s = PL_regstartp[n];
1516 if (*PL_reglastparen < n || !s)
af3f8c16 1517 sayNO; /* Do not match unless seen CLOSEn. */
3280af22 1518 if (s == PL_regendp[n])
a0d0e21e 1519 break;
a0ed51b3
LW
1520
1521 if (UTF && OP(scan) != REF) { /* REF can do byte comparison */
1522 char *l = locinput;
1523 char *e = PL_regendp[n];
1524 /*
1525 * Note that we can't do the "other character" lookup trick as
1526 * in the 8-bit case (no pun intended) because in Unicode we
1527 * have to map both upper and title case to lower case.
1528 */
1529 if (OP(scan) == REFF) {
1530 while (s < e) {
1531 if (l >= PL_regeol)
1532 sayNO;
dfe13c55 1533 if (toLOWER_utf8((U8*)s) != toLOWER_utf8((U8*)l))
a0ed51b3
LW
1534 sayNO;
1535 s += UTF8SKIP(s);
1536 l += UTF8SKIP(l);
1537 }
1538 }
1539 else {
1540 while (s < e) {
1541 if (l >= PL_regeol)
1542 sayNO;
dfe13c55 1543 if (toLOWER_LC_utf8((U8*)s) != toLOWER_LC_utf8((U8*)l))
a0ed51b3
LW
1544 sayNO;
1545 s += UTF8SKIP(s);
1546 l += UTF8SKIP(l);
1547 }
1548 }
1549 locinput = l;
1550 nextchr = UCHARAT(locinput);
1551 break;
1552 }
1553
a0d0e21e 1554 /* Inline the first character, for speed. */
76e3520e 1555 if (UCHARAT(s) != nextchr &&
c8756f30
AK
1556 (OP(scan) == REF ||
1557 (UCHARAT(s) != ((OP(scan) == REFF
76e3520e 1558 ? fold : fold_locale)[nextchr]))))
4633a7c4 1559 sayNO;
3280af22
NIS
1560 ln = PL_regendp[n] - s;
1561 if (locinput + ln > PL_regeol)
4633a7c4 1562 sayNO;
c8756f30
AK
1563 if (ln > 1 && (OP(scan) == REF
1564 ? memNE(s, locinput, ln)
1565 : (OP(scan) == REFF
1566 ? ibcmp(s, locinput, ln)
1567 : ibcmp_locale(s, locinput, ln))))
4633a7c4 1568 sayNO;
a0d0e21e 1569 locinput += ln;
76e3520e 1570 nextchr = UCHARAT(locinput);
a0d0e21e
LW
1571 break;
1572
1573 case NOTHING:
c277df42 1574 case TAIL:
a0d0e21e
LW
1575 break;
1576 case BACK:
1577 break;
c277df42
IZ
1578 case EVAL:
1579 {
1580 dSP;
533c011a 1581 OP_4tree *oop = PL_op;
3280af22
NIS
1582 COP *ocurcop = PL_curcop;
1583 SV **ocurpad = PL_curpad;
c277df42
IZ
1584 SV *ret;
1585
1586 n = ARG(scan);
533c011a
NIS
1587 PL_op = (OP_4tree*)PL_regdata->data[n];
1588 DEBUG_r( PerlIO_printf(Perl_debug_log, " re_eval 0x%x\n", PL_op) );
3280af22 1589 PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 1]);
c277df42 1590
76e3520e 1591 CALLRUNOPS(); /* Scalar context. */
c277df42
IZ
1592 SPAGAIN;
1593 ret = POPs;
1594 PUTBACK;
1595
0f5d15d6
IZ
1596 PL_op = oop;
1597 PL_curpad = ocurpad;
1598 PL_curcop = ocurcop;
c277df42 1599 if (logical) {
0f5d15d6
IZ
1600 if (logical == 2) { /* Postponed subexpression. */
1601 regexp *re;
1602 my_magic mg = Null(my_magic);
1603 re_cc_state state;
1604 CURCUR cctmp;
1605 CHECKPOINT cp, lastcp;
1606
1607 if(SvROK(ret) || SvRMAGICAL(ret)) {
1608 SV *sv = SvROK(ret) ? SvRV(ret) : ret;
1609
1610 if(SvMAGICAL(sv))
1611 mg = mg_find(sv, 'r');
1612 }
1613 if (mg) {
1614 re = (regexp *)mg->mg_obj;
1615 ReREFCNT_inc(re);
1616 }
1617 else {
1618 STRLEN len;
1619 char *t = SvPV(ret, len);
1620 PMOP pm;
1621 char *oprecomp = PL_regprecomp;
1622 I32 osize = PL_regsize;
1623 I32 onpar = PL_regnpar;
1624
1625 pm.op_pmflags = 0;
1626 re = CALLREGCOMP(t, t + len, &pm);
1627 if (!(SvFLAGS(ret)
1628 & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)))
1629 sv_magic(ret,(SV*)ReREFCNT_inc(re),'r',0,0);
1630 PL_regprecomp = oprecomp;
1631 PL_regsize = osize;
1632 PL_regnpar = onpar;
1633 }
1634 DEBUG_r(
1635 PerlIO_printf(Perl_debug_log,
1636 "Entering embedded `%s%.60s%s%s'\n",
1637 PL_colors[0],
1638 re->precomp,
1639 PL_colors[1],
1640 (strlen(re->precomp) > 60 ? "..." : ""))
1641 );
1642 state.node = next;
1643 state.prev = PL_reg_call_cc;
1644 state.cc = PL_regcc;
1645 state.re = PL_reg_re;
1646
1647 cctmp.cur = 0;
1648 cctmp.oldcc = 0;
1649 PL_regcc = &cctmp;
1650
1651 cp = regcppush(0); /* Save *all* the positions. */
1652 REGCP_SET;
1653 cache_re(re);
1654 state.ss = PL_savestack_ix;
1655 *PL_reglastparen = 0;
1656 PL_reg_call_cc = &state;
1657 PL_reginput = locinput;
1658 if (regmatch(re->program + 1)) {
1659 ReREFCNT_dec(re);
1660 regcpblow(cp);
1661 sayYES;
1662 }
1663 DEBUG_r(
1664 PerlIO_printf(Perl_debug_log,
1665 "%*s failed...\n",
1666 REPORT_CODE_OFF+PL_regindent*2, "")
1667 );
1668 ReREFCNT_dec(re);
1669 REGCP_UNWIND;
1670 regcppop();
1671 PL_reg_call_cc = state.prev;
1672 PL_regcc = state.cc;
1673 PL_reg_re = state.re;
d3790889 1674 cache_re(PL_reg_re);
0f5d15d6
IZ
1675 sayNO;
1676 }
c277df42 1677 sw = SvTRUE(ret);
0f5d15d6 1678 logical = 0;
a0ed51b3
LW
1679 }
1680 else
3280af22 1681 sv_setsv(save_scalar(PL_replgv), ret);
c277df42
IZ
1682 break;
1683 }
a0d0e21e 1684 case OPEN:
c277df42 1685 n = ARG(scan); /* which paren pair */
3280af22
NIS
1686 PL_reg_start_tmp[n] = locinput;
1687 if (n > PL_regsize)
1688 PL_regsize = n;
a0d0e21e
LW
1689 break;
1690 case CLOSE:
c277df42 1691 n = ARG(scan); /* which paren pair */
3280af22
NIS
1692 PL_regstartp[n] = PL_reg_start_tmp[n];
1693 PL_regendp[n] = locinput;
1694 if (n > *PL_reglastparen)
1695 *PL_reglastparen = n;
a0d0e21e 1696 break;
c277df42
IZ
1697 case GROUPP:
1698 n = ARG(scan); /* which paren pair */
3280af22 1699 sw = (*PL_reglastparen >= n && PL_regendp[n] != NULL);
c277df42
IZ
1700 break;
1701 case IFTHEN:
1702 if (sw)
1703 next = NEXTOPER(NEXTOPER(scan));
1704 else {
1705 next = scan + ARG(scan);
1706 if (OP(next) == IFTHEN) /* Fake one. */
1707 next = NEXTOPER(NEXTOPER(next));
1708 }
1709 break;
1710 case LOGICAL:
0f5d15d6 1711 logical = scan->flags;
c277df42 1712 break;
a0d0e21e
LW
1713 case CURLYX: {
1714 CURCUR cc;
3280af22 1715 CHECKPOINT cp = PL_savestack_ix;
c277df42
IZ
1716
1717 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
1718 next += ARG(next);
3280af22
NIS
1719 cc.oldcc = PL_regcc;
1720 PL_regcc = &cc;
1721 cc.parenfloor = *PL_reglastparen;
a0d0e21e
LW
1722 cc.cur = -1;
1723 cc.min = ARG1(scan);
1724 cc.max = ARG2(scan);
c277df42 1725 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
a0d0e21e
LW
1726 cc.next = next;
1727 cc.minmod = minmod;
1728 cc.lastloc = 0;
3280af22 1729 PL_reginput = locinput;
a0d0e21e
LW
1730 n = regmatch(PREVOPER(next)); /* start on the WHILEM */
1731 regcpblow(cp);
3280af22 1732 PL_regcc = cc.oldcc;
4633a7c4 1733 saySAME(n);
a0d0e21e
LW
1734 }
1735 /* NOT REACHED */
1736 case WHILEM: {
1737 /*
1738 * This is really hard to understand, because after we match
1739 * what we're trying to match, we must make sure the rest of
1740 * the RE is going to match for sure, and to do that we have
1741 * to go back UP the parse tree by recursing ever deeper. And
1742 * if it fails, we have to reset our parent's current state
1743 * that we can try again after backing off.
1744 */
1745
c277df42 1746 CHECKPOINT cp, lastcp;
3280af22 1747 CURCUR* cc = PL_regcc;
c277df42
IZ
1748 char *lastloc = cc->lastloc; /* Detection of 0-len. */
1749
4633a7c4 1750 n = cc->cur + 1; /* how many we know we matched */
3280af22 1751 PL_reginput = locinput;
a0d0e21e 1752
c277df42
IZ
1753 DEBUG_r(
1754 PerlIO_printf(Perl_debug_log,
1755 "%*s %ld out of %ld..%ld cc=%lx\n",
3280af22 1756 REPORT_CODE_OFF+PL_regindent*2, "",
c277df42
IZ
1757 (long)n, (long)cc->min,
1758 (long)cc->max, (long)cc)
1759 );
4633a7c4 1760
a0d0e21e
LW
1761 /* If degenerate scan matches "", assume scan done. */
1762
579cf2c3 1763 if (locinput == cc->lastloc && n >= cc->min) {
3280af22
NIS
1764 PL_regcc = cc->oldcc;
1765 ln = PL_regcc->cur;
c277df42 1766 DEBUG_r(
c3464db5
DD
1767 PerlIO_printf(Perl_debug_log,
1768 "%*s empty match detected, try continuation...\n",
3280af22 1769 REPORT_CODE_OFF+PL_regindent*2, "")
c277df42 1770 );
a0d0e21e 1771 if (regmatch(cc->next))
4633a7c4 1772 sayYES;
c277df42 1773 DEBUG_r(
c3464db5
DD
1774 PerlIO_printf(Perl_debug_log,
1775 "%*s failed...\n",
3280af22 1776 REPORT_CODE_OFF+PL_regindent*2, "")
c277df42 1777 );
3280af22
NIS
1778 PL_regcc->cur = ln;
1779 PL_regcc = cc;
4633a7c4 1780 sayNO;
a0d0e21e
LW
1781 }
1782
1783 /* First just match a string of min scans. */
1784
1785 if (n < cc->min) {
1786 cc->cur = n;
1787 cc->lastloc = locinput;
4633a7c4
LW
1788 if (regmatch(cc->scan))
1789 sayYES;
1790 cc->cur = n - 1;
c277df42
IZ
1791 cc->lastloc = lastloc;
1792 DEBUG_r(
c3464db5
DD
1793 PerlIO_printf(Perl_debug_log,
1794 "%*s failed...\n",
3280af22 1795 REPORT_CODE_OFF+PL_regindent*2, "")
c277df42 1796 );
4633a7c4 1797 sayNO;
a0d0e21e
LW
1798 }
1799
1800 /* Prefer next over scan for minimal matching. */
1801
1802 if (cc->minmod) {
3280af22
NIS
1803 PL_regcc = cc->oldcc;
1804 ln = PL_regcc->cur;
5f05dabc 1805 cp = regcppush(cc->parenfloor);
c277df42 1806 REGCP_SET;
5f05dabc 1807 if (regmatch(cc->next)) {
c277df42 1808 regcpblow(cp);
4633a7c4 1809 sayYES; /* All done. */
5f05dabc 1810 }
c277df42 1811 REGCP_UNWIND;
5f05dabc 1812 regcppop();
3280af22
NIS
1813 PL_regcc->cur = ln;
1814 PL_regcc = cc;
a0d0e21e 1815
c277df42 1816 if (n >= cc->max) { /* Maximum greed exceeded? */
599cee73 1817 if (ckWARN(WARN_UNSAFE) && n >= REG_INFTY
3280af22
NIS
1818 && !(PL_reg_flags & RF_warned)) {
1819 PL_reg_flags |= RF_warned;
599cee73 1820 warner(WARN_UNSAFE, "%s limit (%d) exceeded",
2f3ca594
GS
1821 "Complex regular subexpression recursion",
1822 REG_INFTY - 1);
c277df42 1823 }
4633a7c4 1824 sayNO;
c277df42 1825 }
a687059c 1826
c277df42 1827 DEBUG_r(
c3464db5
DD
1828 PerlIO_printf(Perl_debug_log,
1829 "%*s trying longer...\n",
3280af22 1830 REPORT_CODE_OFF+PL_regindent*2, "")
c277df42 1831 );
a0d0e21e 1832 /* Try scanning more and see if it helps. */
3280af22 1833 PL_reginput = locinput;
a0d0e21e
LW
1834 cc->cur = n;
1835 cc->lastloc = locinput;
5f05dabc 1836 cp = regcppush(cc->parenfloor);
c277df42 1837 REGCP_SET;
5f05dabc 1838 if (regmatch(cc->scan)) {
c277df42 1839 regcpblow(cp);
4633a7c4 1840 sayYES;
5f05dabc 1841 }
c277df42 1842 DEBUG_r(
c3464db5
DD
1843 PerlIO_printf(Perl_debug_log,
1844 "%*s failed...\n",
3280af22 1845 REPORT_CODE_OFF+PL_regindent*2, "")
c277df42
IZ
1846 );
1847 REGCP_UNWIND;
5f05dabc 1848 regcppop();
4633a7c4 1849 cc->cur = n - 1;
c277df42 1850 cc->lastloc = lastloc;
4633a7c4 1851 sayNO;
a0d0e21e
LW
1852 }
1853
1854 /* Prefer scan over next for maximal matching. */
1855
1856 if (n < cc->max) { /* More greed allowed? */
5f05dabc 1857 cp = regcppush(cc->parenfloor);
a0d0e21e
LW
1858 cc->cur = n;
1859 cc->lastloc = locinput;
c277df42 1860 REGCP_SET;
5f05dabc 1861 if (regmatch(cc->scan)) {
c277df42 1862 regcpblow(cp);
4633a7c4 1863 sayYES;
5f05dabc 1864 }
c277df42 1865 REGCP_UNWIND;
a0d0e21e 1866 regcppop(); /* Restore some previous $<digit>s? */
3280af22 1867 PL_reginput = locinput;
c277df42 1868 DEBUG_r(
c3464db5
DD
1869 PerlIO_printf(Perl_debug_log,
1870 "%*s failed, try continuation...\n",
3280af22 1871 REPORT_CODE_OFF+PL_regindent*2, "")
c277df42
IZ
1872 );
1873 }
599cee73
PM
1874 if (ckWARN(WARN_UNSAFE) && n >= REG_INFTY
1875 && !(PL_reg_flags & RF_warned)) {
3280af22 1876 PL_reg_flags |= RF_warned;
599cee73 1877 warner(WARN_UNSAFE, "%s limit (%d) exceeded",
cb5d145d
GS
1878 "Complex regular subexpression recursion",
1879 REG_INFTY - 1);
a0d0e21e
LW
1880 }
1881
1882 /* Failed deeper matches of scan, so see if this one works. */
3280af22
NIS
1883 PL_regcc = cc->oldcc;
1884 ln = PL_regcc->cur;
a0d0e21e 1885 if (regmatch(cc->next))
4633a7c4 1886 sayYES;
c277df42 1887 DEBUG_r(
c3464db5 1888 PerlIO_printf(Perl_debug_log, "%*s failed...\n",
3280af22 1889 REPORT_CODE_OFF+PL_regindent*2, "")
c277df42 1890 );
3280af22
NIS
1891 PL_regcc->cur = ln;
1892 PL_regcc = cc;
4633a7c4 1893 cc->cur = n - 1;
c277df42 1894 cc->lastloc = lastloc;
4633a7c4 1895 sayNO;
a0d0e21e
LW
1896 }
1897 /* NOT REACHED */
c277df42
IZ
1898 case BRANCHJ:
1899 next = scan + ARG(scan);
1900 if (next == scan)
1901 next = NULL;
1902 inner = NEXTOPER(NEXTOPER(scan));
1903 goto do_branch;
1904 case BRANCH:
1905 inner = NEXTOPER(scan);
1906 do_branch:
1907 {
1908 CHECKPOINT lastcp;
1909 c1 = OP(scan);
1910 if (OP(next) != c1) /* No choice. */
1911 next = inner; /* Avoid recursion. */
a0d0e21e 1912 else {
3280af22 1913 int lastparen = *PL_reglastparen;
c277df42
IZ
1914
1915 REGCP_SET;
a0d0e21e 1916 do {
3280af22 1917 PL_reginput = locinput;
c277df42 1918 if (regmatch(inner))
4633a7c4 1919 sayYES;
c277df42 1920 REGCP_UNWIND;
3280af22
NIS
1921 for (n = *PL_reglastparen; n > lastparen; n--)
1922 PL_regendp[n] = 0;
1923 *PL_reglastparen = n;
c277df42 1924 scan = next;
a0d0e21e 1925 /*SUPPRESS 560*/
c277df42
IZ
1926 if (n = (c1 == BRANCH ? NEXT_OFF(next) : ARG(next)))
1927 next += n;
a0d0e21e 1928 else
c277df42 1929 next = NULL;
c277df42
IZ
1930 inner = NEXTOPER(scan);
1931 if (c1 == BRANCHJ) {
1932 inner = NEXTOPER(inner);
1933 }
1934 } while (scan != NULL && OP(scan) == c1);
4633a7c4 1935 sayNO;
a0d0e21e 1936 /* NOTREACHED */
a687059c 1937 }
a0d0e21e
LW
1938 }
1939 break;
1940 case MINMOD:
1941 minmod = 1;
1942 break;
c277df42
IZ
1943 case CURLYM:
1944 {
00db4c45 1945 I32 l = 0;
c277df42
IZ
1946 CHECKPOINT lastcp;
1947
1948 /* We suppose that the next guy does not need
1949 backtracking: in particular, it is of constant length,
1950 and has no parenths to influence future backrefs. */
1951 ln = ARG1(scan); /* min to match */
1952 n = ARG2(scan); /* max to match */
c277df42
IZ
1953 paren = scan->flags;
1954 if (paren) {
3280af22
NIS
1955 if (paren > PL_regsize)
1956 PL_regsize = paren;
1957 if (paren > *PL_reglastparen)
1958 *PL_reglastparen = paren;
c277df42 1959 }
dc45a647 1960 scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
c277df42
IZ
1961 if (paren)
1962 scan += NEXT_OFF(scan); /* Skip former OPEN. */
3280af22 1963 PL_reginput = locinput;
c277df42
IZ
1964 if (minmod) {
1965 minmod = 0;
1966 if (ln && regrepeat_hard(scan, ln, &l) < ln)
1967 sayNO;
5f4b28b2 1968 if (ln && l == 0 && n >= ln
c277df42
IZ
1969 /* In fact, this is tricky. If paren, then the
1970 fact that we did/didnot match may influence
1971 future execution. */
1972 && !(paren && ln == 0))
1973 ln = n;
3280af22 1974 locinput = PL_reginput;
c277df42
IZ
1975 if (regkind[(U8)OP(next)] == EXACT) {
1976 c1 = UCHARAT(OPERAND(next) + 1);
1977 if (OP(next) == EXACTF)
1978 c2 = fold[c1];
1979 else if (OP(next) == EXACTFL)
1980 c2 = fold_locale[c1];
1981 else
1982 c2 = c1;
a0ed51b3
LW
1983 }
1984 else
c277df42
IZ
1985 c1 = c2 = -1000;
1986 REGCP_SET;
5f4b28b2 1987 /* This may be improved if l == 0. */
c277df42
IZ
1988 while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */
1989 /* If it could work, try it. */
1990 if (c1 == -1000 ||
3280af22
NIS
1991 UCHARAT(PL_reginput) == c1 ||
1992 UCHARAT(PL_reginput) == c2)
c277df42
IZ
1993 {
1994 if (paren) {
1995 if (n) {
dfe13c55 1996 PL_regstartp[paren] = HOPc(PL_reginput, -l);
3280af22 1997 PL_regendp[paren] = PL_reginput;
a0ed51b3
LW
1998 }
1999 else
3280af22 2000 PL_regendp[paren] = NULL;
c277df42
IZ
2001 }
2002 if (regmatch(next))
2003 sayYES;
2004 REGCP_UNWIND;
2005 }
2006 /* Couldn't or didn't -- move forward. */
3280af22 2007 PL_reginput = locinput;
c277df42
IZ
2008 if (regrepeat_hard(scan, 1, &l)) {
2009 ln++;
3280af22 2010 locinput = PL_reginput;
c277df42
IZ
2011 }
2012 else
2013 sayNO;
2014 }
a0ed51b3
LW
2015 }
2016 else {
c277df42
IZ
2017 n = regrepeat_hard(scan, n, &l);
2018 if (n != 0 && l == 0
2019 /* In fact, this is tricky. If paren, then the
2020 fact that we did/didnot match may influence
2021 future execution. */
2022 && !(paren && ln == 0))
2023 ln = n;
3280af22 2024 locinput = PL_reginput;
c277df42 2025 DEBUG_r(
5c0ca799
GS
2026 PerlIO_printf(Perl_debug_log,
2027 "%*s matched %ld times, len=%ld...\n",
3280af22 2028 REPORT_CODE_OFF+PL_regindent*2, "", n, l)
c277df42
IZ
2029 );
2030 if (n >= ln) {
2031 if (regkind[(U8)OP(next)] == EXACT) {
2032 c1 = UCHARAT(OPERAND(next) + 1);
2033 if (OP(next) == EXACTF)
2034 c2 = fold[c1];
2035 else if (OP(next) == EXACTFL)
2036 c2 = fold_locale[c1];
2037 else
2038 c2 = c1;
a0ed51b3
LW
2039 }
2040 else
c277df42
IZ
2041 c1 = c2 = -1000;
2042 }
2043 REGCP_SET;
2044 while (n >= ln) {
2045 /* If it could work, try it. */
2046 if (c1 == -1000 ||
3280af22
NIS
2047 UCHARAT(PL_reginput) == c1 ||
2048 UCHARAT(PL_reginput) == c2)
a0ed51b3
LW
2049 {
2050 DEBUG_r(
c3464db5
DD
2051 PerlIO_printf(Perl_debug_log,
2052 "%*s trying tail with n=%ld...\n",
3280af22 2053 REPORT_CODE_OFF+PL_regindent*2, "", n)
a0ed51b3
LW
2054 );
2055 if (paren) {
2056 if (n) {
dfe13c55 2057 PL_regstartp[paren] = HOPc(PL_reginput, -l);
a0ed51b3 2058 PL_regendp[paren] = PL_reginput;
c277df42 2059 }
a0ed51b3
LW
2060 else
2061 PL_regendp[paren] = NULL;
c277df42 2062 }
a0ed51b3
LW
2063 if (regmatch(next))
2064 sayYES;
2065 REGCP_UNWIND;
2066 }
c277df42
IZ
2067 /* Couldn't or didn't -- back up. */
2068 n--;
dfe13c55 2069 locinput = HOPc(locinput, -l);
3280af22 2070 PL_reginput = locinput;
c277df42
IZ
2071 }
2072 }
2073 sayNO;
2074 break;
2075 }
2076 case CURLYN:
2077 paren = scan->flags; /* Which paren to set */
3280af22
NIS
2078 if (paren > PL_regsize)
2079 PL_regsize = paren;
2080 if (paren > *PL_reglastparen)
2081 *PL_reglastparen = paren;
c277df42
IZ
2082 ln = ARG1(scan); /* min to match */
2083 n = ARG2(scan); /* max to match */
dc45a647 2084 scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
c277df42 2085 goto repeat;
a0d0e21e 2086 case CURLY:
c277df42 2087 paren = 0;
a0d0e21e
LW
2088 ln = ARG1(scan); /* min to match */
2089 n = ARG2(scan); /* max to match */
dc45a647 2090 scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
a0d0e21e
LW
2091 goto repeat;
2092 case STAR:
2093 ln = 0;
c277df42 2094 n = REG_INFTY;
a0d0e21e 2095 scan = NEXTOPER(scan);
c277df42 2096 paren = 0;
a0d0e21e
LW
2097 goto repeat;
2098 case PLUS:
c277df42
IZ
2099 ln = 1;
2100 n = REG_INFTY;
2101 scan = NEXTOPER(scan);
2102 paren = 0;
2103 repeat:
a0d0e21e
LW
2104 /*
2105 * Lookahead to avoid useless match attempts
2106 * when we know what character comes next.
2107 */
bbce6d69
PP
2108 if (regkind[(U8)OP(next)] == EXACT) {
2109 c1 = UCHARAT(OPERAND(next) + 1);
2110 if (OP(next) == EXACTF)
2111 c2 = fold[c1];
2112 else if (OP(next) == EXACTFL)
2113 c2 = fold_locale[c1];
2114 else
2115 c2 = c1;
2116 }
a0d0e21e 2117 else
bbce6d69 2118 c1 = c2 = -1000;
3280af22 2119 PL_reginput = locinput;
a0d0e21e 2120 if (minmod) {
c277df42 2121 CHECKPOINT lastcp;
a0d0e21e
LW
2122 minmod = 0;
2123 if (ln && regrepeat(scan, ln) < ln)
4633a7c4 2124 sayNO;
a0ed51b3 2125 locinput = PL_reginput;
c277df42
IZ
2126 REGCP_SET;
2127 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
a0d0e21e 2128 /* If it could work, try it. */
bbce6d69 2129 if (c1 == -1000 ||
3280af22
NIS
2130 UCHARAT(PL_reginput) == c1 ||
2131 UCHARAT(PL_reginput) == c2)
bbce6d69 2132 {
c277df42
IZ
2133 if (paren) {
2134 if (n) {
dfe13c55 2135 PL_regstartp[paren] = HOPc(PL_reginput, -1);
3280af22 2136 PL_regendp[paren] = PL_reginput;
a0ed51b3
LW
2137 }
2138 else
3280af22 2139 PL_regendp[paren] = NULL;
c277df42 2140 }
a0d0e21e 2141 if (regmatch(next))
4633a7c4 2142 sayYES;
c277df42 2143 REGCP_UNWIND;
bbce6d69 2144 }
c277df42 2145 /* Couldn't or didn't -- move forward. */
a0ed51b3 2146 PL_reginput = locinput;
a0d0e21e
LW
2147 if (regrepeat(scan, 1)) {
2148 ln++;
a0ed51b3
LW
2149 locinput = PL_reginput;
2150 }
2151 else
4633a7c4 2152 sayNO;
a0d0e21e
LW
2153 }
2154 }
2155 else {
c277df42 2156 CHECKPOINT lastcp;
a0d0e21e 2157 n = regrepeat(scan, n);
a0ed51b3 2158 locinput = PL_reginput;
a0d0e21e 2159 if (ln < n && regkind[(U8)OP(next)] == EOL &&
3280af22 2160 (!PL_multiline || OP(next) == SEOL))
a0d0e21e 2161 ln = n; /* why back off? */
c277df42
IZ
2162 REGCP_SET;
2163 if (paren) {
2164 while (n >= ln) {
2165 /* If it could work, try it. */
2166 if (c1 == -1000 ||
3280af22
NIS
2167 UCHARAT(PL_reginput) == c1 ||
2168 UCHARAT(PL_reginput) == c2)
c277df42
IZ
2169 {
2170 if (paren && n) {
2171 if (n) {
dfe13c55 2172 PL_regstartp[paren] = HOPc(PL_reginput, -1);
3280af22 2173 PL_regendp[paren] = PL_reginput;
a0ed51b3
LW
2174 }
2175 else
3280af22 2176 PL_regendp[paren] = NULL;
c277df42
IZ
2177 }
2178 if (regmatch(next))
2179 sayYES;
2180 REGCP_UNWIND;
2181 }
2182 /* Couldn't or didn't -- back up. */
2183 n--;
dfe13c55 2184 PL_reginput = locinput = HOPc(locinput, -1);
c277df42 2185 }
a0ed51b3
LW
2186 }
2187 else {
c277df42
IZ
2188 while (n >= ln) {
2189 /* If it could work, try it. */
2190 if (c1 == -1000 ||
3280af22
NIS
2191 UCHARAT(PL_reginput) == c1 ||
2192 UCHARAT(PL_reginput) == c2)
c277df42
IZ
2193 {
2194 if (regmatch(next))
2195 sayYES;
2196 REGCP_UNWIND;
2197 }
2198 /* Couldn't or didn't -- back up. */
2199 n--;
dfe13c55 2200 PL_reginput = locinput = HOPc(locinput, -1);
bbce6d69 2201 }
a0d0e21e
LW
2202 }
2203 }
4633a7c4 2204 sayNO;
c277df42 2205 break;
a0d0e21e 2206 case END:
0f5d15d6
IZ
2207 if (PL_reg_call_cc) {
2208 re_cc_state *cur_call_cc = PL_reg_call_cc;
2209 CURCUR *cctmp = PL_regcc;
2210 regexp *re = PL_reg_re;
2211 CHECKPOINT cp, lastcp;
2212
2213 cp = regcppush(0); /* Save *all* the positions. */
2214 REGCP_SET;
2215 regcp_set_to(PL_reg_call_cc->ss); /* Restore parens of
2216 the caller. */
2217 PL_reginput = locinput; /* Make position available to
2218 the callcc. */
2219 cache_re(PL_reg_call_cc->re);
2220 PL_regcc = PL_reg_call_cc->cc;
2221 PL_reg_call_cc = PL_reg_call_cc->prev;
2222 if (regmatch(cur_call_cc->node)) {
2223 PL_reg_call_cc = cur_call_cc;
2224 regcpblow(cp);
2225 sayYES;
2226 }
2227 REGCP_UNWIND;
2228 regcppop();
2229 PL_reg_call_cc = cur_call_cc;
2230 PL_regcc = cctmp;
2231 PL_reg_re = re;
2232 cache_re(re);
2233
2234 DEBUG_r(
2235 PerlIO_printf(Perl_debug_log,
2236 "%*s continuation failed...\n",
2237 REPORT_CODE_OFF+PL_regindent*2, "")
2238 );
2239 sayNO;
2240 }
3280af22 2241 if (locinput < PL_regtill)
7e5428c5
IZ
2242 sayNO; /* Cannot match: too short. */
2243 /* Fall through */
2244 case SUCCEED:
3280af22 2245 PL_reginput = locinput; /* put where regtry can find it */
4633a7c4 2246 sayYES; /* Success! */
c277df42
IZ
2247 case SUSPEND:
2248 n = 1;
9fe1d20c 2249 PL_reginput = locinput;
c277df42 2250 goto do_ifmatch;
a0d0e21e 2251 case UNLESSM:
c277df42 2252 n = 0;
a0ed51b3 2253 if (scan->flags) {
dfe13c55 2254 s = HOPMAYBEc(locinput, -scan->flags);
a0ed51b3
LW
2255 if (!s)
2256 goto say_yes;
2257 PL_reginput = s;
2258 }
2259 else
2260 PL_reginput = locinput;
c277df42
IZ
2261 goto do_ifmatch;
2262 case IFMATCH:
2263 n = 1;
a0ed51b3 2264 if (scan->flags) {
dfe13c55 2265 s = HOPMAYBEc(locinput, -scan->flags);
a0ed51b3
LW
2266 if (!s)
2267 goto say_no;
2268 PL_reginput = s;
2269 }
2270 else
2271 PL_reginput = locinput;
2272
c277df42 2273 do_ifmatch:
c277df42
IZ
2274 inner = NEXTOPER(NEXTOPER(scan));
2275 if (regmatch(inner) != n) {
2276 say_no:
2277 if (logical) {
2278 logical = 0;
2279 sw = 0;
2280 goto do_longjump;
a0ed51b3
LW
2281 }
2282 else
c277df42
IZ
2283 sayNO;
2284 }
2285 say_yes:
2286 if (logical) {
2287 logical = 0;
2288 sw = 1;
2289 }
fe44a5e8 2290 if (OP(scan) == SUSPEND) {
3280af22 2291 locinput = PL_reginput;
565764a8 2292 nextchr = UCHARAT(locinput);
fe44a5e8 2293 }
c277df42
IZ
2294 /* FALL THROUGH. */
2295 case LONGJMP:
2296 do_longjump:
2297 next = scan + ARG(scan);
2298 if (next == scan)
2299 next = NULL;
a0d0e21e
LW
2300 break;
2301 default:
c030ccd9 2302 PerlIO_printf(PerlIO_stderr(), "%lx %d\n",
c277df42 2303 (unsigned long)scan, OP(scan));
a0d0e21e 2304 FAIL("regexp memory corruption");
a687059c 2305 }
a0d0e21e
LW
2306 scan = next;
2307 }
a687059c 2308
a0d0e21e
LW
2309 /*
2310 * We get here only if there's trouble -- normally "case END" is
2311 * the terminating point.
2312 */
2313 FAIL("corrupted regexp pointers");
2314 /*NOTREACHED*/
4633a7c4
LW
2315 sayNO;
2316
2317yes:
2318#ifdef DEBUGGING
3280af22 2319 PL_regindent--;
4633a7c4
LW
2320#endif
2321 return 1;
2322
2323no:
2324#ifdef DEBUGGING
3280af22 2325 PL_regindent--;
4633a7c4 2326#endif
a0d0e21e 2327 return 0;
a687059c
LW
2328}
2329
2330/*
2331 - regrepeat - repeatedly match something simple, report how many
2332 */
2333/*
2334 * [This routine now assumes that it will only match on things of length 1.
2335 * That was true before, but now we assume scan - reginput is the count,
a0ed51b3 2336 * rather than incrementing count on every character. [Er, except utf8.]]
a687059c 2337 */
76e3520e 2338STATIC I32
c277df42 2339regrepeat(regnode *p, I32 max)
a687059c 2340{
5c0ca799 2341 dTHR;
a0d0e21e
LW
2342 register char *scan;
2343 register char *opnd;
2344 register I32 c;
3280af22 2345 register char *loceol = PL_regeol;
a0ed51b3 2346 register I32 hardcount = 0;
a0d0e21e 2347
3280af22 2348 scan = PL_reginput;
c277df42 2349 if (max != REG_INFTY && max < loceol - scan)
a0d0e21e 2350 loceol = scan + max;
161b471a 2351 opnd = (char *) OPERAND(p);
a0d0e21e
LW
2352 switch (OP(p)) {
2353 case ANY:
2354 while (scan < loceol && *scan != '\n')
2355 scan++;
2356 break;
2357 case SANY:
2358 scan = loceol;
2359 break;
a0ed51b3
LW
2360 case ANYUTF8:
2361 loceol = PL_regeol;
2362 while (scan < loceol && *scan != '\n') {
2363 scan += UTF8SKIP(scan);
2364 hardcount++;
2365 }
2366 break;
2367 case SANYUTF8:
2368 loceol = PL_regeol;
2369 while (scan < loceol) {
2370 scan += UTF8SKIP(scan);
2371 hardcount++;
2372 }
2373 break;
bbce6d69
PP
2374 case EXACT: /* length of string is 1 */
2375 c = UCHARAT(++opnd);
2376 while (scan < loceol && UCHARAT(scan) == c)
2377 scan++;
2378 break;
2379 case EXACTF: /* length of string is 1 */
2380 c = UCHARAT(++opnd);
2381 while (scan < loceol &&
2382 (UCHARAT(scan) == c || UCHARAT(scan) == fold[c]))
2383 scan++;
2384 break;
2385 case EXACTFL: /* length of string is 1 */
3280af22 2386 PL_reg_flags |= RF_tainted;
bbce6d69
PP
2387 c = UCHARAT(++opnd);
2388 while (scan < loceol &&
2389 (UCHARAT(scan) == c || UCHARAT(scan) == fold_locale[c]))
a0d0e21e
LW
2390 scan++;
2391 break;
a0ed51b3
LW
2392 case ANYOFUTF8:
2393 loceol = PL_regeol;
2394 while (scan < loceol && REGINCLASSUTF8(p, (U8*)scan)) {
2395 scan += UTF8SKIP(scan);
2396 hardcount++;
2397 }
2398 break;
a0d0e21e 2399 case ANYOF:
ae5c130c 2400 while (scan < loceol && REGINCLASS(opnd, *scan))
a0d0e21e 2401 scan++;
a0d0e21e
LW
2402 break;
2403 case ALNUM:
2404 while (scan < loceol && isALNUM(*scan))
2405 scan++;
2406 break;
a0ed51b3
LW
2407 case ALNUMUTF8:
2408 loceol = PL_regeol;
dfe13c55 2409 while (scan < loceol && swash_fetch(PL_utf8_alnum, (U8*)scan)) {
a0ed51b3
LW
2410 scan += UTF8SKIP(scan);
2411 hardcount++;
2412 }
2413 break;
bbce6d69 2414 case ALNUML:
3280af22 2415 PL_reg_flags |= RF_tainted;
bbce6d69
PP
2416 while (scan < loceol && isALNUM_LC(*scan))
2417 scan++;
2418 break;
a0ed51b3
LW
2419 case ALNUMLUTF8:
2420 PL_reg_flags |= RF_tainted;
2421 loceol = PL_regeol;
dfe13c55 2422 while (scan < loceol && isALNUM_LC_utf8((U8*)scan)) {
a0ed51b3
LW
2423 scan += UTF8SKIP(scan);
2424 hardcount++;
2425 }
2426 break;
2427 break;
a0d0e21e
LW
2428 case NALNUM:
2429 while (scan < loceol && !isALNUM(*scan))
2430 scan++;
2431 break;
a0ed51b3
LW
2432 case NALNUMUTF8:
2433 loceol = PL_regeol;
dfe13c55 2434 while (scan < loceol && !swash_fetch(PL_utf8_alnum, (U8*)scan)) {
a0ed51b3
LW
2435 scan += UTF8SKIP(scan);
2436 hardcount++;
2437 }
2438 break;
bbce6d69 2439 case NALNUML:
3280af22 2440 PL_reg_flags |= RF_tainted;
bbce6d69
PP
2441 while (scan < loceol && !isALNUM_LC(*scan))
2442 scan++;
2443 break;
a0ed51b3
LW
2444 case NALNUMLUTF8:
2445 PL_reg_flags |= RF_tainted;
2446 loceol = PL_regeol;
dfe13c55 2447 while (scan < loceol && !isALNUM_LC_utf8((U8*)scan)) {
a0ed51b3
LW
2448 scan += UTF8SKIP(scan);
2449 hardcount++;
2450 }
2451 break;
a0d0e21e
LW
2452 case SPACE:
2453 while (scan < loceol && isSPACE(*scan))
2454 scan++;
2455 break;
a0ed51b3
LW
2456 case SPACEUTF8:
2457 loceol = PL_regeol;
dfe13c55 2458 while (scan < loceol && (*scan == ' ' || swash_fetch(PL_utf8_space,(U8*)scan))) {
a0ed51b3
LW
2459 scan += UTF8SKIP(scan);
2460 hardcount++;
2461 }
2462 break;
bbce6d69 2463 case SPACEL:
3280af22 2464 PL_reg_flags |= RF_tainted;
bbce6d69
PP
2465 while (scan < loceol && isSPACE_LC(*scan))
2466 scan++;
2467 break;
a0ed51b3
LW
2468 case SPACELUTF8:
2469 PL_reg_flags |= RF_tainted;
2470 loceol = PL_regeol;
dfe13c55 2471 while (scan < loceol && (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
a0ed51b3
LW
2472 scan += UTF8SKIP(scan);
2473 hardcount++;
2474 }
2475 break;
a0d0e21e
LW
2476 case NSPACE:
2477 while (scan < loceol && !isSPACE(*scan))
2478 scan++;
2479 break;
a0ed51b3
LW
2480 case NSPACEUTF8:
2481 loceol = PL_regeol;
dfe13c55 2482 while (scan < loceol && !(*scan == ' ' || swash_fetch(PL_utf8_space,(U8*)scan))) {
a0ed51b3
LW
2483 scan += UTF8SKIP(scan);
2484 hardcount++;
2485 }
2486 break;
bbce6d69 2487 case NSPACEL:
3280af22 2488 PL_reg_flags |= RF_tainted;
bbce6d69
PP
2489 while (scan < loceol && !isSPACE_LC(*scan))
2490 scan++;
2491 break;
a0ed51b3
LW
2492 case NSPACELUTF8:
2493 PL_reg_flags |= RF_tainted;
2494 loceol = PL_regeol;
dfe13c55 2495 while (scan < loceol && !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
a0ed51b3
LW
2496 scan += UTF8SKIP(scan);
2497 hardcount++;
2498 }
2499 break;
a0d0e21e
LW
2500 case DIGIT:
2501 while (scan < loceol && isDIGIT(*scan))
2502 scan++;
2503 break;
a0ed51b3
LW
2504 case DIGITUTF8:
2505 loceol = PL_regeol;
dfe13c55 2506 while (scan < loceol && swash_fetch(PL_utf8_digit,(U8*)scan)) {
a0ed51b3
LW
2507 scan += UTF8SKIP(scan);
2508 hardcount++;
2509 }
2510 break;
2511 break;
a0d0e21e
LW
2512 case NDIGIT:
2513 while (scan < loceol && !isDIGIT(*scan))
2514 scan++;
2515 break;
a0ed51b3
LW
2516 case NDIGITUTF8:
2517 loceol = PL_regeol;
dfe13c55 2518 while (scan < loceol && !swash_fetch(PL_utf8_digit,(U8*)scan)) {
a0ed51b3
LW
2519 scan += UTF8SKIP(scan);
2520 hardcount++;
2521 }
2522 break;
a0d0e21e
LW
2523 default: /* Called on something of 0 width. */
2524 break; /* So match right here or not at all. */
2525 }
a687059c 2526
a0ed51b3
LW
2527 if (hardcount)
2528 c = hardcount;
2529 else
2530 c = scan - PL_reginput;
3280af22 2531 PL_reginput = scan;
a687059c 2532
c277df42
IZ
2533 DEBUG_r(
2534 {
2535 SV *prop = sv_newmortal();
2536
2537 regprop(prop, p);
2538 PerlIO_printf(Perl_debug_log,
2539 "%*s %s can match %ld times out of %ld...\n",
2540 REPORT_CODE_OFF+1, "", SvPVX(prop),c,max);
2541 });
2542
a0d0e21e 2543 return(c);
a687059c
LW
2544}
2545
2546/*
c277df42
IZ
2547 - regrepeat_hard - repeatedly match something, report total lenth and length
2548 *
2549 * The repeater is supposed to have constant length.
2550 */
2551
76e3520e 2552STATIC I32
c277df42
IZ
2553regrepeat_hard(regnode *p, I32 max, I32 *lp)
2554{
5c0ca799 2555 dTHR;
c277df42
IZ
2556 register char *scan;
2557 register char *start;
3280af22 2558 register char *loceol = PL_regeol;
a0ed51b3 2559 I32 l = 0;
708e3b05 2560 I32 count = 0, res = 1;
a0ed51b3
LW
2561
2562 if (!max)
2563 return 0;
c277df42 2564
3280af22 2565 start = PL_reginput;
a0ed51b3 2566 if (UTF) {
708e3b05 2567 while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
a0ed51b3
LW
2568 if (!count++) {
2569 l = 0;
2570 while (start < PL_reginput) {
2571 l++;
2572 start += UTF8SKIP(start);
2573 }
2574 *lp = l;
2575 if (l == 0)
2576 return max;
2577 }
2578 if (count == max)
2579 return count;
2580 }
2581 }
2582 else {
708e3b05 2583 while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
a0ed51b3
LW
2584 if (!count++) {
2585 *lp = l = PL_reginput - start;
2586 if (max != REG_INFTY && l*max < loceol - scan)
2587 loceol = scan + l*max;
2588 if (l == 0)
2589 return max;
c277df42
IZ
2590 }
2591 }
2592 }
708e3b05 2593 if (!res)
3280af22 2594 PL_reginput = scan;
c277df42 2595
a0ed51b3 2596 return count;
c277df42
IZ
2597}
2598
2599/*
bbce6d69
PP
2600 - regclass - determine if a character falls into a character class
2601 */
2602
76e3520e 2603STATIC bool
8ac85365 2604reginclass(register char *p, register I32 c)
bbce6d69 2605{
5c0ca799 2606 dTHR;
bbce6d69
PP
2607 char flags = *p;
2608 bool match = FALSE;
2609
2610 c &= 0xFF;
ae5c130c 2611 if (ANYOF_TEST(p, c))
bbce6d69
PP
2612 match = TRUE;
2613 else if (flags & ANYOF_FOLD) {
2614 I32 cf;
2615 if (flags & ANYOF_LOCALE) {
3280af22 2616 PL_reg_flags |= RF_tainted;
bbce6d69
PP
2617 cf = fold_locale[c];
2618 }
2619 else
2620 cf = fold[c];
ae5c130c 2621 if (ANYOF_TEST(p, cf))
bbce6d69
PP
2622 match = TRUE;
2623 }
2624
2625 if (!match && (flags & ANYOF_ISA)) {
3280af22 2626 PL_reg_flags |= RF_tainted;
bbce6d69
PP
2627
2628 if (((flags & ANYOF_ALNUML) && isALNUM_LC(c)) ||
2629 ((flags & ANYOF_NALNUML) && !isALNUM_LC(c)) ||
2630 ((flags & ANYOF_SPACEL) && isSPACE_LC(c)) ||
2631 ((flags & ANYOF_NSPACEL) && !isSPACE_LC(c)))
2632 {
2633 match = TRUE;
2634 }
2635 }
2636
ae5c130c 2637 return (flags & ANYOF_INVERT) ? !match : match;
bbce6d69
PP
2638}
2639
a0ed51b3
LW
2640STATIC bool
2641reginclassutf8(regnode *f, U8 *p)
c485e607
NIS
2642{
2643 dTHR;
a0ed51b3
LW
2644 char flags = ARG1(f);
2645 bool match = FALSE;
2646 SV *sv = (SV*)PL_regdata->data[ARG2(f)];
2647
2648 if (swash_fetch(sv, p))
2649 match = TRUE;
2650 else if (flags & ANYOF_FOLD) {
2651 I32 cf;
dfe13c55 2652 U8 tmpbuf[10];
a0ed51b3
LW
2653 if (flags & ANYOF_LOCALE) {
2654 PL_reg_flags |= RF_tainted;
2655 uv_to_utf8(tmpbuf, toLOWER_LC_utf8(p));
2656 }
2657 else
2658 uv_to_utf8(tmpbuf, toLOWER_utf8(p));
2659 if (swash_fetch(sv, tmpbuf))
2660 match = TRUE;
2661 }
2662
2663 if (!match && (flags & ANYOF_ISA)) {
2664 PL_reg_flags |= RF_tainted;
2665
2666 if (((flags & ANYOF_ALNUML) && isALNUM_LC_utf8(p)) ||
2667 ((flags & ANYOF_NALNUML) && !isALNUM_LC_utf8(p)) ||
2668 ((flags & ANYOF_SPACEL) && isSPACE_LC_utf8(p)) ||
2669 ((flags & ANYOF_NSPACEL) && !isSPACE_LC_utf8(p)))
2670 {
2671 match = TRUE;
2672 }
2673 }
2674
2675 return (flags & ANYOF_INVERT) ? !match : match;
2676}
161b471a 2677
dfe13c55
GS
2678STATIC U8 *
2679reghop(U8 *s, I32 off)
c485e607
NIS
2680{
2681 dTHR;
a0ed51b3
LW
2682 if (off >= 0) {
2683 while (off-- && s < (U8*)PL_regeol)
2684 s += UTF8SKIP(s);
2685 }
2686 else {
2687 while (off++) {
2688 if (s > (U8*)PL_bostr) {
2689 s--;
2690 if (*s & 0x80) {
2691 while (s > (U8*)PL_bostr && (*s & 0xc0) == 0x80)
2692 s--;
2693 } /* XXX could check well-formedness here */
2694 }
2695 }
2696 }
2697 return s;
2698}
161b471a 2699
dfe13c55
GS
2700STATIC U8 *
2701reghopmaybe(U8* s, I32 off)
a0ed51b3 2702{
c485e607 2703 dTHR;
a0ed51b3
LW
2704 if (off >= 0) {
2705 while (off-- && s < (U8*)PL_regeol)
2706 s += UTF8SKIP(s);
2707 if (off >= 0)
2708 return 0;
2709 }
2710 else {
2711 while (off++) {
2712 if (s > (U8*)PL_bostr) {
2713 s--;
2714 if (*s & 0x80) {
2715 while (s > (U8*)PL_bostr && (*s & 0xc0) == 0x80)
2716 s--;
2717 } /* XXX could check well-formedness here */
2718 }
2719 else
2720 break;
2721 }
2722 if (off <= 0)
2723 return 0;
2724 }
2725 return s;
2726}