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 DEBUGGING        /* 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 /*
1650  - regexec_flags - match a regexp against a string
1651  */
1652 I32
1653 Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *strend,
1654               char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
1655 /* strend: pointer to null at end of string */
1656 /* strbeg: real beginning of string */
1657 /* minend: end of match must be >=minend after stringarg. */
1658 /* data: May be used for some additional optimizations.
1659          Currently its only used, with a U32 cast, for transmitting
1660          the ganch offset when doing a /g match. This will change */
1661 /* nosave: For optimizations. */
1662 {
1663     dVAR;
1664     /*register*/ char *s;
1665     register regnode *c;
1666     /*register*/ char *startpos = stringarg;
1667     I32 minlen;         /* must match at least this many chars */
1668     I32 dontbother = 0; /* how many characters not to try at end */
1669     I32 end_shift = 0;                  /* Same for the end. */         /* CC */
1670     I32 scream_pos = -1;                /* Internal iterator of scream. */
1671     char *scream_olds = NULL;
1672     SV* const oreplsv = GvSV(PL_replgv);
1673     const bool do_utf8 = (bool)DO_UTF8(sv);
1674     I32 multiline;
1675     RXi_GET_DECL(prog,progi);
1676     regmatch_info reginfo;  /* create some info to pass to regtry etc */
1677
1678     GET_RE_DEBUG_FLAGS_DECL;
1679
1680     PERL_UNUSED_ARG(data);
1681
1682     /* Be paranoid... */
1683     if (prog == NULL || startpos == NULL) {
1684         Perl_croak(aTHX_ "NULL regexp parameter");
1685         return 0;
1686     }
1687
1688     multiline = prog->extflags & RXf_PMf_MULTILINE;
1689     reginfo.prog = prog;
1690
1691     RX_MATCH_UTF8_set(prog, do_utf8);
1692     DEBUG_EXECUTE_r(
1693         debug_start_match(prog, do_utf8, startpos, strend,
1694         "Matching");
1695     );
1696
1697     minlen = prog->minlen;
1698
1699     if (strend - startpos < (minlen+(prog->check_offset_min<0?prog->check_offset_min:0))) {
1700         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
1701                               "String too short [regexec_flags]...\n"));
1702         goto phooey;
1703     }
1704
1705
1706     /* Check validity of program. */
1707     if (UCHARAT(progi->program) != REG_MAGIC) {
1708         Perl_croak(aTHX_ "corrupted regexp program");
1709     }
1710
1711     PL_reg_flags = 0;
1712     PL_reg_eval_set = 0;
1713     PL_reg_maxiter = 0;
1714
1715     if (prog->extflags & RXf_UTF8)
1716         PL_reg_flags |= RF_utf8;
1717
1718     /* Mark beginning of line for ^ and lookbehind. */
1719     reginfo.bol = startpos; /* XXX not used ??? */
1720     PL_bostr  = strbeg;
1721     reginfo.sv = sv;
1722
1723     /* Mark end of line for $ (and such) */
1724     PL_regeol = strend;
1725
1726     /* see how far we have to get to not match where we matched before */
1727     reginfo.till = startpos+minend;
1728
1729     /* If there is a "must appear" string, look for it. */
1730     s = startpos;
1731
1732     if (prog->extflags & RXf_GPOS_SEEN) { /* Need to set reginfo->ganch */
1733         MAGIC *mg;
1734
1735         if (flags & REXEC_IGNOREPOS)    /* Means: check only at start */
1736             reginfo.ganch = startpos + prog->gofs;
1737         else if (sv && SvTYPE(sv) >= SVt_PVMG
1738                   && SvMAGIC(sv)
1739                   && (mg = mg_find(sv, PERL_MAGIC_regex_global))
1740                   && mg->mg_len >= 0) {
1741             reginfo.ganch = strbeg + mg->mg_len;        /* Defined pos() */
1742             if (prog->extflags & RXf_ANCH_GPOS) {
1743                 if (s > reginfo.ganch)
1744                     goto phooey;
1745                 s = reginfo.ganch - prog->gofs;
1746             }
1747         }
1748         else if (data) {
1749             reginfo.ganch = strbeg + PTR2UV(data);
1750         } else                          /* pos() not defined */
1751             reginfo.ganch = strbeg;
1752     }
1753     if (PL_curpm && (PM_GETRE(PL_curpm) == prog)) {
1754         I32 *t;
1755         if (!progi->swap) {
1756         /* We have to be careful. If the previous successful match
1757            was from this regex we don't want a subsequent paritally
1758            successful match to clobber the old results.
1759            So when we detect this possibility we add a swap buffer
1760            to the re, and switch the buffer each match. If we fail
1761            we switch it back, otherwise we leave it swapped.
1762         */
1763             Newxz(progi->swap, 1, regexp_paren_ofs);
1764             /* no need to copy these */
1765             Newxz(progi->swap->startp, prog->nparens + 1, I32);
1766             Newxz(progi->swap->endp, prog->nparens + 1, I32);
1767         }
1768         t = progi->swap->startp;
1769         progi->swap->startp = prog->startp;
1770         prog->startp = t;
1771         t = progi->swap->endp;
1772         progi->swap->endp = prog->endp;
1773         prog->endp = t;
1774     }
1775     if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) {
1776         re_scream_pos_data d;
1777
1778         d.scream_olds = &scream_olds;
1779         d.scream_pos = &scream_pos;
1780         s = re_intuit_start(prog, sv, s, strend, flags, &d);
1781         if (!s) {
1782             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
1783             goto phooey;        /* not present */
1784         }
1785     }
1786
1787
1788
1789     /* Simplest case:  anchored match need be tried only once. */
1790     /*  [unless only anchor is BOL and multiline is set] */
1791     if (prog->extflags & (RXf_ANCH & ~RXf_ANCH_GPOS)) {
1792         if (s == startpos && regtry(&reginfo, &startpos))
1793             goto got_it;
1794         else if (multiline || (prog->intflags & PREGf_IMPLICIT)
1795                  || (prog->extflags & RXf_ANCH_MBOL)) /* XXXX SBOL? */
1796         {
1797             char *end;
1798
1799             if (minlen)
1800                 dontbother = minlen - 1;
1801             end = HOP3c(strend, -dontbother, strbeg) - 1;
1802             /* for multiline we only have to try after newlines */
1803             if (prog->check_substr || prog->check_utf8) {
1804                 if (s == startpos)
1805                     goto after_try;
1806                 while (1) {
1807                     if (regtry(&reginfo, &s))
1808                         goto got_it;
1809                   after_try:
1810                     if (s >= end)
1811                         goto phooey;
1812                     if (prog->extflags & RXf_USE_INTUIT) {
1813                         s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
1814                         if (!s)
1815                             goto phooey;
1816                     }
1817                     else
1818                         s++;
1819                 }
1820             } else {
1821                 if (s > startpos)
1822                     s--;
1823                 while (s < end) {
1824                     if (*s++ == '\n') { /* don't need PL_utf8skip here */
1825                         if (regtry(&reginfo, &s))
1826                             goto got_it;
1827                     }
1828                 }
1829             }
1830         }
1831         goto phooey;
1832     } else if (RXf_GPOS_CHECK == (prog->extflags & RXf_GPOS_CHECK))
1833     {
1834         /* the warning about reginfo.ganch being used without intialization
1835            is bogus -- we set it above, when prog->extflags & RXf_GPOS_SEEN
1836            and we only enter this block when the same bit is set. */
1837         char *tmp_s = reginfo.ganch - prog->gofs;
1838         if (regtry(&reginfo, &tmp_s))
1839             goto got_it;
1840         goto phooey;
1841     }
1842
1843     /* Messy cases:  unanchored match. */
1844     if ((prog->anchored_substr || prog->anchored_utf8) && prog->intflags & PREGf_SKIP) {
1845         /* we have /x+whatever/ */
1846         /* it must be a one character string (XXXX Except UTF?) */
1847         char ch;
1848 #ifdef DEBUGGING
1849         int did_match = 0;
1850 #endif
1851         if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1852             do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1853         ch = SvPVX_const(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr)[0];
1854
1855         if (do_utf8) {
1856             REXEC_FBC_SCAN(
1857                 if (*s == ch) {
1858                     DEBUG_EXECUTE_r( did_match = 1 );
1859                     if (regtry(&reginfo, &s)) goto got_it;
1860                     s += UTF8SKIP(s);
1861                     while (s < strend && *s == ch)
1862                         s += UTF8SKIP(s);
1863                 }
1864             );
1865         }
1866         else {
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++;
1872                     while (s < strend && *s == ch)
1873                         s++;
1874                 }
1875             );
1876         }
1877         DEBUG_EXECUTE_r(if (!did_match)
1878                 PerlIO_printf(Perl_debug_log,
1879                                   "Did not find anchored character...\n")
1880                );
1881     }
1882     else if (prog->anchored_substr != NULL
1883               || prog->anchored_utf8 != NULL
1884               || ((prog->float_substr != NULL || prog->float_utf8 != NULL)
1885                   && prog->float_max_offset < strend - s)) {
1886         SV *must;
1887         I32 back_max;
1888         I32 back_min;
1889         char *last;
1890         char *last1;            /* Last position checked before */
1891 #ifdef DEBUGGING
1892         int did_match = 0;
1893 #endif
1894         if (prog->anchored_substr || prog->anchored_utf8) {
1895             if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1896                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1897             must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
1898             back_max = back_min = prog->anchored_offset;
1899         } else {
1900             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
1901                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1902             must = do_utf8 ? prog->float_utf8 : prog->float_substr;
1903             back_max = prog->float_max_offset;
1904             back_min = prog->float_min_offset;
1905         }
1906
1907
1908         if (must == &PL_sv_undef)
1909             /* could not downgrade utf8 check substring, so must fail */
1910             goto phooey;
1911
1912         if (back_min<0) {
1913             last = strend;
1914         } else {
1915             last = HOP3c(strend,        /* Cannot start after this */
1916                   -(I32)(CHR_SVLEN(must)
1917                          - (SvTAIL(must) != 0) + back_min), strbeg);
1918         }
1919         if (s > PL_bostr)
1920             last1 = HOPc(s, -1);
1921         else
1922             last1 = s - 1;      /* bogus */
1923
1924         /* XXXX check_substr already used to find "s", can optimize if
1925            check_substr==must. */
1926         scream_pos = -1;
1927         dontbother = end_shift;
1928         strend = HOPc(strend, -dontbother);
1929         while ( (s <= last) &&
1930                 ((flags & REXEC_SCREAM)
1931                  ? (s = screaminstr(sv, must, HOP3c(s, back_min, (back_min<0 ? strbeg : strend)) - strbeg,
1932                                     end_shift, &scream_pos, 0))
1933                  : (s = fbm_instr((unsigned char*)HOP3(s, back_min, (back_min<0 ? strbeg : strend)),
1934                                   (unsigned char*)strend, must,
1935                                   multiline ? FBMrf_MULTILINE : 0))) ) {
1936             /* we may be pointing at the wrong string */
1937             if ((flags & REXEC_SCREAM) && RX_MATCH_COPIED(prog))
1938                 s = strbeg + (s - SvPVX_const(sv));
1939             DEBUG_EXECUTE_r( did_match = 1 );
1940             if (HOPc(s, -back_max) > last1) {
1941                 last1 = HOPc(s, -back_min);
1942                 s = HOPc(s, -back_max);
1943             }
1944             else {
1945                 char * const t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
1946
1947                 last1 = HOPc(s, -back_min);
1948                 s = t;
1949             }
1950             if (do_utf8) {
1951                 while (s <= last1) {
1952                     if (regtry(&reginfo, &s))
1953                         goto got_it;
1954                     s += UTF8SKIP(s);
1955                 }
1956             }
1957             else {
1958                 while (s <= last1) {
1959                     if (regtry(&reginfo, &s))
1960                         goto got_it;
1961                     s++;
1962                 }
1963             }
1964         }
1965         DEBUG_EXECUTE_r(if (!did_match) {
1966             RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0),
1967                 SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
1968             PerlIO_printf(Perl_debug_log, "Did not find %s substr %s%s...\n",
1969                               ((must == prog->anchored_substr || must == prog->anchored_utf8)
1970                                ? "anchored" : "floating"),
1971                 quoted, RE_SV_TAIL(must));
1972         });
1973         goto phooey;
1974     }
1975     else if ( (c = progi->regstclass) ) {
1976         if (minlen) {
1977             const OPCODE op = OP(progi->regstclass);
1978             /* don't bother with what can't match */
1979             if (PL_regkind[op] != EXACT && op != CANY && PL_regkind[op] != TRIE)
1980                 strend = HOPc(strend, -(minlen - 1));
1981         }
1982         DEBUG_EXECUTE_r({
1983             SV * const prop = sv_newmortal();
1984             regprop(prog, prop, c);
1985             {
1986                 RE_PV_QUOTED_DECL(quoted,UTF,PERL_DEBUG_PAD_ZERO(1),
1987                     s,strend-s,60);
1988                 PerlIO_printf(Perl_debug_log,
1989                     "Matching stclass %.*s against %s (%d chars)\n",
1990                     (int)SvCUR(prop), SvPVX_const(prop),
1991                      quoted, (int)(strend - s));
1992             }
1993         });
1994         if (find_byclass(prog, c, s, strend, &reginfo))
1995             goto got_it;
1996         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass... [regexec_flags]\n"));
1997     }
1998     else {
1999         dontbother = 0;
2000         if (prog->float_substr != NULL || prog->float_utf8 != NULL) {
2001             /* Trim the end. */
2002             char *last;
2003             SV* float_real;
2004
2005             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
2006                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
2007             float_real = do_utf8 ? prog->float_utf8 : prog->float_substr;
2008
2009             if (flags & REXEC_SCREAM) {
2010                 last = screaminstr(sv, float_real, s - strbeg,
2011                                    end_shift, &scream_pos, 1); /* last one */
2012                 if (!last)
2013                     last = scream_olds; /* Only one occurrence. */
2014                 /* we may be pointing at the wrong string */
2015                 else if (RX_MATCH_COPIED(prog))
2016                     s = strbeg + (s - SvPVX_const(sv));
2017             }
2018             else {
2019                 STRLEN len;
2020                 const char * const little = SvPV_const(float_real, len);
2021
2022                 if (SvTAIL(float_real)) {
2023                     if (memEQ(strend - len + 1, little, len - 1))
2024                         last = strend - len + 1;
2025                     else if (!multiline)
2026                         last = memEQ(strend - len, little, len)
2027                             ? strend - len : NULL;
2028                     else
2029                         goto find_last;
2030                 } else {
2031                   find_last:
2032                     if (len)
2033                         last = rninstr(s, strend, little, little + len);
2034                     else
2035                         last = strend;  /* matching "$" */
2036                 }
2037             }
2038             if (last == NULL) {
2039                 DEBUG_EXECUTE_r(
2040                     PerlIO_printf(Perl_debug_log,
2041                         "%sCan't trim the tail, match fails (should not happen)%s\n",
2042                         PL_colors[4], PL_colors[5]));
2043                 goto phooey; /* Should not happen! */
2044             }
2045             dontbother = strend - last + prog->float_min_offset;
2046         }
2047         if (minlen && (dontbother < minlen))
2048             dontbother = minlen - 1;
2049         strend -= dontbother;              /* this one's always in bytes! */
2050         /* We don't know much -- general case. */
2051         if (do_utf8) {
2052             for (;;) {
2053                 if (regtry(&reginfo, &s))
2054                     goto got_it;
2055                 if (s >= strend)
2056                     break;
2057                 s += UTF8SKIP(s);
2058             };
2059         }
2060         else {
2061             do {
2062                 if (regtry(&reginfo, &s))
2063                     goto got_it;
2064             } while (s++ < strend);
2065         }
2066     }
2067
2068     /* Failure. */
2069     goto phooey;
2070
2071 got_it:
2072     RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
2073
2074     if (PL_reg_eval_set) {
2075         /* Preserve the current value of $^R */
2076         if (oreplsv != GvSV(PL_replgv))
2077             sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
2078                                                   restored, the value remains
2079                                                   the same. */
2080         restore_pos(aTHX_ prog);
2081     }
2082     if (prog->paren_names)
2083         (void)hv_iterinit(prog->paren_names);
2084
2085     /* make sure $`, $&, $', and $digit will work later */
2086     if ( !(flags & REXEC_NOT_FIRST) ) {
2087         RX_MATCH_COPY_FREE(prog);
2088         if (flags & REXEC_COPY_STR) {
2089             const I32 i = PL_regeol - startpos + (stringarg - strbeg);
2090 #ifdef PERL_OLD_COPY_ON_WRITE
2091             if ((SvIsCOW(sv)
2092                  || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) {
2093                 if (DEBUG_C_TEST) {
2094                     PerlIO_printf(Perl_debug_log,
2095                                   "Copy on write: regexp capture, type %d\n",
2096                                   (int) SvTYPE(sv));
2097                 }
2098                 prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
2099                 prog->subbeg = (char *)SvPVX_const(prog->saved_copy);
2100                 assert (SvPOKp(prog->saved_copy));
2101             } else
2102 #endif
2103             {
2104                 RX_MATCH_COPIED_on(prog);
2105                 s = savepvn(strbeg, i);
2106                 prog->subbeg = s;
2107             }
2108             prog->sublen = i;
2109         }
2110         else {
2111             prog->subbeg = strbeg;
2112             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
2113         }
2114     }
2115
2116     return 1;
2117
2118 phooey:
2119     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
2120                           PL_colors[4], PL_colors[5]));
2121     if (PL_reg_eval_set)
2122         restore_pos(aTHX_ prog);
2123     if (progi->swap) {
2124         /* we failed :-( roll it back */
2125         I32 *t;
2126         t = progi->swap->startp;
2127         progi->swap->startp = prog->startp;
2128         prog->startp = t;
2129         t = progi->swap->endp;
2130         progi->swap->endp = prog->endp;
2131         prog->endp = t;
2132     }
2133     return 0;
2134 }
2135
2136
2137 /*
2138  - regtry - try match at specific point
2139  */
2140 STATIC I32                      /* 0 failure, 1 success */
2141 S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
2142 {
2143     dVAR;
2144     register I32 *sp;
2145     register I32 *ep;
2146     CHECKPOINT lastcp;
2147     regexp *prog = reginfo->prog;
2148     RXi_GET_DECL(prog,progi);
2149     GET_RE_DEBUG_FLAGS_DECL;
2150     reginfo->cutpoint=NULL;
2151
2152     if ((prog->extflags & RXf_EVAL_SEEN) && !PL_reg_eval_set) {
2153         MAGIC *mg;
2154
2155         PL_reg_eval_set = RS_init;
2156         DEBUG_EXECUTE_r(DEBUG_s(
2157             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %"IVdf"\n",
2158                           (IV)(PL_stack_sp - PL_stack_base));
2159             ));
2160         SAVESTACK_CXPOS();
2161         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
2162         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
2163         SAVETMPS;
2164         /* Apparently this is not needed, judging by wantarray. */
2165         /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
2166            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
2167
2168         if (reginfo->sv) {
2169             /* Make $_ available to executed code. */
2170             if (reginfo->sv != DEFSV) {
2171                 SAVE_DEFSV;
2172                 DEFSV = reginfo->sv;
2173             }
2174
2175             if (!(SvTYPE(reginfo->sv) >= SVt_PVMG && SvMAGIC(reginfo->sv)
2176                   && (mg = mg_find(reginfo->sv, PERL_MAGIC_regex_global)))) {
2177                 /* prepare for quick setting of pos */
2178 #ifdef PERL_OLD_COPY_ON_WRITE
2179                 if (SvIsCOW(reginfo->sv))
2180                     sv_force_normal_flags(reginfo->sv, 0);
2181 #endif
2182                 mg = sv_magicext(reginfo->sv, NULL, PERL_MAGIC_regex_global,
2183                                  &PL_vtbl_mglob, NULL, 0);
2184                 mg->mg_len = -1;
2185             }
2186             PL_reg_magic    = mg;
2187             PL_reg_oldpos   = mg->mg_len;
2188             SAVEDESTRUCTOR_X(restore_pos, prog);
2189         }
2190         if (!PL_reg_curpm) {
2191             Newxz(PL_reg_curpm, 1, PMOP);
2192 #ifdef USE_ITHREADS
2193             {
2194                 SV* const repointer = newSViv(0);
2195                 /* so we know which PL_regex_padav element is PL_reg_curpm */
2196                 SvFLAGS(repointer) |= SVf_BREAK;
2197                 av_push(PL_regex_padav,repointer);
2198                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
2199                 PL_regex_pad = AvARRAY(PL_regex_padav);
2200             }
2201 #endif
2202         }
2203         PM_SETRE(PL_reg_curpm, prog);
2204         PL_reg_oldcurpm = PL_curpm;
2205         PL_curpm = PL_reg_curpm;
2206         if (RX_MATCH_COPIED(prog)) {
2207             /*  Here is a serious problem: we cannot rewrite subbeg,
2208                 since it may be needed if this match fails.  Thus
2209                 $` inside (?{}) could fail... */
2210             PL_reg_oldsaved = prog->subbeg;
2211             PL_reg_oldsavedlen = prog->sublen;
2212 #ifdef PERL_OLD_COPY_ON_WRITE
2213             PL_nrs = prog->saved_copy;
2214 #endif
2215             RX_MATCH_COPIED_off(prog);
2216         }
2217         else
2218             PL_reg_oldsaved = NULL;
2219         prog->subbeg = PL_bostr;
2220         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
2221     }
2222     DEBUG_EXECUTE_r(PL_reg_starttry = *startpos);
2223     prog->startp[0] = *startpos - PL_bostr;
2224     PL_reginput = *startpos;
2225     PL_reglastparen = &prog->lastparen;
2226     PL_reglastcloseparen = &prog->lastcloseparen;
2227     prog->lastparen = 0;
2228     prog->lastcloseparen = 0;
2229     PL_regsize = 0;
2230     PL_regstartp = prog->startp;
2231     PL_regendp = prog->endp;
2232     if (PL_reg_start_tmpl <= prog->nparens) {
2233         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
2234         if(PL_reg_start_tmp)
2235             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2236         else
2237             Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2238     }
2239
2240     /* XXXX What this code is doing here?!!!  There should be no need
2241        to do this again and again, PL_reglastparen should take care of
2242        this!  --ilya*/
2243
2244     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
2245      * Actually, the code in regcppop() (which Ilya may be meaning by
2246      * PL_reglastparen), is not needed at all by the test suite
2247      * (op/regexp, op/pat, op/split), but that code is needed, oddly
2248      * enough, for building DynaLoader, or otherwise this
2249      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
2250      * will happen.  Meanwhile, this code *is* needed for the
2251      * above-mentioned test suite tests to succeed.  The common theme
2252      * on those tests seems to be returning null fields from matches.
2253      * --jhi */
2254 #if 1
2255     sp = PL_regstartp;
2256     ep = PL_regendp;
2257     if (prog->nparens) {
2258         register I32 i;
2259         for (i = prog->nparens; i > (I32)*PL_reglastparen; i--) {
2260             *++sp = -1;
2261             *++ep = -1;
2262         }
2263     }
2264 #endif
2265     REGCP_SET(lastcp);
2266     if (regmatch(reginfo, progi->program + 1)) {
2267         PL_regendp[0] = PL_reginput - PL_bostr;
2268         return 1;
2269     }
2270     if (reginfo->cutpoint)
2271         *startpos= reginfo->cutpoint;
2272     REGCP_UNWIND(lastcp);
2273     return 0;
2274 }
2275
2276
2277 #define sayYES goto yes
2278 #define sayNO goto no
2279 #define sayNO_SILENT goto no_silent
2280
2281 /* we dont use STMT_START/END here because it leads to
2282    "unreachable code" warnings, which are bogus, but distracting. */
2283 #define CACHEsayNO \
2284     if (ST.cache_mask) \
2285        PL_reg_poscache[ST.cache_offset] |= ST.cache_mask; \
2286     sayNO
2287
2288 /* this is used to determine how far from the left messages like
2289    'failed...' are printed. It should be set such that messages
2290    are inline with the regop output that created them.
2291 */
2292 #define REPORT_CODE_OFF 32
2293
2294
2295 /* Make sure there is a test for this +1 options in re_tests */
2296 #define TRIE_INITAL_ACCEPT_BUFFLEN 4;
2297
2298 #define CHRTEST_UNINIT -1001 /* c1/c2 haven't been calculated yet */
2299 #define CHRTEST_VOID   -1000 /* the c1/c2 "next char" test should be skipped */
2300
2301 #define SLAB_FIRST(s) (&(s)->states[0])
2302 #define SLAB_LAST(s)  (&(s)->states[PERL_REGMATCH_SLAB_SLOTS-1])
2303
2304 /* grab a new slab and return the first slot in it */
2305
2306 STATIC regmatch_state *
2307 S_push_slab(pTHX)
2308 {
2309 #if PERL_VERSION < 9
2310     dMY_CXT;
2311 #endif
2312     regmatch_slab *s = PL_regmatch_slab->next;
2313     if (!s) {
2314         Newx(s, 1, regmatch_slab);
2315         s->prev = PL_regmatch_slab;
2316         s->next = NULL;
2317         PL_regmatch_slab->next = s;
2318     }
2319     PL_regmatch_slab = s;
2320     return SLAB_FIRST(s);
2321 }
2322
2323
2324 /* push a new state then goto it */
2325
2326 #define PUSH_STATE_GOTO(state, node) \
2327     scan = node; \
2328     st->resume_state = state; \
2329     goto push_state;
2330
2331 /* push a new state with success backtracking, then goto it */
2332
2333 #define PUSH_YES_STATE_GOTO(state, node) \
2334     scan = node; \
2335     st->resume_state = state; \
2336     goto push_yes_state;
2337
2338
2339
2340 /*
2341
2342 regmatch() - main matching routine
2343
2344 This is basically one big switch statement in a loop. We execute an op,
2345 set 'next' to point the next op, and continue. If we come to a point which
2346 we may need to backtrack to on failure such as (A|B|C), we push a
2347 backtrack state onto the backtrack stack. On failure, we pop the top
2348 state, and re-enter the loop at the state indicated. If there are no more
2349 states to pop, we return failure.
2350
2351 Sometimes we also need to backtrack on success; for example /A+/, where
2352 after successfully matching one A, we need to go back and try to
2353 match another one; similarly for lookahead assertions: if the assertion
2354 completes successfully, we backtrack to the state just before the assertion
2355 and then carry on.  In these cases, the pushed state is marked as
2356 'backtrack on success too'. This marking is in fact done by a chain of
2357 pointers, each pointing to the previous 'yes' state. On success, we pop to
2358 the nearest yes state, discarding any intermediate failure-only states.
2359 Sometimes a yes state is pushed just to force some cleanup code to be
2360 called at the end of a successful match or submatch; e.g. (??{$re}) uses
2361 it to free the inner regex.
2362
2363 Note that failure backtracking rewinds the cursor position, while
2364 success backtracking leaves it alone.
2365
2366 A pattern is complete when the END op is executed, while a subpattern
2367 such as (?=foo) is complete when the SUCCESS op is executed. Both of these
2368 ops trigger the "pop to last yes state if any, otherwise return true"
2369 behaviour.
2370
2371 A common convention in this function is to use A and B to refer to the two
2372 subpatterns (or to the first nodes thereof) in patterns like /A*B/: so A is
2373 the subpattern to be matched possibly multiple times, while B is the entire
2374 rest of the pattern. Variable and state names reflect this convention.
2375
2376 The states in the main switch are the union of ops and failure/success of
2377 substates associated with with that op.  For example, IFMATCH is the op
2378 that does lookahead assertions /(?=A)B/ and so the IFMATCH state means
2379 'execute IFMATCH'; while IFMATCH_A is a state saying that we have just
2380 successfully matched A and IFMATCH_A_fail is a state saying that we have
2381 just failed to match A. Resume states always come in pairs. The backtrack
2382 state we push is marked as 'IFMATCH_A', but when that is popped, we resume
2383 at IFMATCH_A or IFMATCH_A_fail, depending on whether we are backtracking
2384 on success or failure.
2385
2386 The struct that holds a backtracking state is actually a big union, with
2387 one variant for each major type of op. The variable st points to the
2388 top-most backtrack struct. To make the code clearer, within each
2389 block of code we #define ST to alias the relevant union.
2390
2391 Here's a concrete example of a (vastly oversimplified) IFMATCH
2392 implementation:
2393
2394     switch (state) {
2395     ....
2396
2397 #define ST st->u.ifmatch
2398
2399     case IFMATCH: // we are executing the IFMATCH op, (?=A)B
2400         ST.foo = ...; // some state we wish to save
2401         ...
2402         // push a yes backtrack state with a resume value of
2403         // IFMATCH_A/IFMATCH_A_fail, then continue execution at the
2404         // first node of A:
2405         PUSH_YES_STATE_GOTO(IFMATCH_A, A);
2406         // NOTREACHED
2407
2408     case IFMATCH_A: // we have successfully executed A; now continue with B
2409         next = B;
2410         bar = ST.foo; // do something with the preserved value
2411         break;
2412
2413     case IFMATCH_A_fail: // A failed, so the assertion failed
2414         ...;   // do some housekeeping, then ...
2415         sayNO; // propagate the failure
2416
2417 #undef ST
2418
2419     ...
2420     }
2421
2422 For any old-timers reading this who are familiar with the old recursive
2423 approach, the code above is equivalent to:
2424
2425     case IFMATCH: // we are executing the IFMATCH op, (?=A)B
2426     {
2427         int foo = ...
2428         ...
2429         if (regmatch(A)) {
2430             next = B;
2431             bar = foo;
2432             break;
2433         }
2434         ...;   // do some housekeeping, then ...
2435         sayNO; // propagate the failure
2436     }
2437
2438 The topmost backtrack state, pointed to by st, is usually free. If you
2439 want to claim it, populate any ST.foo fields in it with values you wish to
2440 save, then do one of
2441
2442         PUSH_STATE_GOTO(resume_state, node);
2443         PUSH_YES_STATE_GOTO(resume_state, node);
2444
2445 which sets that backtrack state's resume value to 'resume_state', pushes a
2446 new free entry to the top of the backtrack stack, then goes to 'node'.
2447 On backtracking, the free slot is popped, and the saved state becomes the
2448 new free state. An ST.foo field in this new top state can be temporarily
2449 accessed to retrieve values, but once the main loop is re-entered, it
2450 becomes available for reuse.
2451
2452 Note that the depth of the backtrack stack constantly increases during the
2453 left-to-right execution of the pattern, rather than going up and down with
2454 the pattern nesting. For example the stack is at its maximum at Z at the
2455 end of the pattern, rather than at X in the following:
2456
2457     /(((X)+)+)+....(Y)+....Z/
2458
2459 The only exceptions to this are lookahead/behind assertions and the cut,
2460 (?>A), which pop all the backtrack states associated with A before
2461 continuing.
2462
2463 Bascktrack state structs are allocated in slabs of about 4K in size.
2464 PL_regmatch_state and st always point to the currently active state,
2465 and PL_regmatch_slab points to the slab currently containing
2466 PL_regmatch_state.  The first time regmatch() is called, the first slab is
2467 allocated, and is never freed until interpreter destruction. When the slab
2468 is full, a new one is allocated and chained to the end. At exit from
2469 regmatch(), slabs allocated since entry are freed.
2470
2471 */
2472
2473
2474 #define DEBUG_STATE_pp(pp)                                  \
2475     DEBUG_STATE_r({                                         \
2476         DUMP_EXEC_POS(locinput, scan, do_utf8);             \
2477         PerlIO_printf(Perl_debug_log,                       \
2478             "    %*s"pp" %s%s%s%s%s\n",                     \
2479             depth*2, "",                                    \
2480             reg_name[st->resume_state],                     \
2481             ((st==yes_state||st==mark_state) ? "[" : ""),   \
2482             ((st==yes_state) ? "Y" : ""),                   \
2483             ((st==mark_state) ? "M" : ""),                  \
2484             ((st==yes_state||st==mark_state) ? "]" : "")    \
2485         );                                                  \
2486     });
2487
2488
2489 #define REG_NODE_NUM(x) ((x) ? (int)((x)-prog) : -1)
2490
2491 #ifdef DEBUGGING
2492
2493 STATIC void
2494 S_debug_start_match(pTHX_ const regexp *prog, const bool do_utf8,
2495     const char *start, const char *end, const char *blurb)
2496 {
2497     const bool utf8_pat= prog->extflags & RXf_UTF8 ? 1 : 0;
2498     if (!PL_colorset)
2499             reginitcolors();
2500     {
2501         RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0),
2502             prog->precomp, prog->prelen, 60);
2503
2504         RE_PV_QUOTED_DECL(s1, do_utf8, PERL_DEBUG_PAD_ZERO(1),
2505             start, end - start, 60);
2506
2507         PerlIO_printf(Perl_debug_log,
2508             "%s%s REx%s %s against %s\n",
2509                        PL_colors[4], blurb, PL_colors[5], s0, s1);
2510
2511         if (do_utf8||utf8_pat)
2512             PerlIO_printf(Perl_debug_log, "UTF-8 %s%s%s...\n",
2513                 utf8_pat ? "pattern" : "",
2514                 utf8_pat && do_utf8 ? " and " : "",
2515                 do_utf8 ? "string" : ""
2516             );
2517     }
2518 }
2519
2520 STATIC void
2521 S_dump_exec_pos(pTHX_ const char *locinput,
2522                       const regnode *scan,
2523                       const char *loc_regeol,
2524                       const char *loc_bostr,
2525                       const char *loc_reg_starttry,
2526                       const bool do_utf8)
2527 {
2528     const int docolor = *PL_colors[0] || *PL_colors[2] || *PL_colors[4];
2529     const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
2530     int l = (loc_regeol - locinput) > taill ? taill : (loc_regeol - locinput);
2531     /* The part of the string before starttry has one color
2532        (pref0_len chars), between starttry and current
2533        position another one (pref_len - pref0_len chars),
2534        after the current position the third one.
2535        We assume that pref0_len <= pref_len, otherwise we
2536        decrease pref0_len.  */
2537     int pref_len = (locinput - loc_bostr) > (5 + taill) - l
2538         ? (5 + taill) - l : locinput - loc_bostr;
2539     int pref0_len;
2540
2541     while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
2542         pref_len++;
2543     pref0_len = pref_len  - (locinput - loc_reg_starttry);
2544     if (l + pref_len < (5 + taill) && l < loc_regeol - locinput)
2545         l = ( loc_regeol - locinput > (5 + taill) - pref_len
2546               ? (5 + taill) - pref_len : loc_regeol - locinput);
2547     while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
2548         l--;
2549     if (pref0_len < 0)
2550         pref0_len = 0;
2551     if (pref0_len > pref_len)
2552         pref0_len = pref_len;
2553     {
2554         const int is_uni = (do_utf8 && OP(scan) != CANY) ? 1 : 0;
2555
2556         RE_PV_COLOR_DECL(s0,len0,is_uni,PERL_DEBUG_PAD(0),
2557             (locinput - pref_len),pref0_len, 60, 4, 5);
2558
2559         RE_PV_COLOR_DECL(s1,len1,is_uni,PERL_DEBUG_PAD(1),
2560                     (locinput - pref_len + pref0_len),
2561                     pref_len - pref0_len, 60, 2, 3);
2562
2563         RE_PV_COLOR_DECL(s2,len2,is_uni,PERL_DEBUG_PAD(2),
2564                     locinput, loc_regeol - locinput, 10, 0, 1);
2565
2566         const STRLEN tlen=len0+len1+len2;
2567         PerlIO_printf(Perl_debug_log,
2568                     "%4"IVdf" <%.*s%.*s%s%.*s>%*s|",
2569                     (IV)(locinput - loc_bostr),
2570                     len0, s0,
2571                     len1, s1,
2572                     (docolor ? "" : "> <"),
2573                     len2, s2,
2574                     (int)(tlen > 19 ? 0 :  19 - tlen),
2575                     "");
2576     }
2577 }
2578
2579 #endif
2580
2581 /* reg_check_named_buff_matched()
2582  * Checks to see if a named buffer has matched. The data array of
2583  * buffer numbers corresponding to the buffer is expected to reside
2584  * in the regexp->data->data array in the slot stored in the ARG() of
2585  * node involved. Note that this routine doesn't actually care about the
2586  * name, that information is not preserved from compilation to execution.
2587  * Returns the index of the leftmost defined buffer with the given name
2588  * or 0 if non of the buffers matched.
2589  */
2590 STATIC I32
2591 S_reg_check_named_buff_matched(pTHX_ const regexp *rex, const regnode *scan) {
2592     I32 n;
2593     RXi_GET_DECL(rex,rexi);
2594     SV *sv_dat=(SV*)rexi->data->data[ ARG( scan ) ];
2595     I32 *nums=(I32*)SvPVX(sv_dat);
2596     for ( n=0; n<SvIVX(sv_dat); n++ ) {
2597         if ((I32)*PL_reglastparen >= nums[n] &&
2598             PL_regendp[nums[n]] != -1)
2599         {
2600             return nums[n];
2601         }
2602     }
2603     return 0;
2604 }
2605
2606 STATIC I32                      /* 0 failure, 1 success */
2607 S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
2608 {
2609 #if PERL_VERSION < 9
2610     dMY_CXT;
2611 #endif
2612     dVAR;
2613     register const bool do_utf8 = PL_reg_match_utf8;
2614     const U32 uniflags = UTF8_ALLOW_DEFAULT;
2615
2616     regexp *rex = reginfo->prog;
2617     RXi_GET_DECL(rex,rexi);
2618
2619     regmatch_slab  *orig_slab;
2620     regmatch_state *orig_state;
2621
2622     /* the current state. This is a cached copy of PL_regmatch_state */
2623     register regmatch_state *st;
2624
2625     /* cache heavy used fields of st in registers */
2626     register regnode *scan;
2627     register regnode *next;
2628     register U32 n = 0; /* general value; init to avoid compiler warning */
2629     register I32 ln = 0; /* len or last;  init to avoid compiler warning */
2630     register char *locinput = PL_reginput;
2631     register I32 nextchr;   /* is always set to UCHARAT(locinput) */
2632
2633     bool result = 0;        /* return value of S_regmatch */
2634     int depth = 0;          /* depth of backtrack stack */
2635     int nochange_depth = 0; /* depth of GOSUB recursion with nochange*/
2636     regmatch_state *yes_state = NULL; /* state to pop to on success of
2637                                                             subpattern */
2638     /* mark_state piggy backs on the yes_state logic so that when we unwind
2639        the stack on success we can update the mark_state as we go */
2640     regmatch_state *mark_state = NULL; /* last mark state we have seen */
2641
2642     regmatch_state *cur_eval = NULL; /* most recent EVAL_AB state */
2643     struct regmatch_state  *cur_curlyx = NULL; /* most recent curlyx */
2644     U32 state_num;
2645     bool no_final = 0;      /* prevent failure from backtracking? */
2646     bool do_cutgroup = 0;   /* no_final only until next branch/trie entry */
2647     char *startpoint = PL_reginput;
2648     SV *popmark = NULL;     /* are we looking for a mark? */
2649     SV *sv_commit = NULL;   /* last mark name seen in failure */
2650     SV *sv_yes_mark = NULL; /* last mark name we have seen
2651                                during a successfull match */
2652     U32 lastopen = 0;       /* last open we saw */
2653     bool has_cutgroup = RX_HAS_CUTGROUP(rex) ? 1 : 0;
2654
2655
2656     /* these three flags are set by various ops to signal information to
2657      * the very next op. They have a useful lifetime of exactly one loop
2658      * iteration, and are not preserved or restored by state pushes/pops
2659      */
2660     bool sw = 0;            /* the condition value in (?(cond)a|b) */
2661     bool minmod = 0;        /* the next "{n,m}" is a "{n,m}?" */
2662     int logical = 0;        /* the following EVAL is:
2663                                 0: (?{...})
2664                                 1: (?(?{...})X|Y)
2665                                 2: (??{...})
2666                                or the following IFMATCH/UNLESSM is:
2667                                 false: plain (?=foo)
2668                                 true:  used as a condition: (?(?=foo))
2669                             */
2670
2671 #ifdef DEBUGGING
2672     GET_RE_DEBUG_FLAGS_DECL;
2673 #endif
2674
2675     DEBUG_OPTIMISE_r( {
2676             PerlIO_printf(Perl_debug_log,"regmatch start\n");
2677     });
2678     /* on first ever call to regmatch, allocate first slab */
2679     if (!PL_regmatch_slab) {
2680         Newx(PL_regmatch_slab, 1, regmatch_slab);
2681         PL_regmatch_slab->prev = NULL;
2682         PL_regmatch_slab->next = NULL;
2683         PL_regmatch_state = SLAB_FIRST(PL_regmatch_slab);
2684     }
2685
2686     /* remember current high-water mark for exit */
2687     /* XXX this should be done with SAVE* instead */
2688     orig_slab  = PL_regmatch_slab;
2689     orig_state = PL_regmatch_state;
2690
2691     /* grab next free state slot */
2692     st = ++PL_regmatch_state;
2693     if (st >  SLAB_LAST(PL_regmatch_slab))
2694         st = PL_regmatch_state = S_push_slab(aTHX);
2695
2696     /* Note that nextchr is a byte even in UTF */
2697     nextchr = UCHARAT(locinput);
2698     scan = prog;
2699     while (scan != NULL) {
2700
2701         DEBUG_EXECUTE_r( {
2702             SV * const prop = sv_newmortal();
2703             regnode *rnext=regnext(scan);
2704             DUMP_EXEC_POS( locinput, scan, do_utf8 );
2705             regprop(rex, prop, scan);
2706
2707             PerlIO_printf(Perl_debug_log,
2708                     "%3"IVdf":%*s%s(%"IVdf")\n",
2709                     (IV)(scan - rexi->program), depth*2, "",
2710                     SvPVX_const(prop),
2711                     (PL_regkind[OP(scan)] == END || !rnext) ?
2712                         0 : (IV)(rnext - rexi->program));
2713         });
2714
2715         next = scan + NEXT_OFF(scan);
2716         if (next == scan)
2717             next = NULL;
2718         state_num = OP(scan);
2719
2720       reenter_switch:
2721         switch (state_num) {
2722         case BOL:
2723             if (locinput == PL_bostr)
2724             {
2725                 /* reginfo->till = reginfo->bol; */
2726                 break;
2727             }
2728             sayNO;
2729         case MBOL:
2730             if (locinput == PL_bostr ||
2731                 ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n'))
2732             {
2733                 break;
2734             }
2735             sayNO;
2736         case SBOL:
2737             if (locinput == PL_bostr)
2738                 break;
2739             sayNO;
2740         case GPOS:
2741             if (locinput == reginfo->ganch)
2742                 break;
2743             sayNO;
2744
2745         case KEEPS:
2746             /* update the startpoint */
2747             st->u.keeper.val = PL_regstartp[0];
2748             PL_reginput = locinput;
2749             PL_regstartp[0] = locinput - PL_bostr;
2750             PUSH_STATE_GOTO(KEEPS_next, next);
2751             /*NOT-REACHED*/
2752         case KEEPS_next_fail:
2753             /* rollback the start point change */
2754             PL_regstartp[0] = st->u.keeper.val;
2755             sayNO_SILENT;
2756             /*NOT-REACHED*/
2757         case EOL:
2758                 goto seol;
2759         case MEOL:
2760             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2761                 sayNO;
2762             break;
2763         case SEOL:
2764           seol:
2765             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2766                 sayNO;
2767             if (PL_regeol - locinput > 1)
2768                 sayNO;
2769             break;
2770         case EOS:
2771             if (PL_regeol != locinput)
2772                 sayNO;
2773             break;
2774         case SANY:
2775             if (!nextchr && locinput >= PL_regeol)
2776                 sayNO;
2777             if (do_utf8) {
2778                 locinput += PL_utf8skip[nextchr];
2779                 if (locinput > PL_regeol)
2780                     sayNO;
2781                 nextchr = UCHARAT(locinput);
2782             }
2783             else
2784                 nextchr = UCHARAT(++locinput);
2785             break;
2786         case CANY:
2787             if (!nextchr && locinput >= PL_regeol)
2788                 sayNO;
2789             nextchr = UCHARAT(++locinput);
2790             break;
2791         case REG_ANY:
2792             if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
2793                 sayNO;
2794             if (do_utf8) {
2795                 locinput += PL_utf8skip[nextchr];
2796                 if (locinput > PL_regeol)
2797                     sayNO;
2798                 nextchr = UCHARAT(locinput);
2799             }
2800             else
2801                 nextchr = UCHARAT(++locinput);
2802             break;
2803
2804 #undef  ST
2805 #define ST st->u.trie
2806         case TRIEC:
2807             /* In this case the charclass data is available inline so
2808                we can fail fast without a lot of extra overhead.
2809              */
2810             if (scan->flags == EXACT || !do_utf8) {
2811                 if(!ANYOF_BITMAP_TEST(scan, *locinput)) {
2812                     DEBUG_EXECUTE_r(
2813                         PerlIO_printf(Perl_debug_log,
2814                                   "%*s  %sfailed to match trie start class...%s\n",
2815                                   REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
2816                     );
2817                     sayNO_SILENT;
2818                     /* NOTREACHED */
2819                 }
2820             }
2821             /* FALL THROUGH */
2822         case TRIE:
2823             {
2824                 /* what type of TRIE am I? (utf8 makes this contextual) */
2825                 const enum { trie_plain, trie_utf8, trie_utf8_fold }
2826                     trie_type = do_utf8 ?
2827                           (scan->flags == EXACT ? trie_utf8 : trie_utf8_fold)
2828                         : trie_plain;
2829
2830                 /* what trie are we using right now */
2831                 reg_trie_data * const trie
2832                     = (reg_trie_data*)rexi->data->data[ ARG( scan ) ];
2833                 HV * widecharmap = (HV *)rexi->data->data[ ARG( scan ) + 1 ];
2834                 U32 state = trie->startstate;
2835
2836                 if (trie->bitmap && trie_type != trie_utf8_fold &&
2837                     !TRIE_BITMAP_TEST(trie,*locinput)
2838                 ) {
2839                     if (trie->states[ state ].wordnum) {
2840                          DEBUG_EXECUTE_r(
2841                             PerlIO_printf(Perl_debug_log,
2842                                           "%*s  %smatched empty string...%s\n",
2843                                           REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
2844                         );
2845                         break;
2846                     } else {
2847                         DEBUG_EXECUTE_r(
2848                             PerlIO_printf(Perl_debug_log,
2849                                           "%*s  %sfailed to match trie start class...%s\n",
2850                                           REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
2851                         );
2852                         sayNO_SILENT;
2853                    }
2854                 }
2855
2856             {
2857                 U8 *uc = ( U8* )locinput;
2858
2859                 STRLEN len = 0;
2860                 STRLEN foldlen = 0;
2861                 U8 *uscan = (U8*)NULL;
2862                 STRLEN bufflen=0;
2863                 SV *sv_accept_buff = NULL;
2864                 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
2865
2866                 ST.accepted = 0; /* how many accepting states we have seen */
2867                 ST.B = next;
2868                 ST.jump = trie->jump;
2869                 ST.me = scan;
2870
2871                 /*
2872                    traverse the TRIE keeping track of all accepting states
2873                    we transition through until we get to a failing node.
2874                 */
2875
2876                 while ( state && uc <= (U8*)PL_regeol ) {
2877                     U32 base = trie->states[ state ].trans.base;
2878                     UV uvc = 0;
2879                     U16 charid;
2880                     /* We use charid to hold the wordnum as we don't use it
2881                        for charid until after we have done the wordnum logic.
2882                        We define an alias just so that the wordnum logic reads
2883                        more naturally. */
2884
2885 #define got_wordnum charid
2886                     got_wordnum = trie->states[ state ].wordnum;
2887
2888                     if ( got_wordnum ) {
2889                         if ( ! ST.accepted ) {
2890                             ENTER;
2891                             SAVETMPS;
2892                             bufflen = TRIE_INITAL_ACCEPT_BUFFLEN;
2893                             sv_accept_buff=newSV(bufflen *
2894                                             sizeof(reg_trie_accepted) - 1);
2895                             SvCUR_set(sv_accept_buff, 0);
2896                             SvPOK_on(sv_accept_buff);
2897                             sv_2mortal(sv_accept_buff);
2898                             SAVETMPS;
2899                             ST.accept_buff =
2900                                 (reg_trie_accepted*)SvPV_nolen(sv_accept_buff );
2901                         }
2902                         do {
2903                             if (ST.accepted >= bufflen) {
2904                                 bufflen *= 2;
2905                                 ST.accept_buff =(reg_trie_accepted*)
2906                                     SvGROW(sv_accept_buff,
2907                                         bufflen * sizeof(reg_trie_accepted));
2908                             }
2909                             SvCUR_set(sv_accept_buff,SvCUR(sv_accept_buff)
2910                                 + sizeof(reg_trie_accepted));
2911
2912
2913                             ST.accept_buff[ST.accepted].wordnum = got_wordnum;
2914                             ST.accept_buff[ST.accepted].endpos = uc;
2915                             ++ST.accepted;
2916                         } while (trie->nextword && (got_wordnum= trie->nextword[got_wordnum]));
2917                     }
2918 #undef got_wordnum
2919
2920                     DEBUG_TRIE_EXECUTE_r({
2921                                 DUMP_EXEC_POS( (char *)uc, scan, do_utf8 );
2922                                 PerlIO_printf( Perl_debug_log,
2923                                     "%*s  %sState: %4"UVxf" Accepted: %4"UVxf" ",
2924                                     2+depth * 2, "", PL_colors[4],
2925                                     (UV)state, (UV)ST.accepted );
2926                     });
2927
2928                     if ( base ) {
2929                         REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc,
2930                                              uscan, len, uvc, charid, foldlen,
2931                                              foldbuf, uniflags);
2932
2933                         if (charid &&
2934                              (base + charid > trie->uniquecharcount )
2935                              && (base + charid - 1 - trie->uniquecharcount
2936                                     < trie->lasttrans)
2937                              && trie->trans[base + charid - 1 -
2938                                     trie->uniquecharcount].check == state)
2939                         {
2940                             state = trie->trans[base + charid - 1 -
2941                                 trie->uniquecharcount ].next;
2942                         }
2943                         else {
2944                             state = 0;
2945                         }
2946                         uc += len;
2947
2948                     }
2949                     else {
2950                         state = 0;
2951                     }
2952                     DEBUG_TRIE_EXECUTE_r(
2953                         PerlIO_printf( Perl_debug_log,
2954                             "Charid:%3x CP:%4"UVxf" After State: %4"UVxf"%s\n",
2955                             charid, uvc, (UV)state, PL_colors[5] );
2956                     );
2957                 }
2958                 if (!ST.accepted )
2959                    sayNO;
2960
2961                 DEBUG_EXECUTE_r(
2962                     PerlIO_printf( Perl_debug_log,
2963                         "%*s  %sgot %"IVdf" possible matches%s\n",
2964                         REPORT_CODE_OFF + depth * 2, "",
2965                         PL_colors[4], (IV)ST.accepted, PL_colors[5] );
2966                 );
2967             }}
2968
2969             /* FALL THROUGH */
2970         case TRIE_next_fail: /* we failed - try next alterative */
2971             if (do_cutgroup) {
2972                 do_cutgroup = 0;
2973                 no_final = 0;
2974             }
2975             if ( ST.accepted == 1 ) {
2976                 /* only one choice left - just continue */
2977                 DEBUG_EXECUTE_r({
2978                     AV *const trie_words
2979                         = (AV *) rexi->data->data[ARG(ST.me)+TRIE_WORDS_OFFSET];
2980                     SV ** const tmp = av_fetch( trie_words,
2981                         ST.accept_buff[ 0 ].wordnum-1, 0 );
2982                     SV *sv= tmp ? sv_newmortal() : NULL;
2983
2984                     PerlIO_printf( Perl_debug_log,
2985                         "%*s  %sonly one match left: #%d <%s>%s\n",
2986                         REPORT_CODE_OFF+depth*2, "", PL_colors[4],
2987                         ST.accept_buff[ 0 ].wordnum,
2988                         tmp ? pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 0,
2989                                 PL_colors[0], PL_colors[1],
2990                                 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)
2991                             )
2992                         : "not compiled under -Dr",
2993                         PL_colors[5] );
2994                 });
2995                 PL_reginput = (char *)ST.accept_buff[ 0 ].endpos;
2996                 /* in this case we free tmps/leave before we call regmatch
2997                    as we wont be using accept_buff again. */
2998
2999                 locinput = PL_reginput;
3000                 nextchr = UCHARAT(locinput);
3001                 if ( !ST.jump || !ST.jump[ST.accept_buff[0].wordnum])
3002                     scan = ST.B;
3003                 else
3004                     scan = ST.me + ST.jump[ST.accept_buff[0].wordnum];
3005                 if (!has_cutgroup) {
3006                     FREETMPS;
3007                     LEAVE;
3008                 } else {
3009                     ST.accepted--;
3010                     PUSH_YES_STATE_GOTO(TRIE_next, scan);
3011                 }
3012
3013                 continue; /* execute rest of RE */
3014             }
3015
3016             if (!ST.accepted-- ) {
3017                 DEBUG_EXECUTE_r({
3018                     PerlIO_printf( Perl_debug_log,
3019                         "%*s  %sTRIE failed...%s\n",
3020                         REPORT_CODE_OFF+depth*2, "",
3021                         PL_colors[4],
3022                         PL_colors[5] );
3023                 });
3024                 FREETMPS;
3025                 LEAVE;
3026                 sayNO_SILENT;
3027             }
3028
3029             /*
3030                There are at least two accepting states left.  Presumably
3031                the number of accepting states is going to be low,
3032                typically two. So we simply scan through to find the one
3033                with lowest wordnum.  Once we find it, we swap the last
3034                state into its place and decrement the size. We then try to
3035                match the rest of the pattern at the point where the word
3036                ends. If we succeed, control just continues along the
3037                regex; if we fail we return here to try the next accepting
3038                state
3039              */
3040
3041             {
3042                 U32 best = 0;
3043                 U32 cur;
3044                 for( cur = 1 ; cur <= ST.accepted ; cur++ ) {
3045                     DEBUG_TRIE_EXECUTE_r(
3046                         PerlIO_printf( Perl_debug_log,
3047                             "%*s  %sgot %"IVdf" (%d) as best, looking at %"IVdf" (%d)%s\n",
3048                             REPORT_CODE_OFF + depth * 2, "", PL_colors[4],
3049                             (IV)best, ST.accept_buff[ best ].wordnum, (IV)cur,
3050                             ST.accept_buff[ cur ].wordnum, PL_colors[5] );
3051                     );
3052
3053                     if (ST.accept_buff[cur].wordnum <
3054                             ST.accept_buff[best].wordnum)
3055                         best = cur;
3056                 }
3057
3058                 DEBUG_EXECUTE_r({
3059                     AV *const trie_words
3060                         = (AV *) rexi->data->data[ARG(ST.me)+TRIE_WORDS_OFFSET];
3061                     SV ** const tmp = av_fetch( trie_words,
3062                         ST.accept_buff[ best ].wordnum - 1, 0 );
3063                     regnode *nextop=(!ST.jump || !ST.jump[ST.accept_buff[best].wordnum]) ?
3064                                     ST.B :
3065                                     ST.me + ST.jump[ST.accept_buff[best].wordnum];
3066                     SV *sv= tmp ? sv_newmortal() : NULL;
3067
3068                     PerlIO_printf( Perl_debug_log,
3069                         "%*s  %strying alternation #%d <%s> at node #%d %s\n",
3070                         REPORT_CODE_OFF+depth*2, "", PL_colors[4],
3071                         ST.accept_buff[best].wordnum,
3072                         tmp ? pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 0,
3073                                 PL_colors[0], PL_colors[1],
3074                                 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)
3075                             ) : "not compiled under -Dr",
3076                             REG_NODE_NUM(nextop),
3077                         PL_colors[5] );
3078                 });
3079
3080                 if ( best<ST.accepted ) {
3081                     reg_trie_accepted tmp = ST.accept_buff[ best ];
3082                     ST.accept_buff[ best ] = ST.accept_buff[ ST.accepted ];
3083                     ST.accept_buff[ ST.accepted ] = tmp;
3084                     best = ST.accepted;
3085                 }
3086                 PL_reginput = (char *)ST.accept_buff[ best ].endpos;
3087                 if ( !ST.jump || !ST.jump[ST.accept_buff[best].wordnum]) {
3088                     scan = ST.B;
3089                     /* NOTREACHED */
3090                 } else {
3091                     scan = ST.me + ST.jump[ST.accept_buff[best].wordnum];
3092                     /* NOTREACHED */
3093                 }
3094                 if (has_cutgroup) {
3095                     PUSH_YES_STATE_GOTO(TRIE_next, scan);
3096                     /* NOTREACHED */
3097                 } else {
3098                     PUSH_STATE_GOTO(TRIE_next, scan);
3099                     /* NOTREACHED */
3100                 }
3101                 /* NOTREACHED */
3102             }
3103             /* NOTREACHED */
3104         case TRIE_next:
3105             FREETMPS;
3106             LEAVE;
3107             sayYES;
3108 #undef  ST
3109
3110         case EXACT: {
3111             char *s = STRING(scan);
3112             ln = STR_LEN(scan);
3113             if (do_utf8 != UTF) {
3114                 /* The target and the pattern have differing utf8ness. */
3115                 char *l = locinput;
3116                 const char * const e = s + ln;
3117
3118                 if (do_utf8) {
3119                     /* The target is utf8, the pattern is not utf8. */
3120                     while (s < e) {
3121                         STRLEN ulen;
3122                         if (l >= PL_regeol)
3123                              sayNO;
3124                         if (NATIVE_TO_UNI(*(U8*)s) !=
3125                             utf8n_to_uvuni((U8*)l, UTF8_MAXBYTES, &ulen,
3126                                             uniflags))
3127                              sayNO;
3128                         l += ulen;
3129                         s ++;
3130                     }
3131                 }
3132                 else {
3133                     /* The target is not utf8, the pattern is utf8. */
3134                     while (s < e) {
3135                         STRLEN ulen;
3136                         if (l >= PL_regeol)
3137                             sayNO;
3138                         if (NATIVE_TO_UNI(*((U8*)l)) !=
3139                             utf8n_to_uvuni((U8*)s, UTF8_MAXBYTES, &ulen,
3140                                            uniflags))
3141                             sayNO;
3142                         s += ulen;
3143                         l ++;
3144                     }
3145                 }
3146                 locinput = l;
3147                 nextchr = UCHARAT(locinput);
3148                 break;
3149             }
3150             /* The target and the pattern have the same utf8ness. */
3151             /* Inline the first character, for speed. */
3152             if (UCHARAT(s) != nextchr)
3153                 sayNO;
3154             if (PL_regeol - locinput < ln)
3155                 sayNO;
3156             if (ln > 1 && memNE(s, locinput, ln))
3157                 sayNO;
3158             locinput += ln;
3159             nextchr = UCHARAT(locinput);
3160             break;
3161             }
3162         case EXACTFL:
3163             PL_reg_flags |= RF_tainted;
3164             /* FALL THROUGH */
3165         case EXACTF: {
3166             char * const s = STRING(scan);
3167             ln = STR_LEN(scan);
3168
3169             if (do_utf8 || UTF) {
3170               /* Either target or the pattern are utf8. */
3171                 const char * const l = locinput;
3172                 char *e = PL_regeol;
3173
3174                 if (ibcmp_utf8(s, 0,  ln, (bool)UTF,
3175                                l, &e, 0,  do_utf8)) {
3176                      /* One more case for the sharp s:
3177                       * pack("U0U*", 0xDF) =~ /ss/i,
3178                       * the 0xC3 0x9F are the UTF-8
3179                       * byte sequence for the U+00DF. */
3180                      if (!(do_utf8 &&
3181                            toLOWER(s[0]) == 's' &&
3182                            ln >= 2 &&
3183                            toLOWER(s[1]) == 's' &&
3184                            (U8)l[0] == 0xC3 &&
3185                            e - l >= 2 &&
3186                            (U8)l[1] == 0x9F))
3187                           sayNO;
3188                 }
3189                 locinput = e;
3190                 nextchr = UCHARAT(locinput);
3191                 break;
3192             }
3193
3194             /* Neither the target and the pattern are utf8. */
3195
3196             /* Inline the first character, for speed. */
3197             if (UCHARAT(s) != nextchr &&
3198                 UCHARAT(s) != ((OP(scan) == EXACTF)
3199                                ? PL_fold : PL_fold_locale)[nextchr])
3200                 sayNO;
3201             if (PL_regeol - locinput < ln)
3202                 sayNO;
3203             if (ln > 1 && (OP(scan) == EXACTF
3204                            ? ibcmp(s, locinput, ln)
3205                            : ibcmp_locale(s, locinput, ln)))
3206                 sayNO;
3207             locinput += ln;
3208             nextchr = UCHARAT(locinput);
3209             break;
3210             }
3211         case ANYOF:
3212             if (do_utf8) {
3213                 STRLEN inclasslen = PL_regeol - locinput;
3214
3215                 if (!reginclass(rex, scan, (U8*)locinput, &inclasslen, do_utf8))
3216                     goto anyof_fail;
3217                 if (locinput >= PL_regeol)
3218                     sayNO;
3219                 locinput += inclasslen ? inclasslen : UTF8SKIP(locinput);
3220                 nextchr = UCHARAT(locinput);
3221                 break;
3222             }
3223             else {
3224                 if (nextchr < 0)
3225                     nextchr = UCHARAT(locinput);
3226                 if (!REGINCLASS(rex, scan, (U8*)locinput))
3227                     goto anyof_fail;
3228                 if (!nextchr && locinput >= PL_regeol)
3229                     sayNO;
3230                 nextchr = UCHARAT(++locinput);
3231                 break;
3232             }
3233         anyof_fail:
3234             /* If we might have the case of the German sharp s
3235              * in a casefolding Unicode character class. */
3236
3237             if (ANYOF_FOLD_SHARP_S(scan, locinput, PL_regeol)) {
3238                  locinput += SHARP_S_SKIP;
3239                  nextchr = UCHARAT(locinput);
3240             }
3241             else
3242                  sayNO;
3243             break;
3244         case ALNUML:
3245             PL_reg_flags |= RF_tainted;
3246             /* FALL THROUGH */
3247         case ALNUM:
3248             if (!nextchr)
3249                 sayNO;
3250             if (do_utf8) {
3251                 LOAD_UTF8_CHARCLASS_ALNUM();
3252                 if (!(OP(scan) == ALNUM
3253                       ? (bool)swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
3254                       : isALNUM_LC_utf8((U8*)locinput)))
3255                 {
3256                     sayNO;
3257                 }
3258                 locinput += PL_utf8skip[nextchr];
3259                 nextchr = UCHARAT(locinput);
3260                 break;
3261             }
3262             if (!(OP(scan) == ALNUM
3263                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
3264                 sayNO;
3265             nextchr = UCHARAT(++locinput);
3266             break;
3267         case NALNUML:
3268             PL_reg_flags |= RF_tainted;
3269             /* FALL THROUGH */
3270         case NALNUM:
3271             if (!nextchr && locinput >= PL_regeol)
3272                 sayNO;
3273             if (do_utf8) {
3274                 LOAD_UTF8_CHARCLASS_ALNUM();
3275                 if (OP(scan) == NALNUM
3276                     ? (bool)swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
3277                     : isALNUM_LC_utf8((U8*)locinput))
3278                 {
3279                     sayNO;
3280                 }
3281                 locinput += PL_utf8skip[nextchr];
3282                 nextchr = UCHARAT(locinput);
3283                 break;
3284             }
3285             if (OP(scan) == NALNUM
3286                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
3287                 sayNO;
3288             nextchr = UCHARAT(++locinput);
3289             break;
3290         case BOUNDL:
3291         case NBOUNDL:
3292             PL_reg_flags |= RF_tainted;
3293             /* FALL THROUGH */
3294         case BOUND:
3295         case NBOUND:
3296             /* was last char in word? */
3297             if (do_utf8) {
3298                 if (locinput == PL_bostr)
3299                     ln = '\n';
3300                 else {
3301                     const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
3302
3303                     ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, uniflags);
3304                 }
3305                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
3306                     ln = isALNUM_uni(ln);
3307                     LOAD_UTF8_CHARCLASS_ALNUM();
3308                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
3309                 }
3310                 else {
3311                     ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
3312                     n = isALNUM_LC_utf8((U8*)locinput);
3313                 }
3314             }
3315             else {
3316                 ln = (locinput != PL_bostr) ?
3317                     UCHARAT(locinput - 1) : '\n';
3318                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
3319                     ln = isALNUM(ln);
3320                     n = isALNUM(nextchr);
3321                 }
3322                 else {
3323                     ln = isALNUM_LC(ln);
3324                     n = isALNUM_LC(nextchr);
3325                 }
3326             }
3327             if (((!ln) == (!n)) == (OP(scan) == BOUND ||
3328                                     OP(scan) == BOUNDL))
3329                     sayNO;
3330             break;
3331         case SPACEL:
3332             PL_reg_flags |= RF_tainted;
3333             /* FALL THROUGH */
3334         case SPACE:
3335             if (!nextchr)
3336                 sayNO;
3337             if (do_utf8) {
3338                 if (UTF8_IS_CONTINUED(nextchr)) {
3339                     LOAD_UTF8_CHARCLASS_SPACE();
3340                     if (!(OP(scan) == SPACE
3341                           ? (bool)swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3342                           : isSPACE_LC_utf8((U8*)locinput)))
3343                     {
3344                         sayNO;
3345                     }
3346                     locinput += PL_utf8skip[nextchr];
3347                     nextchr = UCHARAT(locinput);
3348                     break;
3349                 }
3350                 if (!(OP(scan) == SPACE
3351                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3352                     sayNO;
3353                 nextchr = UCHARAT(++locinput);
3354             }
3355             else {
3356                 if (!(OP(scan) == SPACE
3357                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3358                     sayNO;
3359                 nextchr = UCHARAT(++locinput);
3360             }
3361             break;
3362         case NSPACEL:
3363             PL_reg_flags |= RF_tainted;
3364             /* FALL THROUGH */
3365         case NSPACE:
3366             if (!nextchr && locinput >= PL_regeol)
3367                 sayNO;
3368             if (do_utf8) {
3369                 LOAD_UTF8_CHARCLASS_SPACE();
3370                 if (OP(scan) == NSPACE
3371                     ? (bool)swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3372                     : isSPACE_LC_utf8((U8*)locinput))
3373                 {
3374                     sayNO;
3375                 }
3376                 locinput += PL_utf8skip[nextchr];
3377                 nextchr = UCHARAT(locinput);
3378                 break;
3379             }
3380             if (OP(scan) == NSPACE
3381                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
3382                 sayNO;
3383             nextchr = UCHARAT(++locinput);
3384             break;
3385         case DIGITL:
3386             PL_reg_flags |= RF_tainted;
3387             /* FALL THROUGH */
3388         case DIGIT:
3389             if (!nextchr)
3390                 sayNO;
3391             if (do_utf8) {
3392                 LOAD_UTF8_CHARCLASS_DIGIT();
3393                 if (!(OP(scan) == DIGIT
3394                       ? (bool)swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3395                       : isDIGIT_LC_utf8((U8*)locinput)))
3396                 {
3397                     sayNO;
3398                 }
3399                 locinput += PL_utf8skip[nextchr];
3400                 nextchr = UCHARAT(locinput);
3401                 break;
3402             }
3403             if (!(OP(scan) == DIGIT
3404                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
3405                 sayNO;
3406             nextchr = UCHARAT(++locinput);
3407             break;
3408         case NDIGITL:
3409             PL_reg_flags |= RF_tainted;
3410             /* FALL THROUGH */
3411         case NDIGIT:
3412             if (!nextchr && locinput >= PL_regeol)
3413                 sayNO;
3414             if (do_utf8) {
3415                 LOAD_UTF8_CHARCLASS_DIGIT();
3416                 if (OP(scan) == NDIGIT
3417                     ? (bool)swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3418                     : isDIGIT_LC_utf8((U8*)locinput))
3419                 {
3420                     sayNO;
3421                 }
3422                 locinput += PL_utf8skip[nextchr];
3423                 nextchr = UCHARAT(locinput);
3424                 break;
3425             }
3426             if (OP(scan) == NDIGIT
3427                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
3428                 sayNO;
3429             nextchr = UCHARAT(++locinput);
3430             break;
3431         case CLUMP:
3432             if (locinput >= PL_regeol)
3433                 sayNO;
3434             if  (do_utf8) {
3435                 LOAD_UTF8_CHARCLASS_MARK();
3436                 if (swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3437                     sayNO;
3438                 locinput += PL_utf8skip[nextchr];
3439                 while (locinput < PL_regeol &&
3440                        swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3441                     locinput += UTF8SKIP(locinput);
3442                 if (locinput > PL_regeol)
3443                     sayNO;
3444             }
3445             else
3446                locinput++;
3447             nextchr = UCHARAT(locinput);
3448             break;
3449
3450         case NREFFL:
3451         {
3452             char *s;
3453             char type;
3454             PL_reg_flags |= RF_tainted;
3455             /* FALL THROUGH */
3456         case NREF:
3457         case NREFF:
3458             type = OP(scan);
3459             n = reg_check_named_buff_matched(rex,scan);
3460
3461             if ( n ) {
3462                 type = REF + ( type - NREF );
3463                 goto do_ref;
3464             } else {
3465                 sayNO;
3466             }
3467             /* unreached */
3468         case REFFL:
3469             PL_reg_flags |= RF_tainted;
3470             /* FALL THROUGH */
3471         case REF:
3472         case REFF:
3473             n = ARG(scan);  /* which paren pair */
3474             type = OP(scan);
3475           do_ref:
3476             ln = PL_regstartp[n];
3477             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3478             if (*PL_reglastparen < n || ln == -1)
3479                 sayNO;                  /* Do not match unless seen CLOSEn. */
3480             if (ln == PL_regendp[n])
3481                 break;
3482
3483             s = PL_bostr + ln;
3484             if (do_utf8 && type != REF) {       /* REF can do byte comparison */
3485                 char *l = locinput;
3486                 const char *e = PL_bostr + PL_regendp[n];
3487                 /*
3488                  * Note that we can't do the "other character" lookup trick as
3489                  * in the 8-bit case (no pun intended) because in Unicode we
3490                  * have to map both upper and title case to lower case.
3491                  */
3492                 if (type == REFF) {
3493                     while (s < e) {
3494                         STRLEN ulen1, ulen2;
3495                         U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
3496                         U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
3497
3498                         if (l >= PL_regeol)
3499                             sayNO;
3500                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
3501                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
3502                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
3503                             sayNO;
3504                         s += ulen1;
3505                         l += ulen2;
3506                     }
3507                 }
3508                 locinput = l;
3509                 nextchr = UCHARAT(locinput);
3510                 break;
3511             }
3512
3513             /* Inline the first character, for speed. */
3514             if (UCHARAT(s) != nextchr &&
3515                 (type == REF ||
3516                  (UCHARAT(s) != (type == REFF
3517                                   ? PL_fold : PL_fold_locale)[nextchr])))
3518                 sayNO;
3519             ln = PL_regendp[n] - ln;
3520             if (locinput + ln > PL_regeol)
3521                 sayNO;
3522             if (ln > 1 && (type == REF
3523                            ? memNE(s, locinput, ln)
3524                            : (type == REFF
3525                               ? ibcmp(s, locinput, ln)
3526                               : ibcmp_locale(s, locinput, ln))))
3527                 sayNO;
3528             locinput += ln;
3529             nextchr = UCHARAT(locinput);
3530             break;
3531         }
3532         case NOTHING:
3533         case TAIL:
3534             break;
3535         case BACK:
3536             break;
3537
3538 #undef  ST
3539 #define ST st->u.eval
3540         {
3541             SV *ret;
3542             regexp *re;
3543             regexp_internal *rei;
3544             regnode *startpoint;
3545
3546         case GOSTART:
3547         case GOSUB: /*    /(...(?1))/      */
3548             if (cur_eval && cur_eval->locinput==locinput) {
3549                 if (cur_eval->u.eval.close_paren == (U32)ARG(scan))
3550                     Perl_croak(aTHX_ "Infinite recursion in regex");
3551                 if ( ++nochange_depth > MAX_RECURSE_EVAL_NOCHANGE_DEPTH )
3552                     Perl_croak(aTHX_
3553                         "Pattern subroutine nesting without pos change"
3554                         " exceeded limit in regex");
3555             } else {
3556                 nochange_depth = 0;
3557             }
3558             re = rex;
3559             rei = rexi;
3560             (void)ReREFCNT_inc(rex);
3561             if (OP(scan)==GOSUB) {
3562                 startpoint = scan + ARG2L(scan);
3563                 ST.close_paren = ARG(scan);
3564             } else {
3565                 startpoint = rei->program+1;
3566                 ST.close_paren = 0;
3567             }
3568             goto eval_recurse_doit;
3569             /* NOTREACHED */
3570         case EVAL:  /*   /(?{A})B/   /(??{A})B/  and /(?(?{A})X|Y)B/   */
3571             if (cur_eval && cur_eval->locinput==locinput) {
3572                 if ( ++nochange_depth > MAX_RECURSE_EVAL_NOCHANGE_DEPTH )
3573                     Perl_croak(aTHX_ "EVAL without pos change exceeded limit in regex");
3574             } else {
3575                 nochange_depth = 0;
3576             }
3577             {
3578                 /* execute the code in the {...} */
3579                 dSP;
3580                 SV ** const before = SP;
3581                 OP_4tree * const oop = PL_op;
3582                 COP * const ocurcop = PL_curcop;
3583                 PAD *old_comppad;
3584
3585                 n = ARG(scan);
3586                 PL_op = (OP_4tree*)rexi->data->data[n];
3587                 DEBUG_STATE_r( PerlIO_printf(Perl_debug_log,
3588                     "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
3589                 PAD_SAVE_LOCAL(old_comppad, (PAD*)rexi->data->data[n + 2]);
3590                 PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
3591
3592                 if (sv_yes_mark) {
3593                     SV *sv_mrk = get_sv("REGMARK", 1);
3594                     sv_setsv(sv_mrk, sv_yes_mark);
3595                 }
3596
3597                 CALLRUNOPS(aTHX);                       /* Scalar context. */
3598                 SPAGAIN;
3599                 if (SP == before)
3600                     ret = &PL_sv_undef;   /* protect against empty (?{}) blocks. */
3601                 else {
3602                     ret = POPs;
3603                     PUTBACK;
3604                 }
3605
3606                 PL_op = oop;
3607                 PAD_RESTORE_LOCAL(old_comppad);
3608                 PL_curcop = ocurcop;
3609                 if (!logical) {
3610                     /* /(?{...})/ */
3611                     sv_setsv(save_scalar(PL_replgv), ret);
3612                     break;
3613                 }
3614             }
3615             if (logical == 2) { /* Postponed subexpression: /(??{...})/ */
3616                 logical = 0;
3617                 {
3618                     /* extract RE object from returned value; compiling if
3619                      * necessary */
3620
3621                     MAGIC *mg = NULL;
3622                     const SV *sv;
3623                     if(SvROK(ret) && SvSMAGICAL(sv = SvRV(ret)))
3624                         mg = mg_find(sv, PERL_MAGIC_qr);
3625                     else if (SvSMAGICAL(ret)) {
3626                         if (SvGMAGICAL(ret))
3627                             sv_unmagic(ret, PERL_MAGIC_qr);
3628                         else
3629                             mg = mg_find(ret, PERL_MAGIC_qr);
3630                     }
3631
3632                     if (mg) {
3633                         re = (regexp *)mg->mg_obj;
3634                         (void)ReREFCNT_inc(re);
3635                     }
3636                     else {
3637                         STRLEN len;
3638                         const char * const t = SvPV_const(ret, len);
3639                         PMOP pm;
3640                         const I32 osize = PL_regsize;
3641
3642                         Zero(&pm, 1, PMOP);
3643                         if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
3644                         re = CALLREGCOMP((char*)t, (char*)t + len, &pm);
3645                         if (!(SvFLAGS(ret)
3646                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
3647                                 | SVs_GMG)))
3648                             sv_magic(ret,(SV*)ReREFCNT_inc(re),
3649                                         PERL_MAGIC_qr,0,0);
3650                         PL_regsize = osize;
3651                     }
3652                 }
3653                 rei = RXi_GET(re);
3654                 DEBUG_EXECUTE_r(
3655                     debug_start_match(re, do_utf8, locinput, PL_regeol,
3656                         "Matching embedded");
3657                 );
3658                 startpoint = rei->program + 1;
3659                 ST.close_paren = 0; /* only used for GOSUB */
3660                 /* borrowed from regtry */
3661                 if (PL_reg_start_tmpl <= re->nparens) {
3662                     PL_reg_start_tmpl = re->nparens*3/2 + 3;
3663                     if(PL_reg_start_tmp)
3664                         Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
3665                     else
3666                         Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
3667                 }
3668
3669         eval_recurse_doit: /* Share code with GOSUB below this line */
3670                 /* run the pattern returned from (??{...}) */
3671                 ST.cp = regcppush(0);   /* Save *all* the positions. */
3672                 REGCP_SET(ST.lastcp);
3673
3674                 PL_regstartp = re->startp; /* essentially NOOP on GOSUB */
3675                 PL_regendp = re->endp;     /* essentially NOOP on GOSUB */
3676
3677                 *PL_reglastparen = 0;
3678                 *PL_reglastcloseparen = 0;
3679                 PL_reginput = locinput;
3680                 PL_regsize = 0;
3681
3682                 /* XXXX This is too dramatic a measure... */
3683                 PL_reg_maxiter = 0;
3684
3685                 ST.toggle_reg_flags = PL_reg_flags;
3686                 if (re->extflags & RXf_UTF8)
3687                     PL_reg_flags |= RF_utf8;
3688                 else
3689                     PL_reg_flags &= ~RF_utf8;
3690                 ST.toggle_reg_flags ^= PL_reg_flags; /* diff of old and new */
3691
3692                 ST.prev_rex = rex;
3693                 ST.prev_curlyx = cur_curlyx;
3694                 rex = re;
3695                 rexi = rei;
3696                 cur_curlyx = NULL;
3697                 ST.B = next;
3698                 ST.prev_eval = cur_eval;
3699                 cur_eval = st;
3700                 /* now continue from first node in postoned RE */
3701                 PUSH_YES_STATE_GOTO(EVAL_AB, startpoint);
3702                 /* NOTREACHED */
3703             }
3704             /* logical is 1,   /(?(?{...})X|Y)/ */
3705             sw = (bool)SvTRUE(ret);
3706             logical = 0;
3707             break;
3708         }
3709
3710         case EVAL_AB: /* cleanup after a successful (??{A})B */
3711             /* note: this is called twice; first after popping B, then A */
3712             PL_reg_flags ^= ST.toggle_reg_flags;
3713             ReREFCNT_dec(rex);
3714             rex = ST.prev_rex;
3715             rexi = RXi_GET(rex);
3716             regcpblow(ST.cp);
3717             cur_eval = ST.prev_eval;
3718             cur_curlyx = ST.prev_curlyx;
3719             /* XXXX This is too dramatic a measure... */
3720             PL_reg_maxiter = 0;
3721             sayYES;
3722
3723
3724         case EVAL_AB_fail: /* unsuccessfully ran A or B in (??{A})B */
3725             /* note: this is called twice; first after popping B, then A */
3726             PL_reg_flags ^= ST.toggle_reg_flags;
3727             ReREFCNT_dec(rex);
3728             rex = ST.prev_rex;
3729             rexi = RXi_GET(rex);
3730             PL_reginput = locinput;
3731             REGCP_UNWIND(ST.lastcp);
3732             regcppop(rex);
3733             cur_eval = ST.prev_eval;
3734             cur_curlyx = ST.prev_curlyx;
3735             /* XXXX This is too dramatic a measure... */
3736             PL_reg_maxiter = 0;
3737             sayNO_SILENT;
3738 #undef ST
3739
3740         case OPEN:
3741             n = ARG(scan);  /* which paren pair */
3742             PL_reg_start_tmp[n] = locinput;
3743             if (n > PL_regsize)
3744                 PL_regsize = n;
3745             lastopen = n;
3746             break;
3747         case CLOSE:
3748             n = ARG(scan);  /* which paren pair */
3749             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
3750             PL_regendp[n] = locinput - PL_bostr;
3751             /*if (n > PL_regsize)
3752                 PL_regsize = n;*/
3753             if (n > *PL_reglastparen)
3754                 *PL_reglastparen = n;
3755             *PL_reglastcloseparen = n;
3756             if (cur_eval && cur_eval->u.eval.close_paren == n) {
3757                 goto fake_end;
3758             }
3759             break;
3760         case ACCEPT:
3761             if (ARG(scan)){
3762                 regnode *cursor;
3763                 for (cursor=scan;
3764                      cursor && OP(cursor)!=END;
3765                      cursor=regnext(cursor))
3766                 {
3767                     if ( OP(cursor)==CLOSE ){
3768                         n = ARG(cursor);
3769                         if ( n <= lastopen ) {
3770                             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
3771                             PL_regendp[n] = locinput - PL_bostr;
3772                             /*if (n > PL_regsize)
3773                             PL_regsize = n;*/
3774                             if (n > *PL_reglastparen)
3775                                 *PL_reglastparen = n;
3776                             *PL_reglastcloseparen = n;
3777                             if ( n == ARG(scan) || (cur_eval &&
3778                                 cur_eval->u.eval.close_paren == n))
3779                                 break;
3780                         }
3781                     }
3782                 }
3783             }
3784             goto fake_end;
3785             /*NOTREACHED*/
3786         case GROUPP:
3787             n = ARG(scan);  /* which paren pair */
3788             sw = (bool)(*PL_reglastparen >= n && PL_regendp[n] != -1);
3789             break;
3790         case NGROUPP:
3791             /* reg_check_named_buff_matched returns 0 for no match */
3792             sw = (bool)(0 < reg_check_named_buff_matched(rex,scan));
3793             break;
3794         case INSUBP:
3795             n = ARG(scan);
3796             sw = (cur_eval && (!n || cur_eval->u.eval.close_paren == n));
3797             break;
3798         case DEFINEP:
3799             sw = 0;
3800             break;
3801         case IFTHEN:
3802             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3803             if (sw)
3804                 next = NEXTOPER(NEXTOPER(scan));
3805             else {
3806                 next = scan + ARG(scan);
3807                 if (OP(next) == IFTHEN) /* Fake one. */
3808                     next = NEXTOPER(NEXTOPER(next));
3809             }
3810             break;
3811         case LOGICAL:
3812             logical = scan->flags;
3813             break;
3814
3815 /*******************************************************************
3816
3817 The CURLYX/WHILEM pair of ops handle the most generic case of the /A*B/
3818 pattern, where A and B are subpatterns. (For simple A, CURLYM or
3819 STAR/PLUS/CURLY/CURLYN are used instead.)
3820
3821 A*B is compiled as <CURLYX><A><WHILEM><B>
3822
3823 On entry to the subpattern, CURLYX is called. This pushes a CURLYX
3824 state, which contains the current count, initialised to -1. It also sets
3825 cur_curlyx to point to this state, with any previous value saved in the
3826 state block.
3827
3828 CURLYX then jumps straight to the WHILEM op, rather than executing A,
3829 since the pattern may possibly match zero times (i.e. it's a while {} loop
3830 rather than a do {} while loop).
3831
3832 Each entry to WHILEM represents a successful match of A. The count in the
3833 CURLYX block is incremented, another WHILEM state is pushed, and execution
3834 passes to A or B depending on greediness and the current count.
3835
3836 For example, if matching against the string a1a2a3b (where the aN are
3837 substrings that match /A/), then the match progresses as follows: (the
3838 pushed states are interspersed with the bits of strings matched so far):
3839
3840     <CURLYX cnt=-1>
3841     <CURLYX cnt=0><WHILEM>
3842     <CURLYX cnt=1><WHILEM> a1 <WHILEM>
3843     <CURLYX cnt=2><WHILEM> a1 <WHILEM> a2 <WHILEM>
3844     <CURLYX cnt=3><WHILEM> a1 <WHILEM> a2 <WHILEM> a3 <WHILEM>
3845     <CURLYX cnt=3><WHILEM> a1 <WHILEM> a2 <WHILEM> a3 <WHILEM> b
3846
3847 (Contrast this with something like CURLYM, which maintains only a single
3848 backtrack state:
3849
3850     <CURLYM cnt=0> a1
3851     a1 <CURLYM cnt=1> a2
3852     a1 a2 <CURLYM cnt=2> a3
3853     a1 a2 a3 <CURLYM cnt=3> b
3854 )
3855
3856 Each WHILEM state block marks a point to backtrack to upon partial failure
3857 of A or B, and also contains some minor state data related to that
3858 iteration.  The CURLYX block, pointed to by cur_curlyx, contains the
3859 overall state, such as the count, and pointers to the A and B ops.
3860
3861 This is complicated slightly by nested CURLYX/WHILEM's. Since cur_curlyx
3862 must always point to the *current* CURLYX block, the rules are:
3863
3864 When executing CURLYX, save the old cur_curlyx in the CURLYX state block,
3865 and set cur_curlyx to point the new block.
3866
3867 When popping the CURLYX block after a successful or unsuccessful match,
3868 restore the previous cur_curlyx.
3869
3870 When WHILEM is about to execute B, save the current cur_curlyx, and set it
3871 to the outer one saved in the CURLYX block.
3872
3873 When popping the WHILEM block after a successful or unsuccessful B match,
3874 restore the previous cur_curlyx.
3875
3876 Here's an example for the pattern (AI* BI)*BO
3877 I and O refer to inner and outer, C and W refer to CURLYX and WHILEM:
3878
3879 cur_
3880 curlyx backtrack stack
3881 ------ ---------------
3882 NULL
3883 CO     <CO prev=NULL> <WO>
3884 CI     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai
3885 CO     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi
3886 NULL   <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi <WO prev=CO> bo
3887
3888 At this point the pattern succeeds, and we work back down the stack to
3889 clean up, restoring as we go:
3890
3891 CO     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi
3892 CI     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai
3893 CO     <CO prev=NULL> <WO>
3894 NULL
3895
3896 *******************************************************************/
3897
3898 #define ST st->u.curlyx
3899
3900         case CURLYX:    /* start of /A*B/  (for complex A) */
3901         {
3902             /* No need to save/restore up to this paren */
3903             I32 parenfloor = scan->flags;
3904
3905             assert(next); /* keep Coverity happy */
3906             if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
3907                 next += ARG(next);
3908
3909             /* XXXX Probably it is better to teach regpush to support
3910                parenfloor > PL_regsize... */
3911             if (parenfloor > (I32)*PL_reglastparen)
3912                 parenfloor = *PL_reglastparen; /* Pessimization... */
3913
3914             ST.prev_curlyx= cur_curlyx;
3915             cur_curlyx = st;
3916             ST.cp = PL_savestack_ix;
3917
3918             /* these fields contain the state of the current curly.
3919              * they are accessed by subsequent WHILEMs */
3920             ST.parenfloor = parenfloor;
3921             ST.min = ARG1(scan);
3922             ST.max = ARG2(scan);
3923             ST.A = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3924             ST.B = next;
3925             ST.minmod = minmod;
3926             minmod = 0;
3927             ST.count = -1;      /* this will be updated by WHILEM */
3928             ST.lastloc = NULL;  /* this will be updated by WHILEM */
3929
3930             PL_reginput = locinput;
3931             PUSH_YES_STATE_GOTO(CURLYX_end, PREVOPER(next));
3932             /* NOTREACHED */
3933         }
3934
3935         case CURLYX_end: /* just finished matching all of A*B */
3936             if (PL_reg_eval_set){
3937                 SV *pres= GvSV(PL_replgv);
3938                 SvREFCNT_inc(pres);
3939                 regcpblow(ST.cp);
3940                 sv_setsv(GvSV(PL_replgv), pres);
3941                 SvREFCNT_dec(pres);
3942             } else {
3943                 regcpblow(ST.cp);
3944             }
3945             cur_curlyx = ST.prev_curlyx;
3946             sayYES;
3947             /* NOTREACHED */
3948
3949         case CURLYX_end_fail: /* just failed to match all of A*B */
3950             regcpblow(ST.cp);
3951             cur_curlyx = ST.prev_curlyx;
3952             sayNO;
3953             /* NOTREACHED */
3954
3955
3956 #undef ST
3957 #define ST st->u.whilem
3958
3959         case WHILEM:     /* just matched an A in /A*B/  (for complex A) */
3960         {
3961             /* see the discussion above about CURLYX/WHILEM */
3962             I32 n;
3963             assert(cur_curlyx); /* keep Coverity happy */
3964             n = ++cur_curlyx->u.curlyx.count; /* how many A's matched */
3965             ST.save_lastloc = cur_curlyx->u.curlyx.lastloc;
3966             ST.cache_offset = 0;
3967             ST.cache_mask = 0;
3968
3969             PL_reginput = locinput;
3970
3971             DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
3972                   "%*s  whilem: matched %ld out of %ld..%ld\n",
3973                   REPORT_CODE_OFF+depth*2, "", (long)n,
3974                   (long)cur_curlyx->u.curlyx.min,
3975                   (long)cur_curlyx->u.curlyx.max)
3976             );
3977
3978             /* First just match a string of min A's. */
3979
3980             if (n < cur_curlyx->u.curlyx.min) {
3981                 cur_curlyx->u.curlyx.lastloc = locinput;
3982                 PUSH_STATE_GOTO(WHILEM_A_pre, cur_curlyx->u.curlyx.A);
3983                 /* NOTREACHED */
3984             }
3985
3986             /* If degenerate A matches "", assume A done. */
3987
3988             if (locinput == cur_curlyx->u.curlyx.lastloc) {
3989                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
3990                    "%*s  whilem: empty match detected, trying continuation...\n",
3991                    REPORT_CODE_OFF+depth*2, "")
3992                 );
3993                 goto do_whilem_B_max;
3994             }
3995
3996             /* super-linear cache processing */
3997
3998             if (scan->flags) {
3999
4000                 if (!PL_reg_maxiter) {
4001                     /* start the countdown: Postpone detection until we
4002                      * know the match is not *that* much linear. */
4003                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
4004                     /* possible overflow for long strings and many CURLYX's */
4005                     if (PL_reg_maxiter < 0)
4006                         PL_reg_maxiter = I32_MAX;
4007                     PL_reg_leftiter = PL_reg_maxiter;
4008                 }
4009
4010                 if (PL_reg_leftiter-- == 0) {
4011                     /* initialise cache */
4012                     const I32 size = (PL_reg_maxiter + 7)/8;
4013                     if (PL_reg_poscache) {
4014                         if ((I32)PL_reg_poscache_size < size) {
4015                             Renew(PL_reg_poscache, size, char);
4016                             PL_reg_poscache_size = size;
4017                         }
4018                         Zero(PL_reg_poscache, size, char);
4019                     }
4020                     else {
4021                         PL_reg_poscache_size = size;
4022                         Newxz(PL_reg_poscache, size, char);
4023                     }
4024                     DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4025       "%swhilem: Detected a super-linear match, switching on caching%s...\n",
4026                               PL_colors[4], PL_colors[5])
4027                     );
4028                 }
4029
4030                 if (PL_reg_leftiter < 0) {
4031                     /* have we already failed at this position? */
4032                     I32 offset, mask;
4033                     offset  = (scan->flags & 0xf) - 1
4034                                 + (locinput - PL_bostr)  * (scan->flags>>4);
4035                     mask    = 1 << (offset % 8);
4036                     offset /= 8;
4037                     if (PL_reg_poscache[offset] & mask) {
4038                         DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4039                             "%*s  whilem: (cache) already tried at this position...\n",
4040                             REPORT_CODE_OFF+depth*2, "")
4041                         );
4042                         sayNO; /* cache records failure */
4043                     }
4044                     ST.cache_offset = offset;
4045                     ST.cache_mask   = mask;
4046                 }
4047             }
4048
4049             /* Prefer B over A for minimal matching. */
4050
4051             if (cur_curlyx->u.curlyx.minmod) {
4052                 ST.save_curlyx = cur_curlyx;
4053                 cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
4054                 ST.cp = regcppush(ST.save_curlyx->u.curlyx.parenfloor);
4055                 REGCP_SET(ST.lastcp);
4056                 PUSH_YES_STATE_GOTO(WHILEM_B_min, ST.save_curlyx->u.curlyx.B);
4057                 /* NOTREACHED */
4058             }
4059
4060             /* Prefer A over B for maximal matching. */
4061
4062             if (n < cur_curlyx->u.curlyx.max) { /* More greed allowed? */
4063                 ST.cp = regcppush(cur_curlyx->u.curlyx.parenfloor);
4064                 cur_curlyx->u.curlyx.lastloc = locinput;
4065                 REGCP_SET(ST.lastcp);
4066                 PUSH_STATE_GOTO(WHILEM_A_max, cur_curlyx->u.curlyx.A);
4067                 /* NOTREACHED */
4068             }
4069             goto do_whilem_B_max;
4070         }
4071         /* NOTREACHED */
4072
4073         case WHILEM_B_min: /* just matched B in a minimal match */
4074         case WHILEM_B_max: /* just matched B in a maximal match */
4075             cur_curlyx = ST.save_curlyx;
4076             sayYES;
4077             /* NOTREACHED */
4078
4079         case WHILEM_B_max_fail: /* just failed to match B in a maximal match */
4080             cur_curlyx = ST.save_curlyx;
4081             cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
4082             cur_curlyx->u.curlyx.count--;
4083             CACHEsayNO;
4084             /* NOTREACHED */
4085
4086         case WHILEM_A_min_fail: /* just failed to match A in a minimal match */
4087             REGCP_UNWIND(ST.lastcp);
4088             regcppop(rex);
4089             /* FALL THROUGH */
4090         case WHILEM_A_pre_fail: /* just failed to match even minimal A */
4091             cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
4092             cur_curlyx->u.curlyx.count--;
4093             CACHEsayNO;
4094             /* NOTREACHED */
4095
4096         case WHILEM_A_max_fail: /* just failed to match A in a maximal match */
4097             REGCP_UNWIND(ST.lastcp);
4098             regcppop(rex);      /* Restore some previous $<digit>s? */
4099             PL_reginput = locinput;
4100             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4101                 "%*s  whilem: failed, trying continuation...\n",
4102                 REPORT_CODE_OFF+depth*2, "")
4103             );
4104           do_whilem_B_max:
4105             if (cur_curlyx->u.curlyx.count >= REG_INFTY
4106                 && ckWARN(WARN_REGEXP)
4107                 && !(PL_reg_flags & RF_warned))
4108             {
4109                 PL_reg_flags |= RF_warned;
4110                 Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
4111                      "Complex regular subexpression recursion",
4112                      REG_INFTY - 1);
4113             }
4114
4115             /* now try B */
4116             ST.save_curlyx = cur_curlyx;
4117             cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
4118             PUSH_YES_STATE_GOTO(WHILEM_B_max, ST.save_curlyx->u.curlyx.B);
4119             /* NOTREACHED */
4120
4121         case WHILEM_B_min_fail: /* just failed to match B in a minimal match */
4122             cur_curlyx = ST.save_curlyx;
4123             REGCP_UNWIND(ST.lastcp);
4124             regcppop(rex);
4125
4126             if (cur_curlyx->u.curlyx.count >= cur_curlyx->u.curlyx.max) {
4127                 /* Maximum greed exceeded */
4128                 if (cur_curlyx->u.curlyx.count >= REG_INFTY
4129                     && ckWARN(WARN_REGEXP)
4130                     && !(PL_reg_flags & RF_warned))
4131                 {
4132                     PL_reg_flags |= RF_warned;
4133                     Perl_warner(aTHX_ packWARN(WARN_REGEXP),
4134                         "%s limit (%d) exceeded",
4135                         "Complex regular subexpression recursion",
4136                         REG_INFTY - 1);
4137                 }
4138                 cur_curlyx->u.curlyx.count--;
4139                 CACHEsayNO;
4140             }
4141
4142             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4143                 "%*s  trying longer...\n", REPORT_CODE_OFF+depth*2, "")
4144             );
4145             /* Try grabbing another A and see if it helps. */
4146             PL_reginput = locinput;
4147             cur_curlyx->u.curlyx.lastloc = locinput;
4148             ST.cp = regcppush(cur_curlyx->u.curlyx.parenfloor);
4149             REGCP_SET(ST.lastcp);
4150             PUSH_STATE_GOTO(WHILEM_A_min, ST.save_curlyx->u.curlyx.A);
4151             /* NOTREACHED */
4152
4153 #undef  ST
4154 #define ST st->u.branch
4155
4156         case BRANCHJ:       /*  /(...|A|...)/ with long next pointer */
4157             next = scan + ARG(scan);
4158             if (next == scan)
4159                 next = NULL;
4160             scan = NEXTOPER(scan);
4161             /* FALL THROUGH */
4162
4163         case BRANCH:        /*  /(...|A|...)/ */
4164             scan = NEXTOPER(scan); /* scan now points to inner node */
4165             if ((!next || (OP(next) != BRANCH && OP(next) != BRANCHJ))
4166                 && !has_cutgroup)
4167             {
4168                 /* last branch; skip state push and jump direct to node */
4169                 continue;
4170             }
4171             ST.lastparen = *PL_reglastparen;
4172             ST.next_branch = next;
4173             REGCP_SET(ST.cp);
4174             PL_reginput = locinput;
4175
4176             /* Now go into the branch */
4177             if (has_cutgroup) {
4178                 PUSH_YES_STATE_GOTO(BRANCH_next, scan);
4179             } else {
4180                 PUSH_STATE_GOTO(BRANCH_next, scan);
4181             }
4182             /* NOTREACHED */
4183         case CUTGROUP:
4184             PL_reginput = locinput;
4185             sv_yes_mark = st->u.mark.mark_name = scan->flags ? NULL :
4186                 (SV*)rexi->data->data[ ARG( scan ) ];
4187             PUSH_STATE_GOTO(CUTGROUP_next,next);
4188             /* NOTREACHED */
4189         case CUTGROUP_next_fail:
4190             do_cutgroup = 1;
4191             no_final = 1;
4192             if (st->u.mark.mark_name)
4193                 sv_commit = st->u.mark.mark_name;
4194             sayNO;
4195             /* NOTREACHED */
4196         case BRANCH_next:
4197             sayYES;
4198             /* NOTREACHED */
4199         case BRANCH_next_fail: /* that branch failed; try the next, if any */
4200             if (do_cutgroup) {
4201                 do_cutgroup = 0;
4202                 no_final = 0;
4203             }
4204             REGCP_UNWIND(ST.cp);
4205             for (n = *PL_reglastparen; n > ST.lastparen; n--)
4206                 PL_regendp[n] = -1;
4207             *PL_reglastparen = n;
4208             /*dmq: *PL_reglastcloseparen = n; */
4209             scan = ST.next_branch;
4210             /* no more branches? */
4211             if (!scan || (OP(scan) != BRANCH && OP(scan) != BRANCHJ)) {
4212                 DEBUG_EXECUTE_r({
4213                     PerlIO_printf( Perl_debug_log,
4214                         "%*s  %sBRANCH failed...%s\n",
4215                         REPORT_CODE_OFF+depth*2, "",
4216                         PL_colors[4],
4217                         PL_colors[5] );
4218                 });
4219                 sayNO_SILENT;
4220             }
4221             continue; /* execute next BRANCH[J] op */
4222             /* NOTREACHED */
4223
4224         case MINMOD:
4225             minmod = 1;
4226             break;
4227
4228 #undef  ST
4229 #define ST st->u.curlym
4230
4231         case CURLYM:    /* /A{m,n}B/ where A is fixed-length */
4232
4233             /* This is an optimisation of CURLYX that enables us to push
4234              * only a single backtracking state, no matter now many matches
4235              * there are in {m,n}. It relies on the pattern being constant
4236              * length, with no parens to influence future backrefs
4237              */
4238
4239             ST.me = scan;
4240             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
4241
4242             /* if paren positive, emulate an OPEN/CLOSE around A */
4243             if (ST.me->flags) {
4244                 U32 paren = ST.me->flags;
4245                 if (paren > PL_regsize)
4246                     PL_regsize = paren;
4247                 if (paren > *PL_reglastparen)
4248                     *PL_reglastparen = paren;
4249                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
4250             }
4251             ST.A = scan;
4252             ST.B = next;
4253             ST.alen = 0;
4254             ST.count = 0;
4255             ST.minmod = minmod;
4256             minmod = 0;
4257             ST.c1 = CHRTEST_UNINIT;
4258             REGCP_SET(ST.cp);
4259
4260             if (!(ST.minmod ? ARG1(ST.me) : ARG2(ST.me))) /* min/max */
4261                 goto curlym_do_B;
4262
4263           curlym_do_A: /* execute the A in /A{m,n}B/  */
4264             PL_reginput = locinput;
4265             PUSH_YES_STATE_GOTO(CURLYM_A, ST.A); /* match A */
4266             /* NOTREACHED */
4267
4268         case CURLYM_A: /* we've just matched an A */
4269             locinput = st->locinput;
4270             nextchr = UCHARAT(locinput);
4271
4272             ST.count++;
4273             /* after first match, determine A's length: u.curlym.alen */
4274             if (ST.count == 1) {
4275                 if (PL_reg_match_utf8) {
4276                     char *s = locinput;
4277                     while (s < PL_reginput) {
4278                         ST.alen++;
4279                         s += UTF8SKIP(s);
4280                     }
4281                 }
4282                 else {
4283                     ST.alen = PL_reginput - locinput;
4284                 }
4285                 if (ST.alen == 0)
4286                     ST.count = ST.minmod ? ARG1(ST.me) : ARG2(ST.me);
4287             }
4288             DEBUG_EXECUTE_r(
4289                 PerlIO_printf(Perl_debug_log,
4290                           "%*s  CURLYM now matched %"IVdf" times, len=%"IVdf"...\n",
4291                           (int)(REPORT_CODE_OFF+(depth*2)), "",
4292                           (IV) ST.count, (IV)ST.alen)
4293             );
4294
4295             locinput = PL_reginput;
4296
4297             if (cur_eval && cur_eval->u.eval.close_paren &&
4298                 cur_eval->u.eval.close_paren == (U32)ST.me->flags)
4299                 goto fake_end;
4300
4301             if ( ST.count < (ST.minmod ? ARG1(ST.me) : ARG2(ST.me)) )
4302                 goto curlym_do_A; /* try to match another A */
4303             goto curlym_do_B; /* try to match B */
4304
4305         case CURLYM_A_fail: /* just failed to match an A */
4306             REGCP_UNWIND(ST.cp);
4307
4308             if (ST.minmod || ST.count < ARG1(ST.me) /* min*/
4309                 || (cur_eval && cur_eval->u.eval.close_paren &&
4310                     cur_eval->u.eval.close_paren == (U32)ST.me->flags))
4311                 sayNO;
4312
4313           curlym_do_B: /* execute the B in /A{m,n}B/  */
4314             PL_reginput = locinput;
4315             if (ST.c1 == CHRTEST_UNINIT) {
4316                 /* calculate c1 and c2 for possible match of 1st char
4317                  * following curly */
4318                 ST.c1 = ST.c2 = CHRTEST_VOID;
4319                 if (HAS_TEXT(ST.B) || JUMPABLE(ST.B)) {
4320                     regnode *text_node = ST.B;
4321                     if (! HAS_TEXT(text_node))
4322                         FIND_NEXT_IMPT(text_node);
4323                     /* this used to be
4324
4325                         (HAS_TEXT(text_node) && PL_regkind[OP(text_node)] == EXACT)
4326
4327                         But the former is redundant in light of the latter.
4328
4329                         if this changes back then the macro for
4330                         IS_TEXT and friends need to change.
4331                      */
4332                     if (PL_regkind[OP(text_node)] == EXACT)
4333                     {
4334
4335                         ST.c1 = (U8)*STRING(text_node);
4336                         ST.c2 =
4337                             (IS_TEXTF(text_node))
4338                             ? PL_fold[ST.c1]
4339                             : (IS_TEXTFL(text_node))
4340                                 ? PL_fold_locale[ST.c1]
4341                                 : ST.c1;
4342                     }
4343                 }
4344             }
4345
4346             DEBUG_EXECUTE_r(
4347                 PerlIO_printf(Perl_debug_log,
4348                     "%*s  CURLYM trying tail with matches=%"IVdf"...\n",
4349                     (int)(REPORT_CODE_OFF+(depth*2)),
4350                     "", (IV)ST.count)
4351                 );
4352             if (ST.c1 != CHRTEST_VOID
4353                     && UCHARAT(PL_reginput) != ST.c1
4354                     && UCHARAT(PL_reginput) != ST.c2)
4355             {
4356                 /* simulate B failing */
4357                 state_num = CURLYM_B_fail;
4358                 goto reenter_switch;
4359             }
4360
4361             if (ST.me->flags) {
4362                 /* mark current A as captured */
4363                 I32 paren = ST.me->flags;
4364                 if (ST.count) {
4365                     PL_regstartp[paren]
4366                         = HOPc(PL_reginput, -ST.alen) - PL_bostr;
4367                     PL_regendp[paren] = PL_reginput - PL_bostr;
4368                     /*dmq: *PL_reglastcloseparen = paren; */
4369                 }
4370                 else
4371                     PL_regendp[paren] = -1;
4372                 if (cur_eval && cur_eval->u.eval.close_paren &&
4373                     cur_eval->u.eval.close_paren == (U32)ST.me->flags)
4374                 {
4375                     if (ST.count)
4376                         goto fake_end;
4377                     else
4378                         sayNO;
4379                 }
4380             }
4381
4382             PUSH_STATE_GOTO(CURLYM_B, ST.B); /* match B */
4383             /* NOTREACHED */
4384
4385         case CURLYM_B_fail: /* just failed to match a B */
4386             REGCP_UNWIND(ST.cp);
4387             if (ST.minmod) {
4388                 if (ST.count == ARG2(ST.me) /* max */)
4389                     sayNO;
4390                 goto curlym_do_A; /* try to match a further A */
4391             }
4392             /* backtrack one A */
4393             if (ST.count == ARG1(ST.me) /* min */)
4394                 sayNO;
4395             ST.count--;
4396             locinput = HOPc(locinput, -ST.alen);
4397             goto curlym_do_B; /* try to match B */
4398
4399 #undef ST
4400 #define ST st->u.curly
4401
4402 #define CURLY_SETPAREN(paren, success) \
4403     if (paren) { \
4404         if (success) { \
4405             PL_regstartp[paren] = HOPc(locinput, -1) - PL_bostr; \
4406             PL_regendp[paren] = locinput - PL_bostr; \
4407             *PL_reglastcloseparen = paren; \
4408         } \
4409         else \
4410             PL_regendp[paren] = -1; \
4411     }
4412
4413         case STAR:              /*  /A*B/ where A is width 1 */
4414             ST.paren = 0;
4415             ST.min = 0;
4416             ST.max = REG_INFTY;
4417             scan = NEXTOPER(scan);
4418             goto repeat;
4419         case PLUS:              /*  /A+B/ where A is width 1 */
4420             ST.paren = 0;
4421             ST.min = 1;
4422             ST.max = REG_INFTY;
4423             scan = NEXTOPER(scan);
4424             goto repeat;
4425         case CURLYN:            /*  /(A){m,n}B/ where A is width 1 */
4426             ST.paren = scan->flags;     /* Which paren to set */
4427             if (ST.paren > PL_regsize)
4428                 PL_regsize = ST.paren;
4429             if (ST.paren > *PL_reglastparen)
4430                 *PL_reglastparen = ST.paren;
4431             ST.min = ARG1(scan);  /* min to match */
4432             ST.max = ARG2(scan);  /* max to match */
4433             if (cur_eval && cur_eval->u.eval.close_paren &&
4434                 cur_eval->u.eval.close_paren == (U32)ST.paren) {
4435                 ST.min=1;
4436                 ST.max=1;
4437             }
4438             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
4439             goto repeat;
4440         case CURLY:             /*  /A{m,n}B/ where A is width 1 */
4441             ST.paren = 0;
4442             ST.min = ARG1(scan);  /* min to match */
4443             ST.max = ARG2(scan);  /* max to match */
4444             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
4445           repeat:
4446             /*
4447             * Lookahead to avoid useless match attempts
4448             * when we know what character comes next.
4449             *
4450             * Used to only do .*x and .*?x, but now it allows
4451             * for )'s, ('s and (?{ ... })'s to be in the way
4452             * of the quantifier and the EXACT-like node.  -- japhy
4453             */
4454
4455             if (ST.min > ST.max) /* XXX make this a compile-time check? */
4456                 sayNO;
4457             if (HAS_TEXT(next) || JUMPABLE(next)) {
4458                 U8 *s;
4459                 regnode *text_node = next;
4460
4461                 if (! HAS_TEXT(text_node))
4462                     FIND_NEXT_IMPT(text_node);
4463
4464                 if (! HAS_TEXT(text_node))
4465                     ST.c1 = ST.c2 = CHRTEST_VOID;
4466                 else {
4467                     if ( PL_regkind[OP(text_node)] != EXACT ) {
4468                         ST.c1 = ST.c2 = CHRTEST_VOID;
4469                         goto assume_ok_easy;
4470                     }
4471                     else
4472                         s = (U8*)STRING(text_node);
4473
4474                     /*  Currently we only get here when
4475
4476                         PL_rekind[OP(text_node)] == EXACT
4477
4478                         if this changes back then the macro for IS_TEXT and
4479                         friends need to change. */
4480                     if (!UTF) {
4481                         ST.c2 = ST.c1 = *s;
4482                         if (IS_TEXTF(text_node))
4483                             ST.c2 = PL_fold[ST.c1];
4484                         else if (IS_TEXTFL(text_node))
4485                             ST.c2 = PL_fold_locale[ST.c1];
4486                     }
4487                     else { /* UTF */
4488                         if (IS_TEXTF(text_node)) {
4489                              STRLEN ulen1, ulen2;
4490                              U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
4491                              U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
4492
4493                              to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
4494                              to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
4495 #ifdef EBCDIC
4496                              ST.c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXLEN, 0,
4497                                                     ckWARN(WARN_UTF8) ?
4498                                                     0 : UTF8_ALLOW_ANY);
4499                              ST.c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXLEN, 0,
4500                                                     ckWARN(WARN_UTF8) ?
4501                                                     0 : UTF8_ALLOW_ANY);
4502 #else
4503                              ST.c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
4504                                                     uniflags);
4505                              ST.c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
4506                                                     uniflags);
4507 #endif
4508                         }
4509                         else {
4510                             ST.c2 = ST.c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
4511                                                      uniflags);
4512                         }
4513                     }
4514                 }
4515             }
4516             else
4517                 ST.c1 = ST.c2 = CHRTEST_VOID;
4518         assume_ok_easy:
4519
4520             ST.A = scan;
4521             ST.B = next;
4522             PL_reginput = locinput;
4523             if (minmod) {
4524                 minmod = 0;
4525                 if (ST.min && regrepeat(rex, ST.A, ST.min, depth) < ST.min)
4526                     sayNO;
4527                 ST.count = ST.min;
4528                 locinput = PL_reginput;
4529                 REGCP_SET(ST.cp);
4530                 if (ST.c1 == CHRTEST_VOID)
4531                     goto curly_try_B_min;
4532
4533                 ST.oldloc = locinput;
4534
4535                 /* set ST.maxpos to the furthest point along the
4536                  * string that could possibly match */
4537                 if  (ST.max == REG_INFTY) {
4538                     ST.maxpos = PL_regeol - 1;
4539                     if (do_utf8)
4540                         while (UTF8_IS_CONTINUATION(*(U8*)ST.maxpos))
4541                             ST.maxpos--;
4542                 }
4543                 else if (do_utf8) {
4544                     int m = ST.max - ST.min;
4545                     for (ST.maxpos = locinput;
4546                          m >0 && ST.maxpos + UTF8SKIP(ST.maxpos) <= PL_regeol; m--)
4547                         ST.maxpos += UTF8SKIP(ST.maxpos);
4548                 }
4549                 else {
4550                     ST.maxpos = locinput + ST.max - ST.min;
4551                     if (ST.maxpos >= PL_regeol)
4552                         ST.maxpos = PL_regeol - 1;
4553                 }
4554                 goto curly_try_B_min_known;
4555
4556             }
4557             else {
4558                 ST.count = regrepeat(rex, ST.A, ST.max, depth);
4559                 locinput = PL_reginput;
4560                 if (ST.count < ST.min)
4561                     sayNO;
4562                 if ((ST.count > ST.min)
4563                     && (PL_regkind[OP(ST.B)] == EOL) && (OP(ST.B) != MEOL))
4564                 {
4565                     /* A{m,n} must come at the end of the string, there's
4566                      * no point in backing off ... */
4567                     ST.min = ST.count;
4568                     /* ...except that $ and \Z can match before *and* after
4569                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
4570                        We may back off by one in this case. */
4571                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(ST.B) != EOS)
4572                         ST.min--;
4573                 }
4574                 REGCP_SET(ST.cp);
4575                 goto curly_try_B_max;
4576             }
4577             /* NOTREACHED */
4578
4579
4580         case CURLY_B_min_known_fail:
4581             /* failed to find B in a non-greedy match where c1,c2 valid */
4582             if (ST.paren && ST.count)
4583                 PL_regendp[ST.paren] = -1;
4584
4585             PL_reginput = locinput;     /* Could be reset... */
4586             REGCP_UNWIND(ST.cp);
4587             /* Couldn't or didn't -- move forward. */
4588             ST.oldloc = locinput;
4589             if (do_utf8)
4590                 locinput += UTF8SKIP(locinput);
4591             else
4592                 locinput++;
4593             ST.count++;
4594           curly_try_B_min_known:
4595              /* find the next place where 'B' could work, then call B */
4596             {
4597                 int n;
4598                 if (do_utf8) {
4599                     n = (ST.oldloc == locinput) ? 0 : 1;
4600                     if (ST.c1 == ST.c2) {
4601                         STRLEN len;
4602                         /* set n to utf8_distance(oldloc, locinput) */
4603                         while (locinput <= ST.maxpos &&
4604                                utf8n_to_uvchr((U8*)locinput,
4605                                               UTF8_MAXBYTES, &len,
4606                                               uniflags) != (UV)ST.c1) {
4607                             locinput += len;
4608                             n++;
4609                         }
4610                     }
4611                     else {
4612                         /* set n to utf8_distance(oldloc, locinput) */
4613                         while (locinput <= ST.maxpos) {
4614                             STRLEN len;
4615                             const UV c = utf8n_to_uvchr((U8*)locinput,
4616                                                   UTF8_MAXBYTES, &len,
4617                                                   uniflags);
4618                             if (c == (UV)ST.c1 || c == (UV)ST.c2)
4619                                 break;
4620                             locinput += len;
4621                             n++;
4622                         }
4623                     }
4624                 }
4625                 else {
4626                     if (ST.c1 == ST.c2) {
4627                         while (locinput <= ST.maxpos &&
4628                                UCHARAT(locinput) != ST.c1)
4629                             locinput++;
4630                     }
4631                     else {
4632                         while (locinput <= ST.maxpos
4633                                && UCHARAT(locinput) != ST.c1
4634                                && UCHARAT(locinput) != ST.c2)
4635                             locinput++;
4636                     }
4637                     n = locinput - ST.oldloc;
4638                 }
4639                 if (locinput > ST.maxpos)
4640                     sayNO;
4641                 /* PL_reginput == oldloc now */
4642                 if (n) {
4643                     ST.count += n;
4644                     if (regrepeat(rex, ST.A, n, depth) < n)
4645                         sayNO;
4646                 }
4647                 PL_reginput = locinput;
4648                 CURLY_SETPAREN(ST.paren, ST.count);
4649                 if (cur_eval && cur_eval->u.eval.close_paren &&
4650                     cur_eval->u.eval.close_paren == (U32)ST.paren) {
4651                     goto fake_end;
4652                 }
4653                 PUSH_STATE_GOTO(CURLY_B_min_known, ST.B);
4654             }
4655             /* NOTREACHED */
4656
4657
4658         case CURLY_B_min_fail:
4659             /* failed to find B in a non-greedy match where c1,c2 invalid */
4660             if (ST.paren && ST.count)
4661                 PL_regendp[ST.paren] = -1;
4662
4663             REGCP_UNWIND(ST.cp);
4664             /* failed -- move forward one */
4665             PL_reginput = locinput;
4666             if (regrepeat(rex, ST.A, 1, depth)) {
4667                 ST.count++;
4668                 locinput = PL_reginput;
4669                 if (ST.count <= ST.max || (ST.max == REG_INFTY &&
4670                         ST.count > 0)) /* count overflow ? */
4671                 {
4672                   curly_try_B_min:
4673                     CURLY_SETPAREN(ST.paren, ST.count);
4674                     if (cur_eval && cur_eval->u.eval.close_paren &&
4675                         cur_eval->u.eval.close_paren == (U32)ST.paren) {
4676                         goto fake_end;
4677                     }
4678                     PUSH_STATE_GOTO(CURLY_B_min, ST.B);
4679                 }
4680             }
4681             sayNO;
4682             /* NOTREACHED */
4683
4684
4685         curly_try_B_max:
4686             /* a successful greedy match: now try to match B */
4687             if (cur_eval && cur_eval->u.eval.close_paren &&
4688                 cur_eval->u.eval.close_paren == (U32)ST.paren) {
4689                 goto fake_end;
4690             }
4691             {
4692                 UV c = 0;
4693                 if (ST.c1 != CHRTEST_VOID)
4694                     c = do_utf8 ? utf8n_to_uvchr((U8*)PL_reginput,
4695                                            UTF8_MAXBYTES, 0, uniflags)
4696                                 : (UV) UCHARAT(PL_reginput);
4697                 /* If it could work, try it. */
4698                 if (ST.c1 == CHRTEST_VOID || c == (UV)ST.c1 || c == (UV)ST.c2) {
4699                     CURLY_SETPAREN(ST.paren, ST.count);
4700                     PUSH_STATE_GOTO(CURLY_B_max, ST.B);
4701                     /* NOTREACHED */
4702                 }
4703             }
4704             /* FALL THROUGH */
4705         case CURLY_B_max_fail:
4706             /* failed to find B in a greedy match */
4707             if (ST.paren && ST.count)
4708                 PL_regendp[ST.paren] = -1;
4709
4710             REGCP_UNWIND(ST.cp);
4711             /*  back up. */
4712             if (--ST.count < ST.min)
4713                 sayNO;
4714             PL_reginput = locinput = HOPc(locinput, -1);
4715             goto curly_try_B_max;
4716
4717 #undef ST
4718
4719         case END:
4720             fake_end:
4721             if (cur_eval) {
4722                 /* we've just finished A in /(??{A})B/; now continue with B */
4723                 I32 tmpix;
4724
4725
4726                 st->u.eval.toggle_reg_flags
4727                             = cur_eval->u.eval.toggle_reg_flags;
4728                 PL_reg_flags ^= st->u.eval.toggle_reg_flags;
4729
4730                 st->u.eval.prev_rex = rex;              /* inner */
4731                 rex  = cur_eval->u.eval.prev_rex;       /* outer */
4732                 rexi = RXi_GET(rex);
4733                 cur_curlyx = cur_eval->u.eval.prev_curlyx;
4734                 ReREFCNT_inc(rex);
4735                 st->u.eval.cp = regcppush(0);   /* Save *all* the positions. */
4736                 REGCP_SET(st->u.eval.lastcp);
4737                 PL_reginput = locinput;
4738
4739                 /* Restore parens of the outer rex without popping the
4740                  * savestack */
4741                 tmpix = PL_savestack_ix;
4742                 PL_savestack_ix = cur_eval->u.eval.lastcp;
4743                 regcppop(rex);
4744                 PL_savestack_ix = tmpix;
4745
4746                 st->u.eval.prev_eval = cur_eval;
4747                 cur_eval = cur_eval->u.eval.prev_eval;
4748                 DEBUG_EXECUTE_r(
4749                     PerlIO_printf(Perl_debug_log, "%*s  EVAL trying tail ... %"UVxf"\n",
4750                                       REPORT_CODE_OFF+depth*2, "",PTR2UV(cur_eval)););
4751                 PUSH_YES_STATE_GOTO(EVAL_AB,
4752                         st->u.eval.prev_eval->u.eval.B); /* match B */
4753             }
4754
4755             if (locinput < reginfo->till) {
4756                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4757                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
4758                                       PL_colors[4],
4759                                       (long)(locinput - PL_reg_starttry),
4760                                       (long)(reginfo->till - PL_reg_starttry),
4761                                       PL_colors[5]));
4762
4763                 sayNO_SILENT;           /* Cannot match: too short. */
4764             }
4765             PL_reginput = locinput;     /* put where regtry can find it */
4766             sayYES;                     /* Success! */
4767
4768         case SUCCEED: /* successful SUSPEND/UNLESSM/IFMATCH/CURLYM */
4769             DEBUG_EXECUTE_r(
4770             PerlIO_printf(Perl_debug_log,
4771                 "%*s  %ssubpattern success...%s\n",
4772                 REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5]));
4773             PL_reginput = locinput;     /* put where regtry can find it */
4774             sayYES;                     /* Success! */
4775
4776 #undef  ST
4777 #define ST st->u.ifmatch
4778
4779         case SUSPEND:   /* (?>A) */
4780             ST.wanted = 1;
4781             PL_reginput = locinput;
4782             goto do_ifmatch;
4783
4784         case UNLESSM:   /* -ve lookaround: (?!A), or with flags, (?<!A) */
4785             ST.wanted = 0;
4786             goto ifmatch_trivial_fail_test;
4787
4788         case IFMATCH:   /* +ve lookaround: (?=A), or with flags, (?<=A) */
4789             ST.wanted = 1;
4790           ifmatch_trivial_fail_test:
4791             if (scan->flags) {
4792                 char * const s = HOPBACKc(locinput, scan->flags);
4793                 if (!s) {
4794                     /* trivial fail */
4795                     if (logical) {
4796                         logical = 0;
4797                         sw = 1 - (bool)ST.wanted;
4798                     }
4799                     else if (ST.wanted)
4800                         sayNO;
4801                     next = scan + ARG(scan);
4802                     if (next == scan)
4803                         next = NULL;
4804                     break;
4805                 }
4806                 PL_reginput = s;
4807             }
4808             else
4809                 PL_reginput = locinput;
4810
4811           do_ifmatch:
4812             ST.me = scan;
4813             ST.logical = logical;
4814             /* execute body of (?...A) */
4815             PUSH_YES_STATE_GOTO(IFMATCH_A, NEXTOPER(NEXTOPER(scan)));
4816             /* NOTREACHED */
4817
4818         case IFMATCH_A_fail: /* body of (?...A) failed */
4819             ST.wanted = !ST.wanted;
4820             /* FALL THROUGH */
4821
4822         case IFMATCH_A: /* body of (?...A) succeeded */
4823             if (ST.logical) {
4824                 sw = (bool)ST.wanted;
4825             }
4826             else if (!ST.wanted)
4827                 sayNO;
4828
4829             if (OP(ST.me) == SUSPEND)
4830                 locinput = PL_reginput;
4831             else {
4832                 locinput = PL_reginput = st->locinput;
4833                 nextchr = UCHARAT(locinput);
4834             }
4835             scan = ST.me + ARG(ST.me);
4836             if (scan == ST.me)
4837                 scan = NULL;
4838             continue; /* execute B */
4839
4840 #undef ST
4841
4842         case LONGJMP:
4843             next = scan + ARG(scan);
4844             if (next == scan)
4845                 next = NULL;
4846             break;
4847         case COMMIT:
4848             reginfo->cutpoint = PL_regeol;
4849             /* FALLTHROUGH */
4850         case PRUNE:
4851             PL_reginput = locinput;
4852             if (!scan->flags)
4853                 sv_yes_mark = sv_commit = (SV*)rexi->data->data[ ARG( scan ) ];
4854             PUSH_STATE_GOTO(COMMIT_next,next);
4855             /* NOTREACHED */
4856         case COMMIT_next_fail:
4857             no_final = 1;
4858             /* FALLTHROUGH */
4859         case OPFAIL:
4860             sayNO;
4861             /* NOTREACHED */
4862
4863 #define ST st->u.mark
4864         case MARKPOINT:
4865             ST.prev_mark = mark_state;
4866             ST.mark_name = sv_commit = sv_yes_mark
4867                 = (SV*)rexi->data->data[ ARG( scan ) ];
4868             mark_state = st;
4869             ST.mark_loc = PL_reginput = locinput;
4870             PUSH_YES_STATE_GOTO(MARKPOINT_next,next);
4871             /* NOTREACHED */
4872         case MARKPOINT_next:
4873             mark_state = ST.prev_mark;
4874             sayYES;
4875             /* NOTREACHED */
4876         case MARKPOINT_next_fail:
4877             if (popmark && sv_eq(ST.mark_name,popmark))
4878             {
4879                 if (ST.mark_loc > startpoint)
4880                     reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1);
4881                 popmark = NULL; /* we found our mark */
4882                 sv_commit = ST.mark_name;
4883
4884                 DEBUG_EXECUTE_r({
4885                         PerlIO_printf(Perl_debug_log,
4886                             "%*s  %ssetting cutpoint to mark:%"SVf"...%s\n",
4887                             REPORT_CODE_OFF+depth*2, "",
4888                             PL_colors[4], SVfARG(sv_commit), PL_colors[5]);
4889                 });
4890             }
4891             mark_state = ST.prev_mark;
4892             sv_yes_mark = mark_state ?
4893                 mark_state->u.mark.mark_name : NULL;
4894             sayNO;
4895             /* NOTREACHED */
4896         case SKIP:
4897             PL_reginput = locinput;
4898             if (scan->flags) {
4899                 /* (*SKIP) : if we fail we cut here*/
4900                 ST.mark_name = NULL;
4901                 ST.mark_loc = locinput;
4902                 PUSH_STATE_GOTO(SKIP_next,next);
4903             } else {
4904                 /* (*SKIP:NAME) : if there is a (*MARK:NAME) fail where it was,
4905                    otherwise do nothing.  Meaning we need to scan
4906                  */
4907                 regmatch_state *cur = mark_state;
4908                 SV *find = (SV*)rexi->data->data[ ARG( scan ) ];
4909
4910                 while (cur) {
4911                     if ( sv_eq( cur->u.mark.mark_name,
4912                                 find ) )
4913                     {
4914                         ST.mark_name = find;
4915                         PUSH_STATE_GOTO( SKIP_next, next );
4916                     }
4917                     cur = cur->u.mark.prev_mark;
4918                 }
4919             }
4920             /* Didn't find our (*MARK:NAME) so ignore this (*SKIP:NAME) */
4921             break;
4922         case SKIP_next_fail:
4923             if (ST.mark_name) {
4924                 /* (*CUT:NAME) - Set up to search for the name as we
4925                    collapse the stack*/
4926                 popmark = ST.mark_name;
4927             } else {
4928                 /* (*CUT) - No name, we cut here.*/
4929                 if (ST.mark_loc > startpoint)
4930                     reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1);
4931                 /* but we set sv_commit to latest mark_name if there
4932                    is one so they can test to see how things lead to this
4933                    cut */
4934                 if (mark_state)
4935                     sv_commit=mark_state->u.mark.mark_name;
4936             }
4937             no_final = 1;
4938             sayNO;
4939             /* NOTREACHED */
4940 #undef ST
4941
4942         default:
4943             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
4944                           PTR2UV(scan), OP(scan));
4945             Perl_croak(aTHX_ "regexp memory corruption");
4946
4947         } /* end switch */
4948
4949         /* switch break jumps here */
4950         scan = next; /* prepare to execute the next op and ... */
4951         continue;    /* ... jump back to the top, reusing st */
4952         /* NOTREACHED */
4953
4954       push_yes_state:
4955         /* push a state that backtracks on success */
4956         st->u.yes.prev_yes_state = yes_state;
4957         yes_state = st;
4958         /* FALL THROUGH */
4959       push_state:
4960         /* push a new regex state, then continue at scan  */
4961         {
4962             regmatch_state *newst;
4963
4964             DEBUG_STACK_r({
4965                 regmatch_state *cur = st;
4966                 regmatch_state *curyes = yes_state;
4967                 int curd = depth;
4968                 regmatch_slab *slab = PL_regmatch_slab;
4969                 for (;curd > -1;cur--,curd--) {
4970                     if (cur < SLAB_FIRST(slab)) {
4971                         slab = slab->prev;
4972                         cur = SLAB_LAST(slab);
4973                     }
4974                     PerlIO_printf(Perl_error_log, "%*s#%-3d %-10s %s\n",
4975                         REPORT_CODE_OFF + 2 + depth * 2,"",
4976                         curd, reg_name[cur->resume_state],
4977                         (curyes == cur) ? "yes" : ""
4978                     );
4979                     if (curyes == cur)
4980                         curyes = cur->u.yes.prev_yes_state;
4981                 }
4982             } else
4983                 DEBUG_STATE_pp("push")
4984             );
4985             depth++;
4986             st->locinput = locinput;
4987             newst = st+1;
4988             if (newst >  SLAB_LAST(PL_regmatch_slab))
4989                 newst = S_push_slab(aTHX);
4990             PL_regmatch_state = newst;
4991
4992             locinput = PL_reginput;
4993             nextchr = UCHARAT(locinput);
4994             st = newst;
4995             continue;
4996             /* NOTREACHED */
4997         }
4998     }
4999
5000     /*
5001     * We get here only if there's trouble -- normally "case END" is
5002     * the terminating point.
5003     */
5004     Perl_croak(aTHX_ "corrupted regexp pointers");
5005     /*NOTREACHED*/
5006     sayNO;
5007
5008 yes:
5009     if (yes_state) {
5010         /* we have successfully completed a subexpression, but we must now
5011          * pop to the state marked by yes_state and continue from there */
5012         assert(st != yes_state);
5013 #ifdef DEBUGGING
5014         while (st != yes_state) {
5015             st--;
5016             if (st < SLAB_FIRST(PL_regmatch_slab)) {
5017                 PL_regmatch_slab = PL_regmatch_slab->prev;
5018                 st = SLAB_LAST(PL_regmatch_slab);
5019             }
5020             DEBUG_STATE_r({
5021                 if (no_final) {
5022                     DEBUG_STATE_pp("pop (no final)");
5023                 } else {
5024                     DEBUG_STATE_pp("pop (yes)");
5025                 }
5026             });
5027             depth--;
5028         }
5029 #else
5030         while (yes_state < SLAB_FIRST(PL_regmatch_slab)
5031             || yes_state > SLAB_LAST(PL_regmatch_slab))
5032         {
5033             /* not in this slab, pop slab */
5034             depth -= (st - SLAB_FIRST(PL_regmatch_slab) + 1);
5035             PL_regmatch_slab = PL_regmatch_slab->prev;
5036             st = SLAB_LAST(PL_regmatch_slab);
5037         }
5038         depth -= (st - yes_state);
5039 #endif
5040         st = yes_state;
5041         yes_state = st->u.yes.prev_yes_state;
5042         PL_regmatch_state = st;
5043
5044         if (no_final) {
5045             locinput= st->locinput;
5046             nextchr = UCHARAT(locinput);
5047         }
5048         state_num = st->resume_state + no_final;
5049         goto reenter_switch;
5050     }
5051
5052     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
5053                           PL_colors[4], PL_colors[5]));
5054
5055     result = 1;
5056     goto final_exit;
5057
5058 no:
5059     DEBUG_EXECUTE_r(
5060         PerlIO_printf(Perl_debug_log,
5061             "%*s  %sfailed...%s\n",
5062             REPORT_CODE_OFF+depth*2, "",
5063             PL_colors[4], PL_colors[5])
5064         );
5065
5066 no_silent:
5067     if (no_final) {
5068         if (yes_state) {
5069             goto yes;
5070         } else {
5071             goto final_exit;
5072         }
5073     }
5074     if (depth) {
5075         /* there's a previous state to backtrack to */
5076         st--;
5077         if (st < SLAB_FIRST(PL_regmatch_slab)) {
5078             PL_regmatch_slab = PL_regmatch_slab->prev;
5079             st = SLAB_LAST(PL_regmatch_slab);
5080         }
5081         PL_regmatch_state = st;
5082         locinput= st->locinput;
5083         nextchr = UCHARAT(locinput);
5084
5085         DEBUG_STATE_pp("pop");
5086         depth--;
5087         if (yes_state == st)
5088             yes_state = st->u.yes.prev_yes_state;
5089
5090         state_num = st->resume_state + 1; /* failure = success + 1 */
5091         goto reenter_switch;
5092     }
5093     result = 0;
5094
5095   final_exit:
5096     if (rex->intflags & PREGf_VERBARG_SEEN) {
5097         SV *sv_err = get_sv("REGERROR", 1);
5098         SV *sv_mrk = get_sv("REGMARK", 1);
5099         if (result) {
5100             sv_commit = &PL_sv_no;
5101             if (!sv_yes_mark)
5102                 sv_yes_mark = &PL_sv_yes;
5103         } else {
5104             if (!sv_commit)
5105                 sv_commit = &PL_sv_yes;
5106             sv_yes_mark = &PL_sv_no;
5107         }
5108         sv_setsv(sv_err, sv_commit);
5109         sv_setsv(sv_mrk, sv_yes_mark);
5110     }
5111     /* restore original high-water mark */
5112     PL_regmatch_slab  = orig_slab;
5113     PL_regmatch_state = orig_state;
5114
5115     /* free all slabs above current one */
5116     if (orig_slab->next) {
5117         regmatch_slab *sl = orig_slab->next;
5118         orig_slab->next = NULL;
5119         while (sl) {
5120             regmatch_slab * const osl = sl;
5121             sl = sl->next;
5122             Safefree(osl);
5123         }
5124     }
5125
5126     return result;
5127 }
5128
5129 /*
5130  - regrepeat - repeatedly match something simple, report how many
5131  */
5132 /*
5133  * [This routine now assumes that it will only match on things of length 1.
5134  * That was true before, but now we assume scan - reginput is the count,
5135  * rather than incrementing count on every character.  [Er, except utf8.]]
5136  */
5137 STATIC I32
5138 S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth)
5139 {
5140     dVAR;
5141     register char *scan;
5142     register I32 c;
5143     register char *loceol = PL_regeol;
5144     register I32 hardcount = 0;
5145     register bool do_utf8 = PL_reg_match_utf8;
5146
5147     scan = PL_reginput;
5148     if (max == REG_INFTY)
5149         max = I32_MAX;
5150     else if (max < loceol - scan)
5151         loceol = scan + max;
5152     switch (OP(p)) {
5153     case REG_ANY:
5154         if (do_utf8) {
5155             loceol = PL_regeol;
5156             while (scan < loceol && hardcount < max && *scan != '\n') {
5157                 scan += UTF8SKIP(scan);
5158                 hardcount++;
5159             }
5160         } else {
5161             while (scan < loceol && *scan != '\n')
5162                 scan++;
5163         }
5164         break;
5165     case SANY:
5166         if (do_utf8) {
5167             loceol = PL_regeol;
5168             while (scan < loceol && hardcount < max) {
5169                 scan += UTF8SKIP(scan);
5170                 hardcount++;
5171             }
5172         }
5173         else
5174             scan = loceol;
5175         break;
5176     case CANY:
5177         scan = loceol;
5178         break;
5179     case EXACT:         /* length of string is 1 */
5180         c = (U8)*STRING(p);
5181         while (scan < loceol && UCHARAT(scan) == c)
5182             scan++;
5183         break;
5184     case EXACTF:        /* length of string is 1 */
5185         c = (U8)*STRING(p);
5186         while (scan < loceol &&
5187                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
5188             scan++;
5189         break;
5190     case EXACTFL:       /* length of string is 1 */
5191         PL_reg_flags |= RF_tainted;
5192         c = (U8)*STRING(p);
5193         while (scan < loceol &&
5194                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
5195             scan++;
5196         break;
5197     case ANYOF:
5198         if (do_utf8) {
5199             loceol = PL_regeol;
5200             while (hardcount < max && scan < loceol &&
5201                    reginclass(prog, p, (U8*)scan, 0, do_utf8)) {
5202                 scan += UTF8SKIP(scan);
5203                 hardcount++;
5204             }
5205         } else {
5206             while (scan < loceol && REGINCLASS(prog, p, (U8*)scan))
5207                 scan++;
5208         }
5209         break;
5210     case ALNUM:
5211         if (do_utf8) {
5212             loceol = PL_regeol;
5213             LOAD_UTF8_CHARCLASS_ALNUM();
5214             while (hardcount < max && scan < loceol &&
5215                    swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
5216                 scan += UTF8SKIP(scan);
5217                 hardcount++;
5218             }
5219         } else {
5220             while (scan < loceol && isALNUM(*scan))
5221                 scan++;
5222         }
5223         break;
5224     case ALNUML:
5225         PL_reg_flags |= RF_tainted;
5226         if (do_utf8) {
5227             loceol = PL_regeol;
5228             while (hardcount < max && scan < loceol &&
5229                    isALNUM_LC_utf8((U8*)scan)) {
5230                 scan += UTF8SKIP(scan);
5231                 hardcount++;
5232             }
5233         } else {
5234             while (scan < loceol && isALNUM_LC(*scan))
5235                 scan++;
5236         }
5237         break;
5238     case NALNUM:
5239         if (do_utf8) {
5240             loceol = PL_regeol;
5241             LOAD_UTF8_CHARCLASS_ALNUM();
5242             while (hardcount < max && scan < loceol &&
5243                    !swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
5244                 scan += UTF8SKIP(scan);
5245                 hardcount++;
5246             }
5247         } else {
5248             while (scan < loceol && !isALNUM(*scan))
5249                 scan++;
5250         }
5251         break;
5252     case NALNUML:
5253         PL_reg_flags |= RF_tainted;
5254         if (do_utf8) {
5255             loceol = PL_regeol;
5256             while (hardcount < max && scan < loceol &&
5257                    !isALNUM_LC_utf8((U8*)scan)) {
5258                 scan += UTF8SKIP(scan);
5259                 hardcount++;
5260             }
5261         } else {
5262             while (scan < loceol && !isALNUM_LC(*scan))
5263                 scan++;
5264         }
5265         break;
5266     case SPACE:
5267         if (do_utf8) {
5268             loceol = PL_regeol;
5269             LOAD_UTF8_CHARCLASS_SPACE();
5270             while (hardcount < max && scan < loceol &&
5271                    (*scan == ' ' ||
5272                     swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
5273                 scan += UTF8SKIP(scan);
5274                 hardcount++;
5275             }
5276         } else {
5277             while (scan < loceol && isSPACE(*scan))
5278                 scan++;
5279         }
5280         break;
5281     case SPACEL:
5282         PL_reg_flags |= RF_tainted;
5283         if (do_utf8) {
5284             loceol = PL_regeol;
5285             while (hardcount < max && scan < loceol &&
5286                    (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
5287                 scan += UTF8SKIP(scan);
5288                 hardcount++;
5289             }
5290         } else {
5291             while (scan < loceol && isSPACE_LC(*scan))
5292                 scan++;
5293         }
5294         break;
5295     case NSPACE:
5296         if (do_utf8) {
5297             loceol = PL_regeol;
5298             LOAD_UTF8_CHARCLASS_SPACE();
5299             while (hardcount < max && scan < loceol &&
5300                    !(*scan == ' ' ||
5301                      swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
5302                 scan += UTF8SKIP(scan);
5303                 hardcount++;
5304             }
5305         } else {
5306             while (scan < loceol && !isSPACE(*scan))
5307                 scan++;
5308             break;
5309         }
5310     case NSPACEL:
5311         PL_reg_flags |= RF_tainted;
5312         if (do_utf8) {
5313             loceol = PL_regeol;
5314             while (hardcount < max && scan < loceol &&
5315                    !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
5316                 scan += UTF8SKIP(scan);
5317                 hardcount++;
5318             }
5319         } else {
5320             while (scan < loceol && !isSPACE_LC(*scan))
5321                 scan++;
5322         }
5323         break;
5324     case DIGIT:
5325         if (do_utf8) {
5326             loceol = PL_regeol;
5327             LOAD_UTF8_CHARCLASS_DIGIT();
5328             while (hardcount < max && scan < loceol &&
5329                    swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
5330                 scan += UTF8SKIP(scan);
5331                 hardcount++;
5332             }
5333         } else {
5334             while (scan < loceol && isDIGIT(*scan))
5335                 scan++;
5336         }
5337         break;
5338     case NDIGIT:
5339         if (do_utf8) {
5340             loceol = PL_regeol;
5341             LOAD_UTF8_CHARCLASS_DIGIT();
5342             while (hardcount < max && scan < loceol &&
5343                    !swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
5344                 scan += UTF8SKIP(scan);
5345                 hardcount++;
5346             }
5347         } else {
5348             while (scan < loceol && !isDIGIT(*scan))
5349                 scan++;
5350         }
5351         break;
5352     default:            /* Called on something of 0 width. */
5353         break;          /* So match right here or not at all. */
5354     }
5355
5356     if (hardcount)
5357         c = hardcount;
5358     else
5359         c = scan - PL_reginput;
5360     PL_reginput = scan;
5361
5362     DEBUG_r({
5363         GET_RE_DEBUG_FLAGS_DECL;
5364         DEBUG_EXECUTE_r({
5365             SV * const prop = sv_newmortal();
5366             regprop(prog, prop, p);
5367             PerlIO_printf(Perl_debug_log,
5368                         "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
5369                         REPORT_CODE_OFF + depth*2, "", SvPVX_const(prop),(IV)c,(IV)max);
5370         });
5371     });
5372
5373     return(c);
5374 }
5375
5376
5377 #if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION)
5378 /*
5379 - regclass_swash - prepare the utf8 swash
5380 */
5381
5382 SV *
5383 Perl_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool doinit, SV** listsvp, SV **altsvp)
5384 {
5385     dVAR;
5386     SV *sw  = NULL;
5387     SV *si  = NULL;
5388     SV *alt = NULL;
5389     RXi_GET_DECL(prog,progi);
5390     const struct reg_data * const data = prog ? progi->data : NULL;
5391
5392     if (data && data->count) {
5393         const U32 n = ARG(node);
5394
5395         if (data->what[n] == 's') {
5396             SV * const rv = (SV*)data->data[n];
5397             AV * const av = (AV*)SvRV((SV*)rv);
5398             SV **const ary = AvARRAY(av);
5399             SV **a, **b;
5400
5401             /* See the end of regcomp.c:S_regclass() for
5402              * documentation of these array elements. */
5403
5404             si = *ary;
5405             a  = SvROK(ary[1]) ? &ary[1] : 0;
5406             b  = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : 0;
5407
5408             if (a)
5409                 sw = *a;
5410             else if (si && doinit) {
5411                 sw = swash_init("utf8", "", si, 1, 0);
5412                 (void)av_store(av, 1, sw);
5413             }
5414             if (b)
5415                 alt = *b;
5416         }
5417     }
5418
5419     if (listsvp)
5420         *listsvp = si;
5421     if (altsvp)
5422         *altsvp  = alt;
5423
5424     return sw;
5425 }
5426 #endif
5427
5428 /*
5429  - reginclass - determine if a character falls into a character class
5430
5431   The n is the ANYOF regnode, the p is the target string, lenp
5432   is pointer to the maximum length of how far to go in the p
5433   (if the lenp is zero, UTF8SKIP(p) is used),
5434   do_utf8 tells whether the target string is in UTF-8.
5435
5436  */
5437
5438 STATIC bool
5439 S_reginclass(pTHX_ const regexp *prog, register const regnode *n, register const U8* p, STRLEN* lenp, register bool do_utf8)
5440 {
5441     dVAR;
5442     const char flags = ANYOF_FLAGS(n);
5443     bool match = FALSE;
5444     UV c = *p;
5445     STRLEN len = 0;
5446     STRLEN plen;
5447
5448     if (do_utf8 && !UTF8_IS_INVARIANT(c)) {
5449         c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &len,
5450                 (UTF8_ALLOW_DEFAULT & UTF8_ALLOW_ANYUV) | UTF8_CHECK_ONLY);
5451                 /* see [perl #37836] for UTF8_ALLOW_ANYUV */
5452         if (len == (STRLEN)-1)
5453             Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
5454     }
5455
5456     plen = lenp ? *lenp : UNISKIP(NATIVE_TO_UNI(c));
5457     if (do_utf8 || (flags & ANYOF_UNICODE)) {
5458         if (lenp)
5459             *lenp = 0;
5460         if (do_utf8 && !ANYOF_RUNTIME(n)) {
5461             if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
5462                 match = TRUE;
5463         }
5464         if (!match && do_utf8 && (flags & ANYOF_UNICODE_ALL) && c >= 256)
5465             match = TRUE;
5466         if (!match) {
5467             AV *av;
5468             SV * const sw = regclass_swash(prog, n, TRUE, 0, (SV**)&av);
5469
5470             if (sw) {
5471                 if (swash_fetch(sw, p, do_utf8))
5472                     match = TRUE;
5473                 else if (flags & ANYOF_FOLD) {
5474                     if (!match && lenp && av) {
5475                         I32 i;
5476                         for (i = 0; i <= av_len(av); i++) {
5477                             SV* const sv = *av_fetch(av, i, FALSE);
5478                             STRLEN len;
5479                             const char * const s = SvPV_const(sv, len);
5480
5481                             if (len <= plen && memEQ(s, (char*)p, len)) {
5482                                 *lenp = len;
5483                                 match = TRUE;
5484                                 break;
5485                             }
5486                         }
5487                     }
5488                     if (!match) {
5489                         U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
5490                         STRLEN tmplen;
5491
5492                         to_utf8_fold(p, tmpbuf, &tmplen);
5493                         if (swash_fetch(sw, tmpbuf, do_utf8))
5494                             match = TRUE;
5495                     }
5496                 }
5497             }
5498         }
5499         if (match && lenp && *lenp == 0)
5500             *lenp = UNISKIP(NATIVE_TO_UNI(c));
5501     }
5502     if (!match && c < 256) {
5503         if (ANYOF_BITMAP_TEST(n, c))
5504             match = TRUE;
5505         else if (flags & ANYOF_FOLD) {
5506             U8 f;
5507
5508             if (flags & ANYOF_LOCALE) {
5509                 PL_reg_flags |= RF_tainted;
5510                 f = PL_fold_locale[c];
5511             }
5512             else
5513                 f = PL_fold[c];
5514             if (f != c && ANYOF_BITMAP_TEST(n, f))
5515                 match = TRUE;
5516         }
5517
5518         if (!match && (flags & ANYOF_CLASS)) {
5519             PL_reg_flags |= RF_tainted;
5520             if (
5521                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
5522                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
5523                 (ANYOF_CLASS_TEST(n, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
5524                 (ANYOF_CLASS_TEST(n, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
5525                 (ANYOF_CLASS_TEST(n, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
5526                 (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
5527                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
5528                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
5529                 (ANYOF_CLASS_TEST(n, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
5530                 (ANYOF_CLASS_TEST(n, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
5531                 (ANYOF_CLASS_TEST(n, ANYOF_ASCII)   &&  isASCII(c))     ||
5532                 (ANYOF_CLASS_TEST(n, ANYOF_NASCII)  && !isASCII(c))     ||
5533                 (ANYOF_CLASS_TEST(n, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
5534                 (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
5535                 (ANYOF_CLASS_TEST(n, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
5536                 (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
5537                 (ANYOF_CLASS_TEST(n, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
5538                 (ANYOF_CLASS_TEST(n, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
5539                 (ANYOF_CLASS_TEST(n, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
5540                 (ANYOF_CLASS_TEST(n, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
5541                 (ANYOF_CLASS_TEST(n, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
5542                 (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
5543                 (ANYOF_CLASS_TEST(n, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
5544                 (ANYOF_CLASS_TEST(n, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
5545                 (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
5546                 (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c))    ||
5547                 (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC)  &&  isPSXSPC(c))    ||
5548                 (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c))    ||
5549                 (ANYOF_CLASS_TEST(n, ANYOF_BLANK)   &&  isBLANK(c))     ||
5550                 (ANYOF_CLASS_TEST(n, ANYOF_NBLANK)  && !isBLANK(c))
5551                 ) /* How's that for a conditional? */
5552             {
5553                 match = TRUE;
5554             }
5555         }
5556     }
5557
5558     return (flags & ANYOF_INVERT) ? !match : match;
5559 }
5560
5561 STATIC U8 *
5562 S_reghop3(U8 *s, I32 off, const U8* lim)
5563 {
5564     dVAR;
5565     if (off >= 0) {
5566         while (off-- && s < lim) {
5567             /* XXX could check well-formedness here */
5568             s += UTF8SKIP(s);
5569         }
5570     }
5571     else {
5572         while (off++ && s > lim) {
5573             s--;
5574             if (UTF8_IS_CONTINUED(*s)) {
5575                 while (s > lim && UTF8_IS_CONTINUATION(*s))
5576                     s--;
5577             }
5578             /* XXX could check well-formedness here */
5579         }
5580     }
5581     return s;
5582 }
5583
5584 #ifdef XXX_dmq
5585 /* there are a bunch of places where we use two reghop3's that should
5586    be replaced with this routine. but since thats not done yet
5587    we ifdef it out - dmq
5588 */
5589 STATIC U8 *
5590 S_reghop4(U8 *s, I32 off, const U8* llim, const U8* rlim)
5591 {
5592     dVAR;
5593     if (off >= 0) {
5594         while (off-- && s < rlim) {
5595             /* XXX could check well-formedness here */
5596             s += UTF8SKIP(s);
5597         }
5598     }
5599     else {
5600         while (off++ && s > llim) {
5601             s--;
5602             if (UTF8_IS_CONTINUED(*s)) {
5603                 while (s > llim && UTF8_IS_CONTINUATION(*s))
5604                     s--;
5605             }
5606             /* XXX could check well-formedness here */
5607         }
5608     }
5609     return s;
5610 }
5611 #endif
5612
5613 STATIC U8 *
5614 S_reghopmaybe3(U8* s, I32 off, const U8* lim)
5615 {
5616     dVAR;
5617     if (off >= 0) {
5618         while (off-- && s < lim) {
5619             /* XXX could check well-formedness here */
5620             s += UTF8SKIP(s);
5621         }
5622         if (off >= 0)
5623             return NULL;
5624     }
5625     else {
5626         while (off++ && s > lim) {
5627             s--;
5628             if (UTF8_IS_CONTINUED(*s)) {
5629                 while (s > lim && UTF8_IS_CONTINUATION(*s))
5630                     s--;
5631             }
5632             /* XXX could check well-formedness here */
5633         }
5634         if (off <= 0)
5635             return NULL;
5636     }
5637     return s;
5638 }
5639
5640 static void
5641 restore_pos(pTHX_ void *arg)
5642 {
5643     dVAR;
5644     regexp * const rex = (regexp *)arg;
5645     if (PL_reg_eval_set) {
5646         if (PL_reg_oldsaved) {
5647             rex->subbeg = PL_reg_oldsaved;
5648             rex->sublen = PL_reg_oldsavedlen;
5649 #ifdef PERL_OLD_COPY_ON_WRITE
5650             rex->saved_copy = PL_nrs;
5651 #endif
5652             RX_MATCH_COPIED_on(rex);
5653         }
5654         PL_reg_magic->mg_len = PL_reg_oldpos;
5655         PL_reg_eval_set = 0;
5656         PL_curpm = PL_reg_oldcurpm;
5657     }
5658 }
5659
5660 STATIC void
5661 S_to_utf8_substr(pTHX_ register regexp *prog)
5662 {
5663     int i = 1;
5664     do {
5665         if (prog->substrs->data[i].substr
5666             && !prog->substrs->data[i].utf8_substr) {
5667             SV* const sv = newSVsv(prog->substrs->data[i].substr);
5668             prog->substrs->data[i].utf8_substr = sv;
5669             sv_utf8_upgrade(sv);
5670             if (SvVALID(prog->substrs->data[i].substr))
5671                 fbm_compile(sv, 0);
5672             if (SvTAIL(prog->substrs->data[i].substr))
5673                 SvTAIL_on(sv);
5674             if (prog->substrs->data[i].substr == prog->check_substr)
5675                 prog->check_utf8 = sv;
5676         }
5677     } while (i--);
5678 }
5679
5680 STATIC void
5681 S_to_byte_substr(pTHX_ register regexp *prog)
5682 {
5683     dVAR;
5684     int i = 1;
5685     do {
5686         if (prog->substrs->data[i].utf8_substr
5687             && !prog->substrs->data[i].substr) {
5688             SV* sv = newSVsv(prog->substrs->data[i].utf8_substr);
5689             if (sv_utf8_downgrade(sv, TRUE)) {
5690                 if (SvVALID(prog->substrs->data[i].utf8_substr))
5691                     fbm_compile(sv, 0);
5692                 if (SvTAIL(prog->substrs->data[i].utf8_substr))
5693                     SvTAIL_on(sv);
5694             } else {
5695                 SvREFCNT_dec(sv);
5696                 sv = &PL_sv_undef;
5697             }
5698             prog->substrs->data[i].substr = sv;
5699             if (prog->substrs->data[i].utf8_substr == prog->check_utf8)
5700                 prog->check_substr = sv;
5701         }
5702     } while (i--);
5703 }
5704
5705 /*
5706  * Local variables:
5707  * c-indentation-style: bsd
5708  * c-basic-offset: 4
5709  * indent-tabs-mode: t
5710  * End:
5711  *
5712  * ex: set ts=8 sts=4 sw=4 noet:
5713  */