regexec.c

   1 /*    regexec.c
   2  */
   3
   4 /*
   5  * "One Ring to rule them all, One Ring to find them..."
   6  */
   7
   8 /* This file contains functions for executing a regular expression.  See
   9  * also regcomp.c which funnily enough, contains functions for compiling
  10  * a regular expression.
  11  *
  12  * This file is also copied at build time to ext/re/re_exec.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.
  16  */
  17
  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
  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
  32 #ifdef PERL_EXT_RE_BUILD
  33 #include "re_top.h"
  34 #endif
  35
  36 /*
  37  * pregcomp and pregexec -- regsub and regerror are not used in perl
  38  *
  39  *      Copyright (c) 1986 by University of Toronto.
  40  *      Written by Henry Spencer.  Not derived from licensed software.
  41  *
  42  *      Permission is granted to anyone to use this software for any
  43  *      purpose on any computer system, and to redistribute it freely,
  44  *      subject to the following restrictions:
  45  *
  46  *      1. The author is not responsible for the consequences of use of
  47  *              this software, no matter how awful, even if they arise
  48  *              from defects in it.
  49  *
  50  *      2. The origin of this software must not be misrepresented, either
  51  *              by explicit claim or by omission.
  52  *
  53  *      3. Altered versions must be plainly marked as such, and must not
  54  *              be misrepresented as being the original software.
  55  *
  56  ****    Alterations to Henry's code are...
  57  ****
  58  ****    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
  59  ****    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
  60  ****
  61  ****    You may distribute under the terms of either the GNU General Public
  62  ****    License or the Artistic License, as specified in the README file.
  63  *
  64  * Beware that some of this code is subtly aware of the way operator
  65  * precedence is structured in regular expressions.  Serious changes in
  66  * regular-expression syntax might require a total rethink.
  67  */
  68 #include "EXTERN.h"
  69 #define PERL_IN_REGEXEC_C
  70 #include "perl.h"
  71
  72 #ifdef PERL_IN_XSUB_RE
  73 #  include "re_comp.h"
  74 #else
  75 #  include "regcomp.h"
  76 #endif
  77
  78 #define RF_tainted      1               /* tainted information used? */
  79 #define RF_warned       2               /* warned about big count? */
  80
  81 #define RF_utf8         8               /* Pattern contains multibyte chars? */
  82
  83 #define UTF ((PL_reg_flags & RF_utf8) != 0)
  84
  85 #define RS_init         1               /* eval environment created */
  86 #define RS_set          2               /* replsv value is set */
  87
  88 #ifndef STATIC
  89 #define STATIC  static
  90 #endif
  91
  92 #define REGINCLASS(prog,p,c)  (ANYOF_FLAGS(p) ? reginclass(prog,p,c,0,0) : ANYOF_BITMAP_TEST(p,*(c)))
  93
  94 /*
  95  * Forwards.
  96  */
  97
  98 #define CHR_SVLEN(sv) (do_utf8 ? sv_len_utf8(sv) : SvCUR(sv))
  99 #define CHR_DIST(a,b) (PL_reg_match_utf8 ? utf8_distance(a,b) : a - b)
 100
 101 #define HOPc(pos,off) \
 102         (char *)(PL_reg_match_utf8 \
 103             ? reghop3((U8*)pos, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr)) \
 104             : (U8*)(pos + off))
 105 #define HOPBACKc(pos, off) \
 106         (char*)(PL_reg_match_utf8\
 107             ? reghopmaybe3((U8*)pos, -off, (U8*)PL_bostr) \
 108             : (pos - off >= PL_bostr)           \
 109                 ? (U8*)pos - off                \
 110                 : NULL)
 111
 112 #define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)(pos), off, (U8*)(lim)) : (U8*)(pos + off))
 113 #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
 114
 115 #define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \
 116     if (!CAT2(PL_utf8_,class)) { bool ok; ENTER; save_re_context(); ok=CAT2(is_utf8_,class)((const U8*)str); assert(ok); LEAVE; } } STMT_END
 117 #define LOAD_UTF8_CHARCLASS_ALNUM() LOAD_UTF8_CHARCLASS(alnum,"a")
 118 #define LOAD_UTF8_CHARCLASS_DIGIT() LOAD_UTF8_CHARCLASS(digit,"0")
 119 #define LOAD_UTF8_CHARCLASS_SPACE() LOAD_UTF8_CHARCLASS(space," ")
 120 #define LOAD_UTF8_CHARCLASS_MARK()  LOAD_UTF8_CHARCLASS(mark, "\xcd\x86")
 121
 122 /* TODO: Combine JUMPABLE and HAS_TEXT to cache OP(rn) */
 123
 124 /* for use after a quantifier and before an EXACT-like node -- japhy */
 125 #define JUMPABLE(rn) ( \
 126     OP(rn) == OPEN || OP(rn) == CLOSE || OP(rn) == EVAL || \
 127     OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
 128     OP(rn) == PLUS || OP(rn) == MINMOD || \
 129     OP(rn) == KEEPS || (PL_regkind[OP(rn)] == VERB) || \
 130     (PL_regkind[OP(rn)] == CURLY && ARG1(rn) > 0) \
 131 )
 132 #define IS_EXACT(rn) (PL_regkind[OP(rn)] == EXACT)
 133
 134 #define HAS_TEXT(rn) ( IS_EXACT(rn) || PL_regkind[OP(rn)] == REF )
 135
 136 #if 0
 137 /* Currently these are only used when PL_regkind[OP(rn)] == EXACT so
 138    we don't need this definition. */
 139 #define IS_TEXT(rn)   ( OP(rn)==EXACT   || OP(rn)==REF   || OP(rn)==NREF   )
 140 #define IS_TEXTF(rn)  ( OP(rn)==EXACTF  || OP(rn)==REFF  || OP(rn)==NREFF  )
 141 #define IS_TEXTFL(rn) ( OP(rn)==EXACTFL || OP(rn)==REFFL || OP(rn)==NREFFL )
 142
 143 #else
 144 /* ... so we use this as its faster. */
 145 #define IS_TEXT(rn)   ( OP(rn)==EXACT   )
 146 #define IS_TEXTF(rn)  ( OP(rn)==EXACTF  )
 147 #define IS_TEXTFL(rn) ( OP(rn)==EXACTFL )
 148
 149 #endif
 150
 151 /*
 152   Search for mandatory following text node; for lookahead, the text must
 153   follow but for lookbehind (rn->flags != 0) we skip to the next step.
 154 */
 155 #define FIND_NEXT_IMPT(rn) STMT_START { \
 156     while (JUMPABLE(rn)) { \
 157         const OPCODE type = OP(rn); \
 158         if (type == SUSPEND || PL_regkind[type] == CURLY) \
 159             rn = NEXTOPER(NEXTOPER(rn)); \
 160         else if (type == PLUS) \
 161             rn = NEXTOPER(rn); \
 162         else if (type == IFMATCH) \
 163             rn = (rn->flags == 0) ? NEXTOPER(NEXTOPER(rn)) : rn + ARG(rn); \
 164         else rn += NEXT_OFF(rn); \
 165     } \
 166 } STMT_END
 167
 168
 169 static void restore_pos(pTHX_ void *arg);
 170
 171 STATIC CHECKPOINT
 172 S_regcppush(pTHX_ I32 parenfloor)
 173 {
 174     dVAR;
 175     const int retval = PL_savestack_ix;
 176 #define REGCP_PAREN_ELEMS 4
 177     const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS;
 178     int p;
 179     GET_RE_DEBUG_FLAGS_DECL;
 180
 181     if (paren_elems_to_push < 0)
 182         Perl_croak(aTHX_ "panic: paren_elems_to_push < 0");
 183
 184 #define REGCP_OTHER_ELEMS 8
 185     SSGROW(paren_elems_to_push + REGCP_OTHER_ELEMS);
 186
 187     for (p = PL_regsize; p > parenfloor; p--) {
 188 /* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
 189         SSPUSHINT(PL_regendp[p]);
 190         SSPUSHINT(PL_regstartp[p]);
 191         SSPUSHPTR(PL_reg_start_tmp[p]);
 192         SSPUSHINT(p);
 193         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 194           "     saving \\%"UVuf" %"IVdf"(%"IVdf")..%"IVdf"\n",
 195                       (UV)p, (IV)PL_regstartp[p],
 196                       (IV)(PL_reg_start_tmp[p] - PL_bostr),
 197                       (IV)PL_regendp[p]
 198         ));
 199     }
 200 /* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
 201     SSPUSHPTR(PL_regstartp);
 202     SSPUSHPTR(PL_regendp);
 203     SSPUSHINT(PL_regsize);
 204     SSPUSHINT(*PL_reglastparen);
 205     SSPUSHINT(*PL_reglastcloseparen);
 206     SSPUSHPTR(PL_reginput);
 207 #define REGCP_FRAME_ELEMS 2
 208 /* REGCP_FRAME_ELEMS are part of the REGCP_OTHER_ELEMS and
 209  * are needed for the regexp context stack bookkeeping. */
 210     SSPUSHINT(paren_elems_to_push + REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
 211     SSPUSHINT(SAVEt_REGCONTEXT); /* Magic cookie. */
 212
 213     return retval;
 214 }
 215
 216 /* These are needed since we do not localize EVAL nodes: */
 217 #define REGCP_SET(cp)                                           \
 218     DEBUG_STATE_r(                                              \
 219             PerlIO_printf(Perl_debug_log,                       \
 220                 "  Setting an EVAL scope, savestack=%"IVdf"\n", \
 221                 (IV)PL_savestack_ix));                          \
 222     cp = PL_savestack_ix
 223
 224 #define REGCP_UNWIND(cp)                                        \
 225     DEBUG_STATE_r(                                              \
 226         if (cp != PL_savestack_ix)                              \
 227             PerlIO_printf(Perl_debug_log,                       \
 228                 "  Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
 229                 (IV)(cp), (IV)PL_savestack_ix));                \
 230     regcpblow(cp)
 231
 232 STATIC char *
 233 S_regcppop(pTHX_ const regexp *rex)
 234 {
 235     dVAR;
 236     U32 i;
 237     char *input;
 238
 239     GET_RE_DEBUG_FLAGS_DECL;
 240
 241     /* Pop REGCP_OTHER_ELEMS before the parentheses loop starts. */
 242     i = SSPOPINT;
 243     assert(i == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
 244     i = SSPOPINT; /* Parentheses elements to pop. */
 245     input = (char *) SSPOPPTR;
 246     *PL_reglastcloseparen = SSPOPINT;
 247     *PL_reglastparen = SSPOPINT;
 248     PL_regsize = SSPOPINT;
 249     PL_regendp=(I32 *) SSPOPPTR;
 250     PL_regstartp=(I32 *) SSPOPPTR;
 251
 252
 253     /* Now restore the parentheses context. */
 254     for (i -= (REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
 255          i > 0; i -= REGCP_PAREN_ELEMS) {
 256         I32 tmps;
 257         U32 paren = (U32)SSPOPINT;
 258         PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
 259         PL_regstartp[paren] = SSPOPINT;
 260         tmps = SSPOPINT;
 261         if (paren <= *PL_reglastparen)
 262             PL_regendp[paren] = tmps;
 263         DEBUG_EXECUTE_r(
 264             PerlIO_printf(Perl_debug_log,
 265                           "     restoring \\%"UVuf" to %"IVdf"(%"IVdf")..%"IVdf"%s\n",
 266                           (UV)paren, (IV)PL_regstartp[paren],
 267                           (IV)(PL_reg_start_tmp[paren] - PL_bostr),
 268                           (IV)PL_regendp[paren],
 269                           (paren > *PL_reglastparen ? "(no)" : ""));
 270         );
 271     }
 272     DEBUG_EXECUTE_r(
 273         if (*PL_reglastparen + 1 <= rex->nparens) {
 274             PerlIO_printf(Perl_debug_log,
 275                           "     restoring \\%"IVdf"..\\%"IVdf" to undef\n",
 276                           (IV)(*PL_reglastparen + 1), (IV)rex->nparens);
 277         }
 278     );
 279 #if 1
 280     /* It would seem that the similar code in regtry()
 281      * already takes care of this, and in fact it is in
 282      * a better location to since this code can #if 0-ed out
 283      * but the code in regtry() is needed or otherwise tests
 284      * requiring null fields (pat.t#187 and split.t#{13,14}
 285      * (as of patchlevel 7877)  will fail.  Then again,
 286      * this code seems to be necessary or otherwise
 287      * building DynaLoader will fail:
 288      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
 289      * --jhi */
 290     for (i = *PL_reglastparen + 1; i <= rex->nparens; i++) {
 291         if (i > PL_regsize)
 292             PL_regstartp[i] = -1;
 293         PL_regendp[i] = -1;
 294     }
 295 #endif
 296     return input;
 297 }
 298
 299 #define regcpblow(cp) LEAVE_SCOPE(cp)   /* Ignores regcppush()ed data. */
 300
 301 /*
 302  * pregexec and friends
 303  */
 304
 305 #ifndef PERL_IN_XSUB_RE
 306 /*
 307  - pregexec - match a regexp against a string
 308  */
 309 I32
 310 Perl_pregexec(pTHX_ register regexp *prog, char *stringarg, register char *strend,
 311          char *strbeg, I32 minend, SV *screamer, U32 nosave)
 312 /* strend: pointer to null at end of string */
 313 /* strbeg: real beginning of string */
 314 /* minend: end of match must be >=minend after stringarg. */
 315 /* nosave: For optimizations. */
 316 {
 317     return
 318         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
 319                       nosave ? 0 : REXEC_COPY_STR);
 320 }
 321 #endif
 322
 323 /*
 324  * Need to implement the following flags for reg_anch:
 325  *
 326  * USE_INTUIT_NOML              - Useful to call re_intuit_start() first
 327  * USE_INTUIT_ML
 328  * INTUIT_AUTORITATIVE_NOML     - Can trust a positive answer
 329  * INTUIT_AUTORITATIVE_ML
 330  * INTUIT_ONCE_NOML             - Intuit can match in one location only.
 331  * INTUIT_ONCE_ML
 332  *
 333  * Another flag for this function: SECOND_TIME (so that float substrs
 334  * with giant delta may be not rechecked).
 335  */
 336
 337 /* Assumptions: if ANCH_GPOS, then strpos is anchored. XXXX Check GPOS logic */
 338
 339 /* If SCREAM, then SvPVX_const(sv) should be compatible with strpos and strend.
 340    Otherwise, only SvCUR(sv) is used to get strbeg. */
 341
 342 /* XXXX We assume that strpos is strbeg unless sv. */
 343
 344 /* XXXX Some places assume that there is a fixed substring.
 345         An update may be needed if optimizer marks as "INTUITable"
 346         RExen without fixed substrings.  Similarly, it is assumed that
 347         lengths of all the strings are no more than minlen, thus they
 348         cannot come from lookahead.
 349         (Or minlen should take into account lookahead.)
 350   NOTE: Some of this comment is not correct. minlen does now take account
 351   of lookahead/behind. Further research is required. -- demerphq
 352
 353 */
 354
 355 /* A failure to find a constant substring means that there is no need to make
 356    an expensive call to REx engine, thus we celebrate a failure.  Similarly,
 357    finding a substring too deep into the string means that less calls to
 358    regtry() should be needed.
 359
 360    REx compiler's optimizer found 4 possible hints:
 361         a) Anchored substring;
 362         b) Fixed substring;
 363         c) Whether we are anchored (beginning-of-line or \G);
 364         d) First node (of those at offset 0) which may distingush positions;
 365    We use a)b)d) and multiline-part of c), and try to find a position in the
 366    string which does not contradict any of them.
 367  */
 368
 369 /* Most of decisions we do here should have been done at compile time.
 370    The nodes of the REx which we used for the search should have been
 371    deleted from the finite automaton. */
 372
 373 char *
 374 Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 375                      char *strend, U32 flags, re_scream_pos_data *data)
 376 {
 377     dVAR;
 378     register I32 start_shift = 0;
 379     /* Should be nonnegative! */
 380     register I32 end_shift   = 0;
 381     register char *s;
 382     register SV *check;
 383     char *strbeg;
 384     char *t;
 385     const bool do_utf8 = (sv && SvUTF8(sv)) ? 1 : 0; /* if no sv we have to assume bytes */
 386     I32 ml_anch;
 387     register char *other_last = NULL;   /* other substr checked before this */
 388     char *check_at = NULL;              /* check substr found at this pos */
 389     const I32 multiline = prog->extflags & RXf_PMf_MULTILINE;
 390     RXi_GET_DECL(prog,progi);
 391 #ifdef DEBUGGING
 392     const char * const i_strpos = strpos;
 393 #endif
 394
 395     GET_RE_DEBUG_FLAGS_DECL;
 396
 397     RX_MATCH_UTF8_set(prog,do_utf8);
 398
 399     if (prog->extflags & RXf_UTF8) {
 400         PL_reg_flags |= RF_utf8;
 401     }
 402     DEBUG_EXECUTE_r(
 403         debug_start_match(prog, do_utf8, strpos, strend,
 404             sv ? "Guessing start of match in sv for"
 405                : "Guessing start of match in string for");
 406               );
 407
 408     /* CHR_DIST() would be more correct here but it makes things slow. */
 409     if (prog->minlen > strend - strpos) {
 410         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 411                               "String too short... [re_intuit_start]\n"));
 412         goto fail;
 413     }
 414
 415     strbeg = (sv && SvPOK(sv)) ? strend - SvCUR(sv) : strpos;
 416     PL_regeol = strend;
 417     if (do_utf8) {
 418         if (!prog->check_utf8 && prog->check_substr)
 419             to_utf8_substr(prog);
 420         check = prog->check_utf8;
 421     } else {
 422         if (!prog->check_substr && prog->check_utf8)
 423             to_byte_substr(prog);
 424         check = prog->check_substr;
 425     }
 426     if (check == &PL_sv_undef) {
 427         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 428                 "Non-utf8 string cannot match utf8 check string\n"));
 429         goto fail;
 430     }
 431     if (prog->extflags & RXf_ANCH) {    /* Match at beg-of-str or after \n */
 432         ml_anch = !( (prog->extflags & RXf_ANCH_SINGLE)
 433                      || ( (prog->extflags & RXf_ANCH_BOL)
 434                           && !multiline ) );    /* Check after \n? */
 435
 436         if (!ml_anch) {
 437           if ( !(prog->extflags & RXf_ANCH_GPOS) /* Checked by the caller */
 438                 && !(prog->intflags & PREGf_IMPLICIT) /* not a real BOL */
 439                /* SvCUR is not set on references: SvRV and SvPVX_const overlap */
 440                && sv && !SvROK(sv)
 441                && (strpos != strbeg)) {
 442               DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
 443               goto fail;
 444           }
 445           if (prog->check_offset_min == prog->check_offset_max &&
 446               !(prog->extflags & RXf_CANY_SEEN)) {
 447             /* Substring at constant offset from beg-of-str... */
 448             I32 slen;
 449
 450             s = HOP3c(strpos, prog->check_offset_min, strend);
 451
 452             if (SvTAIL(check)) {
 453                 slen = SvCUR(check);    /* >= 1 */
 454
 455                 if ( strend - s > slen || strend - s < slen - 1
 456                      || (strend - s == slen && strend[-1] != '\n')) {
 457                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String too long...\n"));
 458                     goto fail_finish;
 459                 }
 460                 /* Now should match s[0..slen-2] */
 461                 slen--;
 462                 if (slen && (*SvPVX_const(check) != *s
 463                              || (slen > 1
 464                                  && memNE(SvPVX_const(check), s, slen)))) {
 465                   report_neq:
 466                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String not equal...\n"));
 467                     goto fail_finish;
 468                 }
 469             }
 470             else if (*SvPVX_const(check) != *s
 471                      || ((slen = SvCUR(check)) > 1
 472                          && memNE(SvPVX_const(check), s, slen)))
 473                 goto report_neq;
 474             check_at = s;
 475             goto success_at_start;
 476           }
 477         }
 478         /* Match is anchored, but substr is not anchored wrt beg-of-str. */
 479         s = strpos;
 480         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
 481         end_shift = prog->check_end_shift;
 482
 483         if (!ml_anch) {
 484             const I32 end = prog->check_offset_max + CHR_SVLEN(check)
 485                                          - (SvTAIL(check) != 0);
 486             const I32 eshift = CHR_DIST((U8*)strend, (U8*)s) - end;
 487
 488             if (end_shift < eshift)
 489                 end_shift = eshift;
 490         }
 491     }
 492     else {                              /* Can match at random position */
 493         ml_anch = 0;
 494         s = strpos;
 495         start_shift = prog->check_offset_min;  /* okay to underestimate on CC */
 496         end_shift = prog->check_end_shift;
 497
 498         /* end shift should be non negative here */
 499     }
 500
 501 #ifdef QDEBUGGING       /* 7/99: reports of failure (with the older version) */
 502     if (end_shift < 0)
 503         Perl_croak(aTHX_ "panic: end_shift: %"IVdf" pattern:\n%s\n ",
 504                    (IV)end_shift, prog->precomp);
 505 #endif
 506
 507   restart:
 508     /* Find a possible match in the region s..strend by looking for
 509        the "check" substring in the region corrected by start/end_shift. */
 510
 511     {
 512         I32 srch_start_shift = start_shift;
 513         I32 srch_end_shift = end_shift;
 514         if (srch_start_shift < 0 && strbeg - s > srch_start_shift) {
 515             srch_end_shift -= ((strbeg - s) - srch_start_shift);
 516             srch_start_shift = strbeg - s;
 517         }
 518     DEBUG_OPTIMISE_MORE_r({
 519         PerlIO_printf(Perl_debug_log, "Check offset min: %"IVdf" Start shift: %"IVdf" End shift %"IVdf" Real End Shift: %"IVdf"\n",
 520             (IV)prog->check_offset_min,
 521             (IV)srch_start_shift,
 522             (IV)srch_end_shift,
 523             (IV)prog->check_end_shift);
 524     });
 525
 526     if (flags & REXEC_SCREAM) {
 527         I32 p = -1;                     /* Internal iterator of scream. */
 528         I32 * const pp = data ? data->scream_pos : &p;
 529
 530         if (PL_screamfirst[BmRARE(check)] >= 0
 531             || ( BmRARE(check) == '\n'
 532                  && (BmPREVIOUS(check) == SvCUR(check) - 1)
 533                  && SvTAIL(check) ))
 534             s = screaminstr(sv, check,
 535                             srch_start_shift + (s - strbeg), srch_end_shift, pp, 0);
 536         else
 537             goto fail_finish;
 538         /* we may be pointing at the wrong string */
 539         if (s && RX_MATCH_COPIED(prog))
 540             s = strbeg + (s - SvPVX_const(sv));
 541         if (data)
 542             *data->scream_olds = s;
 543     }
 544     else {
 545         U8* start_point;
 546         U8* end_point;
 547         if (prog->extflags & RXf_CANY_SEEN) {
 548             start_point= (U8*)(s + srch_start_shift);
 549             end_point= (U8*)(strend - srch_end_shift);
 550         } else {
 551             start_point= HOP3(s, srch_start_shift, srch_start_shift < 0 ? strbeg : strend);
 552             end_point= HOP3(strend, -srch_end_shift, strbeg);
 553         }
 554         DEBUG_OPTIMISE_MORE_r({
 555             PerlIO_printf(Perl_debug_log, "fbm_instr len=%d str=<%.*s>\n",
 556                 (int)(end_point - start_point),
 557                 (int)(end_point - start_point) > 20 ? 20 : (int)(end_point - start_point),
 558                 start_point);
 559         });
 560
 561         s = fbm_instr( start_point, end_point,
 562                       check, multiline ? FBMrf_MULTILINE : 0);
 563     }
 564     }
 565     /* Update the count-of-usability, remove useless subpatterns,
 566         unshift s.  */
 567
 568     DEBUG_EXECUTE_r({
 569         RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0),
 570             SvPVX_const(check), RE_SV_DUMPLEN(check), 30);
 571         PerlIO_printf(Perl_debug_log, "%s %s substr %s%s%s",
 572                           (s ? "Found" : "Did not find"),
 573             (check == (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr)
 574                 ? "anchored" : "floating"),
 575             quoted,
 576             RE_SV_TAIL(check),
 577             (s ? " at offset " : "...\n") );
 578     });
 579
 580     if (!s)
 581         goto fail_finish;
 582     /* Finish the diagnostic message */
 583     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - i_strpos)) );
 584
 585     /* XXX dmq: first branch is for positive lookbehind...
 586        Our check string is offset from the beginning of the pattern.
 587        So we need to do any stclass tests offset forward from that
 588        point. I think. :-(
 589      */
 590
 591
 592
 593     check_at=s;
 594
 595
 596     /* Got a candidate.  Check MBOL anchoring, and the *other* substr.
 597        Start with the other substr.
 598        XXXX no SCREAM optimization yet - and a very coarse implementation
 599        XXXX /ttx+/ results in anchored="ttx", floating="x".  floating will
 600                 *always* match.  Probably should be marked during compile...
 601        Probably it is right to do no SCREAM here...
 602      */
 603
 604     if (do_utf8 ? (prog->float_utf8 && prog->anchored_utf8)
 605                 : (prog->float_substr && prog->anchored_substr))
 606     {
 607         /* Take into account the "other" substring. */
 608         /* XXXX May be hopelessly wrong for UTF... */
 609         if (!other_last)
 610             other_last = strpos;
 611         if (check == (do_utf8 ? prog->float_utf8 : prog->float_substr)) {
 612           do_other_anchored:
 613             {
 614                 char * const last = HOP3c(s, -start_shift, strbeg);
 615                 char *last1, *last2;
 616                 char * const saved_s = s;
 617                 SV* must;
 618
 619                 t = s - prog->check_offset_max;
 620                 if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
 621                     && (!do_utf8
 622                         || ((t = (char*)reghopmaybe3((U8*)s, -(prog->check_offset_max), (U8*)strpos))
 623                             && t > strpos)))
 624                     NOOP;
 625                 else
 626                     t = strpos;
 627                 t = HOP3c(t, prog->anchored_offset, strend);
 628                 if (t < other_last)     /* These positions already checked */
 629                     t = other_last;
 630                 last2 = last1 = HOP3c(strend, -prog->minlen, strbeg);
 631                 if (last < last1)
 632                     last1 = last;
 633                 /* XXXX It is not documented what units *_offsets are in.
 634                    We assume bytes, but this is clearly wrong.
 635                    Meaning this code needs to be carefully reviewed for errors.
 636                    dmq.
 637                   */
 638
 639                 /* On end-of-str: see comment below. */
 640                 must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
 641                 if (must == &PL_sv_undef) {
 642                     s = (char*)NULL;
 643                     DEBUG_r(must = prog->anchored_utf8);        /* for debug */
 644                 }
 645                 else
 646                     s = fbm_instr(
 647                         (unsigned char*)t,
 648                         HOP3(HOP3(last1, prog->anchored_offset, strend)
 649                                 + SvCUR(must), -(SvTAIL(must)!=0), strbeg),
 650                         must,
 651                         multiline ? FBMrf_MULTILINE : 0
 652                     );
 653                 DEBUG_EXECUTE_r({
 654                     RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0),
 655                         SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
 656                     PerlIO_printf(Perl_debug_log, "%s anchored substr %s%s",
 657                         (s ? "Found" : "Contradicts"),
 658                         quoted, RE_SV_TAIL(must));
 659                 });
 660
 661
 662                 if (!s) {
 663                     if (last1 >= last2) {
 664                         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 665                                                 ", giving up...\n"));
 666                         goto fail_finish;
 667                     }
 668                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 669                         ", trying floating at offset %ld...\n",
 670                         (long)(HOP3c(saved_s, 1, strend) - i_strpos)));
 671                     other_last = HOP3c(last1, prog->anchored_offset+1, strend);
 672                     s = HOP3c(last, 1, strend);
 673                     goto restart;
 674                 }
 675                 else {
 676                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
 677                           (long)(s - i_strpos)));
 678                     t = HOP3c(s, -prog->anchored_offset, strbeg);
 679                     other_last = HOP3c(s, 1, strend);
 680                     s = saved_s;
 681                     if (t == strpos)
 682                         goto try_at_start;
 683                     goto try_at_offset;
 684                 }
 685             }
 686         }
 687         else {          /* Take into account the floating substring. */
 688             char *last, *last1;
 689             char * const saved_s = s;
 690             SV* must;
 691
 692             t = HOP3c(s, -start_shift, strbeg);
 693             last1 = last =
 694                 HOP3c(strend, -prog->minlen + prog->float_min_offset, strbeg);
 695             if (CHR_DIST((U8*)last, (U8*)t) > prog->float_max_offset)
 696                 last = HOP3c(t, prog->float_max_offset, strend);
 697             s = HOP3c(t, prog->float_min_offset, strend);
 698             if (s < other_last)
 699                 s = other_last;
 700  /* XXXX It is not documented what units *_offsets are in.  Assume bytes.  */
 701             must = do_utf8 ? prog->float_utf8 : prog->float_substr;
 702             /* fbm_instr() takes into account exact value of end-of-str
 703                if the check is SvTAIL(ed).  Since false positives are OK,
 704                and end-of-str is not later than strend we are OK. */
 705             if (must == &PL_sv_undef) {
 706                 s = (char*)NULL;
 707                 DEBUG_r(must = prog->float_utf8);       /* for debug message */
 708             }
 709             else
 710                 s = fbm_instr((unsigned char*)s,
 711                               (unsigned char*)last + SvCUR(must)
 712                                   - (SvTAIL(must)!=0),
 713                               must, multiline ? FBMrf_MULTILINE : 0);
 714             DEBUG_EXECUTE_r({
 715                 RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0),
 716                     SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
 717                 PerlIO_printf(Perl_debug_log, "%s floating substr %s%s",
 718                     (s ? "Found" : "Contradicts"),
 719                     quoted, RE_SV_TAIL(must));
 720             });
 721             if (!s) {
 722                 if (last1 == last) {
 723                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 724                                             ", giving up...\n"));
 725                     goto fail_finish;
 726                 }
 727                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 728                     ", trying anchored starting at offset %ld...\n",
 729                     (long)(saved_s + 1 - i_strpos)));
 730                 other_last = last;
 731                 s = HOP3c(t, 1, strend);
 732                 goto restart;
 733             }
 734             else {
 735                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
 736                       (long)(s - i_strpos)));
 737                 other_last = s; /* Fix this later. --Hugo */
 738                 s = saved_s;
 739                 if (t == strpos)
 740                     goto try_at_start;
 741                 goto try_at_offset;
 742             }
 743         }
 744     }
 745
 746
 747     t= (char*)HOP3( s, -prog->check_offset_max, (prog->check_offset_max<0) ? strend : strpos);
 748
 749     DEBUG_OPTIMISE_MORE_r(
 750         PerlIO_printf(Perl_debug_log,
 751             "Check offset min:%"IVdf" max:%"IVdf" S:%"IVdf" t:%"IVdf" D:%"IVdf" end:%"IVdf"\n",
 752             (IV)prog->check_offset_min,
 753             (IV)prog->check_offset_max,
 754             (IV)(s-strpos),
 755             (IV)(t-strpos),
 756             (IV)(t-s),
 757             (IV)(strend-strpos)
 758         )
 759     );
 760
 761     if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
 762         && (!do_utf8
 763             || ((t = (char*)reghopmaybe3((U8*)s, -prog->check_offset_max, (U8*) ((prog->check_offset_max<0) ? strend : strpos)))
 764                  && t > strpos)))
 765     {
 766         /* Fixed substring is found far enough so that the match
 767            cannot start at strpos. */
 768       try_at_offset:
 769         if (ml_anch && t[-1] != '\n') {
 770             /* Eventually fbm_*() should handle this, but often
 771                anchored_offset is not 0, so this check will not be wasted. */
 772             /* XXXX In the code below we prefer to look for "^" even in
 773                presence of anchored substrings.  And we search even
 774                beyond the found float position.  These pessimizations
 775                are historical artefacts only.  */
 776           find_anchor:
 777             while (t < strend - prog->minlen) {
 778                 if (*t == '\n') {
 779                     if (t < check_at - prog->check_offset_min) {
 780                         if (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) {
 781                             /* Since we moved from the found position,
 782                                we definitely contradict the found anchored
 783                                substr.  Due to the above check we do not
 784                                contradict "check" substr.
 785                                Thus we can arrive here only if check substr
 786                                is float.  Redo checking for "other"=="fixed".
 787                              */
 788                             strpos = t + 1;
 789                             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld, rescanning for anchored from offset %ld...\n",
 790                                 PL_colors[0], PL_colors[1], (long)(strpos - i_strpos), (long)(strpos - i_strpos + prog->anchored_offset)));
 791                             goto do_other_anchored;
 792                         }
 793                         /* We don't contradict the found floating substring. */
 794                         /* XXXX Why not check for STCLASS? */
 795                         s = t + 1;
 796                         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld...\n",
 797                             PL_colors[0], PL_colors[1], (long)(s - i_strpos)));
 798                         goto set_useful;
 799                     }
 800                     /* Position contradicts check-string */
 801                     /* XXXX probably better to look for check-string
 802                        than for "\n", so one should lower the limit for t? */
 803                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting lookup for check-string at offset %ld...\n",
 804                         PL_colors[0], PL_colors[1], (long)(t + 1 - i_strpos)));
 805                     other_last = strpos = s = t + 1;
 806                     goto restart;
 807                 }
 808                 t++;
 809             }
 810             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Did not find /%s^%s/m...\n",
 811                         PL_colors[0], PL_colors[1]));
 812             goto fail_finish;
 813         }
 814         else {
 815             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Starting position does not contradict /%s^%s/m...\n",
 816                         PL_colors[0], PL_colors[1]));
 817         }
 818         s = t;
 819       set_useful:
 820         ++BmUSEFUL(do_utf8 ? prog->check_utf8 : prog->check_substr);    /* hooray/5 */
 821     }
 822     else {
 823         /* The found string does not prohibit matching at strpos,
 824            - no optimization of calling REx engine can be performed,
 825            unless it was an MBOL and we are not after MBOL,
 826            or a future STCLASS check will fail this. */
 827       try_at_start:
 828         /* Even in this situation we may use MBOL flag if strpos is offset
 829            wrt the start of the string. */
 830         if (ml_anch && sv && !SvROK(sv) /* See prev comment on SvROK */
 831             && (strpos != strbeg) && strpos[-1] != '\n'
 832             /* May be due to an implicit anchor of m{.*foo}  */
 833             && !(prog->intflags & PREGf_IMPLICIT))
 834         {
 835             t = strpos;
 836             goto find_anchor;
 837         }
 838         DEBUG_EXECUTE_r( if (ml_anch)
 839             PerlIO_printf(Perl_debug_log, "Position at offset %ld does not contradict /%s^%s/m...\n",
 840                           (long)(strpos - i_strpos), PL_colors[0], PL_colors[1]);
 841         );
 842       success_at_start:
 843         if (!(prog->intflags & PREGf_NAUGHTY)   /* XXXX If strpos moved? */
 844             && (do_utf8 ? (
 845                 prog->check_utf8                /* Could be deleted already */
 846                 && --BmUSEFUL(prog->check_utf8) < 0
 847                 && (prog->check_utf8 == prog->float_utf8)
 848             ) : (
 849                 prog->check_substr              /* Could be deleted already */
 850                 && --BmUSEFUL(prog->check_substr) < 0
 851                 && (prog->check_substr == prog->float_substr)
 852             )))
 853         {
 854             /* If flags & SOMETHING - do not do it many times on the same match */
 855             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "... Disabling check substring...\n"));
 856             SvREFCNT_dec(do_utf8 ? prog->check_utf8 : prog->check_substr);
 857             if (do_utf8 ? prog->check_substr : prog->check_utf8)
 858                 SvREFCNT_dec(do_utf8 ? prog->check_substr : prog->check_utf8);
 859             prog->check_substr = prog->check_utf8 = NULL;       /* disable */
 860             prog->float_substr = prog->float_utf8 = NULL;       /* clear */
 861             check = NULL;                       /* abort */
 862             s = strpos;
 863             /* XXXX This is a remnant of the old implementation.  It
 864                     looks wasteful, since now INTUIT can use many
 865                     other heuristics. */
 866             prog->extflags &= ~RXf_USE_INTUIT;
 867         }
 868         else
 869             s = strpos;
 870     }
 871
 872     /* Last resort... */
 873     /* XXXX BmUSEFUL already changed, maybe multiple change is meaningful... */
 874     /* trie stclasses are too expensive to use here, we are better off to
 875        leave it to regmatch itself */
 876     if (progi->regstclass && PL_regkind[OP(progi->regstclass)]!=TRIE) {
 877         /* minlen == 0 is possible if regstclass is \b or \B,
 878            and the fixed substr is ''$.
 879            Since minlen is already taken into account, s+1 is before strend;
 880            accidentally, minlen >= 1 guaranties no false positives at s + 1
 881            even for \b or \B.  But (minlen? 1 : 0) below assumes that
 882            regstclass does not come from lookahead...  */
 883         /* If regstclass takes bytelength more than 1: If charlength==1, OK.
 884            This leaves EXACTF only, which is dealt with in find_byclass().  */
 885         const U8* const str = (U8*)STRING(progi->regstclass);
 886         const int cl_l = (PL_regkind[OP(progi->regstclass)] == EXACT
 887                     ? CHR_DIST(str+STR_LEN(progi->regstclass), str)
 888                     : 1);
 889         char * endpos;
 890         if (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
 891             endpos= HOP3c(s, (prog->minlen ? cl_l : 0), strend);
 892         else if (prog->float_substr || prog->float_utf8)
 893             endpos= HOP3c(HOP3c(check_at, -start_shift, strbeg), cl_l, strend);
 894         else
 895             endpos= strend;
 896
 897         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "start_shift: %"IVdf" check_at: %"IVdf" s: %"IVdf" endpos: %"IVdf"\n",
 898                                       (IV)start_shift, (IV)(check_at - strbeg), (IV)(s - strbeg), (IV)(endpos - strbeg)));
 899
 900         t = s;
 901         s = find_byclass(prog, progi->regstclass, s, endpos, NULL);
 902         if (!s) {
 903 #ifdef DEBUGGING
 904             const char *what = NULL;
 905 #endif
 906             if (endpos == strend) {
 907                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 908                                 "Could not match STCLASS...\n") );
 909                 goto fail;
 910             }
 911             DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 912                                    "This position contradicts STCLASS...\n") );
 913             if ((prog->extflags & RXf_ANCH) && !ml_anch)
 914                 goto fail;
 915             /* Contradict one of substrings */
 916             if (prog->anchored_substr || prog->anchored_utf8) {
 917                 if ((do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) == check) {
 918                     DEBUG_EXECUTE_r( what = "anchored" );
 919                   hop_and_restart:
 920                     s = HOP3c(t, 1, strend);
 921                     if (s + start_shift + end_shift > strend) {
 922                         /* XXXX Should be taken into account earlier? */
 923                         DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 924                                                "Could not match STCLASS...\n") );
 925                         goto fail;
 926                     }
 927                     if (!check)
 928                         goto giveup;
 929                     DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 930                                 "Looking for %s substr starting at offset %ld...\n",
 931                                  what, (long)(s + start_shift - i_strpos)) );
 932                     goto restart;
 933                 }
 934                 /* Have both, check_string is floating */
 935                 if (t + start_shift >= check_at) /* Contradicts floating=check */
 936                     goto retry_floating_check;
 937                 /* Recheck anchored substring, but not floating... */
 938                 s = check_at;
 939                 if (!check)
 940                     goto giveup;
 941                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 942                           "Looking for anchored substr starting at offset %ld...\n",
 943                           (long)(other_last - i_strpos)) );
 944                 goto do_other_anchored;
 945             }
 946             /* Another way we could have checked stclass at the
 947                current position only: */
 948             if (ml_anch) {
 949                 s = t = t + 1;
 950                 if (!check)
 951                     goto giveup;
 952                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 953                           "Looking for /%s^%s/m starting at offset %ld...\n",
 954                           PL_colors[0], PL_colors[1], (long)(t - i_strpos)) );
 955                 goto try_at_offset;
 956             }
 957             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))     /* Could have been deleted */
 958                 goto fail;
 959             /* Check is floating subtring. */
 960           retry_floating_check:
 961             t = check_at - start_shift;
 962             DEBUG_EXECUTE_r( what = "floating" );
 963             goto hop_and_restart;
 964         }
 965         if (t != s) {
 966             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 967                         "By STCLASS: moving %ld --> %ld\n",
 968                                   (long)(t - i_strpos), (long)(s - i_strpos))
 969                    );
 970         }
 971         else {
 972             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 973                                   "Does not contradict STCLASS...\n");
 974                    );
 975         }
 976     }
 977   giveup:
 978     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s%s:%s match at offset %ld\n",
 979                           PL_colors[4], (check ? "Guessed" : "Giving up"),
 980                           PL_colors[5], (long)(s - i_strpos)) );
 981     return s;
 982
 983   fail_finish:                          /* Substring not found */
 984     if (prog->check_substr || prog->check_utf8)         /* could be removed already */
 985         BmUSEFUL(do_utf8 ? prog->check_utf8 : prog->check_substr) += 5; /* hooray */
 986   fail:
 987     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n",
 988                           PL_colors[4], PL_colors[5]));
 989     return NULL;
 990 }
 991
 992
 993
 994 #define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uscan, len,  \
 995 uvc, charid, foldlen, foldbuf, uniflags) STMT_START {                       \
 996     switch (trie_type) {                                                    \
 997     case trie_utf8_fold:                                                    \
 998         if ( foldlen>0 ) {                                                  \
 999             uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags );     \
1000             foldlen -= len;                                                 \
1001             uscan += len;                                                   \
1002             len=0;                                                          \
1003         } else {                                                            \
1004             uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );   \
1005             uvc = to_uni_fold( uvc, foldbuf, &foldlen );                    \
1006             foldlen -= UNISKIP( uvc );                                      \
1007             uscan = foldbuf + UNISKIP( uvc );                               \
1008         }                                                                   \
1009         break;                                                              \
1010     case trie_utf8:                                                         \
1011         uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );       \
1012         break;                                                              \
1013     case trie_plain:                                                        \
1014         uvc = (UV)*uc;                                                      \
1015         len = 1;                                                            \
1016     }                                                                       \
1017                                                                             \
1018     if (uvc < 256) {                                                        \
1019         charid = trie->charmap[ uvc ];                                      \
1020     }                                                                       \
1021     else {                                                                  \
1022         charid = 0;                                                         \
1023         if (widecharmap) {                                                  \
1024             SV** const svpp = hv_fetch(widecharmap,                         \
1025                         (char*)&uvc, sizeof(UV), 0);                        \
1026             if (svpp)                                                       \
1027                 charid = (U16)SvIV(*svpp);                                  \
1028         }                                                                   \
1029     }                                                                       \
1030 } STMT_END
1031
1032 #define REXEC_FBC_EXACTISH_CHECK(CoNd)                  \
1033     if ( (CoNd)                                        \
1034          && (ln == len ||                              \
1035              ibcmp_utf8(s, NULL, 0,  do_utf8,          \
1036                         m, NULL, ln, (bool)UTF))       \
1037          && (!reginfo || regtry(reginfo, &s)) )         \
1038         goto got_it;                                   \
1039     else {                                             \
1040          U8 foldbuf[UTF8_MAXBYTES_CASE+1];             \
1041          uvchr_to_utf8(tmpbuf, c);                     \
1042          f = to_utf8_fold(tmpbuf, foldbuf, &foldlen);  \
1043          if ( f != c                                   \
1044               && (f == c1 || f == c2)                  \
1045               && (ln == foldlen ||                     \
1046                   !ibcmp_utf8((char *) foldbuf,        \
1047                               NULL, foldlen, do_utf8,  \
1048                               m,                       \
1049                               NULL, ln, (bool)UTF))    \
1050               && (!reginfo || regtry(reginfo, &s)) )    \
1051               goto got_it;                             \
1052     }                                                  \
1053     s += len
1054
1055 #define REXEC_FBC_EXACTISH_SCAN(CoNd)                     \
1056 STMT_START {                                              \
1057     while (s <= e) {                                      \
1058         if ( (CoNd)                                       \
1059              && (ln == 1 || !(OP(c) == EXACTF             \
1060                               ? ibcmp(s, m, ln)           \
1061                               : ibcmp_locale(s, m, ln)))  \
1062              && (!reginfo || regtry(reginfo, &s)) )        \
1063             goto got_it;                                  \
1064         s++;                                              \
1065     }                                                     \
1066 } STMT_END
1067
1068 #define REXEC_FBC_UTF8_SCAN(CoDe)                     \
1069 STMT_START {                                          \
1070     while (s + (uskip = UTF8SKIP(s)) <= strend) {     \
1071         CoDe                                          \
1072         s += uskip;                                   \
1073     }                                                 \
1074 } STMT_END
1075
1076 #define REXEC_FBC_SCAN(CoDe)                          \
1077 STMT_START {                                          \
1078     while (s < strend) {                              \
1079         CoDe                                          \
1080         s++;                                          \
1081     }                                                 \
1082 } STMT_END
1083
1084 #define REXEC_FBC_UTF8_CLASS_SCAN(CoNd)               \
1085 REXEC_FBC_UTF8_SCAN(                                  \
1086     if (CoNd) {                                       \
1087         if (tmp && (!reginfo || regtry(reginfo, &s)))  \
1088             goto got_it;                              \
1089         else                                          \
1090             tmp = doevery;                            \
1091     }                                                 \
1092     else                                              \
1093         tmp = 1;                                      \
1094 )
1095
1096 #define REXEC_FBC_CLASS_SCAN(CoNd)                    \
1097 REXEC_FBC_SCAN(                                       \
1098     if (CoNd) {                                       \
1099         if (tmp && (!reginfo || regtry(reginfo, &s)))  \
1100             goto got_it;                              \
1101         else                                          \
1102             tmp = doevery;                            \
1103     }                                                 \
1104     else                                              \
1105         tmp = 1;                                      \
1106 )
1107
1108 #define REXEC_FBC_TRYIT               \
1109 if ((!reginfo || regtry(reginfo, &s))) \
1110     goto got_it
1111
1112 #define REXEC_FBC_CSCAN_PRELOAD(UtFpReLoAd,CoNdUtF8,CoNd)      \
1113     if (do_utf8) {                                             \
1114         UtFpReLoAd;                                            \
1115         REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8);                   \
1116     }                                                          \
1117     else {                                                     \
1118         REXEC_FBC_CLASS_SCAN(CoNd);                            \
1119     }                                                          \
1120     break
1121
1122 #define REXEC_FBC_CSCAN_TAINT(CoNdUtF8,CoNd)                   \
1123     PL_reg_flags |= RF_tainted;                                \
1124     if (do_utf8) {                                             \
1125         REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8);                   \
1126     }                                                          \
1127     else {                                                     \
1128         REXEC_FBC_CLASS_SCAN(CoNd);                            \
1129     }                                                          \
1130     break
1131
1132 #define DUMP_EXEC_POS(li,s,doutf8) \
1133     dump_exec_pos(li,s,(PL_regeol),(PL_bostr),(PL_reg_starttry),doutf8)
1134
1135 /* We know what class REx starts with.  Try to find this position... */
1136 /* if reginfo is NULL, its a dryrun */
1137 /* annoyingly all the vars in this routine have different names from their counterparts
1138    in regmatch. /grrr */
1139
1140 STATIC char *
1141 S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
1142     const char *strend, regmatch_info *reginfo)
1143 {
1144         dVAR;
1145         const I32 doevery = (prog->intflags & PREGf_SKIP) == 0;
1146         char *m;
1147         STRLEN ln;
1148         STRLEN lnc;
1149         register STRLEN uskip;
1150         unsigned int c1;
1151         unsigned int c2;
1152         char *e;
1153         register I32 tmp = 1;   /* Scratch variable? */
1154         register const bool do_utf8 = PL_reg_match_utf8;
1155         RXi_GET_DECL(prog,progi);
1156
1157         /* We know what class it must start with. */
1158         switch (OP(c)) {
1159         case ANYOF:
1160             if (do_utf8) {
1161                  REXEC_FBC_UTF8_CLASS_SCAN((ANYOF_FLAGS(c) & ANYOF_UNICODE) ||
1162                           !UTF8_IS_INVARIANT((U8)s[0]) ?
1163                           reginclass(prog, c, (U8*)s, 0, do_utf8) :
1164                           REGINCLASS(prog, c, (U8*)s));
1165             }
1166             else {
1167                  while (s < strend) {
1168                       STRLEN skip = 1;
1169
1170                       if (REGINCLASS(prog, c, (U8*)s) ||
1171                           (ANYOF_FOLD_SHARP_S(c, s, strend) &&
1172                            /* The assignment of 2 is intentional:
1173                             * for the folded sharp s, the skip is 2. */
1174                            (skip = SHARP_S_SKIP))) {
1175                            if (tmp && (!reginfo || regtry(reginfo, &s)))
1176                                 goto got_it;
1177                            else
1178                                 tmp = doevery;
1179                       }
1180                       else
1181                            tmp = 1;
1182                       s += skip;
1183                  }
1184             }
1185             break;
1186         case CANY:
1187             REXEC_FBC_SCAN(
1188                 if (tmp && (!reginfo || regtry(reginfo, &s)))
1189                     goto got_it;
1190                 else
1191                     tmp = doevery;
1192             );
1193             break;
1194         case EXACTF:
1195             m   = STRING(c);
1196             ln  = STR_LEN(c);   /* length to match in octets/bytes */
1197             lnc = (I32) ln;     /* length to match in characters */
1198             if (UTF) {
1199                 STRLEN ulen1, ulen2;
1200                 U8 *sm = (U8 *) m;
1201                 U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
1202                 U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
1203                 const U32 uniflags = UTF8_ALLOW_DEFAULT;
1204
1205                 to_utf8_lower((U8*)m, tmpbuf1, &ulen1);
1206                 to_utf8_upper((U8*)m, tmpbuf2, &ulen2);
1207
1208                 c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXBYTES_CASE,
1209                                     0, uniflags);
1210                 c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXBYTES_CASE,
1211                                     0, uniflags);
1212                 lnc = 0;
1213                 while (sm < ((U8 *) m + ln)) {
1214                     lnc++;
1215                     sm += UTF8SKIP(sm);
1216                 }
1217             }
1218             else {
1219                 c1 = *(U8*)m;
1220                 c2 = PL_fold[c1];
1221             }
1222             goto do_exactf;
1223         case EXACTFL:
1224             m   = STRING(c);
1225             ln  = STR_LEN(c);
1226             lnc = (I32) ln;
1227             c1 = *(U8*)m;
1228             c2 = PL_fold_locale[c1];
1229           do_exactf:
1230             e = HOP3c(strend, -((I32)lnc), s);
1231
1232             if (!reginfo && e < s)
1233                 e = s;                  /* Due to minlen logic of intuit() */
1234
1235             /* The idea in the EXACTF* cases is to first find the
1236              * first character of the EXACTF* node and then, if
1237              * necessary, case-insensitively compare the full
1238              * text of the node.  The c1 and c2 are the first
1239              * characters (though in Unicode it gets a bit
1240              * more complicated because there are more cases
1241              * than just upper and lower: one needs to use
1242              * the so-called folding case for case-insensitive
1243              * matching (called "loose matching" in Unicode).
1244              * ibcmp_utf8() will do just that. */
1245
1246             if (do_utf8) {
1247                 UV c, f;
1248                 U8 tmpbuf [UTF8_MAXBYTES+1];
1249                 STRLEN len, foldlen;
1250                 const U32 uniflags = UTF8_ALLOW_DEFAULT;
1251                 if (c1 == c2) {
1252                     /* Upper and lower of 1st char are equal -
1253                      * probably not a "letter". */
1254                     while (s <= e) {
1255                         c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
1256                                            uniflags);
1257                         REXEC_FBC_EXACTISH_CHECK(c == c1);
1258                     }
1259                 }
1260                 else {
1261                     while (s <= e) {
1262                       c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
1263                                            uniflags);
1264
1265                         /* Handle some of the three Greek sigmas cases.
1266                          * Note that not all the possible combinations
1267                          * are handled here: some of them are handled
1268                          * by the standard folding rules, and some of
1269                          * them (the character class or ANYOF cases)
1270                          * are handled during compiletime in
1271                          * regexec.c:S_regclass(). */
1272                         if (c == (UV)UNICODE_GREEK_CAPITAL_LETTER_SIGMA ||
1273                             c == (UV)UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA)
1274                             c = (UV)UNICODE_GREEK_SMALL_LETTER_SIGMA;
1275
1276                         REXEC_FBC_EXACTISH_CHECK(c == c1 || c == c2);
1277                     }
1278                 }
1279             }
1280             else {
1281                 if (c1 == c2)
1282                     REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1);
1283                 else
1284                     REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1 || *(U8*)s == c2);
1285             }
1286             break;
1287         case BOUNDL:
1288             PL_reg_flags |= RF_tainted;
1289             /* FALL THROUGH */
1290         case BOUND:
1291             if (do_utf8) {
1292                 if (s == PL_bostr)
1293                     tmp = '\n';
1294                 else {
1295                     U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);
1296                     tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, UTF8_ALLOW_DEFAULT);
1297                 }
1298                 tmp = ((OP(c) == BOUND ?
1299                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1300                 LOAD_UTF8_CHARCLASS_ALNUM();
1301                 REXEC_FBC_UTF8_SCAN(
1302                     if (tmp == !(OP(c) == BOUND ?
1303                                  (bool)swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1304                                  isALNUM_LC_utf8((U8*)s)))
1305                     {
1306                         tmp = !tmp;
1307                         REXEC_FBC_TRYIT;
1308                 }
1309                 );
1310             }
1311             else {
1312                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1313                 tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1314                 REXEC_FBC_SCAN(
1315                     if (tmp ==
1316                         !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
1317                         tmp = !tmp;
1318                         REXEC_FBC_TRYIT;
1319                 }
1320                 );
1321             }
1322             if ((!prog->minlen && tmp) && (!reginfo || regtry(reginfo, &s)))
1323                 goto got_it;
1324             break;
1325         case NBOUNDL:
1326             PL_reg_flags |= RF_tainted;
1327             /* FALL THROUGH */
1328         case NBOUND:
1329             if (do_utf8) {
1330                 if (s == PL_bostr)
1331                     tmp = '\n';
1332                 else {
1333                     U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);
1334                     tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, UTF8_ALLOW_DEFAULT);
1335                 }
1336                 tmp = ((OP(c) == NBOUND ?
1337                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1338                 LOAD_UTF8_CHARCLASS_ALNUM();
1339                 REXEC_FBC_UTF8_SCAN(
1340                     if (tmp == !(OP(c) == NBOUND ?
1341                                  (bool)swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1342                                  isALNUM_LC_utf8((U8*)s)))
1343                         tmp = !tmp;
1344                     else REXEC_FBC_TRYIT;
1345                 );
1346             }
1347             else {
1348                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1349                 tmp = ((OP(c) == NBOUND ?
1350                         isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1351                 REXEC_FBC_SCAN(
1352                     if (tmp ==
1353                         !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
1354                         tmp = !tmp;
1355                     else REXEC_FBC_TRYIT;
1356                 );
1357             }
1358             if ((!prog->minlen && !tmp) && (!reginfo || regtry(reginfo, &s)))
1359                 goto got_it;
1360             break;
1361         case ALNUM:
1362             REXEC_FBC_CSCAN_PRELOAD(
1363                 LOAD_UTF8_CHARCLASS_ALNUM(),
1364                 swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8),
1365                 isALNUM(*s)
1366             );
1367         case ALNUML:
1368             REXEC_FBC_CSCAN_TAINT(
1369                 isALNUM_LC_utf8((U8*)s),
1370                 isALNUM_LC(*s)
1371             );
1372         case NALNUM:
1373             REXEC_FBC_CSCAN_PRELOAD(
1374                 LOAD_UTF8_CHARCLASS_ALNUM(),
1375                 !swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8),
1376                 !isALNUM(*s)
1377             );
1378         case NALNUML:
1379             REXEC_FBC_CSCAN_TAINT(
1380                 !isALNUM_LC_utf8((U8*)s),
1381                 !isALNUM_LC(*s)
1382             );
1383         case SPACE:
1384             REXEC_FBC_CSCAN_PRELOAD(
1385                 LOAD_UTF8_CHARCLASS_SPACE(),
1386                 *s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8),
1387                 isSPACE(*s)
1388             );
1389         case SPACEL:
1390             REXEC_FBC_CSCAN_TAINT(
1391                 *s == ' ' || isSPACE_LC_utf8((U8*)s),
1392                 isSPACE_LC(*s)
1393             );
1394         case NSPACE:
1395             REXEC_FBC_CSCAN_PRELOAD(
1396                 LOAD_UTF8_CHARCLASS_SPACE(),
1397                 !(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8)),
1398                 !isSPACE(*s)
1399             );
1400         case NSPACEL:
1401             REXEC_FBC_CSCAN_TAINT(
1402                 !(*s == ' ' || isSPACE_LC_utf8((U8*)s)),
1403                 !isSPACE_LC(*s)
1404             );
1405         case DIGIT:
1406             REXEC_FBC_CSCAN_PRELOAD(
1407                 LOAD_UTF8_CHARCLASS_DIGIT(),
1408                 swash_fetch(PL_utf8_digit,(U8*)s, do_utf8),
1409                 isDIGIT(*s)
1410             );
1411         case DIGITL:
1412             REXEC_FBC_CSCAN_TAINT(
1413                 isDIGIT_LC_utf8((U8*)s),
1414                 isDIGIT_LC(*s)
1415             );
1416         case NDIGIT:
1417             REXEC_FBC_CSCAN_PRELOAD(
1418                 LOAD_UTF8_CHARCLASS_DIGIT(),
1419                 !swash_fetch(PL_utf8_digit,(U8*)s, do_utf8),
1420                 !isDIGIT(*s)
1421             );
1422         case NDIGITL:
1423             REXEC_FBC_CSCAN_TAINT(
1424                 !isDIGIT_LC_utf8((U8*)s),
1425                 !isDIGIT_LC(*s)
1426             );
1427         case AHOCORASICKC:
1428         case AHOCORASICK:
1429             {
1430                 const enum { trie_plain, trie_utf8, trie_utf8_fold }
1431                     trie_type = do_utf8 ?
1432                           (c->flags == EXACT ? trie_utf8 : trie_utf8_fold)
1433                         : trie_plain;
1434                 /* what trie are we using right now */
1435                 reg_ac_data *aho
1436                     = (reg_ac_data*)progi->data->data[ ARG( c ) ];
1437                 reg_trie_data *trie
1438                     = (reg_trie_data*)progi->data->data[ aho->trie ];
1439                 HV *widecharmap = (HV*) progi->data->data[ aho->trie + 1 ];
1440
1441                 const char *last_start = strend - trie->minlen;
1442 #ifdef DEBUGGING
1443                 const char *real_start = s;
1444 #endif
1445                 STRLEN maxlen = trie->maxlen;
1446                 SV *sv_points;
1447                 U8 **points; /* map of where we were in the input string
1448                                 when reading a given char. For ASCII this
1449                                 is unnecessary overhead as the relationship
1450                                 is always 1:1, but for unicode, especially
1451                                 case folded unicode this is not true. */
1452                 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1453                 U8 *bitmap=NULL;
1454
1455
1456                 GET_RE_DEBUG_FLAGS_DECL;
1457
1458                 /* We can't just allocate points here. We need to wrap it in
1459                  * an SV so it gets freed properly if there is a croak while
1460                  * running the match */
1461                 ENTER;
1462                 SAVETMPS;
1463                 sv_points=newSV(maxlen * sizeof(U8 *));
1464                 SvCUR_set(sv_points,
1465                     maxlen * sizeof(U8 *));
1466                 SvPOK_on(sv_points);
1467                 sv_2mortal(sv_points);
1468                 points=(U8**)SvPV_nolen(sv_points );
1469                 if ( trie_type != trie_utf8_fold
1470                      && (trie->bitmap || OP(c)==AHOCORASICKC) )
1471                 {
1472                     if (trie->bitmap)
1473                         bitmap=(U8*)trie->bitmap;
1474                     else
1475                         bitmap=(U8*)ANYOF_BITMAP(c);
1476                 }
1477                 /* this is the Aho-Corasick algorithm modified a touch
1478                    to include special handling for long "unknown char"
1479                    sequences. The basic idea being that we use AC as long
1480                    as we are dealing with a possible matching char, when
1481                    we encounter an unknown char (and we have not encountered
1482                    an accepting state) we scan forward until we find a legal
1483                    starting char.
1484                    AC matching is basically that of trie matching, except
1485                    that when we encounter a failing transition, we fall back
1486                    to the current states "fail state", and try the current char
1487                    again, a process we repeat until we reach the root state,
1488                    state 1, or a legal transition. If we fail on the root state
1489                    then we can either terminate if we have reached an accepting
1490                    state previously, or restart the entire process from the beginning
1491                    if we have not.
1492
1493                  */
1494                 while (s <= last_start) {
1495                     const U32 uniflags = UTF8_ALLOW_DEFAULT;
1496                     U8 *uc = (U8*)s;
1497                     U16 charid = 0;
1498                     U32 base = 1;
1499                     U32 state = 1;
1500                     UV uvc = 0;
1501                     STRLEN len = 0;
1502                     STRLEN foldlen = 0;
1503                     U8 *uscan = (U8*)NULL;
1504                     U8 *leftmost = NULL;
1505 #ifdef DEBUGGING
1506                     U32 accepted_word= 0;
1507 #endif
1508                     U32 pointpos = 0;
1509
1510                     while ( state && uc <= (U8*)strend ) {
1511                         int failed=0;
1512                         U32 word = aho->states[ state ].wordnum;
1513
1514                         if( state==1 ) {
1515                             if ( bitmap ) {
1516                                 DEBUG_TRIE_EXECUTE_r(
1517                                     if ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
1518                                         dump_exec_pos( (char *)uc, c, strend, real_start,
1519                                             (char *)uc, do_utf8 );
1520                                         PerlIO_printf( Perl_debug_log,
1521                                             " Scanning for legal start char...\n");
1522                                     }
1523                                 );
1524                                 while ( uc <= (U8*)last_start  && !BITMAP_TEST(bitmap,*uc) ) {
1525                                     uc++;
1526                                 }
1527                                 s= (char *)uc;
1528                             }
1529                             if (uc >(U8*)last_start) break;
1530                         }
1531
1532                         if ( word ) {
1533                             U8 *lpos= points[ (pointpos - trie->wordlen[word-1] ) % maxlen ];
1534                             if (!leftmost || lpos < leftmost) {
1535                                 DEBUG_r(accepted_word=word);
1536                                 leftmost= lpos;
1537                             }
1538                             if (base==0) break;
1539
1540                         }
1541                         points[pointpos++ % maxlen]= uc;
1542                         REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc,
1543                                              uscan, len, uvc, charid, foldlen,
1544                                              foldbuf, uniflags);
1545                         DEBUG_TRIE_EXECUTE_r({
1546                             dump_exec_pos( (char *)uc, c, strend, real_start,
1547                                 s,   do_utf8 );
1548                             PerlIO_printf(Perl_debug_log,
1549                                 " Charid:%3u CP:%4"UVxf" ",
1550                                  charid, uvc);
1551                         });
1552
1553                         do {
1554 #ifdef DEBUGGING
1555                             word = aho->states[ state ].wordnum;
1556 #endif
1557                             base = aho->states[ state ].trans.base;
1558
1559                             DEBUG_TRIE_EXECUTE_r({
1560                                 if (failed)
1561                                     dump_exec_pos( (char *)uc, c, strend, real_start,
1562                                         s,   do_utf8 );
1563                                 PerlIO_printf( Perl_debug_log,
1564                                     "%sState: %4"UVxf", word=%"UVxf,
1565                                     failed ? " Fail transition to " : "",
1566                                     (UV)state, (UV)word);
1567                             });
1568                             if ( base ) {
1569                                 U32 tmp;
1570                                 if (charid &&
1571                                      (base + charid > trie->uniquecharcount )
1572                                      && (base + charid - 1 - trie->uniquecharcount
1573                                             < trie->lasttrans)
1574                                      && trie->trans[base + charid - 1 -
1575                                             trie->uniquecharcount].check == state
1576                                      && (tmp=trie->trans[base + charid - 1 -
1577                                         trie->uniquecharcount ].next))
1578                                 {
1579                                     DEBUG_TRIE_EXECUTE_r(
1580                                         PerlIO_printf( Perl_debug_log," - legal\n"));
1581                                     state = tmp;
1582                                     break;
1583                                 }
1584                                 else {
1585                                     DEBUG_TRIE_EXECUTE_r(
1586                                         PerlIO_printf( Perl_debug_log," - fail\n"));
1587                                     failed = 1;
1588                                     state = aho->fail[state];
1589                                 }
1590                             }
1591                             else {
1592                                 /* we must be accepting here */
1593                                 DEBUG_TRIE_EXECUTE_r(
1594                                         PerlIO_printf( Perl_debug_log," - accepting\n"));
1595                                 failed = 1;
1596                                 break;
1597                             }
1598                         } while(state);
1599                         uc += len;
1600                         if (failed) {
1601                             if (leftmost)
1602                                 break;
1603                             if (!state) state = 1;
1604                         }
1605                     }
1606                     if ( aho->states[ state ].wordnum ) {
1607                         U8 *lpos = points[ (pointpos - trie->wordlen[aho->states[ state ].wordnum-1]) % maxlen ];
1608                         if (!leftmost || lpos < leftmost) {
1609                             DEBUG_r(accepted_word=aho->states[ state ].wordnum);
1610                             leftmost = lpos;
1611                         }
1612                     }
1613                     if (leftmost) {
1614                         s = (char*)leftmost;
1615                         DEBUG_TRIE_EXECUTE_r({
1616                             PerlIO_printf(
1617                                 Perl_debug_log,"Matches word #%"UVxf" at position %"IVdf". Trying full pattern...\n",
1618                                 (UV)accepted_word, (IV)(s - real_start)
1619                             );
1620                         });
1621                         if (!reginfo || regtry(reginfo, &s)) {
1622                             FREETMPS;
1623                             LEAVE;
1624                             goto got_it;
1625                         }
1626                         s = HOPc(s,1);
1627                         DEBUG_TRIE_EXECUTE_r({
1628                             PerlIO_printf( Perl_debug_log,"Pattern failed. Looking for new start point...\n");
1629                         });
1630                     } else {
1631                         DEBUG_TRIE_EXECUTE_r(
1632                             PerlIO_printf( Perl_debug_log,"No match.\n"));
1633                         break;
1634                     }
1635                 }
1636                 FREETMPS;
1637                 LEAVE;
1638             }
1639             break;
1640         default:
1641             Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
1642             break;
1643         }
1644         return 0;
1645       got_it:
1646         return s;
1647 }
1648
1649 void
1650 S_swap_match_buff (pTHX_ regexp *prog) {
1651     I32 *t;
1652     RXi_GET_DECL(prog,progi);
1653
1654     if (!progi->swap) {
1655     /* We have to be careful. If the previous successful match
1656        was from this regex we don't want a subsequent paritally
1657        successful match to clobber the old results.
1658        So when we detect this possibility we add a swap buffer
1659        to the re, and switch the buffer each match. If we fail
1660        we switch it back, otherwise we leave it swapped.
1661     */
1662         Newxz(progi->swap, 1, regexp_paren_ofs);
1663         /* no need to copy these */
1664         Newxz(progi->swap->startp, prog->nparens + 1, I32);
1665         Newxz(progi->swap->endp, prog->nparens + 1, I32);
1666     }
1667     t = progi->swap->startp;
1668     progi->swap->startp = prog->startp;
1669     prog->startp = t;
1670     t = progi->swap->endp;
1671     progi->swap->endp = prog->endp;
1672     prog->endp = t;
1673 }
1674
1675
1676 /*
1677  - regexec_flags - match a regexp against a string
1678  */
1679 I32
1680 Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *strend,
1681               char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
1682 /* strend: pointer to null at end of string */
1683 /* strbeg: real beginning of string */
1684 /* minend: end of match must be >=minend after stringarg. */
1685 /* data: May be used for some additional optimizations.
1686          Currently its only used, with a U32 cast, for transmitting
1687          the ganch offset when doing a /g match. This will change */
1688 /* nosave: For optimizations. */
1689 {
1690     dVAR;
1691     /*register*/ char *s;
1692     register regnode *c;
1693     /*register*/ char *startpos = stringarg;
1694     I32 minlen;         /* must match at least this many chars */
1695     I32 dontbother = 0; /* how many characters not to try at end */
1696     I32 end_shift = 0;                  /* Same for the end. */         /* CC */
1697     I32 scream_pos = -1;                /* Internal iterator of scream. */
1698     char *scream_olds = NULL;
1699     SV* const oreplsv = GvSV(PL_replgv);
1700     const bool do_utf8 = (bool)DO_UTF8(sv);
1701     I32 multiline;
1702     RXi_GET_DECL(prog,progi);
1703     regmatch_info reginfo;  /* create some info to pass to regtry etc */
1704     bool swap_on_fail = 0;
1705
1706     GET_RE_DEBUG_FLAGS_DECL;
1707
1708     PERL_UNUSED_ARG(data);
1709
1710     /* Be paranoid... */
1711     if (prog == NULL || startpos == NULL) {
1712         Perl_croak(aTHX_ "NULL regexp parameter");
1713         return 0;
1714     }
1715
1716     multiline = prog->extflags & RXf_PMf_MULTILINE;
1717     reginfo.prog = prog;
1718
1719     RX_MATCH_UTF8_set(prog, do_utf8);
1720     DEBUG_EXECUTE_r(
1721         debug_start_match(prog, do_utf8, startpos, strend,
1722         "Matching");
1723     );
1724
1725     minlen = prog->minlen;
1726
1727     if (strend - startpos < (minlen+(prog->check_offset_min<0?prog->check_offset_min:0))) {
1728         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
1729                               "String too short [regexec_flags]...\n"));
1730         goto phooey;
1731     }
1732
1733
1734     /* Check validity of program. */
1735     if (UCHARAT(progi->program) != REG_MAGIC) {
1736         Perl_croak(aTHX_ "corrupted regexp program");
1737     }
1738
1739     PL_reg_flags = 0;
1740     PL_reg_eval_set = 0;
1741     PL_reg_maxiter = 0;
1742
1743     if (prog->extflags & RXf_UTF8)
1744         PL_reg_flags |= RF_utf8;
1745
1746     /* Mark beginning of line for ^ and lookbehind. */
1747     reginfo.bol = startpos; /* XXX not used ??? */
1748     PL_bostr  = strbeg;
1749     reginfo.sv = sv;
1750
1751     /* Mark end of line for $ (and such) */
1752     PL_regeol = strend;
1753
1754     /* see how far we have to get to not match where we matched before */
1755     reginfo.till = startpos+minend;
1756
1757     /* If there is a "must appear" string, look for it. */
1758     s = startpos;
1759
1760     if (prog->extflags & RXf_GPOS_SEEN) { /* Need to set reginfo->ganch */
1761         MAGIC *mg;
1762
1763         if (flags & REXEC_IGNOREPOS)    /* Means: check only at start */
1764             reginfo.ganch = startpos + prog->gofs;
1765         else if (sv && SvTYPE(sv) >= SVt_PVMG
1766                   && SvMAGIC(sv)
1767                   && (mg = mg_find(sv, PERL_MAGIC_regex_global))
1768                   && mg->mg_len >= 0) {
1769             reginfo.ganch = strbeg + mg->mg_len;        /* Defined pos() */
1770             if (prog->extflags & RXf_ANCH_GPOS) {
1771                 if (s > reginfo.ganch)
1772                     goto phooey;
1773                 s = reginfo.ganch - prog->gofs;
1774             }
1775         }
1776         else if (data) {
1777             reginfo.ganch = strbeg + PTR2UV(data);
1778         } else                          /* pos() not defined */
1779             reginfo.ganch = strbeg;
1780     }
1781     if (PL_curpm && (PM_GETRE(PL_curpm) == prog)) {
1782         swap_on_fail = 1;
1783         swap_match_buff(prog); /* do we need a save destructor here for
1784                                   eval dies? */
1785     }
1786     if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) {
1787         re_scream_pos_data d;
1788
1789         d.scream_olds = &scream_olds;
1790         d.scream_pos = &scream_pos;
1791         s = re_intuit_start(prog, sv, s, strend, flags, &d);
1792         if (!s) {
1793             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
1794             goto phooey;        /* not present */
1795         }
1796     }
1797
1798
1799
1800     /* Simplest case:  anchored match need be tried only once. */
1801     /*  [unless only anchor is BOL and multiline is set] */
1802     if (prog->extflags & (RXf_ANCH & ~RXf_ANCH_GPOS)) {
1803         if (s == startpos && regtry(&reginfo, &startpos))
1804             goto got_it;
1805         else if (multiline || (prog->intflags & PREGf_IMPLICIT)
1806                  || (prog->extflags & RXf_ANCH_MBOL)) /* XXXX SBOL? */
1807         {
1808             char *end;
1809
1810             if (minlen)
1811                 dontbother = minlen - 1;
1812             end = HOP3c(strend, -dontbother, strbeg) - 1;
1813             /* for multiline we only have to try after newlines */
1814             if (prog->check_substr || prog->check_utf8) {
1815                 if (s == startpos)
1816                     goto after_try;
1817                 while (1) {
1818                     if (regtry(&reginfo, &s))
1819                         goto got_it;
1820                   after_try:
1821                     if (s >= end)
1822                         goto phooey;
1823                     if (prog->extflags & RXf_USE_INTUIT) {
1824                         s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
1825                         if (!s)
1826                             goto phooey;
1827                     }
1828                     else
1829                         s++;
1830                 }
1831             } else {
1832                 if (s > startpos)
1833                     s--;
1834                 while (s < end) {
1835                     if (*s++ == '\n') { /* don't need PL_utf8skip here */
1836                         if (regtry(&reginfo, &s))
1837                             goto got_it;
1838                     }
1839                 }
1840             }
1841         }
1842         goto phooey;
1843     } else if (RXf_GPOS_CHECK == (prog->extflags & RXf_GPOS_CHECK))
1844     {
1845         /* the warning about reginfo.ganch being used without intialization
1846            is bogus -- we set it above, when prog->extflags & RXf_GPOS_SEEN
1847            and we only enter this block when the same bit is set. */
1848         char *tmp_s = reginfo.ganch - prog->gofs;
1849         if (regtry(&reginfo, &tmp_s))
1850             goto got_it;
1851         goto phooey;
1852     }
1853
1854     /* Messy cases:  unanchored match. */
1855     if ((prog->anchored_substr || prog->anchored_utf8) && prog->intflags & PREGf_SKIP) {
1856         /* we have /x+whatever/ */
1857         /* it must be a one character string (XXXX Except UTF?) */
1858         char ch;
1859 #ifdef DEBUGGING
1860         int did_match = 0;
1861 #endif
1862         if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1863             do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1864         ch = SvPVX_const(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr)[0];
1865
1866         if (do_utf8) {
1867             REXEC_FBC_SCAN(
1868                 if (*s == ch) {
1869                     DEBUG_EXECUTE_r( did_match = 1 );
1870                     if (regtry(&reginfo, &s)) goto got_it;
1871                     s += UTF8SKIP(s);
1872                     while (s < strend && *s == ch)
1873                         s += UTF8SKIP(s);
1874                 }
1875             );
1876         }
1877         else {
1878             REXEC_FBC_SCAN(
1879                 if (*s == ch) {
1880                     DEBUG_EXECUTE_r( did_match = 1 );
1881                     if (regtry(&reginfo, &s)) goto got_it;
1882                     s++;
1883                     while (s < strend && *s == ch)
1884                         s++;
1885                 }
1886             );
1887         }
1888         DEBUG_EXECUTE_r(if (!did_match)
1889                 PerlIO_printf(Perl_debug_log,
1890                                   "Did not find anchored character...\n")
1891                );
1892     }
1893     else if (prog->anchored_substr != NULL
1894               || prog->anchored_utf8 != NULL
1895               || ((prog->float_substr != NULL || prog->float_utf8 != NULL)
1896                   && prog->float_max_offset < strend - s)) {
1897         SV *must;
1898         I32 back_max;
1899         I32 back_min;
1900         char *last;
1901         char *last1;            /* Last position checked before */
1902 #ifdef DEBUGGING
1903         int did_match = 0;
1904 #endif
1905         if (prog->anchored_substr || prog->anchored_utf8) {
1906             if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1907                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1908             must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
1909             back_max = back_min = prog->anchored_offset;
1910         } else {
1911             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
1912                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1913             must = do_utf8 ? prog->float_utf8 : prog->float_substr;
1914             back_max = prog->float_max_offset;
1915             back_min = prog->float_min_offset;
1916         }
1917
1918
1919         if (must == &PL_sv_undef)
1920             /* could not downgrade utf8 check substring, so must fail */
1921             goto phooey;
1922
1923         if (back_min<0) {
1924             last = strend;
1925         } else {
1926             last = HOP3c(strend,        /* Cannot start after this */
1927                   -(I32)(CHR_SVLEN(must)
1928                          - (SvTAIL(must) != 0) + back_min), strbeg);
1929         }
1930         if (s > PL_bostr)
1931             last1 = HOPc(s, -1);
1932         else
1933             last1 = s - 1;      /* bogus */
1934
1935         /* XXXX check_substr already used to find "s", can optimize if
1936            check_substr==must. */
1937         scream_pos = -1;
1938         dontbother = end_shift;
1939         strend = HOPc(strend, -dontbother);
1940         while ( (s <= last) &&
1941                 ((flags & REXEC_SCREAM)
1942                  ? (s = screaminstr(sv, must, HOP3c(s, back_min, (back_min<0 ? strbeg : strend)) - strbeg,
1943                                     end_shift, &scream_pos, 0))
1944                  : (s = fbm_instr((unsigned char*)HOP3(s, back_min, (back_min<0 ? strbeg : strend)),
1945                                   (unsigned char*)strend, must,
1946                                   multiline ? FBMrf_MULTILINE : 0))) ) {
1947             /* we may be pointing at the wrong string */
1948             if ((flags & REXEC_SCREAM) && RX_MATCH_COPIED(prog))
1949                 s = strbeg + (s - SvPVX_const(sv));
1950             DEBUG_EXECUTE_r( did_match = 1 );
1951             if (HOPc(s, -back_max) > last1) {
1952                 last1 = HOPc(s, -back_min);
1953                 s = HOPc(s, -back_max);
1954             }
1955             else {
1956                 char * const t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
1957
1958                 last1 = HOPc(s, -back_min);
1959                 s = t;
1960             }
1961             if (do_utf8) {
1962                 while (s <= last1) {
1963                     if (regtry(&reginfo, &s))
1964                         goto got_it;
1965                     s += UTF8SKIP(s);
1966                 }
1967             }
1968             else {
1969                 while (s <= last1) {
1970                     if (regtry(&reginfo, &s))
1971                         goto got_it;
1972                     s++;
1973                 }
1974             }
1975         }
1976         DEBUG_EXECUTE_r(if (!did_match) {
1977             RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0),
1978                 SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
1979             PerlIO_printf(Perl_debug_log, "Did not find %s substr %s%s...\n",
1980                               ((must == prog->anchored_substr || must == prog->anchored_utf8)
1981                                ? "anchored" : "floating"),
1982                 quoted, RE_SV_TAIL(must));
1983         });
1984         goto phooey;
1985     }
1986     else if ( (c = progi->regstclass) ) {
1987         if (minlen) {
1988             const OPCODE op = OP(progi->regstclass);
1989             /* don't bother with what can't match */
1990             if (PL_regkind[op] != EXACT && op != CANY && PL_regkind[op] != TRIE)
1991                 strend = HOPc(strend, -(minlen - 1));
1992         }
1993         DEBUG_EXECUTE_r({
1994             SV * const prop = sv_newmortal();
1995             regprop(prog, prop, c);
1996             {
1997                 RE_PV_QUOTED_DECL(quoted,UTF,PERL_DEBUG_PAD_ZERO(1),
1998                     s,strend-s,60);
1999                 PerlIO_printf(Perl_debug_log,
2000                     "Matching stclass %.*s against %s (%d chars)\n",
2001                     (int)SvCUR(prop), SvPVX_const(prop),
2002                      quoted, (int)(strend - s));
2003             }
2004         });
2005         if (find_byclass(prog, c, s, strend, &reginfo))
2006             goto got_it;
2007         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass... [regexec_flags]\n"));
2008     }
2009     else {
2010         dontbother = 0;
2011         if (prog->float_substr != NULL || prog->float_utf8 != NULL) {
2012             /* Trim the end. */
2013             char *last;
2014             SV* float_real;
2015
2016             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
2017                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
2018             float_real = do_utf8 ? prog->float_utf8 : prog->float_substr;
2019
2020             if (flags & REXEC_SCREAM) {
2021                 last = screaminstr(sv, float_real, s - strbeg,
2022                                    end_shift, &scream_pos, 1); /* last one */
2023                 if (!last)
2024                     last = scream_olds; /* Only one occurrence. */
2025                 /* we may be pointing at the wrong string */
2026                 else if (RX_MATCH_COPIED(prog))
2027                     s = strbeg + (s - SvPVX_const(sv));
2028             }
2029             else {
2030                 STRLEN len;
2031                 const char * const little = SvPV_const(float_real, len);
2032
2033                 if (SvTAIL(float_real)) {
2034                     if (memEQ(strend - len + 1, little, len - 1))
2035                         last = strend - len + 1;
2036                     else if (!multiline)
2037                         last = memEQ(strend - len, little, len)
2038                             ? strend - len : NULL;
2039                     else
2040                         goto find_last;
2041                 } else {
2042                   find_last:
2043                     if (len)
2044                         last = rninstr(s, strend, little, little + len);
2045                     else
2046                         last = strend;  /* matching "$" */
2047                 }
2048             }
2049             if (last == NULL) {
2050                 DEBUG_EXECUTE_r(
2051                     PerlIO_printf(Perl_debug_log,
2052                         "%sCan't trim the tail, match fails (should not happen)%s\n",
2053                         PL_colors[4], PL_colors[5]));
2054                 goto phooey; /* Should not happen! */
2055             }
2056             dontbother = strend - last + prog->float_min_offset;
2057         }
2058         if (minlen && (dontbother < minlen))
2059             dontbother = minlen - 1;
2060         strend -= dontbother;              /* this one's always in bytes! */
2061         /* We don't know much -- general case. */
2062         if (do_utf8) {
2063             for (;;) {
2064                 if (regtry(&reginfo, &s))
2065                     goto got_it;
2066                 if (s >= strend)
2067                     break;
2068                 s += UTF8SKIP(s);
2069             };
2070         }
2071         else {
2072             do {
2073                 if (regtry(&reginfo, &s))
2074                     goto got_it;
2075             } while (s++ < strend);
2076         }
2077     }
2078
2079     /* Failure. */
2080     goto phooey;
2081
2082 got_it:
2083     RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
2084
2085     if (PL_reg_eval_set) {
2086         /* Preserve the current value of $^R */
2087         if (oreplsv != GvSV(PL_replgv))
2088             sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
2089                                                   restored, the value remains
2090                                                   the same. */
2091         restore_pos(aTHX_ prog);
2092     }
2093     if (prog->paren_names)
2094         (void)hv_iterinit(prog->paren_names);
2095
2096     /* make sure $`, $&, $', and $digit will work later */
2097     if ( !(flags & REXEC_NOT_FIRST) ) {
2098         RX_MATCH_COPY_FREE(prog);
2099         if (flags & REXEC_COPY_STR) {
2100             const I32 i = PL_regeol - startpos + (stringarg - strbeg);
2101 #ifdef PERL_OLD_COPY_ON_WRITE
2102             if ((SvIsCOW(sv)
2103                  || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) {
2104                 if (DEBUG_C_TEST) {
2105                     PerlIO_printf(Perl_debug_log,
2106                                   "Copy on write: regexp capture, type %d\n",
2107                                   (int) SvTYPE(sv));
2108                 }
2109                 prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
2110                 prog->subbeg = (char *)SvPVX_const(prog->saved_copy);
2111                 assert (SvPOKp(prog->saved_copy));
2112             } else
2113 #endif
2114             {
2115                 RX_MATCH_COPIED_on(prog);
2116                 s = savepvn(strbeg, i);
2117                 prog->subbeg = s;
2118             }
2119             prog->sublen = i;
2120         }
2121         else {
2122             prog->subbeg = strbeg;
2123             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
2124         }
2125     }
2126
2127     return 1;
2128
2129 phooey:
2130     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
2131                           PL_colors[4], PL_colors[5]));
2132     if (PL_reg_eval_set)
2133         restore_pos(aTHX_ prog);
2134     if (swap_on_fail)
2135         /* we failed :-( roll it back */
2136         swap_match_buff(prog);
2137
2138     return 0;
2139 }
2140
2141
2142
2143
2144 /*
2145  - regtry - try match at specific point
2146  */
2147 STATIC I32                      /* 0 failure, 1 success */
2148 S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
2149 {
2150     dVAR;
2151     register I32 *sp;
2152     register I32 *ep;
2153     CHECKPOINT lastcp;
2154     regexp *prog = reginfo->prog;
2155     RXi_GET_DECL(prog,progi);
2156     GET_RE_DEBUG_FLAGS_DECL;
2157     reginfo->cutpoint=NULL;
2158
2159     if ((prog->extflags & RXf_EVAL_SEEN) && !PL_reg_eval_set) {
2160         MAGIC *mg;
2161
2162         PL_reg_eval_set = RS_init;
2163         DEBUG_EXECUTE_r(DEBUG_s(
2164             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %"IVdf"\n",
2165                           (IV)(PL_stack_sp - PL_stack_base));
2166             ));
2167         SAVESTACK_CXPOS();
2168         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
2169         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
2170         SAVETMPS;
2171         /* Apparently this is not needed, judging by wantarray. */
2172         /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
2173            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
2174
2175         if (reginfo->sv) {
2176             /* Make $_ available to executed code. */
2177             if (reginfo->sv != DEFSV) {
2178                 SAVE_DEFSV;
2179                 DEFSV = reginfo->sv;
2180             }
2181
2182             if (!(SvTYPE(reginfo->sv) >= SVt_PVMG && SvMAGIC(reginfo->sv)
2183                   && (mg = mg_find(reginfo->sv, PERL_MAGIC_regex_global)))) {
2184                 /* prepare for quick setting of pos */
2185 #ifdef PERL_OLD_COPY_ON_WRITE
2186                 if (SvIsCOW(reginfo->sv))
2187                     sv_force_normal_flags(reginfo->sv, 0);
2188 #endif
2189                 mg = sv_magicext(reginfo->sv, NULL, PERL_MAGIC_regex_global,
2190                                  &PL_vtbl_mglob, NULL, 0);
2191                 mg->mg_len = -1;
2192             }
2193             PL_reg_magic    = mg;
2194             PL_reg_oldpos   = mg->mg_len;
2195             SAVEDESTRUCTOR_X(restore_pos, prog);
2196         }
2197         if (!PL_reg_curpm) {
2198             Newxz(PL_reg_curpm, 1, PMOP);
2199 #ifdef USE_ITHREADS
2200             {
2201                 SV* const repointer = newSViv(0);
2202                 /* so we know which PL_regex_padav element is PL_reg_curpm */
2203                 SvFLAGS(repointer) |= SVf_BREAK;
2204                 av_push(PL_regex_padav,repointer);
2205                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
2206                 PL_regex_pad = AvARRAY(PL_regex_padav);
2207             }
2208 #endif
2209         }
2210         PM_SETRE(PL_reg_curpm, prog);
2211         PL_reg_oldcurpm = PL_curpm;
2212         PL_curpm = PL_reg_curpm;
2213         if (RX_MATCH_COPIED(prog)) {
2214             /*  Here is a serious problem: we cannot rewrite subbeg,
2215                 since it may be needed if this match fails.  Thus
2216                 $` inside (?{}) could fail... */
2217             PL_reg_oldsaved = prog->subbeg;
2218             PL_reg_oldsavedlen = prog->sublen;
2219 #ifdef PERL_OLD_COPY_ON_WRITE
2220             PL_nrs = prog->saved_copy;
2221 #endif
2222             RX_MATCH_COPIED_off(prog);
2223         }
2224         else
2225             PL_reg_oldsaved = NULL;
2226         prog->subbeg = PL_bostr;
2227         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
2228     }
2229     DEBUG_EXECUTE_r(PL_reg_starttry = *startpos);
2230     prog->startp[0] = *startpos - PL_bostr;
2231     PL_reginput = *startpos;
2232     PL_reglastparen = &prog->lastparen;
2233     PL_reglastcloseparen = &prog->lastcloseparen;
2234     prog->lastparen = 0;
2235     prog->lastcloseparen = 0;
2236     PL_regsize = 0;
2237     PL_regstartp = prog->startp;
2238     PL_regendp = prog->endp;
2239     if (PL_reg_start_tmpl <= prog->nparens) {
2240         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
2241         if(PL_reg_start_tmp)
2242             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2243         else
2244             Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2245     }
2246
2247     /* XXXX What this code is doing here?!!!  There should be no need
2248        to do this again and again, PL_reglastparen should take care of
2249        this!  --ilya*/
2250
2251     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
2252      * Actually, the code in regcppop() (which Ilya may be meaning by
2253      * PL_reglastparen), is not needed at all by the test suite
2254      * (op/regexp, op/pat, op/split), but that code is needed, oddly
2255      * enough, for building DynaLoader, or otherwise this
2256      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
2257      * will happen.  Meanwhile, this code *is* needed for the
2258      * above-mentioned test suite tests to succeed.  The common theme
2259      * on those tests seems to be returning null fields from matches.
2260      * --jhi */
2261 #if 1
2262     sp = PL_regstartp;
2263     ep = PL_regendp;
2264     if (prog->nparens) {
2265         register I32 i;
2266         for (i = prog->nparens; i > (I32)*PL_reglastparen; i--) {
2267             *++sp = -1;
2268             *++ep = -1;
2269         }
2270     }
2271 #endif
2272     REGCP_SET(lastcp);
2273     if (regmatch(reginfo, progi->program + 1)) {
2274         PL_regendp[0] = PL_reginput - PL_bostr;
2275         return 1;
2276     }
2277     if (reginfo->cutpoint)
2278         *startpos= reginfo->cutpoint;
2279     REGCP_UNWIND(lastcp);
2280     return 0;
2281 }
2282
2283
2284 #define sayYES goto yes
2285 #define sayNO goto no
2286 #define sayNO_SILENT goto no_silent
2287
2288 /* we dont use STMT_START/END here because it leads to
2289    "unreachable code" warnings, which are bogus, but distracting. */
2290 #define CACHEsayNO \
2291     if (ST.cache_mask) \
2292        PL_reg_poscache[ST.cache_offset] |= ST.cache_mask; \
2293     sayNO
2294
2295 /* this is used to determine how far from the left messages like
2296    'failed...' are printed. It should be set such that messages
2297    are inline with the regop output that created them.
2298 */
2299 #define REPORT_CODE_OFF 32
2300
2301
2302 /* Make sure there is a test for this +1 options in re_tests */
2303 #define TRIE_INITAL_ACCEPT_BUFFLEN 4;
2304
2305 #define CHRTEST_UNINIT -1001 /* c1/c2 haven't been calculated yet */
2306 #define CHRTEST_VOID   -1000 /* the c1/c2 "next char" test should be skipped */
2307
2308 #define SLAB_FIRST(s) (&(s)->states[0])
2309 #define SLAB_LAST(s)  (&(s)->states[PERL_REGMATCH_SLAB_SLOTS-1])
2310
2311 /* grab a new slab and return the first slot in it */
2312
2313 STATIC regmatch_state *
2314 S_push_slab(pTHX)
2315 {
2316 #if PERL_VERSION < 9
2317     dMY_CXT;
2318 #endif
2319     regmatch_slab *s = PL_regmatch_slab->next;
2320     if (!s) {
2321         Newx(s, 1, regmatch_slab);
2322         s->prev = PL_regmatch_slab;
2323         s->next = NULL;
2324         PL_regmatch_slab->next = s;
2325     }
2326     PL_regmatch_slab = s;
2327     return SLAB_FIRST(s);
2328 }
2329
2330
2331 /* push a new state then goto it */
2332
2333 #define PUSH_STATE_GOTO(state, node) \
2334     scan = node; \
2335     st->resume_state = state; \
2336     goto push_state;
2337
2338 /* push a new state with success backtracking, then goto it */
2339
2340 #define PUSH_YES_STATE_GOTO(state, node) \
2341     scan = node; \
2342     st->resume_state = state; \
2343     goto push_yes_state;
2344
2345
2346
2347 /*
2348
2349 regmatch() - main matching routine
2350
2351 This is basically one big switch statement in a loop. We execute an op,
2352 set 'next' to point the next op, and continue. If we come to a point which
2353 we may need to backtrack to on failure such as (A|B|C), we push a
2354 backtrack state onto the backtrack stack. On failure, we pop the top
2355 state, and re-enter the loop at the state indicated. If there are no more
2356 states to pop, we return failure.
2357
2358 Sometimes we also need to backtrack on success; for example /A+/, where
2359 after successfully matching one A, we need to go back and try to
2360 match another one; similarly for lookahead assertions: if the assertion
2361 completes successfully, we backtrack to the state just before the assertion
2362 and then carry on.  In these cases, the pushed state is marked as
2363 'backtrack on success too'. This marking is in fact done by a chain of
2364 pointers, each pointing to the previous 'yes' state. On success, we pop to
2365 the nearest yes state, discarding any intermediate failure-only states.
2366 Sometimes a yes state is pushed just to force some cleanup code to be
2367 called at the end of a successful match or submatch; e.g. (??{$re}) uses
2368 it to free the inner regex.
2369
2370 Note that failure backtracking rewinds the cursor position, while
2371 success backtracking leaves it alone.
2372
2373 A pattern is complete when the END op is executed, while a subpattern
2374 such as (?=foo) is complete when the SUCCESS op is executed. Both of these
2375 ops trigger the "pop to last yes state if any, otherwise return true"
2376 behaviour.
2377
2378 A common convention in this function is to use A and B to refer to the two
2379 subpatterns (or to the first nodes thereof) in patterns like /A*B/: so A is
2380 the subpattern to be matched possibly multiple times, while B is the entire
2381 rest of the pattern. Variable and state names reflect this convention.
2382
2383 The states in the main switch are the union of ops and failure/success of
2384 substates associated with with that op.  For example, IFMATCH is the op
2385 that does lookahead assertions /(?=A)B/ and so the IFMATCH state means
2386 'execute IFMATCH'; while IFMATCH_A is a state saying that we have just
2387 successfully matched A and IFMATCH_A_fail is a state saying that we have
2388 just failed to match A. Resume states always come in pairs. The backtrack
2389 state we push is marked as 'IFMATCH_A', but when that is popped, we resume
2390 at IFMATCH_A or IFMATCH_A_fail, depending on whether we are backtracking
2391 on success or failure.
2392
2393 The struct that holds a backtracking state is actually a big union, with
2394 one variant for each major type of op. The variable st points to the
2395 top-most backtrack struct. To make the code clearer, within each
2396 block of code we #define ST to alias the relevant union.
2397
2398 Here's a concrete example of a (vastly oversimplified) IFMATCH
2399 implementation:
2400
2401     switch (state) {
2402     ....
2403
2404 #define ST st->u.ifmatch
2405
2406     case IFMATCH: // we are executing the IFMATCH op, (?=A)B
2407         ST.foo = ...; // some state we wish to save
2408         ...
2409         // push a yes backtrack state with a resume value of
2410         // IFMATCH_A/IFMATCH_A_fail, then continue execution at the
2411         // first node of A:
2412         PUSH_YES_STATE_GOTO(IFMATCH_A, A);
2413         // NOTREACHED
2414
2415     case IFMATCH_A: // we have successfully executed A; now continue with B
2416         next = B;
2417         bar = ST.foo; // do something with the preserved value
2418         break;
2419
2420     case IFMATCH_A_fail: // A failed, so the assertion failed
2421         ...;   // do some housekeeping, then ...
2422         sayNO; // propagate the failure
2423
2424 #undef ST
2425
2426     ...
2427     }
2428
2429 For any old-timers reading this who are familiar with the old recursive
2430 approach, the code above is equivalent to:
2431
2432     case IFMATCH: // we are executing the IFMATCH op, (?=A)B
2433     {
2434         int foo = ...
2435         ...
2436         if (regmatch(A)) {
2437             next = B;
2438             bar = foo;
2439             break;
2440         }
2441         ...;   // do some housekeeping, then ...
2442         sayNO; // propagate the failure
2443     }
2444
2445 The topmost backtrack state, pointed to by st, is usually free. If you
2446 want to claim it, populate any ST.foo fields in it with values you wish to
2447 save, then do one of
2448
2449         PUSH_STATE_GOTO(resume_state, node);
2450         PUSH_YES_STATE_GOTO(resume_state, node);
2451
2452 which sets that backtrack state's resume value to 'resume_state', pushes a
2453 new free entry to the top of the backtrack stack, then goes to 'node'.
2454 On backtracking, the free slot is popped, and the saved state becomes the
2455 new free state. An ST.foo field in this new top state can be temporarily
2456 accessed to retrieve values, but once the main loop is re-entered, it
2457 becomes available for reuse.
2458
2459 Note that the depth of the backtrack stack constantly increases during the
2460 left-to-right execution of the pattern, rather than going up and down with
2461 the pattern nesting. For example the stack is at its maximum at Z at the
2462 end of the pattern, rather than at X in the following:
2463
2464     /(((X)+)+)+....(Y)+....Z/
2465
2466 The only exceptions to this are lookahead/behind assertions and the cut,
2467 (?>A), which pop all the backtrack states associated with A before
2468 continuing.
2469
2470 Bascktrack state structs are allocated in slabs of about 4K in size.
2471 PL_regmatch_state and st always point to the currently active state,
2472 and PL_regmatch_slab points to the slab currently containing
2473 PL_regmatch_state.  The first time regmatch() is called, the first slab is
2474 allocated, and is never freed until interpreter destruction. When the slab
2475 is full, a new one is allocated and chained to the end. At exit from
2476 regmatch(), slabs allocated since entry are freed.
2477
2478 */
2479
2480
2481 #define DEBUG_STATE_pp(pp)                                  \
2482     DEBUG_STATE_r({                                         \
2483         DUMP_EXEC_POS(locinput, scan, do_utf8);             \
2484         PerlIO_printf(Perl_debug_log,                       \
2485             "    %*s"pp" %s%s%s%s%s\n",                     \
2486             depth*2, "",                                    \
2487             reg_name[st->resume_state],                     \
2488             ((st==yes_state||st==mark_state) ? "[" : ""),   \
2489             ((st==yes_state) ? "Y" : ""),                   \
2490             ((st==mark_state) ? "M" : ""),                  \
2491             ((st==yes_state||st==mark_state) ? "]" : "")    \
2492         );                                                  \
2493     });
2494
2495
2496 #define REG_NODE_NUM(x) ((x) ? (int)((x)-prog) : -1)
2497
2498 #ifdef DEBUGGING
2499
2500 STATIC void
2501 S_debug_start_match(pTHX_ const regexp *prog, const bool do_utf8,
2502     const char *start, const char *end, const char *blurb)
2503 {
2504     const bool utf8_pat= prog->extflags & RXf_UTF8 ? 1 : 0;
2505     if (!PL_colorset)
2506             reginitcolors();
2507     {
2508         RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0),
2509             prog->precomp, prog->prelen, 60);
2510
2511         RE_PV_QUOTED_DECL(s1, do_utf8, PERL_DEBUG_PAD_ZERO(1),
2512             start, end - start, 60);
2513
2514         PerlIO_printf(Perl_debug_log,
2515             "%s%s REx%s %s against %s\n",
2516                        PL_colors[4], blurb, PL_colors[5], s0, s1);
2517
2518         if (do_utf8||utf8_pat)
2519             PerlIO_printf(Perl_debug_log, "UTF-8 %s%s%s...\n",
2520                 utf8_pat ? "pattern" : "",
2521                 utf8_pat && do_utf8 ? " and " : "",
2522                 do_utf8 ? "string" : ""
2523             );
2524     }
2525 }
2526
2527 STATIC void
2528 S_dump_exec_pos(pTHX_ const char *locinput,
2529                       const regnode *scan,
2530                       const char *loc_regeol,
2531                       const char *loc_bostr,
2532                       const char *loc_reg_starttry,
2533                       const bool do_utf8)
2534 {
2535     const int docolor = *PL_colors[0] || *PL_colors[2] || *PL_colors[4];
2536     const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
2537     int l = (loc_regeol - locinput) > taill ? taill : (loc_regeol - locinput);
2538     /* The part of the string before starttry has one color
2539        (pref0_len chars), between starttry and current
2540        position another one (pref_len - pref0_len chars),
2541        after the current position the third one.
2542        We assume that pref0_len <= pref_len, otherwise we
2543        decrease pref0_len.  */
2544     int pref_len = (locinput - loc_bostr) > (5 + taill) - l
2545         ? (5 + taill) - l : locinput - loc_bostr;
2546     int pref0_len;
2547
2548     while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
2549         pref_len++;
2550     pref0_len = pref_len  - (locinput - loc_reg_starttry);
2551     if (l + pref_len < (5 + taill) && l < loc_regeol - locinput)
2552         l = ( loc_regeol - locinput > (5 + taill) - pref_len
2553               ? (5 + taill) - pref_len : loc_regeol - locinput);
2554     while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
2555         l--;
2556     if (pref0_len < 0)
2557         pref0_len = 0;
2558     if (pref0_len > pref_len)
2559         pref0_len = pref_len;
2560     {
2561         const int is_uni = (do_utf8 && OP(scan) != CANY) ? 1 : 0;
2562
2563         RE_PV_COLOR_DECL(s0,len0,is_uni,PERL_DEBUG_PAD(0),
2564             (locinput - pref_len),pref0_len, 60, 4, 5);
2565
2566         RE_PV_COLOR_DECL(s1,len1,is_uni,PERL_DEBUG_PAD(1),
2567                     (locinput - pref_len + pref0_len),
2568                     pref_len - pref0_len, 60, 2, 3);
2569
2570         RE_PV_COLOR_DECL(s2,len2,is_uni,PERL_DEBUG_PAD(2),
2571                     locinput, loc_regeol - locinput, 10, 0, 1);
2572
2573         const STRLEN tlen=len0+len1+len2;
2574         PerlIO_printf(Perl_debug_log,
2575                     "%4"IVdf" <%.*s%.*s%s%.*s>%*s|",
2576                     (IV)(locinput - loc_bostr),
2577                     len0, s0,
2578                     len1, s1,
2579                     (docolor ? "" : "> <"),
2580                     len2, s2,
2581                     (int)(tlen > 19 ? 0 :  19 - tlen),
2582                     "");
2583     }
2584 }
2585
2586 #endif
2587
2588 /* reg_check_named_buff_matched()
2589  * Checks to see if a named buffer has matched. The data array of
2590  * buffer numbers corresponding to the buffer is expected to reside
2591  * in the regexp->data->data array in the slot stored in the ARG() of
2592  * node involved. Note that this routine doesn't actually care about the
2593  * name, that information is not preserved from compilation to execution.
2594  * Returns the index of the leftmost defined buffer with the given name
2595  * or 0 if non of the buffers matched.
2596  */
2597 STATIC I32
2598 S_reg_check_named_buff_matched(pTHX_ const regexp *rex, const regnode *scan) {
2599     I32 n;
2600     RXi_GET_DECL(rex,rexi);
2601     SV *sv_dat=(SV*)rexi->data->data[ ARG( scan ) ];
2602     I32 *nums=(I32*)SvPVX(sv_dat);
2603     for ( n=0; n<SvIVX(sv_dat); n++ ) {
2604         if ((I32)*PL_reglastparen >= nums[n] &&
2605             PL_regendp[nums[n]] != -1)
2606         {
2607             return nums[n];
2608         }
2609     }
2610     return 0;
2611 }
2612
2613 STATIC I32                      /* 0 failure, 1 success */
2614 S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
2615 {
2616 #if PERL_VERSION < 9
2617     dMY_CXT;
2618 #endif
2619     dVAR;
2620     register const bool do_utf8 = PL_reg_match_utf8;
2621     const U32 uniflags = UTF8_ALLOW_DEFAULT;
2622
2623     regexp *rex = reginfo->prog;
2624     RXi_GET_DECL(rex,rexi);
2625
2626     regmatch_slab  *orig_slab;
2627     regmatch_state *orig_state;
2628
2629     /* the current state. This is a cached copy of PL_regmatch_state */
2630     register regmatch_state *st;
2631
2632     /* cache heavy used fields of st in registers */
2633     register regnode *scan;
2634     register regnode *next;
2635     register U32 n = 0; /* general value; init to avoid compiler warning */
2636     register I32 ln = 0; /* len or last;  init to avoid compiler warning */
2637     register char *locinput = PL_reginput;
2638     register I32 nextchr;   /* is always set to UCHARAT(locinput) */
2639
2640     bool result = 0;        /* return value of S_regmatch */
2641     int depth = 0;          /* depth of backtrack stack */
2642     int nochange_depth = 0; /* depth of GOSUB recursion with nochange*/
2643     regmatch_state *yes_state = NULL; /* state to pop to on success of
2644                                                             subpattern */
2645     /* mark_state piggy backs on the yes_state logic so that when we unwind
2646        the stack on success we can update the mark_state as we go */
2647     regmatch_state *mark_state = NULL; /* last mark state we have seen */
2648
2649     regmatch_state *cur_eval = NULL; /* most recent EVAL_AB state */
2650     struct regmatch_state  *cur_curlyx = NULL; /* most recent curlyx */
2651     U32 state_num;
2652     bool no_final = 0;      /* prevent failure from backtracking? */
2653     bool do_cutgroup = 0;   /* no_final only until next branch/trie entry */
2654     char *startpoint = PL_reginput;
2655     SV *popmark = NULL;     /* are we looking for a mark? */
2656     SV *sv_commit = NULL;   /* last mark name seen in failure */
2657     SV *sv_yes_mark = NULL; /* last mark name we have seen
2658                                during a successfull match */
2659     U32 lastopen = 0;       /* last open we saw */
2660     bool has_cutgroup = RX_HAS_CUTGROUP(rex) ? 1 : 0;
2661
2662
2663     /* these three flags are set by various ops to signal information to
2664      * the very next op. They have a useful lifetime of exactly one loop
2665      * iteration, and are not preserved or restored by state pushes/pops
2666      */
2667     bool sw = 0;            /* the condition value in (?(cond)a|b) */
2668     bool minmod = 0;        /* the next "{n,m}" is a "{n,m}?" */
2669     int logical = 0;        /* the following EVAL is:
2670                                 0: (?{...})
2671                                 1: (?(?{...})X|Y)
2672                                 2: (??{...})
2673                                or the following IFMATCH/UNLESSM is:
2674                                 false: plain (?=foo)
2675                                 true:  used as a condition: (?(?=foo))
2676                             */
2677
2678 #ifdef DEBUGGING
2679     GET_RE_DEBUG_FLAGS_DECL;
2680 #endif
2681
2682     DEBUG_OPTIMISE_r( {
2683             PerlIO_printf(Perl_debug_log,"regmatch start\n");
2684     });
2685     /* on first ever call to regmatch, allocate first slab */
2686     if (!PL_regmatch_slab) {
2687         Newx(PL_regmatch_slab, 1, regmatch_slab);
2688         PL_regmatch_slab->prev = NULL;
2689         PL_regmatch_slab->next = NULL;
2690         PL_regmatch_state = SLAB_FIRST(PL_regmatch_slab);
2691     }
2692
2693     /* remember current high-water mark for exit */
2694     /* XXX this should be done with SAVE* instead */
2695     orig_slab  = PL_regmatch_slab;
2696     orig_state = PL_regmatch_state;
2697
2698     /* grab next free state slot */
2699     st = ++PL_regmatch_state;
2700     if (st >  SLAB_LAST(PL_regmatch_slab))
2701         st = PL_regmatch_state = S_push_slab(aTHX);
2702
2703     /* Note that nextchr is a byte even in UTF */
2704     nextchr = UCHARAT(locinput);
2705     scan = prog;
2706     while (scan != NULL) {
2707
2708         DEBUG_EXECUTE_r( {
2709             SV * const prop = sv_newmortal();
2710             regnode *rnext=regnext(scan);
2711             DUMP_EXEC_POS( locinput, scan, do_utf8 );
2712             regprop(rex, prop, scan);
2713
2714             PerlIO_printf(Perl_debug_log,
2715                     "%3"IVdf":%*s%s(%"IVdf")\n",
2716                     (IV)(scan - rexi->program), depth*2, "",
2717                     SvPVX_const(prop),
2718                     (PL_regkind[OP(scan)] == END || !rnext) ?
2719                         0 : (IV)(rnext - rexi->program));
2720         });
2721
2722         next = scan + NEXT_OFF(scan);
2723         if (next == scan)
2724             next = NULL;
2725         state_num = OP(scan);
2726
2727       reenter_switch:
2728         switch (state_num) {
2729         case BOL:
2730             if (locinput == PL_bostr)
2731             {
2732                 /* reginfo->till = reginfo->bol; */
2733                 break;
2734             }
2735             sayNO;
2736         case MBOL:
2737             if (locinput == PL_bostr ||
2738                 ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n'))
2739             {
2740                 break;
2741             }
2742             sayNO;
2743         case SBOL:
2744             if (locinput == PL_bostr)
2745                 break;
2746             sayNO;
2747         case GPOS:
2748             if (locinput == reginfo->ganch)
2749                 break;
2750             sayNO;
2751
2752         case KEEPS:
2753             /* update the startpoint */
2754             st->u.keeper.val = PL_regstartp[0];
2755             PL_reginput = locinput;
2756             PL_regstartp[0] = locinput - PL_bostr;
2757             PUSH_STATE_GOTO(KEEPS_next, next);
2758             /*NOT-REACHED*/
2759         case KEEPS_next_fail:
2760             /* rollback the start point change */
2761             PL_regstartp[0] = st->u.keeper.val;
2762             sayNO_SILENT;
2763             /*NOT-REACHED*/
2764         case EOL:
2765                 goto seol;
2766         case MEOL:
2767             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2768                 sayNO;
2769             break;
2770         case SEOL:
2771           seol:
2772             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2773                 sayNO;
2774             if (PL_regeol - locinput > 1)
2775                 sayNO;
2776             break;
2777         case EOS:
2778             if (PL_regeol != locinput)
2779                 sayNO;
2780             break;
2781         case SANY:
2782             if (!nextchr && locinput >= PL_regeol)
2783                 sayNO;
2784             if (do_utf8) {
2785                 locinput += PL_utf8skip[nextchr];
2786                 if (locinput > PL_regeol)
2787                     sayNO;
2788                 nextchr = UCHARAT(locinput);
2789             }
2790             else
2791                 nextchr = UCHARAT(++locinput);
2792             break;
2793         case CANY:
2794             if (!nextchr && locinput >= PL_regeol)
2795                 sayNO;
2796             nextchr = UCHARAT(++locinput);
2797             break;
2798         case REG_ANY:
2799             if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
2800                 sayNO;
2801             if (do_utf8) {
2802                 locinput += PL_utf8skip[nextchr];
2803                 if (locinput > PL_regeol)
2804                     sayNO;
2805                 nextchr = UCHARAT(locinput);
2806             }
2807             else
2808                 nextchr = UCHARAT(++locinput);
2809             break;
2810
2811 #undef  ST
2812 #define ST st->u.trie
2813         case TRIEC:
2814             /* In this case the charclass data is available inline so
2815                we can fail fast without a lot of extra overhead.
2816              */
2817             if (scan->flags == EXACT || !do_utf8) {
2818                 if(!ANYOF_BITMAP_TEST(scan, *locinput)) {
2819                     DEBUG_EXECUTE_r(
2820                         PerlIO_printf(Perl_debug_log,
2821                                   "%*s  %sfailed to match trie start class...%s\n",
2822                                   REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
2823                     );
2824                     sayNO_SILENT;
2825                     /* NOTREACHED */
2826                 }
2827             }
2828             /* FALL THROUGH */
2829         case TRIE:
2830             {
2831                 /* what type of TRIE am I? (utf8 makes this contextual) */
2832                 const enum { trie_plain, trie_utf8, trie_utf8_fold }
2833                     trie_type = do_utf8 ?
2834                           (scan->flags == EXACT ? trie_utf8 : trie_utf8_fold)
2835                         : trie_plain;
2836
2837                 /* what trie are we using right now */
2838                 reg_trie_data * const trie
2839                     = (reg_trie_data*)rexi->data->data[ ARG( scan ) ];
2840                 HV * widecharmap = (HV *)rexi->data->data[ ARG( scan ) + 1 ];
2841                 U32 state = trie->startstate;
2842
2843                 if (trie->bitmap && trie_type != trie_utf8_fold &&
2844                     !TRIE_BITMAP_TEST(trie,*locinput)
2845                 ) {
2846                     if (trie->states[ state ].wordnum) {
2847                          DEBUG_EXECUTE_r(
2848                             PerlIO_printf(Perl_debug_log,
2849                                           "%*s  %smatched empty string...%s\n",
2850                                           REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
2851                         );
2852                         break;
2853                     } else {
2854                         DEBUG_EXECUTE_r(
2855                             PerlIO_printf(Perl_debug_log,
2856                                           "%*s  %sfailed to match trie start class...%s\n",
2857                                           REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
2858                         );
2859                         sayNO_SILENT;
2860                    }
2861                 }
2862
2863             {
2864                 U8 *uc = ( U8* )locinput;
2865
2866                 STRLEN len = 0;
2867                 STRLEN foldlen = 0;
2868                 U8 *uscan = (U8*)NULL;
2869                 STRLEN bufflen=0;
2870                 SV *sv_accept_buff = NULL;
2871                 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
2872
2873                 ST.accepted = 0; /* how many accepting states we have seen */
2874                 ST.B = next;
2875                 ST.jump = trie->jump;
2876                 ST.me = scan;
2877                 /*
2878                    traverse the TRIE keeping track of all accepting states
2879                    we transition through until we get to a failing node.
2880                 */
2881
2882                 while ( state && uc <= (U8*)PL_regeol ) {
2883                     U32 base = trie->states[ state ].trans.base;
2884                     UV uvc = 0;
2885                     U16 charid;
2886                     /* We use charid to hold the wordnum as we don't use it
2887                        for charid until after we have done the wordnum logic.
2888                        We define an alias just so that the wordnum logic reads
2889                        more naturally. */
2890
2891 #define got_wordnum charid
2892                     got_wordnum = trie->states[ state ].wordnum;
2893
2894                     if ( got_wordnum ) {
2895                         if ( ! ST.accepted ) {
2896                             ENTER;
2897                             SAVETMPS;
2898                             bufflen = TRIE_INITAL_ACCEPT_BUFFLEN;
2899                             sv_accept_buff=newSV(bufflen *
2900                                             sizeof(reg_trie_accepted) - 1);
2901                             SvCUR_set(sv_accept_buff, 0);
2902                             SvPOK_on(sv_accept_buff);
2903                             sv_2mortal(sv_accept_buff);
2904                             SAVETMPS;
2905                             ST.accept_buff =
2906                                 (reg_trie_accepted*)SvPV_nolen(sv_accept_buff );
2907                         }
2908                         do {
2909                             if (ST.accepted >= bufflen) {
2910                                 bufflen *= 2;
2911                                 ST.accept_buff =(reg_trie_accepted*)
2912                                     SvGROW(sv_accept_buff,
2913                                         bufflen * sizeof(reg_trie_accepted));
2914                             }
2915                             SvCUR_set(sv_accept_buff,SvCUR(sv_accept_buff)
2916                                 + sizeof(reg_trie_accepted));
2917
2918
2919                             ST.accept_buff[ST.accepted].wordnum = got_wordnum;
2920                             ST.accept_buff[ST.accepted].endpos = uc;
2921                             ++ST.accepted;
2922                         } while (trie->nextword && (got_wordnum= trie->nextword[got_wordnum]));
2923                     }
2924 #undef got_wordnum
2925
2926                     DEBUG_TRIE_EXECUTE_r({
2927                                 DUMP_EXEC_POS( (char *)uc, scan, do_utf8 );
2928                                 PerlIO_printf( Perl_debug_log,
2929                                     "%*s  %sState: %4"UVxf" Accepted: %4"UVxf" ",
2930                                     2+depth * 2, "", PL_colors[4],
2931                                     (UV)state, (UV)ST.accepted );
2932                     });
2933
2934                     if ( base ) {
2935                         REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc,
2936                                              uscan, len, uvc, charid, foldlen,
2937                                              foldbuf, uniflags);
2938
2939                         if (charid &&
2940                              (base + charid > trie->uniquecharcount )
2941                              && (base + charid - 1 - trie->uniquecharcount
2942                                     < trie->lasttrans)
2943                              && trie->trans[base + charid - 1 -
2944                                     trie->uniquecharcount].check == state)
2945                         {
2946                             state = trie->trans[base + charid - 1 -
2947                                 trie->uniquecharcount ].next;
2948                         }
2949                         else {
2950                             state = 0;
2951                         }
2952                         uc += len;
2953
2954                     }
2955                     else {
2956                         state = 0;
2957                     }
2958                     DEBUG_TRIE_EXECUTE_r(
2959                         PerlIO_printf( Perl_debug_log,
2960                             "Charid:%3x CP:%4"UVxf" After State: %4"UVxf"%s\n",
2961                             charid, uvc, (UV)state, PL_colors[5] );
2962                     );
2963                 }
2964                 if (!ST.accepted )
2965                    sayNO;
2966
2967                 DEBUG_EXECUTE_r(
2968                     PerlIO_printf( Perl_debug_log,
2969                         "%*s  %sgot %"IVdf" possible matches%s\n",
2970                         REPORT_CODE_OFF + depth * 2, "",
2971                         PL_colors[4], (IV)ST.accepted, PL_colors[5] );
2972                 );
2973             }}
2974             goto trie_first_try; /* jump into the fail handler */
2975             /* NOTREACHED */
2976         case TRIE_next_fail: /* we failed - try next alterative */
2977             if ( ST.jump) {
2978                 REGCP_UNWIND(ST.cp);
2979                 for (n = *PL_reglastparen; n > ST.lastparen; n--)
2980                     PL_regendp[n] = -1;
2981                 *PL_reglastparen = n;
2982             }
2983           trie_first_try:
2984             if (do_cutgroup) {
2985                 do_cutgroup = 0;
2986                 no_final = 0;
2987             }
2988
2989             if ( ST.jump) {
2990                 ST.lastparen = *PL_reglastparen;
2991                 REGCP_SET(ST.cp);
2992             }
2993             if ( ST.accepted == 1 ) {
2994                 /* only one choice left - just continue */
2995                 DEBUG_EXECUTE_r({
2996                     AV *const trie_words
2997                         = (AV *) rexi->data->data[ARG(ST.me)+TRIE_WORDS_OFFSET];
2998                     SV ** const tmp = av_fetch( trie_words,
2999                         ST.accept_buff[ 0 ].wordnum-1, 0 );
3000                     SV *sv= tmp ? sv_newmortal() : NULL;
3001
3002                     PerlIO_printf( Perl_debug_log,
3003                         "%*s  %sonly one match left: #%d <%s>%s\n",
3004                         REPORT_CODE_OFF+depth*2, "", PL_colors[4],
3005                         ST.accept_buff[ 0 ].wordnum,
3006                         tmp ? pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 0,
3007                                 PL_colors[0], PL_colors[1],
3008                                 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)
3009                             )
3010                         : "not compiled under -Dr",
3011                         PL_colors[5] );
3012                 });
3013                 PL_reginput = (char *)ST.accept_buff[ 0 ].endpos;
3014                 /* in this case we free tmps/leave before we call regmatch
3015                    as we wont be using accept_buff again. */
3016
3017                 locinput = PL_reginput;
3018                 nextchr = UCHARAT(locinput);
3019                 if ( !ST.jump || !ST.jump[ST.accept_buff[0].wordnum])
3020                     scan = ST.B;
3021                 else
3022                     scan = ST.me + ST.jump[ST.accept_buff[0].wordnum];
3023                 if (!has_cutgroup) {
3024                     FREETMPS;
3025                     LEAVE;
3026                 } else {
3027                     ST.accepted--;
3028                     PUSH_YES_STATE_GOTO(TRIE_next, scan);
3029                 }
3030
3031                 continue; /* execute rest of RE */
3032             }
3033
3034             if ( !ST.accepted-- ) {
3035                 DEBUG_EXECUTE_r({
3036                     PerlIO_printf( Perl_debug_log,
3037                         "%*s  %sTRIE failed...%s\n",
3038                         REPORT_CODE_OFF+depth*2, "",
3039                         PL_colors[4],
3040                         PL_colors[5] );
3041                 });
3042                 FREETMPS;
3043                 LEAVE;
3044                 sayNO_SILENT;
3045                 /*NOTREACHED*/
3046             }
3047
3048             /*
3049                There are at least two accepting states left.  Presumably
3050                the number of accepting states is going to be low,
3051                typically two. So we simply scan through to find the one
3052                with lowest wordnum.  Once we find it, we swap the last
3053                state into its place and decrement the size. We then try to
3054                match the rest of the pattern at the point where the word
3055                ends. If we succeed, control just continues along the
3056                regex; if we fail we return here to try the next accepting
3057                state
3058              */
3059
3060             {
3061                 U32 best = 0;
3062                 U32 cur;
3063                 for( cur = 1 ; cur <= ST.accepted ; cur++ ) {
3064                     DEBUG_TRIE_EXECUTE_r(
3065                         PerlIO_printf( Perl_debug_log,
3066                             "%*s  %sgot %"IVdf" (%d) as best, looking at %"IVdf" (%d)%s\n",
3067                             REPORT_CODE_OFF + depth * 2, "", PL_colors[4],
3068                             (IV)best, ST.accept_buff[ best ].wordnum, (IV)cur,
3069                             ST.accept_buff[ cur ].wordnum, PL_colors[5] );
3070                     );
3071
3072                     if (ST.accept_buff[cur].wordnum <
3073                             ST.accept_buff[best].wordnum)
3074                         best = cur;
3075                 }
3076
3077                 DEBUG_EXECUTE_r({
3078                     AV *const trie_words
3079                         = (AV *) rexi->data->data[ARG(ST.me)+TRIE_WORDS_OFFSET];
3080                     SV ** const tmp = av_fetch( trie_words,
3081                         ST.accept_buff[ best ].wordnum - 1, 0 );
3082                     regnode *nextop=(!ST.jump || !ST.jump[ST.accept_buff[best].wordnum]) ?
3083                                     ST.B :
3084                                     ST.me + ST.jump[ST.accept_buff[best].wordnum];
3085                     SV *sv= tmp ? sv_newmortal() : NULL;
3086
3087                     PerlIO_printf( Perl_debug_log,
3088                         "%*s  %strying alternation #%d <%s> at node #%d %s\n",
3089                         REPORT_CODE_OFF+depth*2, "", PL_colors[4],
3090                         ST.accept_buff[best].wordnum,
3091                         tmp ? pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 0,
3092                                 PL_colors[0], PL_colors[1],
3093                                 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)
3094                             ) : "not compiled under -Dr",
3095                             REG_NODE_NUM(nextop),
3096                         PL_colors[5] );
3097                 });
3098
3099                 if ( best<ST.accepted ) {
3100                     reg_trie_accepted tmp = ST.accept_buff[ best ];
3101                     ST.accept_buff[ best ] = ST.accept_buff[ ST.accepted ];
3102                     ST.accept_buff[ ST.accepted ] = tmp;
3103                     best = ST.accepted;
3104                 }
3105                 PL_reginput = (char *)ST.accept_buff[ best ].endpos;
3106                 if ( !ST.jump || !ST.jump[ST.accept_buff[best].wordnum]) {
3107                     scan = ST.B;
3108                     /* NOTREACHED */
3109                 } else {
3110                     scan = ST.me + ST.jump[ST.accept_buff[best].wordnum];
3111                     /* NOTREACHED */
3112                 }
3113                 if (has_cutgroup) {
3114                     PUSH_YES_STATE_GOTO(TRIE_next, scan);
3115                     /* NOTREACHED */
3116                 } else {
3117                     PUSH_STATE_GOTO(TRIE_next, scan);
3118                     /* NOTREACHED */
3119                 }
3120                 /* NOTREACHED */
3121             }
3122             /* NOTREACHED */
3123         case TRIE_next:
3124             FREETMPS;
3125             LEAVE;
3126             sayYES;
3127 #undef  ST
3128
3129         case EXACT: {
3130             char *s = STRING(scan);
3131             ln = STR_LEN(scan);
3132             if (do_utf8 != UTF) {
3133                 /* The target and the pattern have differing utf8ness. */
3134                 char *l = locinput;
3135                 const char * const e = s + ln;
3136
3137                 if (do_utf8) {
3138                     /* The target is utf8, the pattern is not utf8. */
3139                     while (s < e) {
3140                         STRLEN ulen;
3141                         if (l >= PL_regeol)
3142                              sayNO;
3143                         if (NATIVE_TO_UNI(*(U8*)s) !=
3144                             utf8n_to_uvuni((U8*)l, UTF8_MAXBYTES, &ulen,
3145                                             uniflags))
3146                              sayNO;
3147                         l += ulen;
3148                         s ++;
3149                     }
3150                 }
3151                 else {
3152                     /* The target is not utf8, the pattern is utf8. */
3153                     while (s < e) {
3154                         STRLEN ulen;
3155                         if (l >= PL_regeol)
3156                             sayNO;
3157                         if (NATIVE_TO_UNI(*((U8*)l)) !=
3158                             utf8n_to_uvuni((U8*)s, UTF8_MAXBYTES, &ulen,
3159                                            uniflags))
3160                             sayNO;
3161                         s += ulen;
3162                         l ++;
3163                     }
3164                 }
3165                 locinput = l;
3166                 nextchr = UCHARAT(locinput);
3167                 break;
3168             }
3169             /* The target and the pattern have the same utf8ness. */
3170             /* Inline the first character, for speed. */
3171             if (UCHARAT(s) != nextchr)
3172                 sayNO;
3173             if (PL_regeol - locinput < ln)
3174                 sayNO;
3175             if (ln > 1 && memNE(s, locinput, ln))
3176                 sayNO;
3177             locinput += ln;
3178             nextchr = UCHARAT(locinput);
3179             break;
3180             }
3181         case EXACTFL:
3182             PL_reg_flags |= RF_tainted;
3183             /* FALL THROUGH */
3184         case EXACTF: {
3185             char * const s = STRING(scan);
3186             ln = STR_LEN(scan);
3187
3188             if (do_utf8 || UTF) {
3189               /* Either target or the pattern are utf8. */
3190                 const char * const l = locinput;
3191                 char *e = PL_regeol;
3192
3193                 if (ibcmp_utf8(s, 0,  ln, (bool)UTF,
3194                                l, &e, 0,  do_utf8)) {
3195                      /* One more case for the sharp s:
3196                       * pack("U0U*", 0xDF) =~ /ss/i,
3197                       * the 0xC3 0x9F are the UTF-8
3198                       * byte sequence for the U+00DF. */
3199                      if (!(do_utf8 &&
3200                            toLOWER(s[0]) == 's' &&
3201                            ln >= 2 &&
3202                            toLOWER(s[1]) == 's' &&
3203                            (U8)l[0] == 0xC3 &&
3204                            e - l >= 2 &&
3205                            (U8)l[1] == 0x9F))
3206                           sayNO;
3207                 }
3208                 locinput = e;
3209                 nextchr = UCHARAT(locinput);
3210                 break;
3211             }
3212
3213             /* Neither the target and the pattern are utf8. */
3214
3215             /* Inline the first character, for speed. */
3216             if (UCHARAT(s) != nextchr &&
3217                 UCHARAT(s) != ((OP(scan) == EXACTF)
3218                                ? PL_fold : PL_fold_locale)[nextchr])
3219                 sayNO;
3220             if (PL_regeol - locinput < ln)
3221                 sayNO;
3222             if (ln > 1 && (OP(scan) == EXACTF
3223                            ? ibcmp(s, locinput, ln)
3224                            : ibcmp_locale(s, locinput, ln)))
3225                 sayNO;
3226             locinput += ln;
3227             nextchr = UCHARAT(locinput);
3228             break;
3229             }
3230         case ANYOF:
3231             if (do_utf8) {
3232                 STRLEN inclasslen = PL_regeol - locinput;
3233
3234                 if (!reginclass(rex, scan, (U8*)locinput, &inclasslen, do_utf8))
3235                     goto anyof_fail;
3236                 if (locinput >= PL_regeol)
3237                     sayNO;
3238                 locinput += inclasslen ? inclasslen : UTF8SKIP(locinput);
3239                 nextchr = UCHARAT(locinput);
3240                 break;
3241             }
3242             else {
3243                 if (nextchr < 0)
3244                     nextchr = UCHARAT(locinput);
3245                 if (!REGINCLASS(rex, scan, (U8*)locinput))
3246                     goto anyof_fail;
3247                 if (!nextchr && locinput >= PL_regeol)
3248                     sayNO;
3249                 nextchr = UCHARAT(++locinput);
3250                 break;
3251             }
3252         anyof_fail:
3253             /* If we might have the case of the German sharp s
3254              * in a casefolding Unicode character class. */
3255
3256             if (ANYOF_FOLD_SHARP_S(scan, locinput, PL_regeol)) {
3257                  locinput += SHARP_S_SKIP;
3258                  nextchr = UCHARAT(locinput);
3259             }
3260             else
3261                  sayNO;
3262             break;
3263         case ALNUML:
3264             PL_reg_flags |= RF_tainted;
3265             /* FALL THROUGH */
3266         case ALNUM:
3267             if (!nextchr)
3268                 sayNO;
3269             if (do_utf8) {
3270                 LOAD_UTF8_CHARCLASS_ALNUM();
3271                 if (!(OP(scan) == ALNUM
3272                       ? (bool)swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
3273                       : isALNUM_LC_utf8((U8*)locinput)))
3274                 {
3275                     sayNO;
3276                 }
3277                 locinput += PL_utf8skip[nextchr];
3278                 nextchr = UCHARAT(locinput);
3279                 break;
3280             }
3281             if (!(OP(scan) == ALNUM
3282                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
3283                 sayNO;
3284             nextchr = UCHARAT(++locinput);
3285             break;
3286         case NALNUML:
3287             PL_reg_flags |= RF_tainted;
3288             /* FALL THROUGH */
3289         case NALNUM:
3290             if (!nextchr && locinput >= PL_regeol)
3291                 sayNO;
3292             if (do_utf8) {
3293                 LOAD_UTF8_CHARCLASS_ALNUM();
3294                 if (OP(scan) == NALNUM
3295                     ? (bool)swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
3296                     : isALNUM_LC_utf8((U8*)locinput))
3297                 {
3298                     sayNO;
3299                 }
3300                 locinput += PL_utf8skip[nextchr];
3301                 nextchr = UCHARAT(locinput);
3302                 break;
3303             }
3304             if (OP(scan) == NALNUM
3305                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
3306                 sayNO;
3307             nextchr = UCHARAT(++locinput);
3308             break;
3309         case BOUNDL:
3310         case NBOUNDL:
3311             PL_reg_flags |= RF_tainted;
3312             /* FALL THROUGH */
3313         case BOUND:
3314         case NBOUND:
3315             /* was last char in word? */
3316             if (do_utf8) {
3317                 if (locinput == PL_bostr)
3318                     ln = '\n';
3319                 else {
3320                     const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
3321
3322                     ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, uniflags);
3323                 }
3324                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
3325                     ln = isALNUM_uni(ln);
3326                     LOAD_UTF8_CHARCLASS_ALNUM();
3327                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
3328                 }
3329                 else {
3330                     ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
3331                     n = isALNUM_LC_utf8((U8*)locinput);
3332                 }
3333             }
3334             else {
3335                 ln = (locinput != PL_bostr) ?
3336                     UCHARAT(locinput - 1) : '\n';
3337                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
3338                     ln = isALNUM(ln);
3339                     n = isALNUM(nextchr);
3340                 }
3341                 else {
3342                     ln = isALNUM_LC(ln);
3343                     n = isALNUM_LC(nextchr);
3344                 }
3345             }
3346             if (((!ln) == (!n)) == (OP(scan) == BOUND ||
3347                                     OP(scan) == BOUNDL))
3348                     sayNO;
3349             break;
3350         case SPACEL:
3351             PL_reg_flags |= RF_tainted;
3352             /* FALL THROUGH */
3353         case SPACE:
3354             if (!nextchr)
3355                 sayNO;
3356             if (do_utf8) {
3357                 if (UTF8_IS_CONTINUED(nextchr)) {
3358                     LOAD_UTF8_CHARCLASS_SPACE();
3359                     if (!(OP(scan) == SPACE
3360                           ? (bool)swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3361                           : isSPACE_LC_utf8((U8*)locinput)))
3362                     {
3363                         sayNO;
3364                     }
3365                     locinput += PL_utf8skip[nextchr];
3366                     nextchr = UCHARAT(locinput);
3367                     break;
3368                 }
3369                 if (!(OP(scan) == SPACE
3370                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3371                     sayNO;
3372                 nextchr = UCHARAT(++locinput);
3373             }
3374             else {
3375                 if (!(OP(scan) == SPACE
3376                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3377                     sayNO;
3378                 nextchr = UCHARAT(++locinput);
3379             }
3380             break;
3381         case NSPACEL:
3382             PL_reg_flags |= RF_tainted;
3383             /* FALL THROUGH */
3384         case NSPACE:
3385             if (!nextchr && locinput >= PL_regeol)
3386                 sayNO;
3387             if (do_utf8) {
3388                 LOAD_UTF8_CHARCLASS_SPACE();
3389                 if (OP(scan) == NSPACE
3390                     ? (bool)swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3391                     : isSPACE_LC_utf8((U8*)locinput))
3392                 {
3393                     sayNO;
3394                 }
3395                 locinput += PL_utf8skip[nextchr];
3396                 nextchr = UCHARAT(locinput);
3397                 break;
3398             }
3399             if (OP(scan) == NSPACE
3400                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
3401                 sayNO;
3402             nextchr = UCHARAT(++locinput);
3403             break;
3404         case DIGITL:
3405             PL_reg_flags |= RF_tainted;
3406             /* FALL THROUGH */
3407         case DIGIT:
3408             if (!nextchr)
3409                 sayNO;
3410             if (do_utf8) {
3411                 LOAD_UTF8_CHARCLASS_DIGIT();
3412                 if (!(OP(scan) == DIGIT
3413                       ? (bool)swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3414                       : isDIGIT_LC_utf8((U8*)locinput)))
3415                 {
3416                     sayNO;
3417                 }
3418                 locinput += PL_utf8skip[nextchr];
3419                 nextchr = UCHARAT(locinput);
3420                 break;
3421             }
3422             if (!(OP(scan) == DIGIT
3423                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
3424                 sayNO;
3425             nextchr = UCHARAT(++locinput);
3426             break;
3427         case NDIGITL:
3428             PL_reg_flags |= RF_tainted;
3429             /* FALL THROUGH */
3430         case NDIGIT:
3431             if (!nextchr && locinput >= PL_regeol)
3432                 sayNO;
3433             if (do_utf8) {
3434                 LOAD_UTF8_CHARCLASS_DIGIT();
3435                 if (OP(scan) == NDIGIT
3436                     ? (bool)swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3437                     : isDIGIT_LC_utf8((U8*)locinput))
3438                 {
3439                     sayNO;
3440                 }
3441                 locinput += PL_utf8skip[nextchr];
3442                 nextchr = UCHARAT(locinput);
3443                 break;
3444             }
3445             if (OP(scan) == NDIGIT
3446                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
3447                 sayNO;
3448             nextchr = UCHARAT(++locinput);
3449             break;
3450         case CLUMP:
3451             if (locinput >= PL_regeol)
3452                 sayNO;
3453             if  (do_utf8) {
3454                 LOAD_UTF8_CHARCLASS_MARK();
3455                 if (swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3456                     sayNO;
3457                 locinput += PL_utf8skip[nextchr];
3458                 while (locinput < PL_regeol &&
3459                        swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3460                     locinput += UTF8SKIP(locinput);
3461                 if (locinput > PL_regeol)
3462                     sayNO;
3463             }
3464             else
3465                locinput++;
3466             nextchr = UCHARAT(locinput);
3467             break;
3468
3469         case NREFFL:
3470         {
3471             char *s;
3472             char type;
3473             PL_reg_flags |= RF_tainted;
3474             /* FALL THROUGH */
3475         case NREF:
3476         case NREFF:
3477             type = OP(scan);
3478             n = reg_check_named_buff_matched(rex,scan);
3479
3480             if ( n ) {
3481                 type = REF + ( type - NREF );
3482                 goto do_ref;
3483             } else {
3484                 sayNO;
3485             }
3486             /* unreached */
3487         case REFFL:
3488             PL_reg_flags |= RF_tainted;
3489             /* FALL THROUGH */
3490         case REF:
3491         case REFF:
3492             n = ARG(scan);  /* which paren pair */
3493             type = OP(scan);
3494           do_ref:
3495             ln = PL_regstartp[n];
3496             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3497             if (*PL_reglastparen < n || ln == -1)
3498                 sayNO;                  /* Do not match unless seen CLOSEn. */
3499             if (ln == PL_regendp[n])
3500                 break;
3501
3502             s = PL_bostr + ln;
3503             if (do_utf8 && type != REF) {       /* REF can do byte comparison */
3504                 char *l = locinput;
3505                 const char *e = PL_bostr + PL_regendp[n];
3506                 /*
3507                  * Note that we can't do the "other character" lookup trick as
3508                  * in the 8-bit case (no pun intended) because in Unicode we
3509                  * have to map both upper and title case to lower case.
3510                  */
3511                 if (type == REFF) {
3512                     while (s < e) {
3513                         STRLEN ulen1, ulen2;
3514                         U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
3515                         U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
3516
3517                         if (l >= PL_regeol)
3518                             sayNO;
3519                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
3520                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
3521                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
3522                             sayNO;
3523                         s += ulen1;
3524                         l += ulen2;
3525                     }
3526                 }
3527                 locinput = l;
3528                 nextchr = UCHARAT(locinput);
3529                 break;
3530             }
3531
3532             /* Inline the first character, for speed. */
3533             if (UCHARAT(s) != nextchr &&
3534                 (type == REF ||
3535                  (UCHARAT(s) != (type == REFF
3536                                   ? PL_fold : PL_fold_locale)[nextchr])))
3537                 sayNO;
3538             ln = PL_regendp[n] - ln;
3539             if (locinput + ln > PL_regeol)
3540                 sayNO;
3541             if (ln > 1 && (type == REF
3542                            ? memNE(s, locinput, ln)
3543                            : (type == REFF
3544                               ? ibcmp(s, locinput, ln)
3545                               : ibcmp_locale(s, locinput, ln))))
3546                 sayNO;
3547             locinput += ln;
3548             nextchr = UCHARAT(locinput);
3549             break;
3550         }
3551         case NOTHING:
3552         case TAIL:
3553             break;
3554         case BACK:
3555             break;
3556
3557 #undef  ST
3558 #define ST st->u.eval
3559         {
3560             SV *ret;
3561             regexp *re;
3562             regexp_internal *rei;
3563             regnode *startpoint;
3564
3565         case GOSTART:
3566         case GOSUB: /*    /(...(?1))/      */
3567             if (cur_eval && cur_eval->locinput==locinput) {
3568                 if (cur_eval->u.eval.close_paren == (U32)ARG(scan))
3569                     Perl_croak(aTHX_ "Infinite recursion in regex");
3570                 if ( ++nochange_depth > MAX_RECURSE_EVAL_NOCHANGE_DEPTH )
3571                     Perl_croak(aTHX_
3572                         "Pattern subroutine nesting without pos change"
3573                         " exceeded limit in regex");
3574             } else {
3575                 nochange_depth = 0;
3576             }
3577             re = rex;
3578             rei = rexi;
3579             (void)ReREFCNT_inc(rex);
3580             if (OP(scan)==GOSUB) {
3581                 startpoint = scan + ARG2L(scan);
3582                 ST.close_paren = ARG(scan);
3583             } else {
3584                 startpoint = rei->program+1;
3585                 ST.close_paren = 0;
3586             }
3587             goto eval_recurse_doit;
3588             /* NOTREACHED */
3589         case EVAL:  /*   /(?{A})B/   /(??{A})B/  and /(?(?{A})X|Y)B/   */
3590             if (cur_eval && cur_eval->locinput==locinput) {
3591                 if ( ++nochange_depth > MAX_RECURSE_EVAL_NOCHANGE_DEPTH )
3592                     Perl_croak(aTHX_ "EVAL without pos change exceeded limit in regex");
3593             } else {
3594                 nochange_depth = 0;
3595             }
3596             {   regexp *ocurpm = PM_GETRE(PL_curpm);
3597                 char *osubbeg = rex->subbeg;
3598                 STRLEN osublen = rex->sublen;
3599             {
3600                 /* execute the code in the {...} */
3601                 dSP;
3602                 SV ** const before = SP;
3603                 OP_4tree * const oop = PL_op;
3604                 COP * const ocurcop = PL_curcop;
3605                 PAD *old_comppad;
3606
3607
3608                 n = ARG(scan);
3609                 PL_op = (OP_4tree*)rexi->data->data[n];
3610                 DEBUG_STATE_r( PerlIO_printf(Perl_debug_log,
3611                     "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
3612                 PAD_SAVE_LOCAL(old_comppad, (PAD*)rexi->data->data[n + 2]);
3613                 PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
3614
3615                 if (sv_yes_mark) {
3616                     SV *sv_mrk = get_sv("REGMARK", 1);
3617                     sv_setsv(sv_mrk, sv_yes_mark);
3618                 }
3619                 /* make sure that $1 and friends are available with nested eval */
3620                 PM_SETRE(PL_curpm,rex);
3621                 rex->subbeg = ocurpm->subbeg;
3622                 rex->sublen = ocurpm->sublen;
3623
3624                 CALLRUNOPS(aTHX);                       /* Scalar context. */
3625                 SPAGAIN;
3626                 if (SP == before)
3627                     ret = &PL_sv_undef;   /* protect against empty (?{}) blocks. */
3628                 else {
3629                     ret = POPs;
3630                     PUTBACK;
3631                 }
3632
3633                 PL_op = oop;
3634                 PAD_RESTORE_LOCAL(old_comppad);
3635                 PL_curcop = ocurcop;
3636
3637                 if (!logical) {
3638                     /* /(?{...})/ */
3639                     sv_setsv(save_scalar(PL_replgv), ret);
3640                     break;
3641                 }
3642             }
3643             if (logical == 2) { /* Postponed subexpression: /(??{...})/ */
3644                 logical = 0;
3645                 {
3646                     /* extract RE object from returned value; compiling if
3647                      * necessary */
3648
3649                     MAGIC *mg = NULL;
3650                     const SV *sv;
3651                     if(SvROK(ret) && SvSMAGICAL(sv = SvRV(ret)))
3652                         mg = mg_find(sv, PERL_MAGIC_qr);
3653                     else if (SvSMAGICAL(ret)) {
3654                         if (SvGMAGICAL(ret))
3655                             sv_unmagic(ret, PERL_MAGIC_qr);
3656                         else
3657                             mg = mg_find(ret, PERL_MAGIC_qr);
3658                     }
3659
3660                     if (mg) {
3661                         re = (regexp *)mg->mg_obj;
3662                         (void)ReREFCNT_inc(re);
3663                     }
3664                     else {
3665                         STRLEN len;
3666                         const char * const t = SvPV_const(ret, len);
3667                         PMOP pm;
3668                         const I32 osize = PL_regsize;
3669
3670                         Zero(&pm, 1, PMOP);
3671                         if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
3672                         re = CALLREGCOMP((char*)t, (char*)t + len, &pm);
3673                         if (!(SvFLAGS(ret)
3674                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
3675                                 | SVs_GMG)))
3676                             sv_magic(ret,(SV*)ReREFCNT_inc(re),
3677                                         PERL_MAGIC_qr,0,0);
3678                         PL_regsize = osize;
3679                     }
3680                 }
3681                 rei = RXi_GET(re);
3682
3683                 /* restore PL_curpm after the eval */
3684                 PM_SETRE(PL_curpm,ocurpm);
3685                 rex->sublen = osublen;
3686                 rex->subbeg = osubbeg;
3687
3688                 DEBUG_EXECUTE_r(
3689                     debug_start_match(re, do_utf8, locinput, PL_regeol,
3690                         "Matching embedded");
3691                 );
3692                 startpoint = rei->program + 1;
3693                 ST.close_paren = 0; /* only used for GOSUB */
3694                 /* borrowed from regtry */
3695                 if (PL_reg_start_tmpl <= re->nparens) {
3696                     PL_reg_start_tmpl = re->nparens*3/2 + 3;
3697                     if(PL_reg_start_tmp)
3698                         Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
3699                     else
3700                         Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
3701                 }
3702
3703
3704         eval_recurse_doit: /* Share code with GOSUB below this line */
3705                 /* run the pattern returned from (??{...}) */
3706                 ST.cp = regcppush(0);   /* Save *all* the positions. */
3707                 REGCP_SET(ST.lastcp);
3708
3709                 PL_regstartp = re->startp; /* essentially NOOP on GOSUB */
3710                 PL_regendp = re->endp;     /* essentially NOOP on GOSUB */
3711
3712                 *PL_reglastparen = 0;
3713                 *PL_reglastcloseparen = 0;
3714                 PL_reginput = locinput;
3715                 PL_regsize = 0;
3716
3717                 /* XXXX This is too dramatic a measure... */
3718                 PL_reg_maxiter = 0;
3719
3720                 ST.toggle_reg_flags = PL_reg_flags;
3721                 if (re->extflags & RXf_UTF8)
3722                     PL_reg_flags |= RF_utf8;
3723                 else
3724                     PL_reg_flags &= ~RF_utf8;
3725                 ST.toggle_reg_flags ^= PL_reg_flags; /* diff of old and new */
3726
3727                 ST.prev_rex = rex;
3728                 ST.prev_curlyx = cur_curlyx;
3729                 rex = re;
3730                 rexi = rei;
3731                 cur_curlyx = NULL;
3732                 ST.B = next;
3733                 ST.prev_eval = cur_eval;
3734                 cur_eval = st;
3735                 /* now continue from first node in postoned RE */
3736                 PUSH_YES_STATE_GOTO(EVAL_AB, startpoint);
3737                 /* NOTREACHED */
3738             }
3739             /* restore PL_curpm after the eval */
3740             PM_SETRE(PL_curpm,ocurpm);
3741             rex->sublen = osublen;
3742             rex->subbeg = osubbeg;
3743             }
3744             /* logical is 1,   /(?(?{...})X|Y)/ */
3745             sw = (bool)SvTRUE(ret);
3746             logical = 0;
3747             break;
3748         }
3749
3750         case EVAL_AB: /* cleanup after a successful (??{A})B */
3751             /* note: this is called twice; first after popping B, then A */
3752             PL_reg_flags ^= ST.toggle_reg_flags;
3753             ReREFCNT_dec(rex);
3754             rex = ST.prev_rex;
3755             rexi = RXi_GET(rex);
3756             regcpblow(ST.cp);
3757             cur_eval = ST.prev_eval;
3758             cur_curlyx = ST.prev_curlyx;
3759             /* XXXX This is too dramatic a measure... */
3760             PL_reg_maxiter = 0;
3761             sayYES;
3762
3763
3764         case EVAL_AB_fail: /* unsuccessfully ran A or B in (??{A})B */
3765             /* note: this is called twice; first after popping B, then A */
3766             PL_reg_flags ^= ST.toggle_reg_flags;
3767             ReREFCNT_dec(rex);
3768             rex = ST.prev_rex;
3769             rexi = RXi_GET(rex);
3770             PL_reginput = locinput;
3771             REGCP_UNWIND(ST.lastcp);
3772             regcppop(rex);
3773             cur_eval = ST.prev_eval;
3774             cur_curlyx = ST.prev_curlyx;
3775             /* XXXX This is too dramatic a measure... */
3776             PL_reg_maxiter = 0;
3777             sayNO_SILENT;
3778 #undef ST
3779
3780         case OPEN:
3781             n = ARG(scan);  /* which paren pair */
3782             PL_reg_start_tmp[n] = locinput;
3783             if (n > PL_regsize)
3784                 PL_regsize = n;
3785             lastopen = n;
3786             break;
3787         case CLOSE:
3788             n = ARG(scan);  /* which paren pair */
3789             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
3790             PL_regendp[n] = locinput - PL_bostr;
3791             /*if (n > PL_regsize)
3792                 PL_regsize = n;*/
3793             if (n > *PL_reglastparen)
3794                 *PL_reglastparen = n;
3795             *PL_reglastcloseparen = n;
3796             if (cur_eval && cur_eval->u.eval.close_paren == n) {
3797                 goto fake_end;
3798             }
3799             break;
3800         case ACCEPT:
3801             if (ARG(scan)){
3802                 regnode *cursor;
3803                 for (cursor=scan;
3804                      cursor && OP(cursor)!=END;
3805                      cursor=regnext(cursor))
3806                 {
3807                     if ( OP(cursor)==CLOSE ){
3808                         n = ARG(cursor);
3809                         if ( n <= lastopen ) {
3810                             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
3811                             PL_regendp[n] = locinput - PL_bostr;
3812                             /*if (n > PL_regsize)
3813                             PL_regsize = n;*/
3814                             if (n > *PL_reglastparen)
3815                                 *PL_reglastparen = n;
3816                             *PL_reglastcloseparen = n;
3817                             if ( n == ARG(scan) || (cur_eval &&
3818                                 cur_eval->u.eval.close_paren == n))
3819                                 break;
3820                         }
3821                     }
3822                 }
3823             }
3824             goto fake_end;
3825             /*NOTREACHED*/
3826         case GROUPP:
3827             n = ARG(scan);  /* which paren pair */
3828             sw = (bool)(*PL_reglastparen >= n && PL_regendp[n] != -1);
3829             break;
3830         case NGROUPP:
3831             /* reg_check_named_buff_matched returns 0 for no match */
3832             sw = (bool)(0 < reg_check_named_buff_matched(rex,scan));
3833             break;
3834         case INSUBP:
3835             n = ARG(scan);
3836             sw = (cur_eval && (!n || cur_eval->u.eval.close_paren == n));
3837             break;
3838         case DEFINEP:
3839             sw = 0;
3840             break;
3841         case IFTHEN:
3842             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3843             if (sw)
3844                 next = NEXTOPER(NEXTOPER(scan));
3845             else {
3846                 next = scan + ARG(scan);
3847                 if (OP(next) == IFTHEN) /* Fake one. */
3848                     next = NEXTOPER(NEXTOPER(next));
3849             }
3850             break;
3851         case LOGICAL:
3852             logical = scan->flags;
3853             break;
3854
3855 /*******************************************************************
3856
3857 The CURLYX/WHILEM pair of ops handle the most generic case of the /A*B/
3858 pattern, where A and B are subpatterns. (For simple A, CURLYM or
3859 STAR/PLUS/CURLY/CURLYN are used instead.)
3860
3861 A*B is compiled as <CURLYX><A><WHILEM><B>
3862
3863 On entry to the subpattern, CURLYX is called. This pushes a CURLYX
3864 state, which contains the current count, initialised to -1. It also sets
3865 cur_curlyx to point to this state, with any previous value saved in the
3866 state block.
3867
3868 CURLYX then jumps straight to the WHILEM op, rather than executing A,
3869 since the pattern may possibly match zero times (i.e. it's a while {} loop
3870 rather than a do {} while loop).
3871
3872 Each entry to WHILEM represents a successful match of A. The count in the
3873 CURLYX block is incremented, another WHILEM state is pushed, and execution
3874 passes to A or B depending on greediness and the current count.
3875
3876 For example, if matching against the string a1a2a3b (where the aN are
3877 substrings that match /A/), then the match progresses as follows: (the
3878 pushed states are interspersed with the bits of strings matched so far):
3879
3880     <CURLYX cnt=-1>
3881     <CURLYX cnt=0><WHILEM>
3882     <CURLYX cnt=1><WHILEM> a1 <WHILEM>
3883     <CURLYX cnt=2><WHILEM> a1 <WHILEM> a2 <WHILEM>
3884     <CURLYX cnt=3><WHILEM> a1 <WHILEM> a2 <WHILEM> a3 <WHILEM>
3885     <CURLYX cnt=3><WHILEM> a1 <WHILEM> a2 <WHILEM> a3 <WHILEM> b
3886
3887 (Contrast this with something like CURLYM, which maintains only a single
3888 backtrack state:
3889
3890     <CURLYM cnt=0> a1
3891     a1 <CURLYM cnt=1> a2
3892     a1 a2 <CURLYM cnt=2> a3
3893     a1 a2 a3 <CURLYM cnt=3> b
3894 )
3895
3896 Each WHILEM state block marks a point to backtrack to upon partial failure
3897 of A or B, and also contains some minor state data related to that
3898 iteration.  The CURLYX block, pointed to by cur_curlyx, contains the
3899 overall state, such as the count, and pointers to the A and B ops.
3900
3901 This is complicated slightly by nested CURLYX/WHILEM's. Since cur_curlyx
3902 must always point to the *current* CURLYX block, the rules are:
3903
3904 When executing CURLYX, save the old cur_curlyx in the CURLYX state block,
3905 and set cur_curlyx to point the new block.
3906
3907 When popping the CURLYX block after a successful or unsuccessful match,
3908 restore the previous cur_curlyx.
3909
3910 When WHILEM is about to execute B, save the current cur_curlyx, and set it
3911 to the outer one saved in the CURLYX block.
3912
3913 When popping the WHILEM block after a successful or unsuccessful B match,
3914 restore the previous cur_curlyx.
3915
3916 Here's an example for the pattern (AI* BI)*BO
3917 I and O refer to inner and outer, C and W refer to CURLYX and WHILEM:
3918
3919 cur_
3920 curlyx backtrack stack
3921 ------ ---------------
3922 NULL
3923 CO     <CO prev=NULL> <WO>
3924 CI     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai
3925 CO     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi
3926 NULL   <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi <WO prev=CO> bo
3927
3928 At this point the pattern succeeds, and we work back down the stack to
3929 clean up, restoring as we go:
3930
3931 CO     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi
3932 CI     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai
3933 CO     <CO prev=NULL> <WO>
3934 NULL
3935
3936 *******************************************************************/
3937
3938 #define ST st->u.curlyx
3939
3940         case CURLYX:    /* start of /A*B/  (for complex A) */
3941         {
3942             /* No need to save/restore up to this paren */
3943             I32 parenfloor = scan->flags;
3944
3945             assert(next); /* keep Coverity happy */
3946             if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
3947                 next += ARG(next);
3948
3949             /* XXXX Probably it is better to teach regpush to support
3950                parenfloor > PL_regsize... */
3951             if (parenfloor > (I32)*PL_reglastparen)
3952                 parenfloor = *PL_reglastparen; /* Pessimization... */
3953
3954             ST.prev_curlyx= cur_curlyx;
3955             cur_curlyx = st;
3956             ST.cp = PL_savestack_ix;
3957
3958             /* these fields contain the state of the current curly.
3959              * they are accessed by subsequent WHILEMs */
3960             ST.parenfloor = parenfloor;
3961             ST.min = ARG1(scan);
3962             ST.max = ARG2(scan);
3963             ST.A = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3964             ST.B = next;
3965             ST.minmod = minmod;
3966             minmod = 0;
3967             ST.count = -1;      /* this will be updated by WHILEM */
3968             ST.lastloc = NULL;  /* this will be updated by WHILEM */
3969
3970             PL_reginput = locinput;
3971             PUSH_YES_STATE_GOTO(CURLYX_end, PREVOPER(next));
3972             /* NOTREACHED */
3973         }
3974
3975         case CURLYX_end: /* just finished matching all of A*B */
3976             if (PL_reg_eval_set){
3977                 SV *pres= GvSV(PL_replgv);
3978                 SvREFCNT_inc(pres);
3979                 regcpblow(ST.cp);
3980                 sv_setsv(GvSV(PL_replgv), pres);
3981                 SvREFCNT_dec(pres);
3982             } else {
3983                 regcpblow(ST.cp);
3984             }
3985             cur_curlyx = ST.prev_curlyx;
3986             sayYES;
3987             /* NOTREACHED */
3988
3989         case CURLYX_end_fail: /* just failed to match all of A*B */
3990             regcpblow(ST.cp);
3991             cur_curlyx = ST.prev_curlyx;
3992             sayNO;
3993             /* NOTREACHED */
3994
3995
3996 #undef ST
3997 #define ST st->u.whilem
3998
3999         case WHILEM:     /* just matched an A in /A*B/  (for complex A) */
4000         {
4001             /* see the discussion above about CURLYX/WHILEM */
4002             I32 n;
4003             assert(cur_curlyx); /* keep Coverity happy */
4004             n = ++cur_curlyx->u.curlyx.count; /* how many A's matched */
4005             ST.save_lastloc = cur_curlyx->u.curlyx.lastloc;
4006             ST.cache_offset = 0;
4007             ST.cache_mask = 0;
4008
4009             PL_reginput = locinput;
4010
4011             DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4012                   "%*s  whilem: matched %ld out of %ld..%ld\n",
4013                   REPORT_CODE_OFF+depth*2, "", (long)n,
4014                   (long)cur_curlyx->u.curlyx.min,
4015                   (long)cur_curlyx->u.curlyx.max)
4016             );
4017
4018             /* First just match a string of min A's. */
4019
4020             if (n < cur_curlyx->u.curlyx.min) {
4021                 cur_curlyx->u.curlyx.lastloc = locinput;
4022                 PUSH_STATE_GOTO(WHILEM_A_pre, cur_curlyx->u.curlyx.A);
4023                 /* NOTREACHED */
4024             }
4025
4026             /* If degenerate A matches "", assume A done. */
4027
4028             if (locinput == cur_curlyx->u.curlyx.lastloc) {
4029                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4030                    "%*s  whilem: empty match detected, trying continuation...\n",
4031                    REPORT_CODE_OFF+depth*2, "")
4032                 );
4033                 goto do_whilem_B_max;
4034             }
4035
4036             /* super-linear cache processing */
4037
4038             if (scan->flags) {
4039
4040                 if (!PL_reg_maxiter) {
4041                     /* start the countdown: Postpone detection until we
4042                      * know the match is not *that* much linear. */
4043                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
4044                     /* possible overflow for long strings and many CURLYX's */
4045                     if (PL_reg_maxiter < 0)
4046                         PL_reg_maxiter = I32_MAX;
4047                     PL_reg_leftiter = PL_reg_maxiter;
4048                 }
4049
4050                 if (PL_reg_leftiter-- == 0) {
4051                     /* initialise cache */
4052                     const I32 size = (PL_reg_maxiter + 7)/8;
4053                     if (PL_reg_poscache) {
4054                         if ((I32)PL_reg_poscache_size < size) {
4055                             Renew(PL_reg_poscache, size, char);
4056                             PL_reg_poscache_size = size;
4057                         }
4058                         Zero(PL_reg_poscache, size, char);
4059                     }
4060                     else {
4061                         PL_reg_poscache_size = size;
4062                         Newxz(PL_reg_poscache, size, char);
4063                     }
4064                     DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4065       "%swhilem: Detected a super-linear match, switching on caching%s...\n",
4066                               PL_colors[4], PL_colors[5])
4067                     );
4068                 }
4069
4070                 if (PL_reg_leftiter < 0) {
4071                     /* have we already failed at this position? */
4072                     I32 offset, mask;
4073                     offset  = (scan->flags & 0xf) - 1
4074                                 + (locinput - PL_bostr)  * (scan->flags>>4);
4075                     mask    = 1 << (offset % 8);
4076                     offset /= 8;
4077                     if (PL_reg_poscache[offset] & mask) {
4078                         DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4079                             "%*s  whilem: (cache) already tried at this position...\n",
4080                             REPORT_CODE_OFF+depth*2, "")
4081                         );
4082                         sayNO; /* cache records failure */
4083                     }
4084                     ST.cache_offset = offset;
4085                     ST.cache_mask   = mask;
4086                 }
4087             }
4088
4089             /* Prefer B over A for minimal matching. */
4090
4091             if (cur_curlyx->u.curlyx.minmod) {
4092                 ST.save_curlyx = cur_curlyx;
4093                 cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
4094                 ST.cp = regcppush(ST.save_curlyx->u.curlyx.parenfloor);
4095                 REGCP_SET(ST.lastcp);
4096                 PUSH_YES_STATE_GOTO(WHILEM_B_min, ST.save_curlyx->u.curlyx.B);
4097                 /* NOTREACHED */
4098             }
4099
4100             /* Prefer A over B for maximal matching. */
4101
4102             if (n < cur_curlyx->u.curlyx.max) { /* More greed allowed? */
4103                 ST.cp = regcppush(cur_curlyx->u.curlyx.parenfloor);
4104                 cur_curlyx->u.curlyx.lastloc = locinput;
4105                 REGCP_SET(ST.lastcp);
4106                 PUSH_STATE_GOTO(WHILEM_A_max, cur_curlyx->u.curlyx.A);
4107                 /* NOTREACHED */
4108             }
4109             goto do_whilem_B_max;
4110         }
4111         /* NOTREACHED */
4112
4113         case WHILEM_B_min: /* just matched B in a minimal match */
4114         case WHILEM_B_max: /* just matched B in a maximal match */
4115             cur_curlyx = ST.save_curlyx;
4116             sayYES;
4117             /* NOTREACHED */
4118
4119         case WHILEM_B_max_fail: /* just failed to match B in a maximal match */
4120             cur_curlyx = ST.save_curlyx;
4121             cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
4122             cur_curlyx->u.curlyx.count--;
4123             CACHEsayNO;
4124             /* NOTREACHED */
4125
4126         case WHILEM_A_min_fail: /* just failed to match A in a minimal match */
4127             REGCP_UNWIND(ST.lastcp);
4128             regcppop(rex);
4129             /* FALL THROUGH */
4130         case WHILEM_A_pre_fail: /* just failed to match even minimal A */
4131             cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
4132             cur_curlyx->u.curlyx.count--;
4133             CACHEsayNO;
4134             /* NOTREACHED */
4135
4136         case WHILEM_A_max_fail: /* just failed to match A in a maximal match */
4137             REGCP_UNWIND(ST.lastcp);
4138             regcppop(rex);      /* Restore some previous $<digit>s? */
4139             PL_reginput = locinput;
4140             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4141                 "%*s  whilem: failed, trying continuation...\n",
4142                 REPORT_CODE_OFF+depth*2, "")
4143             );
4144           do_whilem_B_max:
4145             if (cur_curlyx->u.curlyx.count >= REG_INFTY
4146                 && ckWARN(WARN_REGEXP)
4147                 && !(PL_reg_flags & RF_warned))
4148             {
4149                 PL_reg_flags |= RF_warned;
4150                 Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
4151                      "Complex regular subexpression recursion",
4152                      REG_INFTY - 1);
4153             }
4154
4155             /* now try B */
4156             ST.save_curlyx = cur_curlyx;
4157             cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
4158             PUSH_YES_STATE_GOTO(WHILEM_B_max, ST.save_curlyx->u.curlyx.B);
4159             /* NOTREACHED */
4160
4161         case WHILEM_B_min_fail: /* just failed to match B in a minimal match */
4162             cur_curlyx = ST.save_curlyx;
4163             REGCP_UNWIND(ST.lastcp);
4164             regcppop(rex);
4165
4166             if (cur_curlyx->u.curlyx.count >= cur_curlyx->u.curlyx.max) {
4167                 /* Maximum greed exceeded */
4168                 if (cur_curlyx->u.curlyx.count >= REG_INFTY
4169                     && ckWARN(WARN_REGEXP)
4170                     && !(PL_reg_flags & RF_warned))
4171                 {
4172                     PL_reg_flags |= RF_warned;
4173                     Perl_warner(aTHX_ packWARN(WARN_REGEXP),
4174                         "%s limit (%d) exceeded",
4175                         "Complex regular subexpression recursion",
4176                         REG_INFTY - 1);
4177                 }
4178                 cur_curlyx->u.curlyx.count--;
4179                 CACHEsayNO;
4180             }
4181
4182             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4183                 "%*s  trying longer...\n", REPORT_CODE_OFF+depth*2, "")
4184             );
4185             /* Try grabbing another A and see if it helps. */
4186             PL_reginput = locinput;
4187             cur_curlyx->u.curlyx.lastloc = locinput;
4188             ST.cp = regcppush(cur_curlyx->u.curlyx.parenfloor);
4189             REGCP_SET(ST.lastcp);
4190             PUSH_STATE_GOTO(WHILEM_A_min, ST.save_curlyx->u.curlyx.A);
4191             /* NOTREACHED */
4192
4193 #undef  ST
4194 #define ST st->u.branch
4195
4196         case BRANCHJ:       /*  /(...|A|...)/ with long next pointer */
4197             next = scan + ARG(scan);
4198             if (next == scan)
4199                 next = NULL;
4200             scan = NEXTOPER(scan);
4201             /* FALL THROUGH */
4202
4203         case BRANCH:        /*  /(...|A|...)/ */
4204             scan = NEXTOPER(scan); /* scan now points to inner node */
4205             if ((!next || (OP(next) != BRANCH && OP(next) != BRANCHJ))
4206                 && !has_cutgroup)
4207             {
4208                 /* last branch; skip state push and jump direct to node */
4209                 continue;
4210             }
4211             ST.lastparen = *PL_reglastparen;
4212             ST.next_branch = next;
4213             REGCP_SET(ST.cp);
4214             PL_reginput = locinput;
4215
4216             /* Now go into the branch */
4217             if (has_cutgroup) {
4218                 PUSH_YES_STATE_GOTO(BRANCH_next, scan);
4219             } else {
4220                 PUSH_STATE_GOTO(BRANCH_next, scan);
4221             }
4222             /* NOTREACHED */
4223         case CUTGROUP:
4224             PL_reginput = locinput;
4225             sv_yes_mark = st->u.mark.mark_name = scan->flags ? NULL :
4226                 (SV*)rexi->data->data[ ARG( scan ) ];
4227             PUSH_STATE_GOTO(CUTGROUP_next,next);
4228             /* NOTREACHED */
4229         case CUTGROUP_next_fail:
4230             do_cutgroup = 1;
4231             no_final = 1;
4232             if (st->u.mark.mark_name)
4233                 sv_commit = st->u.mark.mark_name;
4234             sayNO;
4235             /* NOTREACHED */
4236         case BRANCH_next:
4237             sayYES;
4238             /* NOTREACHED */
4239         case BRANCH_next_fail: /* that branch failed; try the next, if any */
4240             if (do_cutgroup) {
4241                 do_cutgroup = 0;
4242                 no_final = 0;
4243             }
4244             REGCP_UNWIND(ST.cp);
4245             for (n = *PL_reglastparen; n > ST.lastparen; n--)
4246                 PL_regendp[n] = -1;
4247             *PL_reglastparen = n;
4248             /*dmq: *PL_reglastcloseparen = n; */
4249             scan = ST.next_branch;
4250             /* no more branches? */
4251             if (!scan || (OP(scan) != BRANCH && OP(scan) != BRANCHJ)) {
4252                 DEBUG_EXECUTE_r({
4253                     PerlIO_printf( Perl_debug_log,
4254                         "%*s  %sBRANCH failed...%s\n",
4255                         REPORT_CODE_OFF+depth*2, "",
4256                         PL_colors[4],
4257                         PL_colors[5] );
4258                 });
4259                 sayNO_SILENT;
4260             }
4261             continue; /* execute next BRANCH[J] op */
4262             /* NOTREACHED */
4263
4264         case MINMOD:
4265             minmod = 1;
4266             break;
4267
4268 #undef  ST
4269 #define ST st->u.curlym
4270
4271         case CURLYM:    /* /A{m,n}B/ where A is fixed-length */
4272
4273             /* This is an optimisation of CURLYX that enables us to push
4274              * only a single backtracking state, no matter now many matches
4275              * there are in {m,n}. It relies on the pattern being constant
4276              * length, with no parens to influence future backrefs
4277              */
4278
4279             ST.me = scan;
4280             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
4281
4282             /* if paren positive, emulate an OPEN/CLOSE around A */
4283             if (ST.me->flags) {
4284                 U32 paren = ST.me->flags;
4285                 if (paren > PL_regsize)
4286                     PL_regsize = paren;
4287                 if (paren > *PL_reglastparen)
4288                     *PL_reglastparen = paren;
4289                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
4290             }
4291             ST.A = scan;
4292             ST.B = next;
4293             ST.alen = 0;
4294             ST.count = 0;
4295             ST.minmod = minmod;
4296             minmod = 0;
4297             ST.c1 = CHRTEST_UNINIT;
4298             REGCP_SET(ST.cp);
4299
4300             if (!(ST.minmod ? ARG1(ST.me) : ARG2(ST.me))) /* min/max */
4301                 goto curlym_do_B;
4302
4303           curlym_do_A: /* execute the A in /A{m,n}B/  */
4304             PL_reginput = locinput;
4305             PUSH_YES_STATE_GOTO(CURLYM_A, ST.A); /* match A */
4306             /* NOTREACHED */
4307
4308         case CURLYM_A: /* we've just matched an A */
4309             locinput = st->locinput;
4310             nextchr = UCHARAT(locinput);
4311
4312             ST.count++;
4313             /* after first match, determine A's length: u.curlym.alen */
4314             if (ST.count == 1) {
4315                 if (PL_reg_match_utf8) {
4316                     char *s = locinput;
4317                     while (s < PL_reginput) {
4318                         ST.alen++;
4319                         s += UTF8SKIP(s);
4320                     }
4321                 }
4322                 else {
4323                     ST.alen = PL_reginput - locinput;
4324                 }
4325                 if (ST.alen == 0)
4326                     ST.count = ST.minmod ? ARG1(ST.me) : ARG2(ST.me);
4327             }
4328             DEBUG_EXECUTE_r(
4329                 PerlIO_printf(Perl_debug_log,
4330                           "%*s  CURLYM now matched %"IVdf" times, len=%"IVdf"...\n",
4331                           (int)(REPORT_CODE_OFF+(depth*2)), "",
4332                           (IV) ST.count, (IV)ST.alen)
4333             );
4334
4335             locinput = PL_reginput;
4336
4337             if (cur_eval && cur_eval->u.eval.close_paren &&
4338                 cur_eval->u.eval.close_paren == (U32)ST.me->flags)
4339                 goto fake_end;
4340
4341             if ( ST.count < (ST.minmod ? ARG1(ST.me) : ARG2(ST.me)) )
4342                 goto curlym_do_A; /* try to match another A */
4343             goto curlym_do_B; /* try to match B */
4344
4345         case CURLYM_A_fail: /* just failed to match an A */
4346             REGCP_UNWIND(ST.cp);
4347
4348             if (ST.minmod || ST.count < ARG1(ST.me) /* min*/
4349                 || (cur_eval && cur_eval->u.eval.close_paren &&
4350                     cur_eval->u.eval.close_paren == (U32)ST.me->flags))
4351                 sayNO;
4352
4353           curlym_do_B: /* execute the B in /A{m,n}B/  */
4354             PL_reginput = locinput;
4355             if (ST.c1 == CHRTEST_UNINIT) {
4356                 /* calculate c1 and c2 for possible match of 1st char
4357                  * following curly */
4358                 ST.c1 = ST.c2 = CHRTEST_VOID;
4359                 if (HAS_TEXT(ST.B) || JUMPABLE(ST.B)) {
4360                     regnode *text_node = ST.B;
4361                     if (! HAS_TEXT(text_node))
4362                         FIND_NEXT_IMPT(text_node);
4363                     /* this used to be
4364
4365                         (HAS_TEXT(text_node) && PL_regkind[OP(text_node)] == EXACT)
4366
4367                         But the former is redundant in light of the latter.
4368
4369                         if this changes back then the macro for
4370                         IS_TEXT and friends need to change.
4371                      */
4372                     if (PL_regkind[OP(text_node)] == EXACT)
4373                     {
4374
4375                         ST.c1 = (U8)*STRING(text_node);
4376                         ST.c2 =
4377                             (IS_TEXTF(text_node))
4378                             ? PL_fold[ST.c1]
4379                             : (IS_TEXTFL(text_node))
4380                                 ? PL_fold_locale[ST.c1]
4381                                 : ST.c1;
4382                     }
4383                 }
4384             }
4385
4386             DEBUG_EXECUTE_r(
4387                 PerlIO_printf(Perl_debug_log,
4388                     "%*s  CURLYM trying tail with matches=%"IVdf"...\n",
4389                     (int)(REPORT_CODE_OFF+(depth*2)),
4390                     "", (IV)ST.count)
4391                 );
4392             if (ST.c1 != CHRTEST_VOID
4393                     && UCHARAT(PL_reginput) != ST.c1
4394                     && UCHARAT(PL_reginput) != ST.c2)
4395             {
4396                 /* simulate B failing */
4397                 state_num = CURLYM_B_fail;
4398                 goto reenter_switch;
4399             }
4400
4401             if (ST.me->flags) {
4402                 /* mark current A as captured */
4403                 I32 paren = ST.me->flags;
4404                 if (ST.count) {
4405                     PL_regstartp[paren]
4406                         = HOPc(PL_reginput, -ST.alen) - PL_bostr;
4407                     PL_regendp[paren] = PL_reginput - PL_bostr;
4408                     /*dmq: *PL_reglastcloseparen = paren; */
4409                 }
4410                 else
4411                     PL_regendp[paren] = -1;
4412                 if (cur_eval && cur_eval->u.eval.close_paren &&
4413                     cur_eval->u.eval.close_paren == (U32)ST.me->flags)
4414                 {
4415                     if (ST.count)
4416                         goto fake_end;
4417                     else
4418                         sayNO;
4419                 }
4420             }
4421
4422             PUSH_STATE_GOTO(CURLYM_B, ST.B); /* match B */
4423             /* NOTREACHED */
4424
4425         case CURLYM_B_fail: /* just failed to match a B */
4426             REGCP_UNWIND(ST.cp);
4427             if (ST.minmod) {
4428                 if (ST.count == ARG2(ST.me) /* max */)
4429                     sayNO;
4430                 goto curlym_do_A; /* try to match a further A */
4431             }
4432             /* backtrack one A */
4433             if (ST.count == ARG1(ST.me) /* min */)
4434                 sayNO;
4435             ST.count--;
4436             locinput = HOPc(locinput, -ST.alen);
4437             goto curlym_do_B; /* try to match B */
4438
4439 #undef ST
4440 #define ST st->u.curly
4441
4442 #define CURLY_SETPAREN(paren, success) \
4443     if (paren) { \
4444         if (success) { \
4445             PL_regstartp[paren] = HOPc(locinput, -1) - PL_bostr; \
4446             PL_regendp[paren] = locinput - PL_bostr; \
4447             *PL_reglastcloseparen = paren; \
4448         } \
4449         else \
4450             PL_regendp[paren] = -1; \
4451     }
4452
4453         case STAR:              /*  /A*B/ where A is width 1 */
4454             ST.paren = 0;
4455             ST.min = 0;
4456             ST.max = REG_INFTY;
4457             scan = NEXTOPER(scan);
4458             goto repeat;
4459         case PLUS:              /*  /A+B/ where A is width 1 */
4460             ST.paren = 0;
4461             ST.min = 1;
4462             ST.max = REG_INFTY;
4463             scan = NEXTOPER(scan);
4464             goto repeat;
4465         case CURLYN:            /*  /(A){m,n}B/ where A is width 1 */
4466             ST.paren = scan->flags;     /* Which paren to set */
4467             if (ST.paren > PL_regsize)
4468                 PL_regsize = ST.paren;
4469             if (ST.paren > *PL_reglastparen)
4470                 *PL_reglastparen = ST.paren;
4471             ST.min = ARG1(scan);  /* min to match */
4472             ST.max = ARG2(scan);  /* max to match */
4473             if (cur_eval && cur_eval->u.eval.close_paren &&
4474                 cur_eval->u.eval.close_paren == (U32)ST.paren) {
4475                 ST.min=1;
4476                 ST.max=1;
4477             }
4478             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
4479             goto repeat;
4480         case CURLY:             /*  /A{m,n}B/ where A is width 1 */
4481             ST.paren = 0;
4482             ST.min = ARG1(scan);  /* min to match */
4483             ST.max = ARG2(scan);  /* max to match */
4484             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
4485           repeat:
4486             /*
4487             * Lookahead to avoid useless match attempts
4488             * when we know what character comes next.
4489             *
4490             * Used to only do .*x and .*?x, but now it allows
4491             * for )'s, ('s and (?{ ... })'s to be in the way
4492             * of the quantifier and the EXACT-like node.  -- japhy
4493             */
4494
4495             if (ST.min > ST.max) /* XXX make this a compile-time check? */
4496                 sayNO;
4497             if (HAS_TEXT(next) || JUMPABLE(next)) {
4498                 U8 *s;
4499                 regnode *text_node = next;
4500
4501                 if (! HAS_TEXT(text_node))
4502                     FIND_NEXT_IMPT(text_node);
4503
4504                 if (! HAS_TEXT(text_node))
4505                     ST.c1 = ST.c2 = CHRTEST_VOID;
4506                 else {
4507                     if ( PL_regkind[OP(text_node)] != EXACT ) {
4508                         ST.c1 = ST.c2 = CHRTEST_VOID;
4509                         goto assume_ok_easy;
4510                     }
4511                     else
4512                         s = (U8*)STRING(text_node);
4513
4514                     /*  Currently we only get here when
4515
4516                         PL_rekind[OP(text_node)] == EXACT
4517
4518                         if this changes back then the macro for IS_TEXT and
4519                         friends need to change. */
4520                     if (!UTF) {
4521                         ST.c2 = ST.c1 = *s;
4522                         if (IS_TEXTF(text_node))
4523                             ST.c2 = PL_fold[ST.c1];
4524                         else if (IS_TEXTFL(text_node))
4525                             ST.c2 = PL_fold_locale[ST.c1];
4526                     }
4527                     else { /* UTF */
4528                         if (IS_TEXTF(text_node)) {
4529                              STRLEN ulen1, ulen2;
4530                              U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
4531                              U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
4532
4533                              to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
4534                              to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
4535 #ifdef EBCDIC
4536                              ST.c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXLEN, 0,
4537                                                     ckWARN(WARN_UTF8) ?
4538                                                     0 : UTF8_ALLOW_ANY);
4539                              ST.c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXLEN, 0,
4540                                                     ckWARN(WARN_UTF8) ?
4541                                                     0 : UTF8_ALLOW_ANY);
4542 #else
4543                              ST.c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
4544                                                     uniflags);
4545                              ST.c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
4546                                                     uniflags);
4547 #endif
4548                         }
4549                         else {
4550                             ST.c2 = ST.c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
4551                                                      uniflags);
4552                         }
4553                     }
4554                 }
4555             }
4556             else
4557                 ST.c1 = ST.c2 = CHRTEST_VOID;
4558         assume_ok_easy:
4559
4560             ST.A = scan;
4561             ST.B = next;
4562             PL_reginput = locinput;
4563             if (minmod) {
4564                 minmod = 0;
4565                 if (ST.min && regrepeat(rex, ST.A, ST.min, depth) < ST.min)
4566                     sayNO;
4567                 ST.count = ST.min;
4568                 locinput = PL_reginput;
4569                 REGCP_SET(ST.cp);
4570                 if (ST.c1 == CHRTEST_VOID)
4571                     goto curly_try_B_min;
4572
4573                 ST.oldloc = locinput;
4574
4575                 /* set ST.maxpos to the furthest point along the
4576                  * string that could possibly match */
4577                 if  (ST.max == REG_INFTY) {
4578                     ST.maxpos = PL_regeol - 1;
4579                     if (do_utf8)
4580                         while (UTF8_IS_CONTINUATION(*(U8*)ST.maxpos))
4581                             ST.maxpos--;
4582                 }
4583                 else if (do_utf8) {
4584                     int m = ST.max - ST.min;
4585                     for (ST.maxpos = locinput;
4586                          m >0 && ST.maxpos + UTF8SKIP(ST.maxpos) <= PL_regeol; m--)
4587                         ST.maxpos += UTF8SKIP(ST.maxpos);
4588                 }
4589                 else {
4590                     ST.maxpos = locinput + ST.max - ST.min;
4591                     if (ST.maxpos >= PL_regeol)
4592                         ST.maxpos = PL_regeol - 1;
4593                 }
4594                 goto curly_try_B_min_known;
4595
4596             }
4597             else {
4598                 ST.count = regrepeat(rex, ST.A, ST.max, depth);
4599                 locinput = PL_reginput;
4600                 if (ST.count < ST.min)
4601                     sayNO;
4602                 if ((ST.count > ST.min)
4603                     && (PL_regkind[OP(ST.B)] == EOL) && (OP(ST.B) != MEOL))
4604                 {
4605                     /* A{m,n} must come at the end of the string, there's
4606                      * no point in backing off ... */
4607                     ST.min = ST.count;
4608                     /* ...except that $ and \Z can match before *and* after
4609                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
4610                        We may back off by one in this case. */
4611                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(ST.B) != EOS)
4612                         ST.min--;
4613                 }
4614                 REGCP_SET(ST.cp);
4615                 goto curly_try_B_max;
4616             }
4617             /* NOTREACHED */
4618
4619
4620         case CURLY_B_min_known_fail:
4621             /* failed to find B in a non-greedy match where c1,c2 valid */
4622             if (ST.paren && ST.count)
4623                 PL_regendp[ST.paren] = -1;
4624
4625             PL_reginput = locinput;     /* Could be reset... */
4626             REGCP_UNWIND(ST.cp);
4627             /* Couldn't or didn't -- move forward. */
4628             ST.oldloc = locinput;
4629             if (do_utf8)
4630                 locinput += UTF8SKIP(locinput);
4631             else
4632                 locinput++;
4633             ST.count++;
4634           curly_try_B_min_known:
4635              /* find the next place where 'B' could work, then call B */
4636             {
4637                 int n;
4638                 if (do_utf8) {
4639                     n = (ST.oldloc == locinput) ? 0 : 1;
4640                     if (ST.c1 == ST.c2) {
4641                         STRLEN len;
4642                         /* set n to utf8_distance(oldloc, locinput) */
4643                         while (locinput <= ST.maxpos &&
4644                                utf8n_to_uvchr((U8*)locinput,
4645                                               UTF8_MAXBYTES, &len,
4646                                               uniflags) != (UV)ST.c1) {
4647                             locinput += len;
4648                             n++;
4649                         }
4650                     }
4651                     else {
4652                         /* set n to utf8_distance(oldloc, locinput) */
4653                         while (locinput <= ST.maxpos) {
4654                             STRLEN len;
4655                             const UV c = utf8n_to_uvchr((U8*)locinput,
4656                                                   UTF8_MAXBYTES, &len,
4657                                                   uniflags);
4658                             if (c == (UV)ST.c1 || c == (UV)ST.c2)
4659                                 break;
4660                             locinput += len;
4661                             n++;
4662                         }
4663                     }
4664                 }
4665                 else {
4666                     if (ST.c1 == ST.c2) {
4667                         while (locinput <= ST.maxpos &&
4668                                UCHARAT(locinput) != ST.c1)
4669                             locinput++;
4670                     }
4671                     else {
4672                         while (locinput <= ST.maxpos
4673                                && UCHARAT(locinput) != ST.c1
4674                                && UCHARAT(locinput) != ST.c2)
4675                             locinput++;
4676                     }
4677                     n = locinput - ST.oldloc;
4678                 }
4679                 if (locinput > ST.maxpos)
4680                     sayNO;
4681                 /* PL_reginput == oldloc now */
4682                 if (n) {
4683                     ST.count += n;
4684                     if (regrepeat(rex, ST.A, n, depth) < n)
4685                         sayNO;
4686                 }
4687                 PL_reginput = locinput;
4688                 CURLY_SETPAREN(ST.paren, ST.count);
4689                 if (cur_eval && cur_eval->u.eval.close_paren &&
4690                     cur_eval->u.eval.close_paren == (U32)ST.paren) {
4691                     goto fake_end;
4692                 }
4693                 PUSH_STATE_GOTO(CURLY_B_min_known, ST.B);
4694             }
4695             /* NOTREACHED */
4696
4697
4698         case CURLY_B_min_fail:
4699             /* failed to find B in a non-greedy match where c1,c2 invalid */
4700             if (ST.paren && ST.count)
4701                 PL_regendp[ST.paren] = -1;
4702
4703             REGCP_UNWIND(ST.cp);
4704             /* failed -- move forward one */
4705             PL_reginput = locinput;
4706             if (regrepeat(rex, ST.A, 1, depth)) {
4707                 ST.count++;
4708                 locinput = PL_reginput;
4709                 if (ST.count <= ST.max || (ST.max == REG_INFTY &&
4710                         ST.count > 0)) /* count overflow ? */
4711                 {
4712                   curly_try_B_min:
4713                     CURLY_SETPAREN(ST.paren, ST.count);
4714                     if (cur_eval && cur_eval->u.eval.close_paren &&
4715                         cur_eval->u.eval.close_paren == (U32)ST.paren) {
4716                         goto fake_end;
4717                     }
4718                     PUSH_STATE_GOTO(CURLY_B_min, ST.B);
4719                 }
4720             }
4721             sayNO;
4722             /* NOTREACHED */
4723
4724
4725         curly_try_B_max:
4726             /* a successful greedy match: now try to match B */
4727             if (cur_eval && cur_eval->u.eval.close_paren &&
4728                 cur_eval->u.eval.close_paren == (U32)ST.paren) {
4729                 goto fake_end;
4730             }
4731             {
4732                 UV c = 0;
4733                 if (ST.c1 != CHRTEST_VOID)
4734                     c = do_utf8 ? utf8n_to_uvchr((U8*)PL_reginput,
4735                                            UTF8_MAXBYTES, 0, uniflags)
4736                                 : (UV) UCHARAT(PL_reginput);
4737                 /* If it could work, try it. */
4738                 if (ST.c1 == CHRTEST_VOID || c == (UV)ST.c1 || c == (UV)ST.c2) {
4739                     CURLY_SETPAREN(ST.paren, ST.count);
4740                     PUSH_STATE_GOTO(CURLY_B_max, ST.B);
4741                     /* NOTREACHED */
4742                 }
4743             }
4744             /* FALL THROUGH */
4745         case CURLY_B_max_fail:
4746             /* failed to find B in a greedy match */
4747             if (ST.paren && ST.count)
4748                 PL_regendp[ST.paren] = -1;
4749
4750             REGCP_UNWIND(ST.cp);
4751             /*  back up. */
4752             if (--ST.count < ST.min)
4753                 sayNO;
4754             PL_reginput = locinput = HOPc(locinput, -1);
4755             goto curly_try_B_max;
4756
4757 #undef ST
4758
4759         case END:
4760             fake_end:
4761             if (cur_eval) {
4762                 /* we've just finished A in /(??{A})B/; now continue with B */
4763                 I32 tmpix;
4764
4765
4766                 st->u.eval.toggle_reg_flags
4767                             = cur_eval->u.eval.toggle_reg_flags;
4768                 PL_reg_flags ^= st->u.eval.toggle_reg_flags;
4769
4770                 st->u.eval.prev_rex = rex;              /* inner */
4771                 rex  = cur_eval->u.eval.prev_rex;       /* outer */
4772                 rexi = RXi_GET(rex);
4773                 cur_curlyx = cur_eval->u.eval.prev_curlyx;
4774                 ReREFCNT_inc(rex);
4775                 st->u.eval.cp = regcppush(0);   /* Save *all* the positions. */
4776                 REGCP_SET(st->u.eval.lastcp);
4777                 PL_reginput = locinput;
4778
4779                 /* Restore parens of the outer rex without popping the
4780                  * savestack */
4781                 tmpix = PL_savestack_ix;
4782                 PL_savestack_ix = cur_eval->u.eval.lastcp;
4783                 regcppop(rex);
4784                 PL_savestack_ix = tmpix;
4785
4786                 st->u.eval.prev_eval = cur_eval;
4787                 cur_eval = cur_eval->u.eval.prev_eval;
4788                 DEBUG_EXECUTE_r(
4789                     PerlIO_printf(Perl_debug_log, "%*s  EVAL trying tail ... %"UVxf"\n",
4790                                       REPORT_CODE_OFF+depth*2, "",PTR2UV(cur_eval)););
4791                 PUSH_YES_STATE_GOTO(EVAL_AB,
4792                         st->u.eval.prev_eval->u.eval.B); /* match B */
4793             }
4794
4795             if (locinput < reginfo->till) {
4796                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4797                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
4798                                       PL_colors[4],
4799                                       (long)(locinput - PL_reg_starttry),
4800                                       (long)(reginfo->till - PL_reg_starttry),
4801                                       PL_colors[5]));
4802
4803                 sayNO_SILENT;           /* Cannot match: too short. */
4804             }
4805             PL_reginput = locinput;     /* put where regtry can find it */
4806             sayYES;                     /* Success! */
4807
4808         case SUCCEED: /* successful SUSPEND/UNLESSM/IFMATCH/CURLYM */
4809             DEBUG_EXECUTE_r(
4810             PerlIO_printf(Perl_debug_log,
4811                 "%*s  %ssubpattern success...%s\n",
4812                 REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5]));
4813             PL_reginput = locinput;     /* put where regtry can find it */
4814             sayYES;                     /* Success! */
4815
4816 #undef  ST
4817 #define ST st->u.ifmatch
4818
4819         case SUSPEND:   /* (?>A) */
4820             ST.wanted = 1;
4821             PL_reginput = locinput;
4822             goto do_ifmatch;
4823
4824         case UNLESSM:   /* -ve lookaround: (?!A), or with flags, (?<!A) */
4825             ST.wanted = 0;
4826             goto ifmatch_trivial_fail_test;
4827
4828         case IFMATCH:   /* +ve lookaround: (?=A), or with flags, (?<=A) */
4829             ST.wanted = 1;
4830           ifmatch_trivial_fail_test:
4831             if (scan->flags) {
4832                 char * const s = HOPBACKc(locinput, scan->flags);
4833                 if (!s) {
4834                     /* trivial fail */
4835                     if (logical) {
4836                         logical = 0;
4837                         sw = 1 - (bool)ST.wanted;
4838                     }
4839                     else if (ST.wanted)
4840                         sayNO;
4841                     next = scan + ARG(scan);
4842                     if (next == scan)
4843                         next = NULL;
4844                     break;
4845                 }
4846                 PL_reginput = s;
4847             }
4848             else
4849                 PL_reginput = locinput;
4850
4851           do_ifmatch:
4852             ST.me = scan;
4853             ST.logical = logical;
4854             /* execute body of (?...A) */
4855             PUSH_YES_STATE_GOTO(IFMATCH_A, NEXTOPER(NEXTOPER(scan)));
4856             /* NOTREACHED */
4857
4858         case IFMATCH_A_fail: /* body of (?...A) failed */
4859             ST.wanted = !ST.wanted;
4860             /* FALL THROUGH */
4861
4862         case IFMATCH_A: /* body of (?...A) succeeded */
4863             if (ST.logical) {
4864                 sw = (bool)ST.wanted;
4865             }
4866             else if (!ST.wanted)
4867                 sayNO;
4868
4869             if (OP(ST.me) == SUSPEND)
4870                 locinput = PL_reginput;
4871             else {
4872                 locinput = PL_reginput = st->locinput;
4873                 nextchr = UCHARAT(locinput);
4874             }
4875             scan = ST.me + ARG(ST.me);
4876             if (scan == ST.me)
4877                 scan = NULL;
4878             continue; /* execute B */
4879
4880 #undef ST
4881
4882         case LONGJMP:
4883             next = scan + ARG(scan);
4884             if (next == scan)
4885                 next = NULL;
4886             break;
4887         case COMMIT:
4888             reginfo->cutpoint = PL_regeol;
4889             /* FALLTHROUGH */
4890         case PRUNE:
4891             PL_reginput = locinput;
4892             if (!scan->flags)
4893                 sv_yes_mark = sv_commit = (SV*)rexi->data->data[ ARG( scan ) ];
4894             PUSH_STATE_GOTO(COMMIT_next,next);
4895             /* NOTREACHED */
4896         case COMMIT_next_fail:
4897             no_final = 1;
4898             /* FALLTHROUGH */
4899         case OPFAIL:
4900             sayNO;
4901             /* NOTREACHED */
4902
4903 #define ST st->u.mark
4904         case MARKPOINT:
4905             ST.prev_mark = mark_state;
4906             ST.mark_name = sv_commit = sv_yes_mark
4907                 = (SV*)rexi->data->data[ ARG( scan ) ];
4908             mark_state = st;
4909             ST.mark_loc = PL_reginput = locinput;
4910             PUSH_YES_STATE_GOTO(MARKPOINT_next,next);
4911             /* NOTREACHED */
4912         case MARKPOINT_next:
4913             mark_state = ST.prev_mark;
4914             sayYES;
4915             /* NOTREACHED */
4916         case MARKPOINT_next_fail:
4917             if (popmark && sv_eq(ST.mark_name,popmark))
4918             {
4919                 if (ST.mark_loc > startpoint)
4920                     reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1);
4921                 popmark = NULL; /* we found our mark */
4922                 sv_commit = ST.mark_name;
4923
4924                 DEBUG_EXECUTE_r({
4925                         PerlIO_printf(Perl_debug_log,
4926                             "%*s  %ssetting cutpoint to mark:%"SVf"...%s\n",
4927                             REPORT_CODE_OFF+depth*2, "",
4928                             PL_colors[4], SVfARG(sv_commit), PL_colors[5]);
4929                 });
4930             }
4931             mark_state = ST.prev_mark;
4932             sv_yes_mark = mark_state ?
4933                 mark_state->u.mark.mark_name : NULL;
4934             sayNO;
4935             /* NOTREACHED */
4936         case SKIP:
4937             PL_reginput = locinput;
4938             if (scan->flags) {
4939                 /* (*SKIP) : if we fail we cut here*/
4940                 ST.mark_name = NULL;
4941                 ST.mark_loc = locinput;
4942                 PUSH_STATE_GOTO(SKIP_next,next);
4943             } else {
4944                 /* (*SKIP:NAME) : if there is a (*MARK:NAME) fail where it was,
4945                    otherwise do nothing.  Meaning we need to scan
4946                  */
4947                 regmatch_state *cur = mark_state;
4948                 SV *find = (SV*)rexi->data->data[ ARG( scan ) ];
4949
4950                 while (cur) {
4951                     if ( sv_eq( cur->u.mark.mark_name,
4952                                 find ) )
4953                     {
4954                         ST.mark_name = find;
4955                         PUSH_STATE_GOTO( SKIP_next, next );
4956                     }
4957                     cur = cur->u.mark.prev_mark;
4958                 }
4959             }
4960             /* Didn't find our (*MARK:NAME) so ignore this (*SKIP:NAME) */
4961             break;
4962         case SKIP_next_fail:
4963             if (ST.mark_name) {
4964                 /* (*CUT:NAME) - Set up to search for the name as we
4965                    collapse the stack*/
4966                 popmark = ST.mark_name;
4967             } else {
4968                 /* (*CUT) - No name, we cut here.*/
4969                 if (ST.mark_loc > startpoint)
4970                     reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1);
4971                 /* but we set sv_commit to latest mark_name if there
4972                    is one so they can test to see how things lead to this
4973                    cut */
4974                 if (mark_state)
4975                     sv_commit=mark_state->u.mark.mark_name;
4976             }
4977             no_final = 1;
4978             sayNO;
4979             /* NOTREACHED */
4980 #undef ST
4981
4982         default:
4983             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
4984                           PTR2UV(scan), OP(scan));
4985             Perl_croak(aTHX_ "regexp memory corruption");
4986
4987         } /* end switch */
4988
4989         /* switch break jumps here */
4990         scan = next; /* prepare to execute the next op and ... */
4991         continue;    /* ... jump back to the top, reusing st */
4992         /* NOTREACHED */
4993
4994       push_yes_state:
4995         /* push a state that backtracks on success */
4996         st->u.yes.prev_yes_state = yes_state;
4997         yes_state = st;
4998         /* FALL THROUGH */
4999       push_state:
5000         /* push a new regex state, then continue at scan  */
5001         {
5002             regmatch_state *newst;
5003
5004             DEBUG_STACK_r({
5005                 regmatch_state *cur = st;
5006                 regmatch_state *curyes = yes_state;
5007                 int curd = depth;
5008                 regmatch_slab *slab = PL_regmatch_slab;
5009                 for (;curd > -1;cur--,curd--) {
5010                     if (cur < SLAB_FIRST(slab)) {
5011                         slab = slab->prev;
5012                         cur = SLAB_LAST(slab);
5013                     }
5014                     PerlIO_printf(Perl_error_log, "%*s#%-3d %-10s %s\n",
5015                         REPORT_CODE_OFF + 2 + depth * 2,"",
5016                         curd, reg_name[cur->resume_state],
5017                         (curyes == cur) ? "yes" : ""
5018                     );
5019                     if (curyes == cur)
5020                         curyes = cur->u.yes.prev_yes_state;
5021                 }
5022             } else
5023                 DEBUG_STATE_pp("push")
5024             );
5025             depth++;
5026             st->locinput = locinput;
5027             newst = st+1;
5028             if (newst >  SLAB_LAST(PL_regmatch_slab))
5029                 newst = S_push_slab(aTHX);
5030             PL_regmatch_state = newst;
5031
5032             locinput = PL_reginput;
5033             nextchr = UCHARAT(locinput);
5034             st = newst;
5035             continue;
5036             /* NOTREACHED */
5037         }
5038     }
5039
5040     /*
5041     * We get here only if there's trouble -- normally "case END" is
5042     * the terminating point.
5043     */
5044     Perl_croak(aTHX_ "corrupted regexp pointers");
5045     /*NOTREACHED*/
5046     sayNO;
5047
5048 yes:
5049     if (yes_state) {
5050         /* we have successfully completed a subexpression, but we must now
5051          * pop to the state marked by yes_state and continue from there */
5052         assert(st != yes_state);
5053 #ifdef DEBUGGING
5054         while (st != yes_state) {
5055             st--;
5056             if (st < SLAB_FIRST(PL_regmatch_slab)) {
5057                 PL_regmatch_slab = PL_regmatch_slab->prev;
5058                 st = SLAB_LAST(PL_regmatch_slab);
5059             }
5060             DEBUG_STATE_r({
5061                 if (no_final) {
5062                     DEBUG_STATE_pp("pop (no final)");
5063                 } else {
5064                     DEBUG_STATE_pp("pop (yes)");
5065                 }
5066             });
5067             depth--;
5068         }
5069 #else
5070         while (yes_state < SLAB_FIRST(PL_regmatch_slab)
5071             || yes_state > SLAB_LAST(PL_regmatch_slab))
5072         {
5073             /* not in this slab, pop slab */
5074             depth -= (st - SLAB_FIRST(PL_regmatch_slab) + 1);
5075             PL_regmatch_slab = PL_regmatch_slab->prev;
5076             st = SLAB_LAST(PL_regmatch_slab);
5077         }
5078         depth -= (st - yes_state);
5079 #endif
5080         st = yes_state;
5081         yes_state = st->u.yes.prev_yes_state;
5082         PL_regmatch_state = st;
5083
5084         if (no_final) {
5085             locinput= st->locinput;
5086             nextchr = UCHARAT(locinput);
5087         }
5088         state_num = st->resume_state + no_final;
5089         goto reenter_switch;
5090     }
5091
5092     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
5093                           PL_colors[4], PL_colors[5]));
5094
5095     result = 1;
5096     goto final_exit;
5097
5098 no:
5099     DEBUG_EXECUTE_r(
5100         PerlIO_printf(Perl_debug_log,
5101             "%*s  %sfailed...%s\n",
5102             REPORT_CODE_OFF+depth*2, "",
5103             PL_colors[4], PL_colors[5])
5104         );
5105
5106 no_silent:
5107     if (no_final) {
5108         if (yes_state) {
5109             goto yes;
5110         } else {
5111             goto final_exit;
5112         }
5113     }
5114     if (depth) {
5115         /* there's a previous state to backtrack to */
5116         st--;
5117         if (st < SLAB_FIRST(PL_regmatch_slab)) {
5118             PL_regmatch_slab = PL_regmatch_slab->prev;
5119             st = SLAB_LAST(PL_regmatch_slab);
5120         }
5121         PL_regmatch_state = st;
5122         locinput= st->locinput;
5123         nextchr = UCHARAT(locinput);
5124
5125         DEBUG_STATE_pp("pop");
5126         depth--;
5127         if (yes_state == st)
5128             yes_state = st->u.yes.prev_yes_state;
5129
5130         state_num = st->resume_state + 1; /* failure = success + 1 */
5131         goto reenter_switch;
5132     }
5133     result = 0;
5134
5135   final_exit:
5136     if (rex->intflags & PREGf_VERBARG_SEEN) {
5137         SV *sv_err = get_sv("REGERROR", 1);
5138         SV *sv_mrk = get_sv("REGMARK", 1);
5139         if (result) {
5140             sv_commit = &PL_sv_no;
5141             if (!sv_yes_mark)
5142                 sv_yes_mark = &PL_sv_yes;
5143         } else {
5144             if (!sv_commit)
5145                 sv_commit = &PL_sv_yes;
5146             sv_yes_mark = &PL_sv_no;
5147         }
5148         sv_setsv(sv_err, sv_commit);
5149         sv_setsv(sv_mrk, sv_yes_mark);
5150     }
5151     /* restore original high-water mark */
5152     PL_regmatch_slab  = orig_slab;
5153     PL_regmatch_state = orig_state;
5154
5155     /* free all slabs above current one */
5156     if (orig_slab->next) {
5157         regmatch_slab *sl = orig_slab->next;
5158         orig_slab->next = NULL;
5159         while (sl) {
5160             regmatch_slab * const osl = sl;
5161             sl = sl->next;
5162             Safefree(osl);
5163         }
5164     }
5165
5166     return result;
5167 }
5168
5169 /*
5170  - regrepeat - repeatedly match something simple, report how many
5171  */
5172 /*
5173  * [This routine now assumes that it will only match on things of length 1.
5174  * That was true before, but now we assume scan - reginput is the count,
5175  * rather than incrementing count on every character.  [Er, except utf8.]]
5176  */
5177 STATIC I32
5178 S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth)
5179 {
5180     dVAR;
5181     register char *scan;
5182     register I32 c;
5183     register char *loceol = PL_regeol;
5184     register I32 hardcount = 0;
5185     register bool do_utf8 = PL_reg_match_utf8;
5186
5187     scan = PL_reginput;
5188     if (max == REG_INFTY)
5189         max = I32_MAX;
5190     else if (max < loceol - scan)
5191         loceol = scan + max;
5192     switch (OP(p)) {
5193     case REG_ANY:
5194         if (do_utf8) {
5195             loceol = PL_regeol;
5196             while (scan < loceol && hardcount < max && *scan != '\n') {
5197                 scan += UTF8SKIP(scan);
5198                 hardcount++;
5199             }
5200         } else {
5201             while (scan < loceol && *scan != '\n')
5202                 scan++;
5203         }
5204         break;
5205     case SANY:
5206         if (do_utf8) {
5207             loceol = PL_regeol;
5208             while (scan < loceol && hardcount < max) {
5209                 scan += UTF8SKIP(scan);
5210                 hardcount++;
5211             }
5212         }
5213         else
5214             scan = loceol;
5215         break;
5216     case CANY:
5217         scan = loceol;
5218         break;
5219     case EXACT:         /* length of string is 1 */
5220         c = (U8)*STRING(p);
5221         while (scan < loceol && UCHARAT(scan) == c)
5222             scan++;
5223         break;
5224     case EXACTF:        /* length of string is 1 */
5225         c = (U8)*STRING(p);
5226         while (scan < loceol &&
5227                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
5228             scan++;
5229         break;
5230     case EXACTFL:       /* length of string is 1 */
5231         PL_reg_flags |= RF_tainted;
5232         c = (U8)*STRING(p);
5233         while (scan < loceol &&
5234                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
5235             scan++;
5236         break;
5237     case ANYOF:
5238         if (do_utf8) {
5239             loceol = PL_regeol;
5240             while (hardcount < max && scan < loceol &&
5241                    reginclass(prog, p, (U8*)scan, 0, do_utf8)) {
5242                 scan += UTF8SKIP(scan);
5243                 hardcount++;
5244             }
5245         } else {
5246             while (scan < loceol && REGINCLASS(prog, p, (U8*)scan))
5247                 scan++;
5248         }
5249         break;
5250     case ALNUM:
5251         if (do_utf8) {
5252             loceol = PL_regeol;
5253             LOAD_UTF8_CHARCLASS_ALNUM();
5254             while (hardcount < max && scan < loceol &&
5255                    swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
5256                 scan += UTF8SKIP(scan);
5257                 hardcount++;
5258             }
5259         } else {
5260             while (scan < loceol && isALNUM(*scan))
5261                 scan++;
5262         }
5263         break;
5264     case ALNUML:
5265         PL_reg_flags |= RF_tainted;
5266         if (do_utf8) {
5267             loceol = PL_regeol;
5268             while (hardcount < max && scan < loceol &&
5269                    isALNUM_LC_utf8((U8*)scan)) {
5270                 scan += UTF8SKIP(scan);
5271                 hardcount++;
5272             }
5273         } else {
5274             while (scan < loceol && isALNUM_LC(*scan))
5275                 scan++;
5276         }
5277         break;
5278     case NALNUM:
5279         if (do_utf8) {
5280             loceol = PL_regeol;
5281             LOAD_UTF8_CHARCLASS_ALNUM();
5282             while (hardcount < max && scan < loceol &&
5283                    !swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
5284                 scan += UTF8SKIP(scan);
5285                 hardcount++;
5286             }
5287         } else {
5288             while (scan < loceol && !isALNUM(*scan))
5289                 scan++;
5290         }
5291         break;
5292     case NALNUML:
5293         PL_reg_flags |= RF_tainted;
5294         if (do_utf8) {
5295             loceol = PL_regeol;
5296             while (hardcount < max && scan < loceol &&
5297                    !isALNUM_LC_utf8((U8*)scan)) {
5298                 scan += UTF8SKIP(scan);
5299                 hardcount++;
5300             }
5301         } else {
5302             while (scan < loceol && !isALNUM_LC(*scan))
5303                 scan++;
5304         }
5305         break;
5306     case SPACE:
5307         if (do_utf8) {
5308             loceol = PL_regeol;
5309             LOAD_UTF8_CHARCLASS_SPACE();
5310             while (hardcount < max && scan < loceol &&
5311                    (*scan == ' ' ||
5312                     swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
5313                 scan += UTF8SKIP(scan);
5314                 hardcount++;
5315             }
5316         } else {
5317             while (scan < loceol && isSPACE(*scan))
5318                 scan++;
5319         }
5320         break;
5321     case SPACEL:
5322         PL_reg_flags |= RF_tainted;
5323         if (do_utf8) {
5324             loceol = PL_regeol;
5325             while (hardcount < max && scan < loceol &&
5326                    (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
5327                 scan += UTF8SKIP(scan);
5328                 hardcount++;
5329             }
5330         } else {
5331             while (scan < loceol && isSPACE_LC(*scan))
5332                 scan++;
5333         }
5334         break;
5335     case NSPACE:
5336         if (do_utf8) {
5337             loceol = PL_regeol;
5338             LOAD_UTF8_CHARCLASS_SPACE();
5339             while (hardcount < max && scan < loceol &&
5340                    !(*scan == ' ' ||
5341                      swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
5342                 scan += UTF8SKIP(scan);
5343                 hardcount++;
5344             }
5345         } else {
5346             while (scan < loceol && !isSPACE(*scan))
5347                 scan++;
5348             break;
5349         }
5350     case NSPACEL:
5351         PL_reg_flags |= RF_tainted;
5352         if (do_utf8) {
5353             loceol = PL_regeol;
5354             while (hardcount < max && scan < loceol &&
5355                    !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
5356                 scan += UTF8SKIP(scan);
5357                 hardcount++;
5358             }
5359         } else {
5360             while (scan < loceol && !isSPACE_LC(*scan))
5361                 scan++;
5362         }
5363         break;
5364     case DIGIT:
5365         if (do_utf8) {
5366             loceol = PL_regeol;
5367             LOAD_UTF8_CHARCLASS_DIGIT();
5368             while (hardcount < max && scan < loceol &&
5369                    swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
5370                 scan += UTF8SKIP(scan);
5371                 hardcount++;
5372             }
5373         } else {
5374             while (scan < loceol && isDIGIT(*scan))
5375                 scan++;
5376         }
5377         break;
5378     case NDIGIT:
5379         if (do_utf8) {
5380             loceol = PL_regeol;
5381             LOAD_UTF8_CHARCLASS_DIGIT();
5382             while (hardcount < max && scan < loceol &&
5383                    !swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
5384                 scan += UTF8SKIP(scan);
5385                 hardcount++;
5386             }
5387         } else {
5388             while (scan < loceol && !isDIGIT(*scan))
5389                 scan++;
5390         }
5391         break;
5392     default:            /* Called on something of 0 width. */
5393         break;          /* So match right here or not at all. */
5394     }
5395
5396     if (hardcount)
5397         c = hardcount;
5398     else
5399         c = scan - PL_reginput;
5400     PL_reginput = scan;
5401
5402     DEBUG_r({
5403         GET_RE_DEBUG_FLAGS_DECL;
5404         DEBUG_EXECUTE_r({
5405             SV * const prop = sv_newmortal();
5406             regprop(prog, prop, p);
5407             PerlIO_printf(Perl_debug_log,
5408                         "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
5409                         REPORT_CODE_OFF + depth*2, "", SvPVX_const(prop),(IV)c,(IV)max);
5410         });
5411     });
5412
5413     return(c);
5414 }
5415
5416
5417 #if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION)
5418 /*
5419 - regclass_swash - prepare the utf8 swash
5420 */
5421
5422 SV *
5423 Perl_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool doinit, SV** listsvp, SV **altsvp)
5424 {
5425     dVAR;
5426     SV *sw  = NULL;
5427     SV *si  = NULL;
5428     SV *alt = NULL;
5429     RXi_GET_DECL(prog,progi);
5430     const struct reg_data * const data = prog ? progi->data : NULL;
5431
5432     if (data && data->count) {
5433         const U32 n = ARG(node);
5434
5435         if (data->what[n] == 's') {
5436             SV * const rv = (SV*)data->data[n];
5437             AV * const av = (AV*)SvRV((SV*)rv);
5438             SV **const ary = AvARRAY(av);
5439             SV **a, **b;
5440
5441             /* See the end of regcomp.c:S_regclass() for
5442              * documentation of these array elements. */
5443
5444             si = *ary;
5445             a  = SvROK(ary[1]) ? &ary[1] : 0;
5446             b  = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : 0;
5447
5448             if (a)
5449                 sw = *a;
5450             else if (si && doinit) {
5451                 sw = swash_init("utf8", "", si, 1, 0);
5452                 (void)av_store(av, 1, sw);
5453             }
5454             if (b)
5455                 alt = *b;
5456         }
5457     }
5458
5459     if (listsvp)
5460         *listsvp = si;
5461     if (altsvp)
5462         *altsvp  = alt;
5463
5464     return sw;
5465 }
5466 #endif
5467
5468 /*
5469  - reginclass - determine if a character falls into a character class
5470
5471   The n is the ANYOF regnode, the p is the target string, lenp
5472   is pointer to the maximum length of how far to go in the p
5473   (if the lenp is zero, UTF8SKIP(p) is used),
5474   do_utf8 tells whether the target string is in UTF-8.
5475
5476  */
5477
5478 STATIC bool
5479 S_reginclass(pTHX_ const regexp *prog, register const regnode *n, register const U8* p, STRLEN* lenp, register bool do_utf8)
5480 {
5481     dVAR;
5482     const char flags = ANYOF_FLAGS(n);
5483     bool match = FALSE;
5484     UV c = *p;
5485     STRLEN len = 0;
5486     STRLEN plen;
5487
5488     if (do_utf8 && !UTF8_IS_INVARIANT(c)) {
5489         c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &len,
5490                 (UTF8_ALLOW_DEFAULT & UTF8_ALLOW_ANYUV) | UTF8_CHECK_ONLY);
5491                 /* see [perl #37836] for UTF8_ALLOW_ANYUV */
5492         if (len == (STRLEN)-1)
5493             Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
5494     }
5495
5496     plen = lenp ? *lenp : UNISKIP(NATIVE_TO_UNI(c));
5497     if (do_utf8 || (flags & ANYOF_UNICODE)) {
5498         if (lenp)
5499             *lenp = 0;
5500         if (do_utf8 && !ANYOF_RUNTIME(n)) {
5501             if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
5502                 match = TRUE;
5503         }
5504         if (!match && do_utf8 && (flags & ANYOF_UNICODE_ALL) && c >= 256)
5505             match = TRUE;
5506         if (!match) {
5507             AV *av;
5508             SV * const sw = regclass_swash(prog, n, TRUE, 0, (SV**)&av);
5509
5510             if (sw) {
5511                 if (swash_fetch(sw, p, do_utf8))
5512                     match = TRUE;
5513                 else if (flags & ANYOF_FOLD) {
5514                     if (!match && lenp && av) {
5515                         I32 i;
5516                         for (i = 0; i <= av_len(av); i++) {
5517                             SV* const sv = *av_fetch(av, i, FALSE);
5518                             STRLEN len;
5519                             const char * const s = SvPV_const(sv, len);
5520
5521                             if (len <= plen && memEQ(s, (char*)p, len)) {
5522                                 *lenp = len;
5523                                 match = TRUE;
5524                                 break;
5525                             }
5526                         }
5527                     }
5528                     if (!match) {
5529                         U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
5530                         STRLEN tmplen;
5531
5532                         to_utf8_fold(p, tmpbuf, &tmplen);
5533                         if (swash_fetch(sw, tmpbuf, do_utf8))
5534                             match = TRUE;
5535                     }
5536                 }
5537             }
5538         }
5539         if (match && lenp && *lenp == 0)
5540             *lenp = UNISKIP(NATIVE_TO_UNI(c));
5541     }
5542     if (!match && c < 256) {
5543         if (ANYOF_BITMAP_TEST(n, c))
5544             match = TRUE;
5545         else if (flags & ANYOF_FOLD) {
5546             U8 f;
5547
5548             if (flags & ANYOF_LOCALE) {
5549                 PL_reg_flags |= RF_tainted;
5550                 f = PL_fold_locale[c];
5551             }
5552             else
5553                 f = PL_fold[c];
5554             if (f != c && ANYOF_BITMAP_TEST(n, f))
5555                 match = TRUE;
5556         }
5557
5558         if (!match && (flags & ANYOF_CLASS)) {
5559             PL_reg_flags |= RF_tainted;
5560             if (
5561                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
5562                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
5563                 (ANYOF_CLASS_TEST(n, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
5564                 (ANYOF_CLASS_TEST(n, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
5565                 (ANYOF_CLASS_TEST(n, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
5566                 (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
5567                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
5568                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
5569                 (ANYOF_CLASS_TEST(n, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
5570                 (ANYOF_CLASS_TEST(n, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
5571                 (ANYOF_CLASS_TEST(n, ANYOF_ASCII)   &&  isASCII(c))     ||
5572                 (ANYOF_CLASS_TEST(n, ANYOF_NASCII)  && !isASCII(c))     ||
5573                 (ANYOF_CLASS_TEST(n, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
5574                 (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
5575                 (ANYOF_CLASS_TEST(n, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
5576                 (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
5577                 (ANYOF_CLASS_TEST(n, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
5578                 (ANYOF_CLASS_TEST(n, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
5579                 (ANYOF_CLASS_TEST(n, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
5580                 (ANYOF_CLASS_TEST(n, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
5581                 (ANYOF_CLASS_TEST(n, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
5582                 (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
5583                 (ANYOF_CLASS_TEST(n, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
5584                 (ANYOF_CLASS_TEST(n, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
5585                 (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
5586                 (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c))    ||
5587                 (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC)  &&  isPSXSPC(c))    ||
5588                 (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c))    ||
5589                 (ANYOF_CLASS_TEST(n, ANYOF_BLANK)   &&  isBLANK(c))     ||
5590                 (ANYOF_CLASS_TEST(n, ANYOF_NBLANK)  && !isBLANK(c))
5591                 ) /* How's that for a conditional? */
5592             {
5593                 match = TRUE;
5594             }
5595         }
5596     }
5597
5598     return (flags & ANYOF_INVERT) ? !match : match;
5599 }
5600
5601 STATIC U8 *
5602 S_reghop3(U8 *s, I32 off, const U8* lim)
5603 {
5604     dVAR;
5605     if (off >= 0) {
5606         while (off-- && s < lim) {
5607             /* XXX could check well-formedness here */
5608             s += UTF8SKIP(s);
5609         }
5610     }
5611     else {
5612         while (off++ && s > lim) {
5613             s--;
5614             if (UTF8_IS_CONTINUED(*s)) {
5615                 while (s > lim && UTF8_IS_CONTINUATION(*s))
5616                     s--;
5617             }
5618             /* XXX could check well-formedness here */
5619         }
5620     }
5621     return s;
5622 }
5623
5624 #ifdef XXX_dmq
5625 /* there are a bunch of places where we use two reghop3's that should
5626    be replaced with this routine. but since thats not done yet
5627    we ifdef it out - dmq
5628 */
5629 STATIC U8 *
5630 S_reghop4(U8 *s, I32 off, const U8* llim, const U8* rlim)
5631 {
5632     dVAR;
5633     if (off >= 0) {
5634         while (off-- && s < rlim) {
5635             /* XXX could check well-formedness here */
5636             s += UTF8SKIP(s);
5637         }
5638     }
5639     else {
5640         while (off++ && s > llim) {
5641             s--;
5642             if (UTF8_IS_CONTINUED(*s)) {
5643                 while (s > llim && UTF8_IS_CONTINUATION(*s))
5644                     s--;
5645             }
5646             /* XXX could check well-formedness here */
5647         }
5648     }
5649     return s;
5650 }
5651 #endif
5652
5653 STATIC U8 *
5654 S_reghopmaybe3(U8* s, I32 off, const U8* lim)
5655 {
5656     dVAR;
5657     if (off >= 0) {
5658         while (off-- && s < lim) {
5659             /* XXX could check well-formedness here */
5660             s += UTF8SKIP(s);
5661         }
5662         if (off >= 0)
5663             return NULL;
5664     }
5665     else {
5666         while (off++ && s > lim) {
5667             s--;
5668             if (UTF8_IS_CONTINUED(*s)) {
5669                 while (s > lim && UTF8_IS_CONTINUATION(*s))
5670                     s--;
5671             }
5672             /* XXX could check well-formedness here */
5673         }
5674         if (off <= 0)
5675             return NULL;
5676     }
5677     return s;
5678 }
5679
5680 static void
5681 restore_pos(pTHX_ void *arg)
5682 {
5683     dVAR;
5684     regexp * const rex = (regexp *)arg;
5685     if (PL_reg_eval_set) {
5686         if (PL_reg_oldsaved) {
5687             rex->subbeg = PL_reg_oldsaved;
5688             rex->sublen = PL_reg_oldsavedlen;
5689 #ifdef PERL_OLD_COPY_ON_WRITE
5690             rex->saved_copy = PL_nrs;
5691 #endif
5692             RX_MATCH_COPIED_on(rex);
5693         }
5694         PL_reg_magic->mg_len = PL_reg_oldpos;
5695         PL_reg_eval_set = 0;
5696         PL_curpm = PL_reg_oldcurpm;
5697     }
5698 }
5699
5700 STATIC void
5701 S_to_utf8_substr(pTHX_ register regexp *prog)
5702 {
5703     int i = 1;
5704     do {
5705         if (prog->substrs->data[i].substr
5706             && !prog->substrs->data[i].utf8_substr) {
5707             SV* const sv = newSVsv(prog->substrs->data[i].substr);
5708             prog->substrs->data[i].utf8_substr = sv;
5709             sv_utf8_upgrade(sv);
5710             if (SvVALID(prog->substrs->data[i].substr)) {
5711                 const U8 flags = BmFLAGS(prog->substrs->data[i].substr);
5712                 if (flags & FBMcf_TAIL) {
5713                     /* Trim the trailing \n that fbm_compile added last
5714                        time.  */
5715                     SvCUR_set(sv, SvCUR(sv) - 1);
5716                     /* Whilst this makes the SV technically "invalid" (as its
5717                        buffer is no longer followed by "\0") when fbm_compile()
5718                        adds the "\n" back, a "\0" is restored.  */
5719                 }
5720                 fbm_compile(sv, flags);
5721             }
5722             if (prog->substrs->data[i].substr == prog->check_substr)
5723                 prog->check_utf8 = sv;
5724         }
5725     } while (i--);
5726 }
5727
5728 STATIC void
5729 S_to_byte_substr(pTHX_ register regexp *prog)
5730 {
5731     dVAR;
5732     int i = 1;
5733     do {
5734         if (prog->substrs->data[i].utf8_substr
5735             && !prog->substrs->data[i].substr) {
5736             SV* sv = newSVsv(prog->substrs->data[i].utf8_substr);
5737             if (sv_utf8_downgrade(sv, TRUE)) {
5738                 if (SvVALID(prog->substrs->data[i].utf8_substr)) {
5739                     const U8 flags
5740                         = BmFLAGS(prog->substrs->data[i].utf8_substr);
5741                     if (flags & FBMcf_TAIL) {
5742                         /* Trim the trailing \n that fbm_compile added last
5743                            time.  */
5744                         SvCUR_set(sv, SvCUR(sv) - 1);
5745                     }
5746                     fbm_compile(sv, flags);
5747                 }
5748             } else {
5749                 SvREFCNT_dec(sv);
5750                 sv = &PL_sv_undef;
5751             }
5752             prog->substrs->data[i].substr = sv;
5753             if (prog->substrs->data[i].utf8_substr == prog->check_utf8)
5754                 prog->check_substr = sv;
5755         }
5756     } while (i--);
5757 }
5758
5759 /*
5760  * Local variables:
5761  * c-indentation-style: bsd
5762  * c-basic-offset: 4
5763  * indent-tabs-mode: t
5764  * End:
5765  *
5766  * ex: set ts=8 sts=4 sw=4 noet:
5767  */