regexec.c

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