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