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