regexec.c

   1 /*    regexec.c
   2  */
   3
   4 /*
   5  *      One Ring to rule them all, One Ring to find them
   6  &
   7  *     [p.v of _The Lord of the Rings_, opening poem]
   8  *     [p.50 of _The Lord of the Rings_, I/iii: "The Shadow of the Past"]
   9  *     [p.254 of _The Lord of the Rings_, II/ii: "The Council of Elrond"]
  10  */
  11
  12 /* This file contains functions for executing a regular expression.  See
  13  * also regcomp.c which funnily enough, contains functions for compiling
  14  * a regular expression.
  15  *
  16  * This file is also copied at build time to ext/re/re_exec.c, where
  17  * it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
  18  * This causes the main functions to be compiled under new names and with
  19  * debugging support added, which makes "use re 'debug'" work.
  20  */
  21
  22 /* NOTE: this is derived from Henry Spencer's regexp code, and should not
  23  * confused with the original package (see point 3 below).  Thanks, Henry!
  24  */
  25
  26 /* Additional note: this code is very heavily munged from Henry's version
  27  * in places.  In some spots I've traded clarity for efficiency, so don't
  28  * blame Henry for some of the lack of readability.
  29  */
  30
  31 /* The names of the functions have been changed from regcomp and
  32  * regexec to  pregcomp and pregexec in order to avoid conflicts
  33  * with the POSIX routines of the same names.
  34 */
  35
  36 #ifdef PERL_EXT_RE_BUILD
  37 #include "re_top.h"
  38 #endif
  39
  40 /*
  41  * pregcomp and pregexec -- regsub and regerror are not used in perl
  42  *
  43  *      Copyright (c) 1986 by University of Toronto.
  44  *      Written by Henry Spencer.  Not derived from licensed software.
  45  *
  46  *      Permission is granted to anyone to use this software for any
  47  *      purpose on any computer system, and to redistribute it freely,
  48  *      subject to the following restrictions:
  49  *
  50  *      1. The author is not responsible for the consequences of use of
  51  *              this software, no matter how awful, even if they arise
  52  *              from defects in it.
  53  *
  54  *      2. The origin of this software must not be misrepresented, either
  55  *              by explicit claim or by omission.
  56  *
  57  *      3. Altered versions must be plainly marked as such, and must not
  58  *              be misrepresented as being the original software.
  59  *
  60  ****    Alterations to Henry's code are...
  61  ****
  62  ****    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
  63  ****    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
  64  ****    by Larry Wall and others
  65  ****
  66  ****    You may distribute under the terms of either the GNU General Public
  67  ****    License or the Artistic License, as specified in the README file.
  68  *
  69  * Beware that some of this code is subtly aware of the way operator
  70  * precedence is structured in regular expressions.  Serious changes in
  71  * regular-expression syntax might require a total rethink.
  72  */
  73 #include "EXTERN.h"
  74 #define PERL_IN_REGEXEC_C
  75 #include "perl.h"
  76
  77 #ifdef PERL_IN_XSUB_RE
  78 #  include "re_comp.h"
  79 #else
  80 #  include "regcomp.h"
  81 #endif
  82
  83 #define RF_tainted      1       /* tainted information used? e.g. locale */
  84 #define RF_warned       2               /* warned about big count? */
  85
  86 #define RF_utf8         8               /* Pattern contains multibyte chars? */
  87
  88 #define UTF_PATTERN ((PL_reg_flags & RF_utf8) != 0)
  89
  90 #define RS_init         1               /* eval environment created */
  91 #define RS_set          2               /* replsv value is set */
  92
  93 #ifndef STATIC
  94 #define STATIC  static
  95 #endif
  96
  97 /* Valid for non-utf8 strings, non-ANYOFV nodes only: avoids the reginclass
  98  * call if there are no complications: i.e., if everything matchable is
  99  * straight forward in the bitmap */
 100 #define REGINCLASS(prog,p,c)  (ANYOF_FLAGS(p) ? reginclass(prog,p,c,0,0)   \
 101                                               : ANYOF_BITMAP_TEST(p,*(c)))
 102
 103 /*
 104  * Forwards.
 105  */
 106
 107 #define CHR_SVLEN(sv) (utf8_target ? sv_len_utf8(sv) : SvCUR(sv))
 108 #define CHR_DIST(a,b) (PL_reg_match_utf8 ? utf8_distance(a,b) : a - b)
 109
 110 #define HOPc(pos,off) \
 111         (char *)(PL_reg_match_utf8 \
 112             ? reghop3((U8*)pos, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr)) \
 113             : (U8*)(pos + off))
 114 #define HOPBACKc(pos, off) \
 115         (char*)(PL_reg_match_utf8\
 116             ? reghopmaybe3((U8*)pos, -off, (U8*)PL_bostr) \
 117             : (pos - off >= PL_bostr)           \
 118                 ? (U8*)pos - off                \
 119                 : NULL)
 120
 121 #define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)(pos), off, (U8*)(lim)) : (U8*)(pos + off))
 122 #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
 123
 124 /* these are unrolled below in the CCC_TRY_XXX defined */
 125 #define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \
 126     if (!CAT2(PL_utf8_,class)) { \
 127         bool ok; \
 128         ENTER; save_re_context(); \
 129         ok=CAT2(is_utf8_,class)((const U8*)str); \
 130         assert(ok); LEAVE; } } STMT_END
 131
 132 /* Doesn't do an assert to verify that is correct */
 133 #define LOAD_UTF8_CHARCLASS_NO_CHECK(class) STMT_START { \
 134     if (!CAT2(PL_utf8_,class)) { \
 135         bool throw_away __attribute__unused__; \
 136         ENTER; save_re_context(); \
 137         throw_away = CAT2(is_utf8_,class)((const U8*)" "); \
 138         LEAVE; } } STMT_END
 139
 140 #define LOAD_UTF8_CHARCLASS_ALNUM() LOAD_UTF8_CHARCLASS(alnum,"a")
 141 #define LOAD_UTF8_CHARCLASS_DIGIT() LOAD_UTF8_CHARCLASS(digit,"0")
 142 #define LOAD_UTF8_CHARCLASS_SPACE() LOAD_UTF8_CHARCLASS(space," ")
 143
 144 #define LOAD_UTF8_CHARCLASS_GCB()  /* Grapheme cluster boundaries */        \
 145         LOAD_UTF8_CHARCLASS(X_begin, " ");                                  \
 146         LOAD_UTF8_CHARCLASS(X_non_hangul, "A");                             \
 147         /* These are utf8 constants, and not utf-ebcdic constants, so the   \
 148             * assert should likely and hopefully fail on an EBCDIC machine */ \
 149         LOAD_UTF8_CHARCLASS(X_extend, "\xcc\x80"); /* U+0300 */             \
 150                                                                             \
 151         /* No asserts are done for these, in case called on an early        \
 152             * Unicode version in which they map to nothing */               \
 153         LOAD_UTF8_CHARCLASS_NO_CHECK(X_prepend);/* U+0E40 "\xe0\xb9\x80" */ \
 154         LOAD_UTF8_CHARCLASS_NO_CHECK(X_L);          /* U+1100 "\xe1\x84\x80" */ \
 155         LOAD_UTF8_CHARCLASS_NO_CHECK(X_LV);     /* U+AC00 "\xea\xb0\x80" */ \
 156         LOAD_UTF8_CHARCLASS_NO_CHECK(X_LVT);    /* U+AC01 "\xea\xb0\x81" */ \
 157         LOAD_UTF8_CHARCLASS_NO_CHECK(X_LV_LVT_V);/* U+AC01 "\xea\xb0\x81" */\
 158         LOAD_UTF8_CHARCLASS_NO_CHECK(X_T);      /* U+11A8 "\xe1\x86\xa8" */ \
 159         LOAD_UTF8_CHARCLASS_NO_CHECK(X_V)       /* U+1160 "\xe1\x85\xa0" */
 160
 161 #define PLACEHOLDER     /* Something for the preprocessor to grab onto */
 162
 163 /* The actual code for CCC_TRY, which uses several variables from the routine
 164  * it's callable from.  It is designed to be the bulk of a case statement.
 165  * FUNC is the macro or function to call on non-utf8 targets that indicate if
 166  *      nextchr matches the class.
 167  * UTF8_TEST is the whole test string to use for utf8 targets
 168  * LOAD is what to use to test, and if not present to load in the swash for the
 169  *      class
 170  * POS_OR_NEG is either empty or ! to complement the results of FUNC or
 171  *      UTF8_TEST test.
 172  * The logic is: Fail if we're at the end-of-string; otherwise if the target is
 173  * utf8 and a variant, load the swash if necessary and test using the utf8
 174  * test.  Advance to the next character if test is ok, otherwise fail; If not
 175  * utf8 or an invariant under utf8, use the non-utf8 test, and fail if it
 176  * fails, or advance to the next character */
 177
 178 #define _CCC_TRY_CODE(POS_OR_NEG, FUNC, UTF8_TEST, CLASS, STR)                \
 179     if (locinput >= PL_regeol) {                                              \
 180         sayNO;                                                                \
 181     }                                                                         \
 182     if (utf8_target && UTF8_IS_CONTINUED(nextchr)) {                          \
 183         LOAD_UTF8_CHARCLASS(CLASS, STR);                                      \
 184         if (POS_OR_NEG (UTF8_TEST)) {                                         \
 185             sayNO;                                                            \
 186         }                                                                     \
 187         locinput += PL_utf8skip[nextchr];                                     \
 188         nextchr = UCHARAT(locinput);                                          \
 189         break;                                                                \
 190     }                                                                         \
 191     if (POS_OR_NEG (FUNC(nextchr))) {                                         \
 192         sayNO;                                                                \
 193     }                                                                         \
 194     nextchr = UCHARAT(++locinput);                                            \
 195     break;
 196
 197 /* Handle the non-locale cases for a character class and its complement.  It
 198  * calls _CCC_TRY_CODE with a ! to complement the test for the character class.
 199  * This is because that code fails when the test succeeds, so we want to have
 200  * the test fail so that the code succeeds.  The swash is stored in a
 201  * predictable PL_ place */
 202 #define _CCC_TRY_NONLOCALE(NAME,  NNAME,  FUNC,                               \
 203                            CLASS, STR)                                        \
 204     case NAME:                                                                \
 205         _CCC_TRY_CODE( !, FUNC,                                               \
 206                           cBOOL(swash_fetch(CAT2(PL_utf8_,CLASS),             \
 207                                             (U8*)locinput, TRUE)),            \
 208                           CLASS, STR)                                         \
 209     case NNAME:                                                               \
 210         _CCC_TRY_CODE(  PLACEHOLDER , FUNC,                                   \
 211                           cBOOL(swash_fetch(CAT2(PL_utf8_,CLASS),             \
 212                                             (U8*)locinput, TRUE)),            \
 213                           CLASS, STR)                                         \
 214
 215 /* Generate the case statements for both locale and non-locale character
 216  * classes in regmatch for classes that don't have special unicode semantics.
 217  * Locales don't use an immediate swash, but an intermediary special locale
 218  * function that is called on the pointer to the current place in the input
 219  * string.  That function will resolve to needing the same swash.  One might
 220  * think that because we don't know what the locale will match, we shouldn't
 221  * check with the swash loading function that it loaded properly; ie, that we
 222  * should use LOAD_UTF8_CHARCLASS_NO_CHECK for those, but what is passed to the
 223  * regular LOAD_UTF8_CHARCLASS is in non-locale terms, and so locale is
 224  * irrelevant here */
 225 #define CCC_TRY(NAME,  NNAME,  FUNC,                                          \
 226                 NAMEL, NNAMEL, LCFUNC, LCFUNC_utf8,                           \
 227                 NAMEA, NNAMEA, FUNCA,                                         \
 228                 CLASS, STR)                                                   \
 229     case NAMEL:                                                               \
 230         PL_reg_flags |= RF_tainted;                                           \
 231         _CCC_TRY_CODE( !, LCFUNC, LCFUNC_utf8((U8*)locinput), CLASS, STR)     \
 232     case NNAMEL:                                                              \
 233         PL_reg_flags |= RF_tainted;                                           \
 234         _CCC_TRY_CODE( PLACEHOLDER, LCFUNC, LCFUNC_utf8((U8*)locinput),       \
 235                        CLASS, STR)                                            \
 236     case NAMEA:                                                               \
 237         if (locinput >= PL_regeol || ! FUNCA(nextchr)) {                      \
 238             sayNO;                                                            \
 239         }                                                                     \
 240         /* Matched a utf8-invariant, so don't have to worry about utf8 */     \
 241         nextchr = UCHARAT(++locinput);                                        \
 242         break;                                                                \
 243     case NNAMEA:                                                              \
 244         if (locinput >= PL_regeol || FUNCA(nextchr)) {                        \
 245             sayNO;                                                            \
 246         }                                                                     \
 247         if (utf8_target) {                                                    \
 248             locinput += PL_utf8skip[nextchr];                                 \
 249             nextchr = UCHARAT(locinput);                                      \
 250         }                                                                     \
 251         else {                                                                \
 252             nextchr = UCHARAT(++locinput);                                    \
 253         }                                                                     \
 254         break;                                                                \
 255     /* Generate the non-locale cases */                                       \
 256     _CCC_TRY_NONLOCALE(NAME, NNAME, FUNC, CLASS, STR)
 257
 258 /* This is like CCC_TRY, but has an extra set of parameters for generating case
 259  * statements to handle separate Unicode semantics nodes */
 260 #define CCC_TRY_U(NAME,  NNAME,  FUNC,                                         \
 261                   NAMEL, NNAMEL, LCFUNC, LCFUNC_utf8,                          \
 262                   NAMEU, NNAMEU, FUNCU,                                        \
 263                   NAMEA, NNAMEA, FUNCA,                                        \
 264                   CLASS, STR)                                                  \
 265     CCC_TRY(NAME, NNAME, FUNC,                                                 \
 266             NAMEL, NNAMEL, LCFUNC, LCFUNC_utf8,                                \
 267             NAMEA, NNAMEA, FUNCA,                                              \
 268             CLASS, STR)                                                        \
 269     _CCC_TRY_NONLOCALE(NAMEU, NNAMEU, FUNCU, CLASS, STR)
 270
 271 /* TODO: Combine JUMPABLE and HAS_TEXT to cache OP(rn) */
 272
 273 /* for use after a quantifier and before an EXACT-like node -- japhy */
 274 /* it would be nice to rework regcomp.sym to generate this stuff. sigh
 275  *
 276  * NOTE that *nothing* that affects backtracking should be in here, specifically
 277  * VERBS must NOT be included. JUMPABLE is used to determine  if we can ignore a
 278  * node that is in between two EXACT like nodes when ascertaining what the required
 279  * "follow" character is. This should probably be moved to regex compile time
 280  * although it may be done at run time beause of the REF possibility - more
 281  * investigation required. -- demerphq
 282 */
 283 #define JUMPABLE(rn) (      \
 284     OP(rn) == OPEN ||       \
 285     (OP(rn) == CLOSE && (!cur_eval || cur_eval->u.eval.close_paren != ARG(rn))) || \
 286     OP(rn) == EVAL ||   \
 287     OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
 288     OP(rn) == PLUS || OP(rn) == MINMOD || \
 289     OP(rn) == KEEPS || \
 290     (PL_regkind[OP(rn)] == CURLY && ARG1(rn) > 0) \
 291 )
 292 #define IS_EXACT(rn) (PL_regkind[OP(rn)] == EXACT)
 293
 294 #define HAS_TEXT(rn) ( IS_EXACT(rn) || PL_regkind[OP(rn)] == REF )
 295
 296 #if 0
 297 /* Currently these are only used when PL_regkind[OP(rn)] == EXACT so
 298    we don't need this definition. */
 299 #define IS_TEXT(rn)   ( OP(rn)==EXACT   || OP(rn)==REF   || OP(rn)==NREF   )
 300 #define IS_TEXTF(rn)  ( (OP(rn)==EXACTFU || OP(rn)==EXACTFA ||  OP(rn)==EXACTF)  || OP(rn)==REFF  || OP(rn)==NREFF )
 301 #define IS_TEXTFL(rn) ( OP(rn)==EXACTFL || OP(rn)==REFFL || OP(rn)==NREFFL )
 302
 303 #else
 304 /* ... so we use this as its faster. */
 305 #define IS_TEXT(rn)   ( OP(rn)==EXACT   )
 306 #define IS_TEXTFU(rn)  ( OP(rn)==EXACTFU || OP(rn) == EXACTFA)
 307 #define IS_TEXTF(rn)  ( OP(rn)==EXACTF  )
 308 #define IS_TEXTFL(rn) ( OP(rn)==EXACTFL )
 309
 310 #endif
 311
 312 /*
 313   Search for mandatory following text node; for lookahead, the text must
 314   follow but for lookbehind (rn->flags != 0) we skip to the next step.
 315 */
 316 #define FIND_NEXT_IMPT(rn) STMT_START { \
 317     while (JUMPABLE(rn)) { \
 318         const OPCODE type = OP(rn); \
 319         if (type == SUSPEND || PL_regkind[type] == CURLY) \
 320             rn = NEXTOPER(NEXTOPER(rn)); \
 321         else if (type == PLUS) \
 322             rn = NEXTOPER(rn); \
 323         else if (type == IFMATCH) \
 324             rn = (rn->flags == 0) ? NEXTOPER(NEXTOPER(rn)) : rn + ARG(rn); \
 325         else rn += NEXT_OFF(rn); \
 326     } \
 327 } STMT_END
 328
 329
 330 static void restore_pos(pTHX_ void *arg);
 331
 332 #define REGCP_PAREN_ELEMS 4
 333 #define REGCP_OTHER_ELEMS 5
 334 #define REGCP_FRAME_ELEMS 1
 335 /* REGCP_FRAME_ELEMS are not part of the REGCP_OTHER_ELEMS and
 336  * are needed for the regexp context stack bookkeeping. */
 337
 338 STATIC CHECKPOINT
 339 S_regcppush(pTHX_ I32 parenfloor)
 340 {
 341     dVAR;
 342     const int retval = PL_savestack_ix;
 343     const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS;
 344     const UV total_elems = paren_elems_to_push + REGCP_OTHER_ELEMS;
 345     const UV elems_shifted = total_elems << SAVE_TIGHT_SHIFT;
 346     int p;
 347     GET_RE_DEBUG_FLAGS_DECL;
 348
 349     if (paren_elems_to_push < 0)
 350         Perl_croak(aTHX_ "panic: paren_elems_to_push < 0");
 351
 352     if ((elems_shifted >> SAVE_TIGHT_SHIFT) != total_elems)
 353         Perl_croak(aTHX_ "panic: paren_elems_to_push offset %"UVuf
 354                    " out of range (%lu-%ld)",
 355                    total_elems, (unsigned long)PL_regsize, (long)parenfloor);
 356
 357     SSGROW(total_elems + REGCP_FRAME_ELEMS);
 358
 359     for (p = PL_regsize; p > parenfloor; p--) {
 360 /* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
 361         SSPUSHINT(PL_regoffs[p].end);
 362         SSPUSHINT(PL_regoffs[p].start);
 363         SSPUSHPTR(PL_reg_start_tmp[p]);
 364         SSPUSHINT(p);
 365         DEBUG_BUFFERS_r(PerlIO_printf(Perl_debug_log,
 366           "     saving \\%"UVuf" %"IVdf"(%"IVdf")..%"IVdf"\n",
 367                       (UV)p, (IV)PL_regoffs[p].start,
 368                       (IV)(PL_reg_start_tmp[p] - PL_bostr),
 369                       (IV)PL_regoffs[p].end
 370         ));
 371     }
 372 /* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
 373     SSPUSHPTR(PL_regoffs);
 374     SSPUSHINT(PL_regsize);
 375     SSPUSHINT(*PL_reglastparen);
 376     SSPUSHINT(*PL_reglastcloseparen);
 377     SSPUSHPTR(PL_reginput);
 378     SSPUSHUV(SAVEt_REGCONTEXT | elems_shifted); /* Magic cookie. */
 379
 380     return retval;
 381 }
 382
 383 /* These are needed since we do not localize EVAL nodes: */
 384 #define REGCP_SET(cp)                                           \
 385     DEBUG_STATE_r(                                              \
 386             PerlIO_printf(Perl_debug_log,                       \
 387                 "  Setting an EVAL scope, savestack=%"IVdf"\n", \
 388                 (IV)PL_savestack_ix));                          \
 389     cp = PL_savestack_ix
 390
 391 #define REGCP_UNWIND(cp)                                        \
 392     DEBUG_STATE_r(                                              \
 393         if (cp != PL_savestack_ix)                              \
 394             PerlIO_printf(Perl_debug_log,                       \
 395                 "  Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
 396                 (IV)(cp), (IV)PL_savestack_ix));                \
 397     regcpblow(cp)
 398
 399 STATIC char *
 400 S_regcppop(pTHX_ const regexp *rex)
 401 {
 402     dVAR;
 403     UV i;
 404     char *input;
 405     GET_RE_DEBUG_FLAGS_DECL;
 406
 407     PERL_ARGS_ASSERT_REGCPPOP;
 408
 409     /* Pop REGCP_OTHER_ELEMS before the parentheses loop starts. */
 410     i = SSPOPUV;
 411     assert((i & SAVE_MASK) == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
 412     i >>= SAVE_TIGHT_SHIFT; /* Parentheses elements to pop. */
 413     input = (char *) SSPOPPTR;
 414     *PL_reglastcloseparen = SSPOPINT;
 415     *PL_reglastparen = SSPOPINT;
 416     PL_regsize = SSPOPINT;
 417     PL_regoffs=(regexp_paren_pair *) SSPOPPTR;
 418
 419     i -= REGCP_OTHER_ELEMS;
 420     /* Now restore the parentheses context. */
 421     for ( ; i > 0; i -= REGCP_PAREN_ELEMS) {
 422         I32 tmps;
 423         U32 paren = (U32)SSPOPINT;
 424         PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
 425         PL_regoffs[paren].start = SSPOPINT;
 426         tmps = SSPOPINT;
 427         if (paren <= *PL_reglastparen)
 428             PL_regoffs[paren].end = tmps;
 429         DEBUG_BUFFERS_r(
 430             PerlIO_printf(Perl_debug_log,
 431                           "     restoring \\%"UVuf" to %"IVdf"(%"IVdf")..%"IVdf"%s\n",
 432                           (UV)paren, (IV)PL_regoffs[paren].start,
 433                           (IV)(PL_reg_start_tmp[paren] - PL_bostr),
 434                           (IV)PL_regoffs[paren].end,
 435                           (paren > *PL_reglastparen ? "(no)" : ""));
 436         );
 437     }
 438     DEBUG_BUFFERS_r(
 439         if (*PL_reglastparen + 1 <= rex->nparens) {
 440             PerlIO_printf(Perl_debug_log,
 441                           "     restoring \\%"IVdf"..\\%"IVdf" to undef\n",
 442                           (IV)(*PL_reglastparen + 1), (IV)rex->nparens);
 443         }
 444     );
 445 #if 1
 446     /* It would seem that the similar code in regtry()
 447      * already takes care of this, and in fact it is in
 448      * a better location to since this code can #if 0-ed out
 449      * but the code in regtry() is needed or otherwise tests
 450      * requiring null fields (pat.t#187 and split.t#{13,14}
 451      * (as of patchlevel 7877)  will fail.  Then again,
 452      * this code seems to be necessary or otherwise
 453      * this erroneously leaves $1 defined: "1" =~ /^(?:(\d)x)?\d$/
 454      * --jhi updated by dapm */
 455     for (i = *PL_reglastparen + 1; i <= rex->nparens; i++) {
 456         if (i > PL_regsize)
 457             PL_regoffs[i].start = -1;
 458         PL_regoffs[i].end = -1;
 459     }
 460 #endif
 461     return input;
 462 }
 463
 464 #define regcpblow(cp) LEAVE_SCOPE(cp)   /* Ignores regcppush()ed data. */
 465
 466 /*
 467  * pregexec and friends
 468  */
 469
 470 #ifndef PERL_IN_XSUB_RE
 471 /*
 472  - pregexec - match a regexp against a string
 473  */
 474 I32
 475 Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, register char *strend,
 476          char *strbeg, I32 minend, SV *screamer, U32 nosave)
 477 /* strend: pointer to null at end of string */
 478 /* strbeg: real beginning of string */
 479 /* minend: end of match must be >=minend after stringarg. */
 480 /* nosave: For optimizations. */
 481 {
 482     PERL_ARGS_ASSERT_PREGEXEC;
 483
 484     return
 485         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
 486                       nosave ? 0 : REXEC_COPY_STR);
 487 }
 488 #endif
 489
 490 /*
 491  * Need to implement the following flags for reg_anch:
 492  *
 493  * USE_INTUIT_NOML              - Useful to call re_intuit_start() first
 494  * USE_INTUIT_ML
 495  * INTUIT_AUTORITATIVE_NOML     - Can trust a positive answer
 496  * INTUIT_AUTORITATIVE_ML
 497  * INTUIT_ONCE_NOML             - Intuit can match in one location only.
 498  * INTUIT_ONCE_ML
 499  *
 500  * Another flag for this function: SECOND_TIME (so that float substrs
 501  * with giant delta may be not rechecked).
 502  */
 503
 504 /* Assumptions: if ANCH_GPOS, then strpos is anchored. XXXX Check GPOS logic */
 505
 506 /* If SCREAM, then SvPVX_const(sv) should be compatible with strpos and strend.
 507    Otherwise, only SvCUR(sv) is used to get strbeg. */
 508
 509 /* XXXX We assume that strpos is strbeg unless sv. */
 510
 511 /* XXXX Some places assume that there is a fixed substring.
 512         An update may be needed if optimizer marks as "INTUITable"
 513         RExen without fixed substrings.  Similarly, it is assumed that
 514         lengths of all the strings are no more than minlen, thus they
 515         cannot come from lookahead.
 516         (Or minlen should take into account lookahead.)
 517   NOTE: Some of this comment is not correct. minlen does now take account
 518   of lookahead/behind. Further research is required. -- demerphq
 519
 520 */
 521
 522 /* A failure to find a constant substring means that there is no need to make
 523    an expensive call to REx engine, thus we celebrate a failure.  Similarly,
 524    finding a substring too deep into the string means that less calls to
 525    regtry() should be needed.
 526
 527    REx compiler's optimizer found 4 possible hints:
 528         a) Anchored substring;
 529         b) Fixed substring;
 530         c) Whether we are anchored (beginning-of-line or \G);
 531         d) First node (of those at offset 0) which may distinguish positions;
 532    We use a)b)d) and multiline-part of c), and try to find a position in the
 533    string which does not contradict any of them.
 534  */
 535
 536 /* Most of decisions we do here should have been done at compile time.
 537    The nodes of the REx which we used for the search should have been
 538    deleted from the finite automaton. */
 539
 540 char *
 541 Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
 542                      char *strend, const U32 flags, re_scream_pos_data *data)
 543 {
 544     dVAR;
 545     struct regexp *const prog = (struct regexp *)SvANY(rx);
 546     register I32 start_shift = 0;
 547     /* Should be nonnegative! */
 548     register I32 end_shift   = 0;
 549     register char *s;
 550     register SV *check;
 551     char *strbeg;
 552     char *t;
 553     const bool utf8_target = (sv && SvUTF8(sv)) ? 1 : 0; /* if no sv we have to assume bytes */
 554     I32 ml_anch;
 555     register char *other_last = NULL;   /* other substr checked before this */
 556     char *check_at = NULL;              /* check substr found at this pos */
 557     const I32 multiline = prog->extflags & RXf_PMf_MULTILINE;
 558     RXi_GET_DECL(prog,progi);
 559 #ifdef DEBUGGING
 560     const char * const i_strpos = strpos;
 561 #endif
 562     GET_RE_DEBUG_FLAGS_DECL;
 563
 564     PERL_ARGS_ASSERT_RE_INTUIT_START;
 565
 566     RX_MATCH_UTF8_set(rx,utf8_target);
 567
 568     if (RX_UTF8(rx)) {
 569         PL_reg_flags |= RF_utf8;
 570     }
 571     DEBUG_EXECUTE_r(
 572         debug_start_match(rx, utf8_target, strpos, strend,
 573             sv ? "Guessing start of match in sv for"
 574                : "Guessing start of match in string for");
 575               );
 576
 577     /* CHR_DIST() would be more correct here but it makes things slow. */
 578     if (prog->minlen > strend - strpos) {
 579         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 580                               "String too short... [re_intuit_start]\n"));
 581         goto fail;
 582     }
 583
 584     strbeg = (sv && SvPOK(sv)) ? strend - SvCUR(sv) : strpos;
 585     PL_regeol = strend;
 586     if (utf8_target) {
 587         if (!prog->check_utf8 && prog->check_substr)
 588             to_utf8_substr(prog);
 589         check = prog->check_utf8;
 590     } else {
 591         if (!prog->check_substr && prog->check_utf8)
 592             to_byte_substr(prog);
 593         check = prog->check_substr;
 594     }
 595     if (check == &PL_sv_undef) {
 596         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 597                 "Non-utf8 string cannot match utf8 check string\n"));
 598         goto fail;
 599     }
 600     if (prog->extflags & RXf_ANCH) {    /* Match at beg-of-str or after \n */
 601         ml_anch = !( (prog->extflags & RXf_ANCH_SINGLE)
 602                      || ( (prog->extflags & RXf_ANCH_BOL)
 603                           && !multiline ) );    /* Check after \n? */
 604
 605         if (!ml_anch) {
 606           if ( !(prog->extflags & RXf_ANCH_GPOS) /* Checked by the caller */
 607                 && !(prog->intflags & PREGf_IMPLICIT) /* not a real BOL */
 608                /* SvCUR is not set on references: SvRV and SvPVX_const overlap */
 609                && sv && !SvROK(sv)
 610                && (strpos != strbeg)) {
 611               DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
 612               goto fail;
 613           }
 614           if (prog->check_offset_min == prog->check_offset_max &&
 615               !(prog->extflags & RXf_CANY_SEEN)) {
 616             /* Substring at constant offset from beg-of-str... */
 617             I32 slen;
 618
 619             s = HOP3c(strpos, prog->check_offset_min, strend);
 620
 621             if (SvTAIL(check)) {
 622                 slen = SvCUR(check);    /* >= 1 */
 623
 624                 if ( strend - s > slen || strend - s < slen - 1
 625                      || (strend - s == slen && strend[-1] != '\n')) {
 626                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String too long...\n"));
 627                     goto fail_finish;
 628                 }
 629                 /* Now should match s[0..slen-2] */
 630                 slen--;
 631                 if (slen && (*SvPVX_const(check) != *s
 632                              || (slen > 1
 633                                  && memNE(SvPVX_const(check), s, slen)))) {
 634                   report_neq:
 635                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String not equal...\n"));
 636                     goto fail_finish;
 637                 }
 638             }
 639             else if (*SvPVX_const(check) != *s
 640                      || ((slen = SvCUR(check)) > 1
 641                          && memNE(SvPVX_const(check), s, slen)))
 642                 goto report_neq;
 643             check_at = s;
 644             goto success_at_start;
 645           }
 646         }
 647         /* Match is anchored, but substr is not anchored wrt beg-of-str. */
 648         s = strpos;
 649         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
 650         end_shift = prog->check_end_shift;
 651
 652         if (!ml_anch) {
 653             const I32 end = prog->check_offset_max + CHR_SVLEN(check)
 654                                          - (SvTAIL(check) != 0);
 655             const I32 eshift = CHR_DIST((U8*)strend, (U8*)s) - end;
 656
 657             if (end_shift < eshift)
 658                 end_shift = eshift;
 659         }
 660     }
 661     else {                              /* Can match at random position */
 662         ml_anch = 0;
 663         s = strpos;
 664         start_shift = prog->check_offset_min;  /* okay to underestimate on CC */
 665         end_shift = prog->check_end_shift;
 666
 667         /* end shift should be non negative here */
 668     }
 669
 670 #ifdef QDEBUGGING       /* 7/99: reports of failure (with the older version) */
 671     if (end_shift < 0)
 672         Perl_croak(aTHX_ "panic: end_shift: %"IVdf" pattern:\n%s\n ",
 673                    (IV)end_shift, RX_PRECOMP(prog));
 674 #endif
 675
 676   restart:
 677     /* Find a possible match in the region s..strend by looking for
 678        the "check" substring in the region corrected by start/end_shift. */
 679
 680     {
 681         I32 srch_start_shift = start_shift;
 682         I32 srch_end_shift = end_shift;
 683         if (srch_start_shift < 0 && strbeg - s > srch_start_shift) {
 684             srch_end_shift -= ((strbeg - s) - srch_start_shift);
 685             srch_start_shift = strbeg - s;
 686         }
 687     DEBUG_OPTIMISE_MORE_r({
 688         PerlIO_printf(Perl_debug_log, "Check offset min: %"IVdf" Start shift: %"IVdf" End shift %"IVdf" Real End Shift: %"IVdf"\n",
 689             (IV)prog->check_offset_min,
 690             (IV)srch_start_shift,
 691             (IV)srch_end_shift,
 692             (IV)prog->check_end_shift);
 693     });
 694
 695     if ((flags & REXEC_SCREAM) && SvSCREAM(sv)) {
 696         I32 p = -1;                     /* Internal iterator of scream. */
 697         I32 * const pp = data ? data->scream_pos : &p;
 698         const MAGIC *mg;
 699         bool found = FALSE;
 700
 701         assert(SvMAGICAL(sv));
 702         mg = mg_find(sv, PERL_MAGIC_study);
 703         assert(mg);
 704
 705         if (mg->mg_private == 1) {
 706             found = ((U8 *)mg->mg_ptr)[BmRARE(check)] != (U8)~0;
 707         } else if (mg->mg_private == 2) {
 708             found = ((U16 *)mg->mg_ptr)[BmRARE(check)] != (U16)~0;
 709         } else {
 710             assert (mg->mg_private == 4);
 711             found = ((U32 *)mg->mg_ptr)[BmRARE(check)] != (U32)~0;
 712         }
 713
 714         if (found
 715             || ( BmRARE(check) == '\n'
 716                  && (BmPREVIOUS(check) == SvCUR(check) - 1)
 717                  && SvTAIL(check) ))
 718             s = screaminstr(sv, check,
 719                             srch_start_shift + (s - strbeg), srch_end_shift, pp, 0);
 720         else
 721             goto fail_finish;
 722         /* we may be pointing at the wrong string */
 723         if (s && RXp_MATCH_COPIED(prog))
 724             s = strbeg + (s - SvPVX_const(sv));
 725         if (data)
 726             *data->scream_olds = s;
 727     }
 728     else {
 729         U8* start_point;
 730         U8* end_point;
 731         if (prog->extflags & RXf_CANY_SEEN) {
 732             start_point= (U8*)(s + srch_start_shift);
 733             end_point= (U8*)(strend - srch_end_shift);
 734         } else {
 735             start_point= HOP3(s, srch_start_shift, srch_start_shift < 0 ? strbeg : strend);
 736             end_point= HOP3(strend, -srch_end_shift, strbeg);
 737         }
 738         DEBUG_OPTIMISE_MORE_r({
 739             PerlIO_printf(Perl_debug_log, "fbm_instr len=%d str=<%.*s>\n",
 740                 (int)(end_point - start_point),
 741                 (int)(end_point - start_point) > 20 ? 20 : (int)(end_point - start_point),
 742                 start_point);
 743         });
 744
 745         s = fbm_instr( start_point, end_point,
 746                       check, multiline ? FBMrf_MULTILINE : 0);
 747     }
 748     }
 749     /* Update the count-of-usability, remove useless subpatterns,
 750         unshift s.  */
 751
 752     DEBUG_EXECUTE_r({
 753         RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0),
 754             SvPVX_const(check), RE_SV_DUMPLEN(check), 30);
 755         PerlIO_printf(Perl_debug_log, "%s %s substr %s%s%s",
 756                           (s ? "Found" : "Did not find"),
 757             (check == (utf8_target ? prog->anchored_utf8 : prog->anchored_substr)
 758                 ? "anchored" : "floating"),
 759             quoted,
 760             RE_SV_TAIL(check),
 761             (s ? " at offset " : "...\n") );
 762     });
 763
 764     if (!s)
 765         goto fail_finish;
 766     /* Finish the diagnostic message */
 767     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - i_strpos)) );
 768
 769     /* XXX dmq: first branch is for positive lookbehind...
 770        Our check string is offset from the beginning of the pattern.
 771        So we need to do any stclass tests offset forward from that
 772        point. I think. :-(
 773      */
 774
 775
 776
 777     check_at=s;
 778
 779
 780     /* Got a candidate.  Check MBOL anchoring, and the *other* substr.
 781        Start with the other substr.
 782        XXXX no SCREAM optimization yet - and a very coarse implementation
 783        XXXX /ttx+/ results in anchored="ttx", floating="x".  floating will
 784                 *always* match.  Probably should be marked during compile...
 785        Probably it is right to do no SCREAM here...
 786      */
 787
 788     if (utf8_target ? (prog->float_utf8 && prog->anchored_utf8)
 789                 : (prog->float_substr && prog->anchored_substr))
 790     {
 791         /* Take into account the "other" substring. */
 792         /* XXXX May be hopelessly wrong for UTF... */
 793         if (!other_last)
 794             other_last = strpos;
 795         if (check == (utf8_target ? prog->float_utf8 : prog->float_substr)) {
 796           do_other_anchored:
 797             {
 798                 char * const last = HOP3c(s, -start_shift, strbeg);
 799                 char *last1, *last2;
 800                 char * const saved_s = s;
 801                 SV* must;
 802
 803                 t = s - prog->check_offset_max;
 804                 if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
 805                     && (!utf8_target
 806                         || ((t = (char*)reghopmaybe3((U8*)s, -(prog->check_offset_max), (U8*)strpos))
 807                             && t > strpos)))
 808                     NOOP;
 809                 else
 810                     t = strpos;
 811                 t = HOP3c(t, prog->anchored_offset, strend);
 812                 if (t < other_last)     /* These positions already checked */
 813                     t = other_last;
 814                 last2 = last1 = HOP3c(strend, -prog->minlen, strbeg);
 815                 if (last < last1)
 816                     last1 = last;
 817                 /* XXXX It is not documented what units *_offsets are in.
 818                    We assume bytes, but this is clearly wrong.
 819                    Meaning this code needs to be carefully reviewed for errors.
 820                    dmq.
 821                   */
 822
 823                 /* On end-of-str: see comment below. */
 824                 must = utf8_target ? prog->anchored_utf8 : prog->anchored_substr;
 825                 if (must == &PL_sv_undef) {
 826                     s = (char*)NULL;
 827                     DEBUG_r(must = prog->anchored_utf8);        /* for debug */
 828                 }
 829                 else
 830                     s = fbm_instr(
 831                         (unsigned char*)t,
 832                         HOP3(HOP3(last1, prog->anchored_offset, strend)
 833                                 + SvCUR(must), -(SvTAIL(must)!=0), strbeg),
 834                         must,
 835                         multiline ? FBMrf_MULTILINE : 0
 836                     );
 837                 DEBUG_EXECUTE_r({
 838                     RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0),
 839                         SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
 840                     PerlIO_printf(Perl_debug_log, "%s anchored substr %s%s",
 841                         (s ? "Found" : "Contradicts"),
 842                         quoted, RE_SV_TAIL(must));
 843                 });
 844
 845
 846                 if (!s) {
 847                     if (last1 >= last2) {
 848                         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 849                                                 ", giving up...\n"));
 850                         goto fail_finish;
 851                     }
 852                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 853                         ", trying floating at offset %ld...\n",
 854                         (long)(HOP3c(saved_s, 1, strend) - i_strpos)));
 855                     other_last = HOP3c(last1, prog->anchored_offset+1, strend);
 856                     s = HOP3c(last, 1, strend);
 857                     goto restart;
 858                 }
 859                 else {
 860                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
 861                           (long)(s - i_strpos)));
 862                     t = HOP3c(s, -prog->anchored_offset, strbeg);
 863                     other_last = HOP3c(s, 1, strend);
 864                     s = saved_s;
 865                     if (t == strpos)
 866                         goto try_at_start;
 867                     goto try_at_offset;
 868                 }
 869             }
 870         }
 871         else {          /* Take into account the floating substring. */
 872             char *last, *last1;
 873             char * const saved_s = s;
 874             SV* must;
 875
 876             t = HOP3c(s, -start_shift, strbeg);
 877             last1 = last =
 878                 HOP3c(strend, -prog->minlen + prog->float_min_offset, strbeg);
 879             if (CHR_DIST((U8*)last, (U8*)t) > prog->float_max_offset)
 880                 last = HOP3c(t, prog->float_max_offset, strend);
 881             s = HOP3c(t, prog->float_min_offset, strend);
 882             if (s < other_last)
 883                 s = other_last;
 884  /* XXXX It is not documented what units *_offsets are in.  Assume bytes.  */
 885             must = utf8_target ? prog->float_utf8 : prog->float_substr;
 886             /* fbm_instr() takes into account exact value of end-of-str
 887                if the check is SvTAIL(ed).  Since false positives are OK,
 888                and end-of-str is not later than strend we are OK. */
 889             if (must == &PL_sv_undef) {
 890                 s = (char*)NULL;
 891                 DEBUG_r(must = prog->float_utf8);       /* for debug message */
 892             }
 893             else
 894                 s = fbm_instr((unsigned char*)s,
 895                               (unsigned char*)last + SvCUR(must)
 896                                   - (SvTAIL(must)!=0),
 897                               must, multiline ? FBMrf_MULTILINE : 0);
 898             DEBUG_EXECUTE_r({
 899                 RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0),
 900                     SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
 901                 PerlIO_printf(Perl_debug_log, "%s floating substr %s%s",
 902                     (s ? "Found" : "Contradicts"),
 903                     quoted, RE_SV_TAIL(must));
 904             });
 905             if (!s) {
 906                 if (last1 == last) {
 907                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 908                                             ", giving up...\n"));
 909                     goto fail_finish;
 910                 }
 911                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 912                     ", trying anchored starting at offset %ld...\n",
 913                     (long)(saved_s + 1 - i_strpos)));
 914                 other_last = last;
 915                 s = HOP3c(t, 1, strend);
 916                 goto restart;
 917             }
 918             else {
 919                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
 920                       (long)(s - i_strpos)));
 921                 other_last = s; /* Fix this later. --Hugo */
 922                 s = saved_s;
 923                 if (t == strpos)
 924                     goto try_at_start;
 925                 goto try_at_offset;
 926             }
 927         }
 928     }
 929
 930
 931     t= (char*)HOP3( s, -prog->check_offset_max, (prog->check_offset_max<0) ? strend : strpos);
 932
 933     DEBUG_OPTIMISE_MORE_r(
 934         PerlIO_printf(Perl_debug_log,
 935             "Check offset min:%"IVdf" max:%"IVdf" S:%"IVdf" t:%"IVdf" D:%"IVdf" end:%"IVdf"\n",
 936             (IV)prog->check_offset_min,
 937             (IV)prog->check_offset_max,
 938             (IV)(s-strpos),
 939             (IV)(t-strpos),
 940             (IV)(t-s),
 941             (IV)(strend-strpos)
 942         )
 943     );
 944
 945     if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
 946         && (!utf8_target
 947             || ((t = (char*)reghopmaybe3((U8*)s, -prog->check_offset_max, (U8*) ((prog->check_offset_max<0) ? strend : strpos)))
 948                  && t > strpos)))
 949     {
 950         /* Fixed substring is found far enough so that the match
 951            cannot start at strpos. */
 952       try_at_offset:
 953         if (ml_anch && t[-1] != '\n') {
 954             /* Eventually fbm_*() should handle this, but often
 955                anchored_offset is not 0, so this check will not be wasted. */
 956             /* XXXX In the code below we prefer to look for "^" even in
 957                presence of anchored substrings.  And we search even
 958                beyond the found float position.  These pessimizations
 959                are historical artefacts only.  */
 960           find_anchor:
 961             while (t < strend - prog->minlen) {
 962                 if (*t == '\n') {
 963                     if (t < check_at - prog->check_offset_min) {
 964                         if (utf8_target ? prog->anchored_utf8 : prog->anchored_substr) {
 965                             /* Since we moved from the found position,
 966                                we definitely contradict the found anchored
 967                                substr.  Due to the above check we do not
 968                                contradict "check" substr.
 969                                Thus we can arrive here only if check substr
 970                                is float.  Redo checking for "other"=="fixed".
 971                              */
 972                             strpos = t + 1;
 973                             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld, rescanning for anchored from offset %ld...\n",
 974                                 PL_colors[0], PL_colors[1], (long)(strpos - i_strpos), (long)(strpos - i_strpos + prog->anchored_offset)));
 975                             goto do_other_anchored;
 976                         }
 977                         /* We don't contradict the found floating substring. */
 978                         /* XXXX Why not check for STCLASS? */
 979                         s = t + 1;
 980                         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld...\n",
 981                             PL_colors[0], PL_colors[1], (long)(s - i_strpos)));
 982                         goto set_useful;
 983                     }
 984                     /* Position contradicts check-string */
 985                     /* XXXX probably better to look for check-string
 986                        than for "\n", so one should lower the limit for t? */
 987                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting lookup for check-string at offset %ld...\n",
 988                         PL_colors[0], PL_colors[1], (long)(t + 1 - i_strpos)));
 989                     other_last = strpos = s = t + 1;
 990                     goto restart;
 991                 }
 992                 t++;
 993             }
 994             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Did not find /%s^%s/m...\n",
 995                         PL_colors[0], PL_colors[1]));
 996             goto fail_finish;
 997         }
 998         else {
 999             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Starting position does not contradict /%s^%s/m...\n",
1000                         PL_colors[0], PL_colors[1]));
1001         }
1002         s = t;
1003       set_useful:
1004         ++BmUSEFUL(utf8_target ? prog->check_utf8 : prog->check_substr);        /* hooray/5 */
1005     }
1006     else {
1007         /* The found string does not prohibit matching at strpos,
1008            - no optimization of calling REx engine can be performed,
1009            unless it was an MBOL and we are not after MBOL,
1010            or a future STCLASS check will fail this. */
1011       try_at_start:
1012         /* Even in this situation we may use MBOL flag if strpos is offset
1013            wrt the start of the string. */
1014         if (ml_anch && sv && !SvROK(sv) /* See prev comment on SvROK */
1015             && (strpos != strbeg) && strpos[-1] != '\n'
1016             /* May be due to an implicit anchor of m{.*foo}  */
1017             && !(prog->intflags & PREGf_IMPLICIT))
1018         {
1019             t = strpos;
1020             goto find_anchor;
1021         }
1022         DEBUG_EXECUTE_r( if (ml_anch)
1023             PerlIO_printf(Perl_debug_log, "Position at offset %ld does not contradict /%s^%s/m...\n",
1024                           (long)(strpos - i_strpos), PL_colors[0], PL_colors[1]);
1025         );
1026       success_at_start:
1027         if (!(prog->intflags & PREGf_NAUGHTY)   /* XXXX If strpos moved? */
1028             && (utf8_target ? (
1029                 prog->check_utf8                /* Could be deleted already */
1030                 && --BmUSEFUL(prog->check_utf8) < 0
1031                 && (prog->check_utf8 == prog->float_utf8)
1032             ) : (
1033                 prog->check_substr              /* Could be deleted already */
1034                 && --BmUSEFUL(prog->check_substr) < 0
1035                 && (prog->check_substr == prog->float_substr)
1036             )))
1037         {
1038             /* If flags & SOMETHING - do not do it many times on the same match */
1039             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "... Disabling check substring...\n"));
1040             /* XXX Does the destruction order has to change with utf8_target? */
1041             SvREFCNT_dec(utf8_target ? prog->check_utf8 : prog->check_substr);
1042             SvREFCNT_dec(utf8_target ? prog->check_substr : prog->check_utf8);
1043             prog->check_substr = prog->check_utf8 = NULL;       /* disable */
1044             prog->float_substr = prog->float_utf8 = NULL;       /* clear */
1045             check = NULL;                       /* abort */
1046             s = strpos;
1047             /* XXXX If the check string was an implicit check MBOL, then we need to unset the relevant flag
1048                     see http://bugs.activestate.com/show_bug.cgi?id=87173 */
1049             if (prog->intflags & PREGf_IMPLICIT)
1050                 prog->extflags &= ~RXf_ANCH_MBOL;
1051             /* XXXX This is a remnant of the old implementation.  It
1052                     looks wasteful, since now INTUIT can use many
1053                     other heuristics. */
1054             prog->extflags &= ~RXf_USE_INTUIT;
1055             /* XXXX What other flags might need to be cleared in this branch? */
1056         }
1057         else
1058             s = strpos;
1059     }
1060
1061     /* Last resort... */
1062     /* XXXX BmUSEFUL already changed, maybe multiple change is meaningful... */
1063     /* trie stclasses are too expensive to use here, we are better off to
1064        leave it to regmatch itself */
1065     if (progi->regstclass && PL_regkind[OP(progi->regstclass)]!=TRIE) {
1066         /* minlen == 0 is possible if regstclass is \b or \B,
1067            and the fixed substr is ''$.
1068            Since minlen is already taken into account, s+1 is before strend;
1069            accidentally, minlen >= 1 guaranties no false positives at s + 1
1070            even for \b or \B.  But (minlen? 1 : 0) below assumes that
1071            regstclass does not come from lookahead...  */
1072         /* If regstclass takes bytelength more than 1: If charlength==1, OK.
1073            This leaves EXACTF-ish only, which are dealt with in find_byclass().  */
1074         const U8* const str = (U8*)STRING(progi->regstclass);
1075         const int cl_l = (PL_regkind[OP(progi->regstclass)] == EXACT
1076                     ? CHR_DIST(str+STR_LEN(progi->regstclass), str)
1077                     : 1);
1078         char * endpos;
1079         if (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
1080             endpos= HOP3c(s, (prog->minlen ? cl_l : 0), strend);
1081         else if (prog->float_substr || prog->float_utf8)
1082             endpos= HOP3c(HOP3c(check_at, -start_shift, strbeg), cl_l, strend);
1083         else
1084             endpos= strend;
1085
1086         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "start_shift: %"IVdf" check_at: %"IVdf" s: %"IVdf" endpos: %"IVdf"\n",
1087                                       (IV)start_shift, (IV)(check_at - strbeg), (IV)(s - strbeg), (IV)(endpos - strbeg)));
1088
1089         t = s;
1090         s = find_byclass(prog, progi->regstclass, s, endpos, NULL);
1091         if (!s) {
1092 #ifdef DEBUGGING
1093             const char *what = NULL;
1094 #endif
1095             if (endpos == strend) {
1096                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
1097                                 "Could not match STCLASS...\n") );
1098                 goto fail;
1099             }
1100             DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
1101                                    "This position contradicts STCLASS...\n") );
1102             if ((prog->extflags & RXf_ANCH) && !ml_anch)
1103                 goto fail;
1104             /* Contradict one of substrings */
1105             if (prog->anchored_substr || prog->anchored_utf8) {
1106                 if ((utf8_target ? prog->anchored_utf8 : prog->anchored_substr) == check) {
1107                     DEBUG_EXECUTE_r( what = "anchored" );
1108                   hop_and_restart:
1109                     s = HOP3c(t, 1, strend);
1110                     if (s + start_shift + end_shift > strend) {
1111                         /* XXXX Should be taken into account earlier? */
1112                         DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
1113                                                "Could not match STCLASS...\n") );
1114                         goto fail;
1115                     }
1116                     if (!check)
1117                         goto giveup;
1118                     DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
1119                                 "Looking for %s substr starting at offset %ld...\n",
1120                                  what, (long)(s + start_shift - i_strpos)) );
1121                     goto restart;
1122                 }
1123                 /* Have both, check_string is floating */
1124                 if (t + start_shift >= check_at) /* Contradicts floating=check */
1125                     goto retry_floating_check;
1126                 /* Recheck anchored substring, but not floating... */
1127                 s = check_at;
1128                 if (!check)
1129                     goto giveup;
1130                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
1131                           "Looking for anchored substr starting at offset %ld...\n",
1132                           (long)(other_last - i_strpos)) );
1133                 goto do_other_anchored;
1134             }
1135             /* Another way we could have checked stclass at the
1136                current position only: */
1137             if (ml_anch) {
1138                 s = t = t + 1;
1139                 if (!check)
1140                     goto giveup;
1141                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
1142                           "Looking for /%s^%s/m starting at offset %ld...\n",
1143                           PL_colors[0], PL_colors[1], (long)(t - i_strpos)) );
1144                 goto try_at_offset;
1145             }
1146             if (!(utf8_target ? prog->float_utf8 : prog->float_substr)) /* Could have been deleted */
1147                 goto fail;
1148             /* Check is floating substring. */
1149           retry_floating_check:
1150             t = check_at - start_shift;
1151             DEBUG_EXECUTE_r( what = "floating" );
1152             goto hop_and_restart;
1153         }
1154         if (t != s) {
1155             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
1156                         "By STCLASS: moving %ld --> %ld\n",
1157                                   (long)(t - i_strpos), (long)(s - i_strpos))
1158                    );
1159         }
1160         else {
1161             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
1162                                   "Does not contradict STCLASS...\n");
1163                    );
1164         }
1165     }
1166   giveup:
1167     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s%s:%s match at offset %ld\n",
1168                           PL_colors[4], (check ? "Guessed" : "Giving up"),
1169                           PL_colors[5], (long)(s - i_strpos)) );
1170     return s;
1171
1172   fail_finish:                          /* Substring not found */
1173     if (prog->check_substr || prog->check_utf8)         /* could be removed already */
1174         BmUSEFUL(utf8_target ? prog->check_utf8 : prog->check_substr) += 5; /* hooray */
1175   fail:
1176     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n",
1177                           PL_colors[4], PL_colors[5]));
1178     return NULL;
1179 }
1180
1181 #define DECL_TRIE_TYPE(scan) \
1182     const enum { trie_plain, trie_utf8, trie_utf8_fold, trie_latin_utf8_fold } \
1183                     trie_type = (scan->flags != EXACT) \
1184                               ? (utf8_target ? trie_utf8_fold : (UTF_PATTERN ? trie_latin_utf8_fold : trie_plain)) \
1185                               : (utf8_target ? trie_utf8 : trie_plain)
1186
1187 #define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uscan, len,  \
1188 uvc, charid, foldlen, foldbuf, uniflags) STMT_START {                       \
1189     switch (trie_type) {                                                    \
1190     case trie_utf8_fold:                                                    \
1191         if ( foldlen>0 ) {                                                  \
1192             uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags ); \
1193             foldlen -= len;                                                 \
1194             uscan += len;                                                   \
1195             len=0;                                                          \
1196         } else {                                                            \
1197             uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags ); \
1198             uvc = to_uni_fold( uvc, foldbuf, &foldlen );                    \
1199             foldlen -= UNISKIP( uvc );                                      \
1200             uscan = foldbuf + UNISKIP( uvc );                               \
1201         }                                                                   \
1202         break;                                                              \
1203     case trie_latin_utf8_fold:                                              \
1204         if ( foldlen>0 ) {                                                  \
1205             uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags );     \
1206             foldlen -= len;                                                 \
1207             uscan += len;                                                   \
1208             len=0;                                                          \
1209         } else {                                                            \
1210             len = 1;                                                        \
1211             uvc = to_uni_fold( *(U8*)uc, foldbuf, &foldlen );               \
1212             foldlen -= UNISKIP( uvc );                                      \
1213             uscan = foldbuf + UNISKIP( uvc );                               \
1214         }                                                                   \
1215         break;                                                              \
1216     case trie_utf8:                                                         \
1217         uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );       \
1218         break;                                                              \
1219     case trie_plain:                                                        \
1220         uvc = (UV)*uc;                                                      \
1221         len = 1;                                                            \
1222     }                                                                       \
1223     if (uvc < 256) {                                                        \
1224         charid = trie->charmap[ uvc ];                                      \
1225     }                                                                       \
1226     else {                                                                  \
1227         charid = 0;                                                         \
1228         if (widecharmap) {                                                  \
1229             SV** const svpp = hv_fetch(widecharmap,                         \
1230                         (char*)&uvc, sizeof(UV), 0);                        \
1231             if (svpp)                                                       \
1232                 charid = (U16)SvIV(*svpp);                                  \
1233         }                                                                   \
1234     }                                                                       \
1235 } STMT_END
1236
1237 #define REXEC_FBC_EXACTISH_SCAN(CoNd)                     \
1238 STMT_START {                                              \
1239     while (s <= e) {                                      \
1240         if ( (CoNd)                                       \
1241              && (ln == 1 || folder(s, pat_string, ln))    \
1242              && (!reginfo || regtry(reginfo, &s)) )       \
1243             goto got_it;                                  \
1244         s++;                                              \
1245     }                                                     \
1246 } STMT_END
1247
1248 #define REXEC_FBC_UTF8_SCAN(CoDe)                     \
1249 STMT_START {                                          \
1250     while (s + (uskip = UTF8SKIP(s)) <= strend) {     \
1251         CoDe                                          \
1252         s += uskip;                                   \
1253     }                                                 \
1254 } STMT_END
1255
1256 #define REXEC_FBC_SCAN(CoDe)                          \
1257 STMT_START {                                          \
1258     while (s < strend) {                              \
1259         CoDe                                          \
1260         s++;                                          \
1261     }                                                 \
1262 } STMT_END
1263
1264 #define REXEC_FBC_UTF8_CLASS_SCAN(CoNd)               \
1265 REXEC_FBC_UTF8_SCAN(                                  \
1266     if (CoNd) {                                       \
1267         if (tmp && (!reginfo || regtry(reginfo, &s)))  \
1268             goto got_it;                              \
1269         else                                          \
1270             tmp = doevery;                            \
1271     }                                                 \
1272     else                                              \
1273         tmp = 1;                                      \
1274 )
1275
1276 #define REXEC_FBC_CLASS_SCAN(CoNd)                    \
1277 REXEC_FBC_SCAN(                                       \
1278     if (CoNd) {                                       \
1279         if (tmp && (!reginfo || regtry(reginfo, &s)))  \
1280             goto got_it;                              \
1281         else                                          \
1282             tmp = doevery;                            \
1283     }                                                 \
1284     else                                              \
1285         tmp = 1;                                      \
1286 )
1287
1288 #define REXEC_FBC_TRYIT               \
1289 if ((!reginfo || regtry(reginfo, &s))) \
1290     goto got_it
1291
1292 #define REXEC_FBC_CSCAN(CoNdUtF8,CoNd)                         \
1293     if (utf8_target) {                                             \
1294         REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8);                   \
1295     }                                                          \
1296     else {                                                     \
1297         REXEC_FBC_CLASS_SCAN(CoNd);                            \
1298     }
1299
1300 #define REXEC_FBC_CSCAN_PRELOAD(UtFpReLoAd,CoNdUtF8,CoNd)      \
1301     if (utf8_target) {                                             \
1302         UtFpReLoAd;                                            \
1303         REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8);                   \
1304     }                                                          \
1305     else {                                                     \
1306         REXEC_FBC_CLASS_SCAN(CoNd);                            \
1307     }
1308
1309 #define REXEC_FBC_CSCAN_TAINT(CoNdUtF8,CoNd)                   \
1310     PL_reg_flags |= RF_tainted;                                \
1311     if (utf8_target) {                                             \
1312         REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8);                   \
1313     }                                                          \
1314     else {                                                     \
1315         REXEC_FBC_CLASS_SCAN(CoNd);                            \
1316     }
1317
1318 #define DUMP_EXEC_POS(li,s,doutf8) \
1319     dump_exec_pos(li,s,(PL_regeol),(PL_bostr),(PL_reg_starttry),doutf8)
1320
1321
1322 #define UTF8_NOLOAD(TEST_NON_UTF8, IF_SUCCESS, IF_FAIL) \
1323         tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';                         \
1324         tmp = TEST_NON_UTF8(tmp);                                              \
1325         REXEC_FBC_UTF8_SCAN(                                                   \
1326             if (tmp == ! TEST_NON_UTF8((U8) *s)) { \
1327                 tmp = !tmp;                                                    \
1328                 IF_SUCCESS;                                                    \
1329             }                                                                  \
1330             else {                                                             \
1331                 IF_FAIL;                                                       \
1332             }                                                                  \
1333         );                                                                     \
1334
1335 #define UTF8_LOAD(TeSt1_UtF8, TeSt2_UtF8, IF_SUCCESS, IF_FAIL) \
1336         if (s == PL_bostr) {                                                   \
1337             tmp = '\n';                                                        \
1338         }                                                                      \
1339         else {                                                                 \
1340             U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);                 \
1341             tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, UTF8_ALLOW_DEFAULT);       \
1342         }                                                                      \
1343         tmp = TeSt1_UtF8;                                                      \
1344         LOAD_UTF8_CHARCLASS_ALNUM();                                                                \
1345         REXEC_FBC_UTF8_SCAN(                                                   \
1346             if (tmp == ! (TeSt2_UtF8)) { \
1347                 tmp = !tmp;                                                    \
1348                 IF_SUCCESS;                                                    \
1349             }                                                                  \
1350             else {                                                             \
1351                 IF_FAIL;                                                       \
1352             }                                                                  \
1353         );                                                                     \
1354
1355 /* The only difference between the BOUND and NBOUND cases is that
1356  * REXEC_FBC_TRYIT is called when matched in BOUND, and when non-matched in
1357  * NBOUND.  This is accomplished by passing it in either the if or else clause,
1358  * with the other one being empty */
1359 #define FBC_BOUND(TEST_NON_UTF8, TEST1_UTF8, TEST2_UTF8) \
1360     FBC_BOUND_COMMON(UTF8_LOAD(TEST1_UTF8, TEST2_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER), TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER)
1361
1362 #define FBC_BOUND_NOLOAD(TEST_NON_UTF8, TEST1_UTF8, TEST2_UTF8) \
1363     FBC_BOUND_COMMON(UTF8_NOLOAD(TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER), TEST_NON_UTF8, REXEC_FBC_TRYIT, PLACEHOLDER)
1364
1365 #define FBC_NBOUND(TEST_NON_UTF8, TEST1_UTF8, TEST2_UTF8) \
1366     FBC_BOUND_COMMON(UTF8_LOAD(TEST1_UTF8, TEST2_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT), TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT)
1367
1368 #define FBC_NBOUND_NOLOAD(TEST_NON_UTF8, TEST1_UTF8, TEST2_UTF8) \
1369     FBC_BOUND_COMMON(UTF8_NOLOAD(TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT), TEST_NON_UTF8, PLACEHOLDER, REXEC_FBC_TRYIT)
1370
1371
1372 /* Common to the BOUND and NBOUND cases.  Unfortunately the UTF8 tests need to
1373  * be passed in completely with the variable name being tested, which isn't
1374  * such a clean interface, but this is easier to read than it was before.  We
1375  * are looking for the boundary (or non-boundary between a word and non-word
1376  * character.  The utf8 and non-utf8 cases have the same logic, but the details
1377  * must be different.  Find the "wordness" of the character just prior to this
1378  * one, and compare it with the wordness of this one.  If they differ, we have
1379  * a boundary.  At the beginning of the string, pretend that the previous
1380  * character was a new-line */
1381 #define FBC_BOUND_COMMON(UTF8_CODE, TEST_NON_UTF8, IF_SUCCESS, IF_FAIL) \
1382     if (utf8_target) {                                                         \
1383                 UTF8_CODE \
1384     }                                                                          \
1385     else {  /* Not utf8 */                                                     \
1386         tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';                         \
1387         tmp = TEST_NON_UTF8(tmp);                                              \
1388         REXEC_FBC_SCAN(                                                        \
1389             if (tmp == ! TEST_NON_UTF8((U8) *s)) {                             \
1390                 tmp = !tmp;                                                    \
1391                 IF_SUCCESS;                                                    \
1392             }                                                                  \
1393             else {                                                             \
1394                 IF_FAIL;                                                       \
1395             }                                                                  \
1396         );                                                                     \
1397     }                                                                          \
1398     if ((!prog->minlen && tmp) && (!reginfo || regtry(reginfo, &s)))           \
1399         goto got_it;
1400
1401 /* We know what class REx starts with.  Try to find this position... */
1402 /* if reginfo is NULL, its a dryrun */
1403 /* annoyingly all the vars in this routine have different names from their counterparts
1404    in regmatch. /grrr */
1405
1406 STATIC char *
1407 S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
1408     const char *strend, regmatch_info *reginfo)
1409 {
1410         dVAR;
1411         const I32 doevery = (prog->intflags & PREGf_SKIP) == 0;
1412         char *pat_string;   /* The pattern's exactish string */
1413         char *pat_end;      /* ptr to end char of pat_string */
1414         re_fold_t folder;       /* Function for computing non-utf8 folds */
1415         const U8 *fold_array;   /* array for folding ords < 256 */
1416         STRLEN ln;
1417         STRLEN lnc;
1418         register STRLEN uskip;
1419         U8 c1;
1420         U8 c2;
1421         char *e;
1422         register I32 tmp = 1;   /* Scratch variable? */
1423         register const bool utf8_target = PL_reg_match_utf8;
1424         UV utf8_fold_flags = 0;
1425         RXi_GET_DECL(prog,progi);
1426
1427         PERL_ARGS_ASSERT_FIND_BYCLASS;
1428
1429         /* We know what class it must start with. */
1430         switch (OP(c)) {
1431         case ANYOFV:
1432         case ANYOF:
1433             if (utf8_target || OP(c) == ANYOFV) {
1434                 STRLEN inclasslen = strend - s;
1435                 REXEC_FBC_UTF8_CLASS_SCAN(
1436                           reginclass(prog, c, (U8*)s, &inclasslen, utf8_target));
1437             }
1438             else {
1439                 REXEC_FBC_CLASS_SCAN(REGINCLASS(prog, c, (U8*)s));
1440             }
1441             break;
1442         case CANY:
1443             REXEC_FBC_SCAN(
1444                 if (tmp && (!reginfo || regtry(reginfo, &s)))
1445                     goto got_it;
1446                 else
1447                     tmp = doevery;
1448             );
1449             break;
1450
1451         case EXACTFA:
1452             if (UTF_PATTERN || utf8_target) {
1453                 utf8_fold_flags = FOLDEQ_UTF8_NOMIX_ASCII;
1454                 goto do_exactf_utf8;
1455             }
1456             fold_array = PL_fold_latin1;    /* Latin1 folds are not affected by */
1457             folder = foldEQ_latin1;         /* /a, except the sharp s one which */
1458             goto do_exactf_non_utf8;        /* isn't dealt with by these */
1459
1460         case EXACTFU:
1461             if (UTF_PATTERN || utf8_target) {
1462                 utf8_fold_flags = 0;
1463                 goto do_exactf_utf8;
1464             }
1465
1466             /* Any 'ss' in the pattern should have been replaced by regcomp,
1467              * so we don't have to worry here about this single special case
1468              * in the Latin1 range */
1469             fold_array = PL_fold_latin1;
1470             folder = foldEQ_latin1;
1471             goto do_exactf_non_utf8;
1472
1473         case EXACTF:
1474             if (UTF_PATTERN || utf8_target) {
1475                 utf8_fold_flags = 0;
1476                 goto do_exactf_utf8;
1477             }
1478             fold_array = PL_fold;
1479             folder = foldEQ;
1480             goto do_exactf_non_utf8;
1481
1482         case EXACTFL:
1483             if (UTF_PATTERN || utf8_target) {
1484                 utf8_fold_flags = FOLDEQ_UTF8_LOCALE;
1485                 goto do_exactf_utf8;
1486             }
1487             fold_array = PL_fold_locale;
1488             folder = foldEQ_locale;
1489
1490             /* FALL THROUGH */
1491
1492         do_exactf_non_utf8: /* Neither pattern nor string are UTF8 */
1493
1494             /* The idea in the non-utf8 EXACTF* cases is to first find the
1495              * first character of the EXACTF* node and then, if necessary,
1496              * case-insensitively compare the full text of the node.  c1 is the
1497              * first character.  c2 is its fold.  This logic will not work for
1498              * Unicode semantics and the german sharp ss, which hence should
1499              * not be compiled into a node that gets here. */
1500             pat_string = STRING(c);
1501             ln  = STR_LEN(c);   /* length to match in octets/bytes */
1502
1503             e = HOP3c(strend, -((I32)ln), s);
1504
1505             if (!reginfo && e < s) {
1506                 e = s;                  /* Due to minlen logic of intuit() */
1507             }
1508
1509             c1 = *pat_string;
1510             c2 = fold_array[c1];
1511             if (c1 == c2) { /* If char and fold are the same */
1512                 REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1);
1513             }
1514             else {
1515                 REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1 || *(U8*)s == c2);
1516             }
1517             break;
1518
1519         do_exactf_utf8:
1520
1521             /* If one of the operands is in utf8, we can't use the simpler
1522              * folding above, due to the fact that many different characters
1523              * can have the same fold, or portion of a fold, or different-
1524              * length fold */
1525             pat_string = STRING(c);
1526             ln  = STR_LEN(c);   /* length to match in octets/bytes */
1527             pat_end = pat_string + ln;
1528             lnc = (UTF_PATTERN) /* length to match in characters */
1529                     ? utf8_length((U8 *) pat_string, (U8 *) pat_end)
1530                     : ln;
1531
1532             e = HOP3c(strend, -((I32)lnc), s);
1533
1534             if (!reginfo && e < s) {
1535                 e = s;                  /* Due to minlen logic of intuit() */
1536             }
1537
1538             while (s <= e) {
1539                 char *my_strend= (char *)strend;
1540                 if (foldEQ_utf8_flags(s, &my_strend, 0,  utf8_target,
1541                       pat_string, NULL, ln, cBOOL(UTF_PATTERN), utf8_fold_flags)
1542                     && (!reginfo || regtry(reginfo, &s)) )
1543                 {
1544                     goto got_it;
1545                 }
1546                 s += UTF8SKIP(s);
1547             }
1548             break;
1549         case BOUNDL:
1550             PL_reg_flags |= RF_tainted;
1551             FBC_BOUND(isALNUM_LC,
1552                       isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp)),
1553                       isALNUM_LC_utf8((U8*)s));
1554             break;
1555         case NBOUNDL:
1556             PL_reg_flags |= RF_tainted;
1557             FBC_NBOUND(isALNUM_LC,
1558                        isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp)),
1559                        isALNUM_LC_utf8((U8*)s));
1560             break;
1561         case BOUND:
1562             FBC_BOUND(isWORDCHAR,
1563                       isALNUM_uni(tmp),
1564                       cBOOL(swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target)));
1565             break;
1566         case BOUNDA:
1567             FBC_BOUND_NOLOAD(isWORDCHAR_A,
1568                              isWORDCHAR_A(tmp),
1569                              isWORDCHAR_A((U8*)s));
1570             break;
1571         case NBOUND:
1572             FBC_NBOUND(isWORDCHAR,
1573                        isALNUM_uni(tmp),
1574                        cBOOL(swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target)));
1575             break;
1576         case NBOUNDA:
1577             FBC_NBOUND_NOLOAD(isWORDCHAR_A,
1578                               isWORDCHAR_A(tmp),
1579                               isWORDCHAR_A((U8*)s));
1580             break;
1581         case BOUNDU:
1582             FBC_BOUND(isWORDCHAR_L1,
1583                       isALNUM_uni(tmp),
1584                       cBOOL(swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target)));
1585             break;
1586         case NBOUNDU:
1587             FBC_NBOUND(isWORDCHAR_L1,
1588                        isALNUM_uni(tmp),
1589                        cBOOL(swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target)));
1590             break;
1591         case ALNUML:
1592             REXEC_FBC_CSCAN_TAINT(
1593                 isALNUM_LC_utf8((U8*)s),
1594                 isALNUM_LC(*s)
1595             );
1596             break;
1597         case ALNUMU:
1598             REXEC_FBC_CSCAN_PRELOAD(
1599                 LOAD_UTF8_CHARCLASS_ALNUM(),
1600                 swash_fetch(PL_utf8_alnum,(U8*)s, utf8_target),
1601                 isWORDCHAR_L1((U8) *s)
1602             );
1603             break;
1604         case ALNUM:
1605             REXEC_FBC_CSCAN_PRELOAD(
1606                 LOAD_UTF8_CHARCLASS_ALNUM(),
1607                 swash_fetch(PL_utf8_alnum,(U8*)s, utf8_target),
1608                 isWORDCHAR((U8) *s)
1609             );
1610             break;
1611         case ALNUMA:
1612             /* Don't need to worry about utf8, as it can match only a single
1613              * byte invariant character */
1614             REXEC_FBC_CLASS_SCAN( isWORDCHAR_A(*s));
1615             break;
1616         case NALNUMU:
1617             REXEC_FBC_CSCAN_PRELOAD(
1618                 LOAD_UTF8_CHARCLASS_ALNUM(),
1619                 !swash_fetch(PL_utf8_alnum,(U8*)s, utf8_target),
1620                 ! isWORDCHAR_L1((U8) *s)
1621             );
1622             break;
1623         case NALNUM:
1624             REXEC_FBC_CSCAN_PRELOAD(
1625                 LOAD_UTF8_CHARCLASS_ALNUM(),
1626                 !swash_fetch(PL_utf8_alnum, (U8*)s, utf8_target),
1627                 ! isALNUM(*s)
1628             );
1629             break;
1630         case NALNUMA:
1631             REXEC_FBC_CSCAN(
1632                 !isWORDCHAR_A(*s),
1633                 !isWORDCHAR_A(*s)
1634             );
1635             break;
1636         case NALNUML:
1637             REXEC_FBC_CSCAN_TAINT(
1638                 !isALNUM_LC_utf8((U8*)s),
1639                 !isALNUM_LC(*s)
1640             );
1641             break;
1642         case SPACEU:
1643             REXEC_FBC_CSCAN_PRELOAD(
1644                 LOAD_UTF8_CHARCLASS_SPACE(),
1645                 *s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, utf8_target),
1646                 isSPACE_L1((U8) *s)
1647             );
1648             break;
1649         case SPACE:
1650             REXEC_FBC_CSCAN_PRELOAD(
1651                 LOAD_UTF8_CHARCLASS_SPACE(),
1652                 *s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, utf8_target),
1653                 isSPACE((U8) *s)
1654             );
1655             break;
1656         case SPACEA:
1657             /* Don't need to worry about utf8, as it can match only a single
1658              * byte invariant character */
1659             REXEC_FBC_CLASS_SCAN( isSPACE_A(*s));
1660             break;
1661         case SPACEL:
1662             REXEC_FBC_CSCAN_TAINT(
1663                 isSPACE_LC_utf8((U8*)s),
1664                 isSPACE_LC(*s)
1665             );
1666             break;
1667         case NSPACEU:
1668             REXEC_FBC_CSCAN_PRELOAD(
1669                 LOAD_UTF8_CHARCLASS_SPACE(),
1670                 !( *s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, utf8_target)),
1671                 ! isSPACE_L1((U8) *s)
1672             );
1673             break;
1674         case NSPACE:
1675             REXEC_FBC_CSCAN_PRELOAD(
1676                 LOAD_UTF8_CHARCLASS_SPACE(),
1677                 !(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, utf8_target)),
1678                 ! isSPACE((U8) *s)
1679             );
1680             break;
1681         case NSPACEA:
1682             REXEC_FBC_CSCAN(
1683                 !isSPACE_A(*s),
1684                 !isSPACE_A(*s)
1685             );
1686             break;
1687         case NSPACEL:
1688             REXEC_FBC_CSCAN_TAINT(
1689                 !isSPACE_LC_utf8((U8*)s),
1690                 !isSPACE_LC(*s)
1691             );
1692             break;
1693         case DIGIT:
1694             REXEC_FBC_CSCAN_PRELOAD(
1695                 LOAD_UTF8_CHARCLASS_DIGIT(),
1696                 swash_fetch(PL_utf8_digit,(U8*)s, utf8_target),
1697                 isDIGIT(*s)
1698             );
1699             break;
1700         case DIGITA:
1701             /* Don't need to worry about utf8, as it can match only a single
1702              * byte invariant character */
1703             REXEC_FBC_CLASS_SCAN( isDIGIT_A(*s));
1704             break;
1705         case DIGITL:
1706             REXEC_FBC_CSCAN_TAINT(
1707                 isDIGIT_LC_utf8((U8*)s),
1708                 isDIGIT_LC(*s)
1709             );
1710             break;
1711         case NDIGIT:
1712             REXEC_FBC_CSCAN_PRELOAD(
1713                 LOAD_UTF8_CHARCLASS_DIGIT(),
1714                 !swash_fetch(PL_utf8_digit,(U8*)s, utf8_target),
1715                 !isDIGIT(*s)
1716             );
1717             break;
1718         case NDIGITA:
1719             REXEC_FBC_CSCAN(
1720                 !isDIGIT_A(*s),
1721                 !isDIGIT_A(*s)
1722             );
1723             break;
1724         case NDIGITL:
1725             REXEC_FBC_CSCAN_TAINT(
1726                 !isDIGIT_LC_utf8((U8*)s),
1727                 !isDIGIT_LC(*s)
1728             );
1729             break;
1730         case LNBREAK:
1731             REXEC_FBC_CSCAN(
1732                 is_LNBREAK_utf8(s),
1733                 is_LNBREAK_latin1(s)
1734             );
1735             break;
1736         case VERTWS:
1737             REXEC_FBC_CSCAN(
1738                 is_VERTWS_utf8(s),
1739                 is_VERTWS_latin1(s)
1740             );
1741             break;
1742         case NVERTWS:
1743             REXEC_FBC_CSCAN(
1744                 !is_VERTWS_utf8(s),
1745                 !is_VERTWS_latin1(s)
1746             );
1747             break;
1748         case HORIZWS:
1749             REXEC_FBC_CSCAN(
1750                 is_HORIZWS_utf8(s),
1751                 is_HORIZWS_latin1(s)
1752             );
1753             break;
1754         case NHORIZWS:
1755             REXEC_FBC_CSCAN(
1756                 !is_HORIZWS_utf8(s),
1757                 !is_HORIZWS_latin1(s)
1758             );
1759             break;
1760         case AHOCORASICKC:
1761         case AHOCORASICK:
1762             {
1763                 DECL_TRIE_TYPE(c);
1764                 /* what trie are we using right now */
1765                 reg_ac_data *aho
1766                     = (reg_ac_data*)progi->data->data[ ARG( c ) ];
1767                 reg_trie_data *trie
1768                     = (reg_trie_data*)progi->data->data[ aho->trie ];
1769                 HV *widecharmap = MUTABLE_HV(progi->data->data[ aho->trie + 1 ]);
1770
1771                 const char *last_start = strend - trie->minlen;
1772 #ifdef DEBUGGING
1773                 const char *real_start = s;
1774 #endif
1775                 STRLEN maxlen = trie->maxlen;
1776                 SV *sv_points;
1777                 U8 **points; /* map of where we were in the input string
1778                                 when reading a given char. For ASCII this
1779                                 is unnecessary overhead as the relationship
1780                                 is always 1:1, but for Unicode, especially
1781                                 case folded Unicode this is not true. */
1782                 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
1783                 U8 *bitmap=NULL;
1784
1785
1786                 GET_RE_DEBUG_FLAGS_DECL;
1787
1788                 /* We can't just allocate points here. We need to wrap it in
1789                  * an SV so it gets freed properly if there is a croak while
1790                  * running the match */
1791                 ENTER;
1792                 SAVETMPS;
1793                 sv_points=newSV(maxlen * sizeof(U8 *));
1794                 SvCUR_set(sv_points,
1795                     maxlen * sizeof(U8 *));
1796                 SvPOK_on(sv_points);
1797                 sv_2mortal(sv_points);
1798                 points=(U8**)SvPV_nolen(sv_points );
1799                 if ( trie_type != trie_utf8_fold
1800                      && (trie->bitmap || OP(c)==AHOCORASICKC) )
1801                 {
1802                     if (trie->bitmap)
1803                         bitmap=(U8*)trie->bitmap;
1804                     else
1805                         bitmap=(U8*)ANYOF_BITMAP(c);
1806                 }
1807                 /* this is the Aho-Corasick algorithm modified a touch
1808                    to include special handling for long "unknown char"
1809                    sequences. The basic idea being that we use AC as long
1810                    as we are dealing with a possible matching char, when
1811                    we encounter an unknown char (and we have not encountered
1812                    an accepting state) we scan forward until we find a legal
1813                    starting char.
1814                    AC matching is basically that of trie matching, except
1815                    that when we encounter a failing transition, we fall back
1816                    to the current states "fail state", and try the current char
1817                    again, a process we repeat until we reach the root state,
1818                    state 1, or a legal transition. If we fail on the root state
1819                    then we can either terminate if we have reached an accepting
1820                    state previously, or restart the entire process from the beginning
1821                    if we have not.
1822
1823                  */
1824                 while (s <= last_start) {
1825                     const U32 uniflags = UTF8_ALLOW_DEFAULT;
1826                     U8 *uc = (U8*)s;
1827                     U16 charid = 0;
1828                     U32 base = 1;
1829                     U32 state = 1;
1830                     UV uvc = 0;
1831                     STRLEN len = 0;
1832                     STRLEN foldlen = 0;
1833                     U8 *uscan = (U8*)NULL;
1834                     U8 *leftmost = NULL;
1835 #ifdef DEBUGGING
1836                     U32 accepted_word= 0;
1837 #endif
1838                     U32 pointpos = 0;
1839
1840                     while ( state && uc <= (U8*)strend ) {
1841                         int failed=0;
1842                         U32 word = aho->states[ state ].wordnum;
1843
1844                         if( state==1 ) {
1845                             if ( bitmap ) {
1846                                 DEBUG_TRIE_EXECUTE_r(
1847                                     if ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
1848                                         dump_exec_pos( (char *)uc, c, strend, real_start,
1849                                             (char *)uc, utf8_target );
1850                                         PerlIO_printf( Perl_debug_log,
1851                                             " Scanning for legal start char...\n");
1852                                     }
1853                                 );
1854                                 if (utf8_target) {
1855                                     while ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
1856                                         uc += UTF8SKIP(uc);
1857                                     }
1858                                 } else {
1859                                     while ( uc <= (U8*)last_start  && !BITMAP_TEST(bitmap,*uc) ) {
1860                                         uc++;
1861                                     }
1862                                 }
1863                                 s= (char *)uc;
1864                             }
1865                             if (uc >(U8*)last_start) break;
1866                         }
1867
1868                         if ( word ) {
1869                             U8 *lpos= points[ (pointpos - trie->wordinfo[word].len) % maxlen ];
1870                             if (!leftmost || lpos < leftmost) {
1871                                 DEBUG_r(accepted_word=word);
1872                                 leftmost= lpos;
1873                             }
1874                             if (base==0) break;
1875
1876                         }
1877                         points[pointpos++ % maxlen]= uc;
1878                         REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc,
1879                                              uscan, len, uvc, charid, foldlen,
1880                                              foldbuf, uniflags);
1881                         DEBUG_TRIE_EXECUTE_r({
1882                             dump_exec_pos( (char *)uc, c, strend, real_start,
1883                                 s,   utf8_target );
1884                             PerlIO_printf(Perl_debug_log,
1885                                 " Charid:%3u CP:%4"UVxf" ",
1886                                  charid, uvc);
1887                         });
1888
1889                         do {
1890 #ifdef DEBUGGING
1891                             word = aho->states[ state ].wordnum;
1892 #endif
1893                             base = aho->states[ state ].trans.base;
1894
1895                             DEBUG_TRIE_EXECUTE_r({
1896                                 if (failed)
1897                                     dump_exec_pos( (char *)uc, c, strend, real_start,
1898                                         s,   utf8_target );
1899                                 PerlIO_printf( Perl_debug_log,
1900                                     "%sState: %4"UVxf", word=%"UVxf,
1901                                     failed ? " Fail transition to " : "",
1902                                     (UV)state, (UV)word);
1903                             });
1904                             if ( base ) {
1905                                 U32 tmp;
1906                                 I32 offset;
1907                                 if (charid &&
1908                                      ( ((offset = base + charid
1909                                         - 1 - trie->uniquecharcount)) >= 0)
1910                                      && ((U32)offset < trie->lasttrans)
1911                                      && trie->trans[offset].check == state
1912                                      && (tmp=trie->trans[offset].next))
1913                                 {
1914                                     DEBUG_TRIE_EXECUTE_r(
1915                                         PerlIO_printf( Perl_debug_log," - legal\n"));
1916                                     state = tmp;
1917                                     break;
1918                                 }
1919                                 else {
1920                                     DEBUG_TRIE_EXECUTE_r(
1921                                         PerlIO_printf( Perl_debug_log," - fail\n"));
1922                                     failed = 1;
1923                                     state = aho->fail[state];
1924                                 }
1925                             }
1926                             else {
1927                                 /* we must be accepting here */
1928                                 DEBUG_TRIE_EXECUTE_r(
1929                                         PerlIO_printf( Perl_debug_log," - accepting\n"));
1930                                 failed = 1;
1931                                 break;
1932                             }
1933                         } while(state);
1934                         uc += len;
1935                         if (failed) {
1936                             if (leftmost)
1937                                 break;
1938                             if (!state) state = 1;
1939                         }
1940                     }
1941                     if ( aho->states[ state ].wordnum ) {
1942                         U8 *lpos = points[ (pointpos - trie->wordinfo[aho->states[ state ].wordnum].len) % maxlen ];
1943                         if (!leftmost || lpos < leftmost) {
1944                             DEBUG_r(accepted_word=aho->states[ state ].wordnum);
1945                             leftmost = lpos;
1946                         }
1947                     }
1948                     if (leftmost) {
1949                         s = (char*)leftmost;
1950                         DEBUG_TRIE_EXECUTE_r({
1951                             PerlIO_printf(
1952                                 Perl_debug_log,"Matches word #%"UVxf" at position %"IVdf". Trying full pattern...\n",
1953                                 (UV)accepted_word, (IV)(s - real_start)
1954                             );
1955                         });
1956                         if (!reginfo || regtry(reginfo, &s)) {
1957                             FREETMPS;
1958                             LEAVE;
1959                             goto got_it;
1960                         }
1961                         s = HOPc(s,1);
1962                         DEBUG_TRIE_EXECUTE_r({
1963                             PerlIO_printf( Perl_debug_log,"Pattern failed. Looking for new start point...\n");
1964                         });
1965                     } else {
1966                         DEBUG_TRIE_EXECUTE_r(
1967                             PerlIO_printf( Perl_debug_log,"No match.\n"));
1968                         break;
1969                     }
1970                 }
1971                 FREETMPS;
1972                 LEAVE;
1973             }
1974             break;
1975         default:
1976             Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
1977             break;
1978         }
1979         return 0;
1980       got_it:
1981         return s;
1982 }
1983
1984
1985 /*
1986  - regexec_flags - match a regexp against a string
1987  */
1988 I32
1989 Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *strend,
1990               char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
1991 /* strend: pointer to null at end of string */
1992 /* strbeg: real beginning of string */
1993 /* minend: end of match must be >=minend after stringarg. */
1994 /* data: May be used for some additional optimizations.
1995          Currently its only used, with a U32 cast, for transmitting
1996          the ganch offset when doing a /g match. This will change */
1997 /* nosave: For optimizations. */
1998 {
1999     dVAR;
2000     struct regexp *const prog = (struct regexp *)SvANY(rx);
2001     /*register*/ char *s;
2002     register regnode *c;
2003     /*register*/ char *startpos = stringarg;
2004     I32 minlen;         /* must match at least this many chars */
2005     I32 dontbother = 0; /* how many characters not to try at end */
2006     I32 end_shift = 0;                  /* Same for the end. */         /* CC */
2007     I32 scream_pos = -1;                /* Internal iterator of scream. */
2008     char *scream_olds = NULL;
2009     const bool utf8_target = cBOOL(DO_UTF8(sv));
2010     I32 multiline;
2011     RXi_GET_DECL(prog,progi);
2012     regmatch_info reginfo;  /* create some info to pass to regtry etc */
2013     regexp_paren_pair *swap = NULL;
2014     GET_RE_DEBUG_FLAGS_DECL;
2015
2016     PERL_ARGS_ASSERT_REGEXEC_FLAGS;
2017     PERL_UNUSED_ARG(data);
2018
2019     /* Be paranoid... */
2020     if (prog == NULL || startpos == NULL) {
2021         Perl_croak(aTHX_ "NULL regexp parameter");
2022         return 0;
2023     }
2024
2025     multiline = prog->extflags & RXf_PMf_MULTILINE;
2026     reginfo.prog = rx;   /* Yes, sorry that this is confusing.  */
2027
2028     RX_MATCH_UTF8_set(rx, utf8_target);
2029     DEBUG_EXECUTE_r(
2030         debug_start_match(rx, utf8_target, startpos, strend,
2031         "Matching");
2032     );
2033
2034     minlen = prog->minlen;
2035
2036     if (strend - startpos < (minlen+(prog->check_offset_min<0?prog->check_offset_min:0))) {
2037         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
2038                               "String too short [regexec_flags]...\n"));
2039         goto phooey;
2040     }
2041
2042
2043     /* Check validity of program. */
2044     if (UCHARAT(progi->program) != REG_MAGIC) {
2045         Perl_croak(aTHX_ "corrupted regexp program");
2046     }
2047
2048     PL_reg_flags = 0;
2049     PL_reg_eval_set = 0;
2050     PL_reg_maxiter = 0;
2051
2052     if (RX_UTF8(rx))
2053         PL_reg_flags |= RF_utf8;
2054
2055     /* Mark beginning of line for ^ and lookbehind. */
2056     reginfo.bol = startpos; /* XXX not used ??? */
2057     PL_bostr  = strbeg;
2058     reginfo.sv = sv;
2059
2060     /* Mark end of line for $ (and such) */
2061     PL_regeol = strend;
2062
2063     /* see how far we have to get to not match where we matched before */
2064     reginfo.till = startpos+minend;
2065
2066     /* If there is a "must appear" string, look for it. */
2067     s = startpos;
2068
2069     if (prog->extflags & RXf_GPOS_SEEN) { /* Need to set reginfo->ganch */
2070         MAGIC *mg;
2071         if (flags & REXEC_IGNOREPOS){   /* Means: check only at start */
2072             reginfo.ganch = startpos + prog->gofs;
2073             DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
2074               "GPOS IGNOREPOS: reginfo.ganch = startpos + %"UVxf"\n",(UV)prog->gofs));
2075         } else if (sv && SvTYPE(sv) >= SVt_PVMG
2076                   && SvMAGIC(sv)
2077                   && (mg = mg_find(sv, PERL_MAGIC_regex_global))
2078                   && mg->mg_len >= 0) {
2079             reginfo.ganch = strbeg + mg->mg_len;        /* Defined pos() */
2080             DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
2081                 "GPOS MAGIC: reginfo.ganch = strbeg + %"IVdf"\n",(IV)mg->mg_len));
2082
2083             if (prog->extflags & RXf_ANCH_GPOS) {
2084                 if (s > reginfo.ganch)
2085                     goto phooey;
2086                 s = reginfo.ganch - prog->gofs;
2087                 DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
2088                      "GPOS ANCH_GPOS: s = ganch - %"UVxf"\n",(UV)prog->gofs));
2089                 if (s < strbeg)
2090                     goto phooey;
2091             }
2092         }
2093         else if (data) {
2094             reginfo.ganch = strbeg + PTR2UV(data);
2095             DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
2096                  "GPOS DATA: reginfo.ganch= strbeg + %"UVxf"\n",PTR2UV(data)));
2097
2098         } else {                                /* pos() not defined */
2099             reginfo.ganch = strbeg;
2100             DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
2101                  "GPOS: reginfo.ganch = strbeg\n"));
2102         }
2103     }
2104     if (PL_curpm && (PM_GETRE(PL_curpm) == rx)) {
2105         /* We have to be careful. If the previous successful match
2106            was from this regex we don't want a subsequent partially
2107            successful match to clobber the old results.
2108            So when we detect this possibility we add a swap buffer
2109            to the re, and switch the buffer each match. If we fail
2110            we switch it back, otherwise we leave it swapped.
2111         */
2112         swap = prog->offs;
2113         /* do we need a save destructor here for eval dies? */
2114         Newxz(prog->offs, (prog->nparens + 1), regexp_paren_pair);
2115     }
2116     if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) {
2117         re_scream_pos_data d;
2118
2119         d.scream_olds = &scream_olds;
2120         d.scream_pos = &scream_pos;
2121         s = re_intuit_start(rx, sv, s, strend, flags, &d);
2122         if (!s) {
2123             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
2124             goto phooey;        /* not present */
2125         }
2126     }
2127
2128
2129
2130     /* Simplest case:  anchored match need be tried only once. */
2131     /*  [unless only anchor is BOL and multiline is set] */
2132     if (prog->extflags & (RXf_ANCH & ~RXf_ANCH_GPOS)) {
2133         if (s == startpos && regtry(&reginfo, &startpos))
2134             goto got_it;
2135         else if (multiline || (prog->intflags & PREGf_IMPLICIT)
2136                  || (prog->extflags & RXf_ANCH_MBOL)) /* XXXX SBOL? */
2137         {
2138             char *end;
2139
2140             if (minlen)
2141                 dontbother = minlen - 1;
2142             end = HOP3c(strend, -dontbother, strbeg) - 1;
2143             /* for multiline we only have to try after newlines */
2144             if (prog->check_substr || prog->check_utf8) {
2145                 /* because of the goto we can not easily reuse the macros for bifurcating the
2146                    unicode/non-unicode match modes here like we do elsewhere - demerphq */
2147                 if (utf8_target) {
2148                     if (s == startpos)
2149                         goto after_try_utf8;
2150                     while (1) {
2151                         if (regtry(&reginfo, &s)) {
2152                             goto got_it;
2153                         }
2154                       after_try_utf8:
2155                         if (s > end) {
2156                             goto phooey;
2157                         }
2158                         if (prog->extflags & RXf_USE_INTUIT) {
2159                             s = re_intuit_start(rx, sv, s + UTF8SKIP(s), strend, flags, NULL);
2160                             if (!s) {
2161                                 goto phooey;
2162                             }
2163                         }
2164                         else {
2165                             s += UTF8SKIP(s);
2166                         }
2167                     }
2168                 } /* end search for check string in unicode */
2169                 else {
2170                     if (s == startpos) {
2171                         goto after_try_latin;
2172                     }
2173                     while (1) {
2174                         if (regtry(&reginfo, &s)) {
2175                             goto got_it;
2176                         }
2177                       after_try_latin:
2178                         if (s > end) {
2179                             goto phooey;
2180                         }
2181                         if (prog->extflags & RXf_USE_INTUIT) {
2182                             s = re_intuit_start(rx, sv, s + 1, strend, flags, NULL);
2183                             if (!s) {
2184                                 goto phooey;
2185                             }
2186                         }
2187                         else {
2188                             s++;
2189                         }
2190                     }
2191                 } /* end search for check string in latin*/
2192             } /* end search for check string */
2193             else { /* search for newline */
2194                 if (s > startpos) {
2195                     /*XXX: The s-- is almost definitely wrong here under unicode - demeprhq*/
2196                     s--;
2197                 }
2198                 /* We can use a more efficient search as newlines are the same in unicode as they are in latin */
2199                 while (s < end) {
2200                     if (*s++ == '\n') { /* don't need PL_utf8skip here */
2201                         if (regtry(&reginfo, &s))
2202                             goto got_it;
2203                     }
2204                 }
2205             } /* end search for newline */
2206         } /* end anchored/multiline check string search */
2207         goto phooey;
2208     } else if (RXf_GPOS_CHECK == (prog->extflags & RXf_GPOS_CHECK))
2209     {
2210         /* the warning about reginfo.ganch being used without initialization
2211            is bogus -- we set it above, when prog->extflags & RXf_GPOS_SEEN
2212            and we only enter this block when the same bit is set. */
2213         char *tmp_s = reginfo.ganch - prog->gofs;
2214
2215         if (tmp_s >= strbeg && regtry(&reginfo, &tmp_s))
2216             goto got_it;
2217         goto phooey;
2218     }
2219
2220     /* Messy cases:  unanchored match. */
2221     if ((prog->anchored_substr || prog->anchored_utf8) && prog->intflags & PREGf_SKIP) {
2222         /* we have /x+whatever/ */
2223         /* it must be a one character string (XXXX Except UTF_PATTERN?) */
2224         char ch;
2225 #ifdef DEBUGGING
2226         int did_match = 0;
2227 #endif
2228         if (!(utf8_target ? prog->anchored_utf8 : prog->anchored_substr))
2229             utf8_target ? to_utf8_substr(prog) : to_byte_substr(prog);
2230         ch = SvPVX_const(utf8_target ? prog->anchored_utf8 : prog->anchored_substr)[0];
2231
2232         if (utf8_target) {
2233             REXEC_FBC_SCAN(
2234                 if (*s == ch) {
2235                     DEBUG_EXECUTE_r( did_match = 1 );
2236                     if (regtry(&reginfo, &s)) goto got_it;
2237                     s += UTF8SKIP(s);
2238                     while (s < strend && *s == ch)
2239                         s += UTF8SKIP(s);
2240                 }
2241             );
2242         }
2243         else {
2244             REXEC_FBC_SCAN(
2245                 if (*s == ch) {
2246                     DEBUG_EXECUTE_r( did_match = 1 );
2247                     if (regtry(&reginfo, &s)) goto got_it;
2248                     s++;
2249                     while (s < strend && *s == ch)
2250                         s++;
2251                 }
2252             );
2253         }
2254         DEBUG_EXECUTE_r(if (!did_match)
2255                 PerlIO_printf(Perl_debug_log,
2256                                   "Did not find anchored character...\n")
2257                );
2258     }
2259     else if (prog->anchored_substr != NULL
2260               || prog->anchored_utf8 != NULL
2261               || ((prog->float_substr != NULL || prog->float_utf8 != NULL)
2262                   && prog->float_max_offset < strend - s)) {
2263         SV *must;
2264         I32 back_max;
2265         I32 back_min;
2266         char *last;
2267         char *last1;            /* Last position checked before */
2268 #ifdef DEBUGGING
2269         int did_match = 0;
2270 #endif
2271         if (prog->anchored_substr || prog->anchored_utf8) {
2272             if (!(utf8_target ? prog->anchored_utf8 : prog->anchored_substr))
2273                 utf8_target ? to_utf8_substr(prog) : to_byte_substr(prog);
2274             must = utf8_target ? prog->anchored_utf8 : prog->anchored_substr;
2275             back_max = back_min = prog->anchored_offset;
2276         } else {
2277             if (!(utf8_target ? prog->float_utf8 : prog->float_substr))
2278                 utf8_target ? to_utf8_substr(prog) : to_byte_substr(prog);
2279             must = utf8_target ? prog->float_utf8 : prog->float_substr;
2280             back_max = prog->float_max_offset;
2281             back_min = prog->float_min_offset;
2282         }
2283
2284
2285         if (must == &PL_sv_undef)
2286             /* could not downgrade utf8 check substring, so must fail */
2287             goto phooey;
2288
2289         if (back_min<0) {
2290             last = strend;
2291         } else {
2292             last = HOP3c(strend,        /* Cannot start after this */
2293                   -(I32)(CHR_SVLEN(must)
2294                          - (SvTAIL(must) != 0) + back_min), strbeg);
2295         }
2296         if (s > PL_bostr)
2297             last1 = HOPc(s, -1);
2298         else
2299             last1 = s - 1;      /* bogus */
2300
2301         /* XXXX check_substr already used to find "s", can optimize if
2302            check_substr==must. */
2303         scream_pos = -1;
2304         dontbother = end_shift;
2305         strend = HOPc(strend, -dontbother);
2306         while ( (s <= last) &&
2307                 ((flags & REXEC_SCREAM) && SvSCREAM(sv)
2308                  ? (s = screaminstr(sv, must, HOP3c(s, back_min, (back_min<0 ? strbeg : strend)) - strbeg,
2309                                     end_shift, &scream_pos, 0))
2310                  : (s = fbm_instr((unsigned char*)HOP3(s, back_min, (back_min<0 ? strbeg : strend)),
2311                                   (unsigned char*)strend, must,
2312                                   multiline ? FBMrf_MULTILINE : 0))) ) {
2313             /* we may be pointing at the wrong string */
2314             if ((flags & REXEC_SCREAM) && RXp_MATCH_COPIED(prog))
2315                 s = strbeg + (s - SvPVX_const(sv));
2316             DEBUG_EXECUTE_r( did_match = 1 );
2317             if (HOPc(s, -back_max) > last1) {
2318                 last1 = HOPc(s, -back_min);
2319                 s = HOPc(s, -back_max);
2320             }
2321             else {
2322                 char * const t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
2323
2324                 last1 = HOPc(s, -back_min);
2325                 s = t;
2326             }
2327             if (utf8_target) {
2328                 while (s <= last1) {
2329                     if (regtry(&reginfo, &s))
2330                         goto got_it;
2331                     s += UTF8SKIP(s);
2332                 }
2333             }
2334             else {
2335                 while (s <= last1) {
2336                     if (regtry(&reginfo, &s))
2337                         goto got_it;
2338                     s++;
2339                 }
2340             }
2341         }
2342         DEBUG_EXECUTE_r(if (!did_match) {
2343             RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0),
2344                 SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
2345             PerlIO_printf(Perl_debug_log, "Did not find %s substr %s%s...\n",
2346                               ((must == prog->anchored_substr || must == prog->anchored_utf8)
2347                                ? "anchored" : "floating"),
2348                 quoted, RE_SV_TAIL(must));
2349         });
2350         goto phooey;
2351     }
2352     else if ( (c = progi->regstclass) ) {
2353         if (minlen) {
2354             const OPCODE op = OP(progi->regstclass);
2355             /* don't bother with what can't match */
2356             if (PL_regkind[op] != EXACT && op != CANY && PL_regkind[op] != TRIE)
2357                 strend = HOPc(strend, -(minlen - 1));
2358         }
2359         DEBUG_EXECUTE_r({
2360             SV * const prop = sv_newmortal();
2361             regprop(prog, prop, c);
2362             {
2363                 RE_PV_QUOTED_DECL(quoted,utf8_target,PERL_DEBUG_PAD_ZERO(1),
2364                     s,strend-s,60);
2365                 PerlIO_printf(Perl_debug_log,
2366                     "Matching stclass %.*s against %s (%d bytes)\n",
2367                     (int)SvCUR(prop), SvPVX_const(prop),
2368                      quoted, (int)(strend - s));
2369             }
2370         });
2371         if (find_byclass(prog, c, s, strend, &reginfo))
2372             goto got_it;
2373         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass... [regexec_flags]\n"));
2374     }
2375     else {
2376         dontbother = 0;
2377         if (prog->float_substr != NULL || prog->float_utf8 != NULL) {
2378             /* Trim the end. */
2379             char *last;
2380             SV* float_real;
2381
2382             if (!(utf8_target ? prog->float_utf8 : prog->float_substr))
2383                 utf8_target ? to_utf8_substr(prog) : to_byte_substr(prog);
2384             float_real = utf8_target ? prog->float_utf8 : prog->float_substr;
2385
2386             if ((flags & REXEC_SCREAM) && SvSCREAM(sv)) {
2387                 last = screaminstr(sv, float_real, s - strbeg,
2388                                    end_shift, &scream_pos, 1); /* last one */
2389                 if (!last)
2390                     last = scream_olds; /* Only one occurrence. */
2391                 /* we may be pointing at the wrong string */
2392                 else if (RXp_MATCH_COPIED(prog))
2393                     s = strbeg + (s - SvPVX_const(sv));
2394             }
2395             else {
2396                 STRLEN len;
2397                 const char * const little = SvPV_const(float_real, len);
2398
2399                 if (SvTAIL(float_real)) {
2400                     if (memEQ(strend - len + 1, little, len - 1))
2401                         last = strend - len + 1;
2402                     else if (!multiline)
2403                         last = memEQ(strend - len, little, len)
2404                             ? strend - len : NULL;
2405                     else
2406                         goto find_last;
2407                 } else {
2408                   find_last:
2409                     if (len)
2410                         last = rninstr(s, strend, little, little + len);
2411                     else
2412                         last = strend;  /* matching "$" */
2413                 }
2414             }
2415             if (last == NULL) {
2416                 DEBUG_EXECUTE_r(
2417                     PerlIO_printf(Perl_debug_log,
2418                         "%sCan't trim the tail, match fails (should not happen)%s\n",
2419                         PL_colors[4], PL_colors[5]));
2420                 goto phooey; /* Should not happen! */
2421             }
2422             dontbother = strend - last + prog->float_min_offset;
2423         }
2424         if (minlen && (dontbother < minlen))
2425             dontbother = minlen - 1;
2426         strend -= dontbother;              /* this one's always in bytes! */
2427         /* We don't know much -- general case. */
2428         if (utf8_target) {
2429             for (;;) {
2430                 if (regtry(&reginfo, &s))
2431                     goto got_it;
2432                 if (s >= strend)
2433                     break;
2434                 s += UTF8SKIP(s);
2435             };
2436         }
2437         else {
2438             do {
2439                 if (regtry(&reginfo, &s))
2440                     goto got_it;
2441             } while (s++ < strend);
2442         }
2443     }
2444
2445     /* Failure. */
2446     goto phooey;
2447
2448 got_it:
2449     Safefree(swap);
2450     RX_MATCH_TAINTED_set(rx, PL_reg_flags & RF_tainted);
2451
2452     if (PL_reg_eval_set)
2453         restore_pos(aTHX_ prog);
2454     if (RXp_PAREN_NAMES(prog))
2455         (void)hv_iterinit(RXp_PAREN_NAMES(prog));
2456
2457     /* make sure $`, $&, $', and $digit will work later */
2458     if ( !(flags & REXEC_NOT_FIRST) ) {
2459         RX_MATCH_COPY_FREE(rx);
2460         if (flags & REXEC_COPY_STR) {
2461             const I32 i = PL_regeol - startpos + (stringarg - strbeg);
2462 #ifdef PERL_OLD_COPY_ON_WRITE
2463             if ((SvIsCOW(sv)
2464                  || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) {
2465                 if (DEBUG_C_TEST) {
2466                     PerlIO_printf(Perl_debug_log,
2467                                   "Copy on write: regexp capture, type %d\n",
2468                                   (int) SvTYPE(sv));
2469                 }
2470                 prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
2471                 prog->subbeg = (char *)SvPVX_const(prog->saved_copy);
2472                 assert (SvPOKp(prog->saved_copy));
2473             } else
2474 #endif
2475             {
2476                 RX_MATCH_COPIED_on(rx);
2477                 s = savepvn(strbeg, i);
2478                 prog->subbeg = s;
2479             }
2480             prog->sublen = i;
2481         }
2482         else {
2483             prog->subbeg = strbeg;
2484             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
2485         }
2486     }
2487
2488     return 1;
2489
2490 phooey:
2491     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
2492                           PL_colors[4], PL_colors[5]));
2493     if (PL_reg_eval_set)
2494         restore_pos(aTHX_ prog);
2495     if (swap) {
2496         /* we failed :-( roll it back */
2497         Safefree(prog->offs);
2498         prog->offs = swap;
2499     }
2500
2501     return 0;
2502 }
2503
2504
2505 /*
2506  - regtry - try match at specific point
2507  */
2508 STATIC I32                      /* 0 failure, 1 success */
2509 S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
2510 {
2511     dVAR;
2512     CHECKPOINT lastcp;
2513     REGEXP *const rx = reginfo->prog;
2514     regexp *const prog = (struct regexp *)SvANY(rx);
2515     RXi_GET_DECL(prog,progi);
2516     GET_RE_DEBUG_FLAGS_DECL;
2517
2518     PERL_ARGS_ASSERT_REGTRY;
2519
2520     reginfo->cutpoint=NULL;
2521
2522     if ((prog->extflags & RXf_EVAL_SEEN) && !PL_reg_eval_set) {
2523         MAGIC *mg;
2524
2525         PL_reg_eval_set = RS_init;
2526         DEBUG_EXECUTE_r(DEBUG_s(
2527             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %"IVdf"\n",
2528                           (IV)(PL_stack_sp - PL_stack_base));
2529             ));
2530         SAVESTACK_CXPOS();
2531         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
2532         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
2533         SAVETMPS;
2534         /* Apparently this is not needed, judging by wantarray. */
2535         /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
2536            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
2537
2538         if (reginfo->sv) {
2539             /* Make $_ available to executed code. */
2540             if (reginfo->sv != DEFSV) {
2541                 SAVE_DEFSV;
2542                 DEFSV_set(reginfo->sv);
2543             }
2544
2545             if (!(SvTYPE(reginfo->sv) >= SVt_PVMG && SvMAGIC(reginfo->sv)
2546                   && (mg = mg_find(reginfo->sv, PERL_MAGIC_regex_global)))) {
2547                 /* prepare for quick setting of pos */
2548 #ifdef PERL_OLD_COPY_ON_WRITE
2549                 if (SvIsCOW(reginfo->sv))
2550                     sv_force_normal_flags(reginfo->sv, 0);
2551 #endif
2552                 mg = sv_magicext(reginfo->sv, NULL, PERL_MAGIC_regex_global,
2553                                  &PL_vtbl_mglob, NULL, 0);
2554                 mg->mg_len = -1;
2555             }
2556             PL_reg_magic    = mg;
2557             PL_reg_oldpos   = mg->mg_len;
2558             SAVEDESTRUCTOR_X(restore_pos, prog);
2559         }
2560         if (!PL_reg_curpm) {
2561             Newxz(PL_reg_curpm, 1, PMOP);
2562 #ifdef USE_ITHREADS
2563             {
2564                 SV* const repointer = &PL_sv_undef;
2565                 /* this regexp is also owned by the new PL_reg_curpm, which
2566                    will try to free it.  */
2567                 av_push(PL_regex_padav, repointer);
2568                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
2569                 PL_regex_pad = AvARRAY(PL_regex_padav);
2570             }
2571 #endif
2572         }
2573 #ifdef USE_ITHREADS
2574         /* It seems that non-ithreads works both with and without this code.
2575            So for efficiency reasons it seems best not to have the code
2576            compiled when it is not needed.  */
2577         /* This is safe against NULLs: */
2578         ReREFCNT_dec(PM_GETRE(PL_reg_curpm));
2579         /* PM_reg_curpm owns a reference to this regexp.  */
2580         (void)ReREFCNT_inc(rx);
2581 #endif
2582         PM_SETRE(PL_reg_curpm, rx);
2583         PL_reg_oldcurpm = PL_curpm;
2584         PL_curpm = PL_reg_curpm;
2585         if (RXp_MATCH_COPIED(prog)) {
2586             /*  Here is a serious problem: we cannot rewrite subbeg,
2587                 since it may be needed if this match fails.  Thus
2588                 $` inside (?{}) could fail... */
2589             PL_reg_oldsaved = prog->subbeg;
2590             PL_reg_oldsavedlen = prog->sublen;
2591 #ifdef PERL_OLD_COPY_ON_WRITE
2592             PL_nrs = prog->saved_copy;
2593 #endif
2594             RXp_MATCH_COPIED_off(prog);
2595         }
2596         else
2597             PL_reg_oldsaved = NULL;
2598         prog->subbeg = PL_bostr;
2599         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
2600     }
2601     DEBUG_EXECUTE_r(PL_reg_starttry = *startpos);
2602     prog->offs[0].start = *startpos - PL_bostr;
2603     PL_reginput = *startpos;
2604     PL_reglastparen = &prog->lastparen;
2605     PL_reglastcloseparen = &prog->lastcloseparen;
2606     prog->lastparen = 0;
2607     prog->lastcloseparen = 0;
2608     PL_regsize = 0;
2609     PL_regoffs = prog->offs;
2610     if (PL_reg_start_tmpl <= prog->nparens) {
2611         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
2612         if(PL_reg_start_tmp)
2613             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2614         else
2615             Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2616     }
2617
2618     /* XXXX What this code is doing here?!!!  There should be no need
2619        to do this again and again, PL_reglastparen should take care of
2620        this!  --ilya*/
2621
2622     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
2623      * Actually, the code in regcppop() (which Ilya may be meaning by
2624      * PL_reglastparen), is not needed at all by the test suite
2625      * (op/regexp, op/pat, op/split), but that code is needed otherwise
2626      * this erroneously leaves $1 defined: "1" =~ /^(?:(\d)x)?\d$/
2627      * Meanwhile, this code *is* needed for the
2628      * above-mentioned test suite tests to succeed.  The common theme
2629      * on those tests seems to be returning null fields from matches.
2630      * --jhi updated by dapm */
2631 #if 1
2632     if (prog->nparens) {
2633         regexp_paren_pair *pp = PL_regoffs;
2634         register I32 i;
2635         for (i = prog->nparens; i > (I32)*PL_reglastparen; i--) {
2636             ++pp;
2637             pp->start = -1;
2638             pp->end = -1;
2639         }
2640     }
2641 #endif
2642     REGCP_SET(lastcp);
2643     if (regmatch(reginfo, progi->program + 1)) {
2644         PL_regoffs[0].end = PL_reginput - PL_bostr;
2645         return 1;
2646     }
2647     if (reginfo->cutpoint)
2648         *startpos= reginfo->cutpoint;
2649     REGCP_UNWIND(lastcp);
2650     return 0;
2651 }
2652
2653
2654 #define sayYES goto yes
2655 #define sayNO goto no
2656 #define sayNO_SILENT goto no_silent
2657
2658 /* we dont use STMT_START/END here because it leads to
2659    "unreachable code" warnings, which are bogus, but distracting. */
2660 #define CACHEsayNO \
2661     if (ST.cache_mask) \
2662        PL_reg_poscache[ST.cache_offset] |= ST.cache_mask; \
2663     sayNO
2664
2665 /* this is used to determine how far from the left messages like
2666    'failed...' are printed. It should be set such that messages
2667    are inline with the regop output that created them.
2668 */
2669 #define REPORT_CODE_OFF 32
2670
2671
2672 #define CHRTEST_UNINIT -1001 /* c1/c2 haven't been calculated yet */
2673 #define CHRTEST_VOID   -1000 /* the c1/c2 "next char" test should be skipped */
2674
2675 #define SLAB_FIRST(s) (&(s)->states[0])
2676 #define SLAB_LAST(s)  (&(s)->states[PERL_REGMATCH_SLAB_SLOTS-1])
2677
2678 /* grab a new slab and return the first slot in it */
2679
2680 STATIC regmatch_state *
2681 S_push_slab(pTHX)
2682 {
2683 #if PERL_VERSION < 9 && !defined(PERL_CORE)
2684     dMY_CXT;
2685 #endif
2686     regmatch_slab *s = PL_regmatch_slab->next;
2687     if (!s) {
2688         Newx(s, 1, regmatch_slab);
2689         s->prev = PL_regmatch_slab;
2690         s->next = NULL;
2691         PL_regmatch_slab->next = s;
2692     }
2693     PL_regmatch_slab = s;
2694     return SLAB_FIRST(s);
2695 }
2696
2697
2698 /* push a new state then goto it */
2699
2700 #define PUSH_STATE_GOTO(state, node) \
2701     scan = node; \
2702     st->resume_state = state; \
2703     goto push_state;
2704
2705 /* push a new state with success backtracking, then goto it */
2706
2707 #define PUSH_YES_STATE_GOTO(state, node) \
2708     scan = node; \
2709     st->resume_state = state; \
2710     goto push_yes_state;
2711
2712
2713
2714 /*
2715
2716 regmatch() - main matching routine
2717
2718 This is basically one big switch statement in a loop. We execute an op,
2719 set 'next' to point the next op, and continue. If we come to a point which
2720 we may need to backtrack to on failure such as (A|B|C), we push a
2721 backtrack state onto the backtrack stack. On failure, we pop the top
2722 state, and re-enter the loop at the state indicated. If there are no more
2723 states to pop, we return failure.
2724
2725 Sometimes we also need to backtrack on success; for example /A+/, where
2726 after successfully matching one A, we need to go back and try to
2727 match another one; similarly for lookahead assertions: if the assertion
2728 completes successfully, we backtrack to the state just before the assertion
2729 and then carry on.  In these cases, the pushed state is marked as
2730 'backtrack on success too'. This marking is in fact done by a chain of
2731 pointers, each pointing to the previous 'yes' state. On success, we pop to
2732 the nearest yes state, discarding any intermediate failure-only states.
2733 Sometimes a yes state is pushed just to force some cleanup code to be
2734 called at the end of a successful match or submatch; e.g. (??{$re}) uses
2735 it to free the inner regex.
2736
2737 Note that failure backtracking rewinds the cursor position, while
2738 success backtracking leaves it alone.
2739
2740 A pattern is complete when the END op is executed, while a subpattern
2741 such as (?=foo) is complete when the SUCCESS op is executed. Both of these
2742 ops trigger the "pop to last yes state if any, otherwise return true"
2743 behaviour.
2744
2745 A common convention in this function is to use A and B to refer to the two
2746 subpatterns (or to the first nodes thereof) in patterns like /A*B/: so A is
2747 the subpattern to be matched possibly multiple times, while B is the entire
2748 rest of the pattern. Variable and state names reflect this convention.
2749
2750 The states in the main switch are the union of ops and failure/success of
2751 substates associated with with that op.  For example, IFMATCH is the op
2752 that does lookahead assertions /(?=A)B/ and so the IFMATCH state means
2753 'execute IFMATCH'; while IFMATCH_A is a state saying that we have just
2754 successfully matched A and IFMATCH_A_fail is a state saying that we have
2755 just failed to match A. Resume states always come in pairs. The backtrack
2756 state we push is marked as 'IFMATCH_A', but when that is popped, we resume
2757 at IFMATCH_A or IFMATCH_A_fail, depending on whether we are backtracking
2758 on success or failure.
2759
2760 The struct that holds a backtracking state is actually a big union, with
2761 one variant for each major type of op. The variable st points to the
2762 top-most backtrack struct. To make the code clearer, within each
2763 block of code we #define ST to alias the relevant union.
2764
2765 Here's a concrete example of a (vastly oversimplified) IFMATCH
2766 implementation:
2767
2768     switch (state) {
2769     ....
2770
2771 #define ST st->u.ifmatch
2772
2773     case IFMATCH: // we are executing the IFMATCH op, (?=A)B
2774         ST.foo = ...; // some state we wish to save
2775         ...
2776         // push a yes backtrack state with a resume value of
2777         // IFMATCH_A/IFMATCH_A_fail, then continue execution at the
2778         // first node of A:
2779         PUSH_YES_STATE_GOTO(IFMATCH_A, A);
2780         // NOTREACHED
2781
2782     case IFMATCH_A: // we have successfully executed A; now continue with B
2783         next = B;
2784         bar = ST.foo; // do something with the preserved value
2785         break;
2786
2787     case IFMATCH_A_fail: // A failed, so the assertion failed
2788         ...;   // do some housekeeping, then ...
2789         sayNO; // propagate the failure
2790
2791 #undef ST
2792
2793     ...
2794     }
2795
2796 For any old-timers reading this who are familiar with the old recursive
2797 approach, the code above is equivalent to:
2798
2799     case IFMATCH: // we are executing the IFMATCH op, (?=A)B
2800     {
2801         int foo = ...
2802         ...
2803         if (regmatch(A)) {
2804             next = B;
2805             bar = foo;
2806             break;
2807         }
2808         ...;   // do some housekeeping, then ...
2809         sayNO; // propagate the failure
2810     }
2811
2812 The topmost backtrack state, pointed to by st, is usually free. If you
2813 want to claim it, populate any ST.foo fields in it with values you wish to
2814 save, then do one of
2815
2816         PUSH_STATE_GOTO(resume_state, node);
2817         PUSH_YES_STATE_GOTO(resume_state, node);
2818
2819 which sets that backtrack state's resume value to 'resume_state', pushes a
2820 new free entry to the top of the backtrack stack, then goes to 'node'.
2821 On backtracking, the free slot is popped, and the saved state becomes the
2822 new free state. An ST.foo field in this new top state can be temporarily
2823 accessed to retrieve values, but once the main loop is re-entered, it
2824 becomes available for reuse.
2825
2826 Note that the depth of the backtrack stack constantly increases during the
2827 left-to-right execution of the pattern, rather than going up and down with
2828 the pattern nesting. For example the stack is at its maximum at Z at the
2829 end of the pattern, rather than at X in the following:
2830
2831     /(((X)+)+)+....(Y)+....Z/
2832
2833 The only exceptions to this are lookahead/behind assertions and the cut,
2834 (?>A), which pop all the backtrack states associated with A before
2835 continuing.
2836
2837 Backtrack state structs are allocated in slabs of about 4K in size.
2838 PL_regmatch_state and st always point to the currently active state,
2839 and PL_regmatch_slab points to the slab currently containing
2840 PL_regmatch_state.  The first time regmatch() is called, the first slab is
2841 allocated, and is never freed until interpreter destruction. When the slab
2842 is full, a new one is allocated and chained to the end. At exit from
2843 regmatch(), slabs allocated since entry are freed.
2844
2845 */
2846
2847
2848 #define DEBUG_STATE_pp(pp)                                  \
2849     DEBUG_STATE_r({                                         \
2850         DUMP_EXEC_POS(locinput, scan, utf8_target);                 \
2851         PerlIO_printf(Perl_debug_log,                       \
2852             "    %*s"pp" %s%s%s%s%s\n",                     \
2853             depth*2, "",                                    \
2854             PL_reg_name[st->resume_state],                     \
2855             ((st==yes_state||st==mark_state) ? "[" : ""),   \
2856             ((st==yes_state) ? "Y" : ""),                   \
2857             ((st==mark_state) ? "M" : ""),                  \
2858             ((st==yes_state||st==mark_state) ? "]" : "")    \
2859         );                                                  \
2860     });
2861
2862
2863 #define REG_NODE_NUM(x) ((x) ? (int)((x)-prog) : -1)
2864
2865 #ifdef DEBUGGING
2866
2867 STATIC void
2868 S_debug_start_match(pTHX_ const REGEXP *prog, const bool utf8_target,
2869     const char *start, const char *end, const char *blurb)
2870 {
2871     const bool utf8_pat = RX_UTF8(prog) ? 1 : 0;
2872
2873     PERL_ARGS_ASSERT_DEBUG_START_MATCH;
2874
2875     if (!PL_colorset)
2876             reginitcolors();
2877     {
2878         RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0),
2879             RX_PRECOMP_const(prog), RX_PRELEN(prog), 60);
2880
2881         RE_PV_QUOTED_DECL(s1, utf8_target, PERL_DEBUG_PAD_ZERO(1),
2882             start, end - start, 60);
2883
2884         PerlIO_printf(Perl_debug_log,
2885             "%s%s REx%s %s against %s\n",
2886                        PL_colors[4], blurb, PL_colors[5], s0, s1);
2887
2888         if (utf8_target||utf8_pat)
2889             PerlIO_printf(Perl_debug_log, "UTF-8 %s%s%s...\n",
2890                 utf8_pat ? "pattern" : "",
2891                 utf8_pat && utf8_target ? " and " : "",
2892                 utf8_target ? "string" : ""
2893             );
2894     }
2895 }
2896
2897 STATIC void
2898 S_dump_exec_pos(pTHX_ const char *locinput,
2899                       const regnode *scan,
2900                       const char *loc_regeol,
2901                       const char *loc_bostr,
2902                       const char *loc_reg_starttry,
2903                       const bool utf8_target)
2904 {
2905     const int docolor = *PL_colors[0] || *PL_colors[2] || *PL_colors[4];
2906     const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
2907     int l = (loc_regeol - locinput) > taill ? taill : (loc_regeol - locinput);
2908     /* The part of the string before starttry has one color
2909        (pref0_len chars), between starttry and current
2910        position another one (pref_len - pref0_len chars),
2911        after the current position the third one.
2912        We assume that pref0_len <= pref_len, otherwise we
2913        decrease pref0_len.  */
2914     int pref_len = (locinput - loc_bostr) > (5 + taill) - l
2915         ? (5 + taill) - l : locinput - loc_bostr;
2916     int pref0_len;
2917
2918     PERL_ARGS_ASSERT_DUMP_EXEC_POS;
2919
2920     while (utf8_target && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
2921         pref_len++;
2922     pref0_len = pref_len  - (locinput - loc_reg_starttry);
2923     if (l + pref_len < (5 + taill) && l < loc_regeol - locinput)
2924         l = ( loc_regeol - locinput > (5 + taill) - pref_len
2925               ? (5 + taill) - pref_len : loc_regeol - locinput);
2926     while (utf8_target && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
2927         l--;
2928     if (pref0_len < 0)
2929         pref0_len = 0;
2930     if (pref0_len > pref_len)
2931         pref0_len = pref_len;
2932     {
2933         const int is_uni = (utf8_target && OP(scan) != CANY) ? 1 : 0;
2934
2935         RE_PV_COLOR_DECL(s0,len0,is_uni,PERL_DEBUG_PAD(0),
2936             (locinput - pref_len),pref0_len, 60, 4, 5);
2937
2938         RE_PV_COLOR_DECL(s1,len1,is_uni,PERL_DEBUG_PAD(1),
2939                     (locinput - pref_len + pref0_len),
2940                     pref_len - pref0_len, 60, 2, 3);
2941
2942         RE_PV_COLOR_DECL(s2,len2,is_uni,PERL_DEBUG_PAD(2),
2943                     locinput, loc_regeol - locinput, 10, 0, 1);
2944
2945         const STRLEN tlen=len0+len1+len2;
2946         PerlIO_printf(Perl_debug_log,
2947                     "%4"IVdf" <%.*s%.*s%s%.*s>%*s|",
2948                     (IV)(locinput - loc_bostr),
2949                     len0, s0,
2950                     len1, s1,
2951                     (docolor ? "" : "> <"),
2952                     len2, s2,
2953                     (int)(tlen > 19 ? 0 :  19 - tlen),
2954                     "");
2955     }
2956 }
2957
2958 #endif
2959
2960 /* reg_check_named_buff_matched()
2961  * Checks to see if a named buffer has matched. The data array of
2962  * buffer numbers corresponding to the buffer is expected to reside
2963  * in the regexp->data->data array in the slot stored in the ARG() of
2964  * node involved. Note that this routine doesn't actually care about the
2965  * name, that information is not preserved from compilation to execution.
2966  * Returns the index of the leftmost defined buffer with the given name
2967  * or 0 if non of the buffers matched.
2968  */
2969 STATIC I32
2970 S_reg_check_named_buff_matched(pTHX_ const regexp *rex, const regnode *scan)
2971 {
2972     I32 n;
2973     RXi_GET_DECL(rex,rexi);
2974     SV *sv_dat= MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
2975     I32 *nums=(I32*)SvPVX(sv_dat);
2976
2977     PERL_ARGS_ASSERT_REG_CHECK_NAMED_BUFF_MATCHED;
2978
2979     for ( n=0; n<SvIVX(sv_dat); n++ ) {
2980         if ((I32)*PL_reglastparen >= nums[n] &&
2981             PL_regoffs[nums[n]].end != -1)
2982         {
2983             return nums[n];
2984         }
2985     }
2986     return 0;
2987 }
2988
2989
2990 /* free all slabs above current one  - called during LEAVE_SCOPE */
2991
2992 STATIC void
2993 S_clear_backtrack_stack(pTHX_ void *p)
2994 {
2995     regmatch_slab *s = PL_regmatch_slab->next;
2996     PERL_UNUSED_ARG(p);
2997
2998     if (!s)
2999         return;
3000     PL_regmatch_slab->next = NULL;
3001     while (s) {
3002         regmatch_slab * const osl = s;
3003         s = s->next;
3004         Safefree(osl);
3005     }
3006 }
3007
3008
3009 #define SETREX(Re1,Re2) \
3010     if (PL_reg_eval_set) PM_SETRE((PL_reg_curpm), (Re2)); \
3011     Re1 = (Re2)
3012
3013 STATIC I32                      /* 0 failure, 1 success */
3014 S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
3015 {
3016 #if PERL_VERSION < 9 && !defined(PERL_CORE)
3017     dMY_CXT;
3018 #endif
3019     dVAR;
3020     register const bool utf8_target = PL_reg_match_utf8;
3021     const U32 uniflags = UTF8_ALLOW_DEFAULT;
3022     REGEXP *rex_sv = reginfo->prog;
3023     regexp *rex = (struct regexp *)SvANY(rex_sv);
3024     RXi_GET_DECL(rex,rexi);
3025     I32 oldsave;
3026     /* the current state. This is a cached copy of PL_regmatch_state */
3027     register regmatch_state *st;
3028     /* cache heavy used fields of st in registers */
3029     register regnode *scan;
3030     register regnode *next;
3031     register U32 n = 0; /* general value; init to avoid compiler warning */
3032     register I32 ln = 0; /* len or last;  init to avoid compiler warning */
3033     register char *locinput = PL_reginput;
3034     register I32 nextchr;   /* is always set to UCHARAT(locinput) */
3035
3036     bool result = 0;        /* return value of S_regmatch */
3037     int depth = 0;          /* depth of backtrack stack */
3038     U32 nochange_depth = 0; /* depth of GOSUB recursion with nochange */
3039     const U32 max_nochange_depth =
3040         (3 * rex->nparens > MAX_RECURSE_EVAL_NOCHANGE_DEPTH) ?
3041         3 * rex->nparens : MAX_RECURSE_EVAL_NOCHANGE_DEPTH;
3042     regmatch_state *yes_state = NULL; /* state to pop to on success of
3043                                                             subpattern */
3044     /* mark_state piggy backs on the yes_state logic so that when we unwind
3045        the stack on success we can update the mark_state as we go */
3046     regmatch_state *mark_state = NULL; /* last mark state we have seen */
3047     regmatch_state *cur_eval = NULL; /* most recent EVAL_AB state */
3048     struct regmatch_state  *cur_curlyx = NULL; /* most recent curlyx */
3049     U32 state_num;
3050     bool no_final = 0;      /* prevent failure from backtracking? */
3051     bool do_cutgroup = 0;   /* no_final only until next branch/trie entry */
3052     char *startpoint = PL_reginput;
3053     SV *popmark = NULL;     /* are we looking for a mark? */
3054     SV *sv_commit = NULL;   /* last mark name seen in failure */
3055     SV *sv_yes_mark = NULL; /* last mark name we have seen
3056                                during a successful match */
3057     U32 lastopen = 0;       /* last open we saw */
3058     bool has_cutgroup = RX_HAS_CUTGROUP(rex) ? 1 : 0;
3059     SV* const oreplsv = GvSV(PL_replgv);
3060     /* these three flags are set by various ops to signal information to
3061      * the very next op. They have a useful lifetime of exactly one loop
3062      * iteration, and are not preserved or restored by state pushes/pops
3063      */
3064     bool sw = 0;            /* the condition value in (?(cond)a|b) */
3065     bool minmod = 0;        /* the next "{n,m}" is a "{n,m}?" */
3066     int logical = 0;        /* the following EVAL is:
3067                                 0: (?{...})
3068                                 1: (?(?{...})X|Y)
3069                                 2: (??{...})
3070                                or the following IFMATCH/UNLESSM is:
3071                                 false: plain (?=foo)
3072                                 true:  used as a condition: (?(?=foo))
3073                             */
3074 #ifdef DEBUGGING
3075     GET_RE_DEBUG_FLAGS_DECL;
3076 #endif
3077
3078     PERL_ARGS_ASSERT_REGMATCH;
3079
3080     DEBUG_OPTIMISE_r( DEBUG_EXECUTE_r({
3081             PerlIO_printf(Perl_debug_log,"regmatch start\n");
3082     }));
3083     /* on first ever call to regmatch, allocate first slab */
3084     if (!PL_regmatch_slab) {
3085         Newx(PL_regmatch_slab, 1, regmatch_slab);
3086         PL_regmatch_slab->prev = NULL;
3087         PL_regmatch_slab->next = NULL;
3088         PL_regmatch_state = SLAB_FIRST(PL_regmatch_slab);
3089     }
3090
3091     oldsave = PL_savestack_ix;
3092     SAVEDESTRUCTOR_X(S_clear_backtrack_stack, NULL);
3093     SAVEVPTR(PL_regmatch_slab);
3094     SAVEVPTR(PL_regmatch_state);
3095
3096     /* grab next free state slot */
3097     st = ++PL_regmatch_state;
3098     if (st >  SLAB_LAST(PL_regmatch_slab))
3099         st = PL_regmatch_state = S_push_slab(aTHX);
3100
3101     /* Note that nextchr is a byte even in UTF */
3102     nextchr = UCHARAT(locinput);
3103     scan = prog;
3104     while (scan != NULL) {
3105
3106         DEBUG_EXECUTE_r( {
3107             SV * const prop = sv_newmortal();
3108             regnode *rnext=regnext(scan);
3109             DUMP_EXEC_POS( locinput, scan, utf8_target );
3110             regprop(rex, prop, scan);
3111
3112             PerlIO_printf(Perl_debug_log,
3113                     "%3"IVdf":%*s%s(%"IVdf")\n",
3114                     (IV)(scan - rexi->program), depth*2, "",
3115                     SvPVX_const(prop),
3116                     (PL_regkind[OP(scan)] == END || !rnext) ?
3117                         0 : (IV)(rnext - rexi->program));
3118         });
3119
3120         next = scan + NEXT_OFF(scan);
3121         if (next == scan)
3122             next = NULL;
3123         state_num = OP(scan);
3124
3125       reenter_switch:
3126
3127         assert(PL_reglastparen == &rex->lastparen);
3128         assert(PL_reglastcloseparen == &rex->lastcloseparen);
3129         assert(PL_regoffs == rex->offs);
3130
3131         switch (state_num) {
3132         case BOL:
3133             if (locinput == PL_bostr)
3134             {
3135                 /* reginfo->till = reginfo->bol; */
3136                 break;
3137             }
3138             sayNO;
3139         case MBOL:
3140             if (locinput == PL_bostr ||
3141                 ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n'))
3142             {
3143                 break;
3144             }
3145             sayNO;
3146         case SBOL:
3147             if (locinput == PL_bostr)
3148                 break;
3149             sayNO;
3150         case GPOS:
3151             if (locinput == reginfo->ganch)
3152                 break;
3153             sayNO;
3154
3155         case KEEPS:
3156             /* update the startpoint */
3157             st->u.keeper.val = PL_regoffs[0].start;
3158             PL_reginput = locinput;
3159             PL_regoffs[0].start = locinput - PL_bostr;
3160             PUSH_STATE_GOTO(KEEPS_next, next);
3161             /*NOT-REACHED*/
3162         case KEEPS_next_fail:
3163             /* rollback the start point change */
3164             PL_regoffs[0].start = st->u.keeper.val;
3165             sayNO_SILENT;
3166             /*NOT-REACHED*/
3167         case EOL:
3168                 goto seol;
3169         case MEOL:
3170             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
3171                 sayNO;
3172             break;
3173         case SEOL:
3174           seol:
3175             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
3176                 sayNO;
3177             if (PL_regeol - locinput > 1)
3178                 sayNO;
3179             break;
3180         case EOS:
3181             if (PL_regeol != locinput)
3182                 sayNO;
3183             break;
3184         case SANY:
3185             if (!nextchr && locinput >= PL_regeol)
3186                 sayNO;
3187             if (utf8_target) {
3188                 locinput += PL_utf8skip[nextchr];
3189                 if (locinput > PL_regeol)
3190                     sayNO;
3191                 nextchr = UCHARAT(locinput);
3192             }
3193             else
3194                 nextchr = UCHARAT(++locinput);
3195             break;
3196         case CANY:
3197             if (!nextchr && locinput >= PL_regeol)
3198                 sayNO;
3199             nextchr = UCHARAT(++locinput);
3200             break;
3201         case REG_ANY:
3202             if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
3203                 sayNO;
3204             if (utf8_target) {
3205                 locinput += PL_utf8skip[nextchr];
3206                 if (locinput > PL_regeol)
3207                     sayNO;
3208                 nextchr = UCHARAT(locinput);
3209             }
3210             else
3211                 nextchr = UCHARAT(++locinput);
3212             break;
3213
3214 #undef  ST
3215 #define ST st->u.trie
3216         case TRIEC:
3217             /* In this case the charclass data is available inline so
3218                we can fail fast without a lot of extra overhead.
3219              */
3220             if (scan->flags == EXACT || !utf8_target) {
3221                 if(!ANYOF_BITMAP_TEST(scan, *locinput)) {
3222                     DEBUG_EXECUTE_r(
3223                         PerlIO_printf(Perl_debug_log,
3224                                   "%*s  %sfailed to match trie start class...%s\n",
3225                                   REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
3226                     );
3227                     sayNO_SILENT;
3228                     /* NOTREACHED */
3229                 }
3230             }
3231             /* FALL THROUGH */
3232         case TRIE:
3233             /* the basic plan of execution of the trie is:
3234              * At the beginning, run though all the states, and
3235              * find the longest-matching word. Also remember the position
3236              * of the shortest matching word. For example, this pattern:
3237              *    1  2 3 4    5
3238              *    ab|a|x|abcd|abc
3239              * when matched against the string "abcde", will generate
3240              * accept states for all words except 3, with the longest
3241              * matching word being 4, and the shortest being 1 (with
3242              * the position being after char 1 of the string).
3243              *
3244              * Then for each matching word, in word order (i.e. 1,2,4,5),
3245              * we run the remainder of the pattern; on each try setting
3246              * the current position to the character following the word,
3247              * returning to try the next word on failure.
3248              *
3249              * We avoid having to build a list of words at runtime by
3250              * using a compile-time structure, wordinfo[].prev, which
3251              * gives, for each word, the previous accepting word (if any).
3252              * In the case above it would contain the mappings 1->2, 2->0,
3253              * 3->0, 4->5, 5->1.  We can use this table to generate, from
3254              * the longest word (4 above), a list of all words, by
3255              * following the list of prev pointers; this gives us the
3256              * unordered list 4,5,1,2. Then given the current word we have
3257              * just tried, we can go through the list and find the
3258              * next-biggest word to try (so if we just failed on word 2,
3259              * the next in the list is 4).
3260              *
3261              * Since at runtime we don't record the matching position in
3262              * the string for each word, we have to work that out for
3263              * each word we're about to process. The wordinfo table holds
3264              * the character length of each word; given that we recorded
3265              * at the start: the position of the shortest word and its
3266              * length in chars, we just need to move the pointer the
3267              * difference between the two char lengths. Depending on
3268              * Unicode status and folding, that's cheap or expensive.
3269              *
3270              * This algorithm is optimised for the case where are only a
3271              * small number of accept states, i.e. 0,1, or maybe 2.
3272              * With lots of accepts states, and having to try all of them,
3273              * it becomes quadratic on number of accept states to find all
3274              * the next words.
3275              */
3276
3277             {
3278                 /* what type of TRIE am I? (utf8 makes this contextual) */
3279                 DECL_TRIE_TYPE(scan);
3280
3281                 /* what trie are we using right now */
3282                 reg_trie_data * const trie
3283                     = (reg_trie_data*)rexi->data->data[ ARG( scan ) ];
3284                 HV * widecharmap = MUTABLE_HV(rexi->data->data[ ARG( scan ) + 1 ]);
3285                 U32 state = trie->startstate;
3286
3287                 if (trie->bitmap && trie_type != trie_utf8_fold &&
3288                     !TRIE_BITMAP_TEST(trie,*locinput)
3289                 ) {
3290                     if (trie->states[ state ].wordnum) {
3291                          DEBUG_EXECUTE_r(
3292                             PerlIO_printf(Perl_debug_log,
3293                                           "%*s  %smatched empty string...%s\n",
3294                                           REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
3295                         );
3296                         if (!trie->jump)
3297                             break;
3298                     } else {
3299                         DEBUG_EXECUTE_r(
3300                             PerlIO_printf(Perl_debug_log,
3301                                           "%*s  %sfailed to match trie start class...%s\n",
3302                                           REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
3303                         );
3304                         sayNO_SILENT;
3305                    }
3306                 }
3307
3308             {
3309                 U8 *uc = ( U8* )locinput;
3310
3311                 STRLEN len = 0;
3312                 STRLEN foldlen = 0;
3313                 U8 *uscan = (U8*)NULL;
3314                 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
3315                 U32 charcount = 0; /* how many input chars we have matched */
3316                 U32 accepted = 0; /* have we seen any accepting states? */
3317
3318                 ST.B = next;
3319                 ST.jump = trie->jump;
3320                 ST.me = scan;
3321                 ST.firstpos = NULL;
3322                 ST.longfold = FALSE; /* char longer if folded => it's harder */
3323                 ST.nextword = 0;
3324
3325                 /* fully traverse the TRIE; note the position of the
3326                    shortest accept state and the wordnum of the longest
3327                    accept state */
3328
3329                 while ( state && uc <= (U8*)PL_regeol ) {
3330                     U32 base = trie->states[ state ].trans.base;
3331                     UV uvc = 0;
3332                     U16 charid = 0;
3333                     U16 wordnum;
3334                     wordnum = trie->states[ state ].wordnum;
3335
3336                     if (wordnum) { /* it's an accept state */
3337                         if (!accepted) {
3338                             accepted = 1;
3339                             /* record first match position */
3340                             if (ST.longfold) {
3341                                 ST.firstpos = (U8*)locinput;
3342                                 ST.firstchars = 0;
3343                             }
3344                             else {
3345                                 ST.firstpos = uc;
3346                                 ST.firstchars = charcount;
3347                             }
3348                         }
3349                         if (!ST.nextword || wordnum < ST.nextword)
3350                             ST.nextword = wordnum;
3351                         ST.topword = wordnum;
3352                     }
3353
3354                     DEBUG_TRIE_EXECUTE_r({
3355                                 DUMP_EXEC_POS( (char *)uc, scan, utf8_target );
3356                                 PerlIO_printf( Perl_debug_log,
3357                                     "%*s  %sState: %4"UVxf" Accepted: %c ",
3358                                     2+depth * 2, "", PL_colors[4],
3359                                     (UV)state, (accepted ? 'Y' : 'N'));
3360                     });
3361
3362                     /* read a char and goto next state */
3363                     if ( base ) {
3364                         I32 offset;
3365                         REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc,
3366                                              uscan, len, uvc, charid, foldlen,
3367                                              foldbuf, uniflags);
3368                         charcount++;
3369                         if (foldlen>0)
3370                             ST.longfold = TRUE;
3371                         if (charid &&
3372                              ( ((offset =
3373                               base + charid - 1 - trie->uniquecharcount)) >= 0)
3374
3375                              && ((U32)offset < trie->lasttrans)
3376                              && trie->trans[offset].check == state)
3377                         {
3378                             state = trie->trans[offset].next;
3379                         }
3380                         else {
3381                             state = 0;
3382                         }
3383                         uc += len;
3384
3385                     }
3386                     else {
3387                         state = 0;
3388                     }
3389                     DEBUG_TRIE_EXECUTE_r(
3390                         PerlIO_printf( Perl_debug_log,
3391                             "Charid:%3x CP:%4"UVxf" After State: %4"UVxf"%s\n",
3392                             charid, uvc, (UV)state, PL_colors[5] );
3393                     );
3394                 }
3395                 if (!accepted)
3396                    sayNO;
3397
3398                 /* calculate total number of accept states */
3399                 {
3400                     U16 w = ST.topword;
3401                     accepted = 0;
3402                     while (w) {
3403                         w = trie->wordinfo[w].prev;
3404                         accepted++;
3405                     }
3406                     ST.accepted = accepted;
3407                 }
3408
3409                 DEBUG_EXECUTE_r(
3410                     PerlIO_printf( Perl_debug_log,
3411                         "%*s  %sgot %"IVdf" possible matches%s\n",
3412                         REPORT_CODE_OFF + depth * 2, "",
3413                         PL_colors[4], (IV)ST.accepted, PL_colors[5] );
3414                 );
3415                 goto trie_first_try; /* jump into the fail handler */
3416             }}
3417             /* NOTREACHED */
3418
3419         case TRIE_next_fail: /* we failed - try next alternative */
3420             if ( ST.jump) {
3421                 REGCP_UNWIND(ST.cp);
3422                 for (n = *PL_reglastparen; n > ST.lastparen; n--)
3423                     PL_regoffs[n].end = -1;
3424                 *PL_reglastparen = n;
3425             }
3426             if (!--ST.accepted) {
3427                 DEBUG_EXECUTE_r({
3428                     PerlIO_printf( Perl_debug_log,
3429                         "%*s  %sTRIE failed...%s\n",
3430                         REPORT_CODE_OFF+depth*2, "",
3431                         PL_colors[4],
3432                         PL_colors[5] );
3433                 });
3434                 sayNO_SILENT;
3435             }
3436             {
3437                 /* Find next-highest word to process.  Note that this code
3438                  * is O(N^2) per trie run (O(N) per branch), so keep tight */
3439                 register U16 min = 0;
3440                 register U16 word;
3441                 register U16 const nextword = ST.nextword;
3442                 register reg_trie_wordinfo * const wordinfo
3443                     = ((reg_trie_data*)rexi->data->data[ARG(ST.me)])->wordinfo;
3444                 for (word=ST.topword; word; word=wordinfo[word].prev) {
3445                     if (word > nextword && (!min || word < min))
3446                         min = word;
3447                 }
3448                 ST.nextword = min;
3449             }
3450
3451           trie_first_try:
3452             if (do_cutgroup) {
3453                 do_cutgroup = 0;
3454                 no_final = 0;
3455             }
3456
3457             if ( ST.jump) {
3458                 ST.lastparen = *PL_reglastparen;
3459                 REGCP_SET(ST.cp);
3460             }
3461
3462             /* find start char of end of current word */
3463             {
3464                 U32 chars; /* how many chars to skip */
3465                 U8 *uc = ST.firstpos;
3466                 reg_trie_data * const trie
3467                     = (reg_trie_data*)rexi->data->data[ARG(ST.me)];
3468
3469                 assert((trie->wordinfo[ST.nextword].len - trie->prefixlen)
3470                             >=  ST.firstchars);
3471                 chars = (trie->wordinfo[ST.nextword].len - trie->prefixlen)
3472                             - ST.firstchars;
3473
3474                 if (ST.longfold) {
3475                     /* the hard option - fold each char in turn and find
3476                      * its folded length (which may be different */
3477                     U8 foldbuf[UTF8_MAXBYTES_CASE + 1];
3478                     STRLEN foldlen;
3479                     STRLEN len;
3480                     UV uvc;
3481                     U8 *uscan;
3482
3483                     while (chars) {
3484                         if (utf8_target) {
3485                             uvc = utf8n_to_uvuni((U8*)uc, UTF8_MAXLEN, &len,
3486                                                     uniflags);
3487                             uc += len;
3488                         }
3489                         else {
3490                             uvc = *uc;
3491                             uc++;
3492                         }
3493                         uvc = to_uni_fold(uvc, foldbuf, &foldlen);
3494                         uscan = foldbuf;
3495                         while (foldlen) {
3496                             if (!--chars)
3497                                 break;
3498                             uvc = utf8n_to_uvuni(uscan, UTF8_MAXLEN, &len,
3499                                             uniflags);
3500                             uscan += len;
3501                             foldlen -= len;
3502                         }
3503                     }
3504                 }
3505                 else {
3506                     if (utf8_target)
3507                         while (chars--)
3508                             uc += UTF8SKIP(uc);
3509                     else
3510                         uc += chars;
3511                 }
3512                 PL_reginput = (char *)uc;
3513             }
3514
3515             scan = (ST.jump && ST.jump[ST.nextword])
3516                         ? ST.me + ST.jump[ST.nextword]
3517                         : ST.B;
3518
3519             DEBUG_EXECUTE_r({
3520                 PerlIO_printf( Perl_debug_log,
3521                     "%*s  %sTRIE matched word #%d, continuing%s\n",
3522                     REPORT_CODE_OFF+depth*2, "",
3523                     PL_colors[4],
3524                     ST.nextword,
3525                     PL_colors[5]
3526                     );
3527             });
3528
3529             if (ST.accepted > 1 || has_cutgroup) {
3530                 PUSH_STATE_GOTO(TRIE_next, scan);
3531                 /* NOTREACHED */
3532             }
3533             /* only one choice left - just continue */
3534             DEBUG_EXECUTE_r({
3535                 AV *const trie_words
3536                     = MUTABLE_AV(rexi->data->data[ARG(ST.me)+TRIE_WORDS_OFFSET]);
3537                 SV ** const tmp = av_fetch( trie_words,
3538                     ST.nextword-1, 0 );
3539                 SV *sv= tmp ? sv_newmortal() : NULL;
3540
3541                 PerlIO_printf( Perl_debug_log,
3542                     "%*s  %sonly one match left, short-circuiting: #%d <%s>%s\n",
3543                     REPORT_CODE_OFF+depth*2, "", PL_colors[4],
3544                     ST.nextword,
3545                     tmp ? pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 0,
3546                             PL_colors[0], PL_colors[1],
3547                             (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)|PERL_PV_ESCAPE_NONASCII
3548                         )
3549                     : "not compiled under -Dr",
3550                     PL_colors[5] );
3551             });
3552
3553             locinput = PL_reginput;
3554             nextchr = UCHARAT(locinput);
3555             continue; /* execute rest of RE */
3556             /* NOTREACHED */
3557 #undef  ST
3558
3559         case EXACT: {
3560             char *s = STRING(scan);
3561             ln = STR_LEN(scan);
3562             if (utf8_target != UTF_PATTERN) {
3563                 /* The target and the pattern have differing utf8ness. */
3564                 char *l = locinput;
3565                 const char * const e = s + ln;
3566
3567                 if (utf8_target) {
3568                     /* The target is utf8, the pattern is not utf8. */
3569                     while (s < e) {
3570                         STRLEN ulen;
3571                         if (l >= PL_regeol)
3572                              sayNO;
3573                         if (NATIVE_TO_UNI(*(U8*)s) !=
3574                             utf8n_to_uvuni((U8*)l, UTF8_MAXBYTES, &ulen,
3575                                             uniflags))
3576                              sayNO;
3577                         l += ulen;
3578                         s ++;
3579                     }
3580                 }
3581                 else {
3582                     /* The target is not utf8, the pattern is utf8. */
3583                     while (s < e) {
3584                         STRLEN ulen;
3585                         if (l >= PL_regeol)
3586                             sayNO;
3587                         if (NATIVE_TO_UNI(*((U8*)l)) !=
3588                             utf8n_to_uvuni((U8*)s, UTF8_MAXBYTES, &ulen,
3589                                            uniflags))
3590                             sayNO;
3591                         s += ulen;
3592                         l ++;
3593                     }
3594                 }
3595                 locinput = l;
3596                 nextchr = UCHARAT(locinput);
3597                 break;
3598             }
3599             /* The target and the pattern have the same utf8ness. */
3600             /* Inline the first character, for speed. */
3601             if (UCHARAT(s) != nextchr)
3602                 sayNO;
3603             if (PL_regeol - locinput < ln)
3604                 sayNO;
3605             if (ln > 1 && memNE(s, locinput, ln))
3606                 sayNO;
3607             locinput += ln;
3608             nextchr = UCHARAT(locinput);
3609             break;
3610             }
3611         case EXACTFL: {
3612             re_fold_t folder;
3613             const U8 * fold_array;
3614             const char * s;
3615             U32 fold_utf8_flags;
3616
3617             PL_reg_flags |= RF_tainted;
3618             folder = foldEQ_locale;
3619             fold_array = PL_fold_locale;
3620             fold_utf8_flags = FOLDEQ_UTF8_LOCALE;
3621             goto do_exactf;
3622
3623         case EXACTFU:
3624             folder = foldEQ_latin1;
3625             fold_array = PL_fold_latin1;
3626             fold_utf8_flags = 0;
3627             goto do_exactf;
3628
3629         case EXACTFA:
3630             folder = foldEQ_latin1;
3631             fold_array = PL_fold_latin1;
3632             fold_utf8_flags = FOLDEQ_UTF8_NOMIX_ASCII;
3633             goto do_exactf;
3634
3635         case EXACTF:
3636             folder = foldEQ;
3637             fold_array = PL_fold;
3638             fold_utf8_flags = 0;
3639
3640           do_exactf:
3641             s = STRING(scan);
3642             ln = STR_LEN(scan);
3643
3644             if (utf8_target || UTF_PATTERN) {
3645               /* Either target or the pattern are utf8. */
3646                 const char * const l = locinput;
3647                 char *e = PL_regeol;
3648
3649                 if (! foldEQ_utf8_flags(s, 0,  ln, cBOOL(UTF_PATTERN),
3650                                l, &e, 0,  utf8_target, fold_utf8_flags))
3651                 {
3652                     sayNO;
3653                 }
3654                 locinput = e;
3655                 nextchr = UCHARAT(locinput);
3656                 break;
3657             }
3658
3659             /* Neither the target nor the pattern are utf8 */
3660             if (UCHARAT(s) != nextchr &&
3661                 UCHARAT(s) != fold_array[nextchr])
3662             {
3663                 sayNO;
3664             }
3665             if (PL_regeol - locinput < ln)
3666                 sayNO;
3667             if (ln > 1 && ! folder(s, locinput, ln))
3668                 sayNO;
3669             locinput += ln;
3670             nextchr = UCHARAT(locinput);
3671             break;
3672         }
3673
3674         /* XXX Could improve efficiency by separating these all out using a
3675          * macro or in-line function.  At that point regcomp.c would no longer
3676          * have to set the FLAGS fields of these */
3677         case BOUNDL:
3678         case NBOUNDL:
3679             PL_reg_flags |= RF_tainted;
3680             /* FALL THROUGH */
3681         case BOUND:
3682         case BOUNDU:
3683         case BOUNDA:
3684         case NBOUND:
3685         case NBOUNDU:
3686         case NBOUNDA:
3687             /* was last char in word? */
3688             if (utf8_target
3689                 && FLAGS(scan) != REGEX_ASCII_RESTRICTED_CHARSET
3690                 && FLAGS(scan) != REGEX_ASCII_MORE_RESTRICTED_CHARSET)
3691             {
3692                 if (locinput == PL_bostr)
3693                     ln = '\n';
3694                 else {
3695                     const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
3696
3697                     ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, uniflags);
3698                 }
3699                 if (FLAGS(scan) != REGEX_LOCALE_CHARSET) {
3700                     ln = isALNUM_uni(ln);
3701                     LOAD_UTF8_CHARCLASS_ALNUM();
3702                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, utf8_target);
3703                 }
3704                 else {
3705                     ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
3706                     n = isALNUM_LC_utf8((U8*)locinput);
3707                 }
3708             }
3709             else {
3710
3711                 /* Here the string isn't utf8, or is utf8 and only ascii
3712                  * characters are to match \w.  In the latter case looking at
3713                  * the byte just prior to the current one may be just the final
3714                  * byte of a multi-byte character.  This is ok.  There are two
3715                  * cases:
3716                  * 1) it is a single byte character, and then the test is doing
3717                  *      just what it's supposed to.
3718                  * 2) it is a multi-byte character, in which case the final
3719                  *      byte is never mistakable for ASCII, and so the test
3720                  *      will say it is not a word character, which is the
3721                  *      correct answer. */
3722                 ln = (locinput != PL_bostr) ?
3723                     UCHARAT(locinput - 1) : '\n';
3724                 switch (FLAGS(scan)) {
3725                     case REGEX_UNICODE_CHARSET:
3726                         ln = isWORDCHAR_L1(ln);
3727                         n = isWORDCHAR_L1(nextchr);
3728                         break;
3729                     case REGEX_LOCALE_CHARSET:
3730                         ln = isALNUM_LC(ln);
3731                         n = isALNUM_LC(nextchr);
3732                         break;
3733                     case REGEX_DEPENDS_CHARSET:
3734                         ln = isALNUM(ln);
3735                         n = isALNUM(nextchr);
3736                         break;
3737                     case REGEX_ASCII_RESTRICTED_CHARSET:
3738                     case REGEX_ASCII_MORE_RESTRICTED_CHARSET:
3739                         ln = isWORDCHAR_A(ln);
3740                         n = isWORDCHAR_A(nextchr);
3741                         break;
3742                     default:
3743                         Perl_croak(aTHX_ "panic: Unexpected FLAGS %u in op %u", FLAGS(scan), OP(scan));
3744                         break;
3745                 }
3746             }
3747             /* Note requires that all BOUNDs be lower than all NBOUNDs in
3748              * regcomp.sym */
3749             if (((!ln) == (!n)) == (OP(scan) < NBOUND))
3750                     sayNO;
3751             break;
3752         case ANYOFV:
3753         case ANYOF:
3754             if (utf8_target || state_num == ANYOFV) {
3755                 STRLEN inclasslen = PL_regeol - locinput;
3756                 if (locinput >= PL_regeol)
3757                     sayNO;
3758
3759                 if (!reginclass(rex, scan, (U8*)locinput, &inclasslen, utf8_target))
3760                     sayNO;
3761                 locinput += inclasslen;
3762                 nextchr = UCHARAT(locinput);
3763                 break;
3764             }
3765             else {
3766                 if (nextchr < 0)
3767                     nextchr = UCHARAT(locinput);
3768                 if (!nextchr && locinput >= PL_regeol)
3769                     sayNO;
3770                 if (!REGINCLASS(rex, scan, (U8*)locinput))
3771                     sayNO;
3772                 nextchr = UCHARAT(++locinput);
3773                 break;
3774             }
3775             break;
3776         /* Special char classes - The defines start on line 129 or so */
3777         CCC_TRY_U(ALNUM,  NALNUM,  isWORDCHAR,
3778                   ALNUML, NALNUML, isALNUM_LC, isALNUM_LC_utf8,
3779                   ALNUMU, NALNUMU, isWORDCHAR_L1,
3780                   ALNUMA, NALNUMA, isWORDCHAR_A,
3781                   alnum, "a");
3782
3783         CCC_TRY_U(SPACE,  NSPACE,  isSPACE,
3784                   SPACEL, NSPACEL, isSPACE_LC, isSPACE_LC_utf8,
3785                   SPACEU, NSPACEU, isSPACE_L1,
3786                   SPACEA, NSPACEA, isSPACE_A,
3787                   space, " ");
3788
3789         CCC_TRY(DIGIT,  NDIGIT,  isDIGIT,
3790                 DIGITL, NDIGITL, isDIGIT_LC, isDIGIT_LC_utf8,
3791                 DIGITA, NDIGITA, isDIGIT_A,
3792                 digit, "0");
3793
3794         case CLUMP: /* Match \X: logical Unicode character.  This is defined as
3795                        a Unicode extended Grapheme Cluster */
3796             /* From http://www.unicode.org/reports/tr29 (5.2 version).  An
3797               extended Grapheme Cluster is:
3798
3799                CR LF
3800                | Prepend* Begin Extend*
3801                | .
3802
3803                Begin is (Hangul-syllable | ! Control)
3804                Extend is (Grapheme_Extend | Spacing_Mark)
3805                Control is [ GCB_Control CR LF ]
3806
3807                The discussion below shows how the code for CLUMP is derived
3808                from this regex.  Note that most of these concepts are from
3809                property values of the Grapheme Cluster Boundary (GCB) property.
3810                No code point can have multiple property values for a given
3811                property.  Thus a code point in Prepend can't be in Control, but
3812                it must be in !Control.  This is why Control above includes
3813                GCB_Control plus CR plus LF.  The latter two are used in the GCB
3814                property separately, and so can't be in GCB_Control, even though
3815                they logically are controls.  Control is not the same as gc=cc,
3816                but includes format and other characters as well.
3817
3818                The Unicode definition of Hangul-syllable is:
3819                    L+
3820                    | (L* ( ( V | LV ) V* | LVT ) T*)
3821                    | T+
3822                   )
3823                Each of these is a value for the GCB property, and hence must be
3824                disjoint, so the order they are tested is immaterial, so the
3825                above can safely be changed to
3826                    T+
3827                    | L+
3828                    | (L* ( LVT | ( V | LV ) V*) T*)
3829
3830                The last two terms can be combined like this:
3831                    L* ( L
3832                         | (( LVT | ( V | LV ) V*) T*))
3833
3834                And refactored into this:
3835                    L* (L | LVT T* | V  V* T* | LV  V* T*)
3836
3837                That means that if we have seen any L's at all we can quit
3838                there, but if the next character is an LVT, a V, or an LV we
3839                should keep going.
3840
3841                There is a subtlety with Prepend* which showed up in testing.
3842                Note that the Begin, and only the Begin is required in:
3843                 | Prepend* Begin Extend*
3844                Also, Begin contains '! Control'.  A Prepend must be a
3845                '!  Control', which means it must also be a Begin.  What it
3846                comes down to is that if we match Prepend* and then find no
3847                suitable Begin afterwards, that if we backtrack the last
3848                Prepend, that one will be a suitable Begin.
3849             */
3850
3851             if (locinput >= PL_regeol)
3852                 sayNO;
3853             if  (! utf8_target) {
3854
3855                 /* Match either CR LF  or '.', as all the other possibilities
3856                  * require utf8 */
3857                 locinput++;         /* Match the . or CR */
3858                 if (nextchr == '\r' /* And if it was CR, and the next is LF,
3859                                        match the LF */
3860                     && locinput < PL_regeol
3861                     && UCHARAT(locinput) == '\n') locinput++;
3862             }
3863             else {
3864
3865                 /* Utf8: See if is ( CR LF ); already know that locinput <
3866                  * PL_regeol, so locinput+1 is in bounds */
3867                 if (nextchr == '\r' && UCHARAT(locinput + 1) == '\n') {
3868                     locinput += 2;
3869                 }
3870                 else {
3871                     /* In case have to backtrack to beginning, then match '.' */
3872                     char *starting = locinput;
3873
3874                     /* In case have to backtrack the last prepend */
3875                     char *previous_prepend = 0;
3876
3877                     LOAD_UTF8_CHARCLASS_GCB();
3878
3879                     /* Match (prepend)* */
3880                     while (locinput < PL_regeol
3881                            && swash_fetch(PL_utf8_X_prepend,
3882                                           (U8*)locinput, utf8_target))
3883                     {
3884                         previous_prepend = locinput;
3885                         locinput += UTF8SKIP(locinput);
3886                     }
3887
3888                     /* As noted above, if we matched a prepend character, but
3889                      * the next thing won't match, back off the last prepend we
3890                      * matched, as it is guaranteed to match the begin */
3891                     if (previous_prepend
3892                         && (locinput >=  PL_regeol
3893                             || ! swash_fetch(PL_utf8_X_begin,
3894                                              (U8*)locinput, utf8_target)))
3895                     {
3896                         locinput = previous_prepend;
3897                     }
3898
3899                     /* Note that here we know PL_regeol > locinput, as we
3900                      * tested that upon input to this switch case, and if we
3901                      * moved locinput forward, we tested the result just above
3902                      * and it either passed, or we backed off so that it will
3903                      * now pass */
3904                     if (! swash_fetch(PL_utf8_X_begin, (U8*)locinput, utf8_target)) {
3905
3906                         /* Here did not match the required 'Begin' in the
3907                          * second term.  So just match the very first
3908                          * character, the '.' of the final term of the regex */
3909                         locinput = starting + UTF8SKIP(starting);
3910                     } else {
3911
3912                         /* Here is the beginning of a character that can have
3913                          * an extender.  It is either a hangul syllable, or a
3914                          * non-control */
3915                         if (swash_fetch(PL_utf8_X_non_hangul,
3916                                         (U8*)locinput, utf8_target))
3917                         {
3918
3919                             /* Here not a Hangul syllable, must be a
3920                              * ('!  * Control') */
3921                             locinput += UTF8SKIP(locinput);
3922                         } else {
3923
3924                             /* Here is a Hangul syllable.  It can be composed
3925                              * of several individual characters.  One
3926                              * possibility is T+ */
3927                             if (swash_fetch(PL_utf8_X_T,
3928                                             (U8*)locinput, utf8_target))
3929                             {
3930                                 while (locinput < PL_regeol
3931                                         && swash_fetch(PL_utf8_X_T,
3932                                                         (U8*)locinput, utf8_target))
3933                                 {
3934                                     locinput += UTF8SKIP(locinput);
3935                                 }
3936                             } else {
3937
3938                                 /* Here, not T+, but is a Hangul.  That means
3939                                  * it is one of the others: L, LV, LVT or V,
3940                                  * and matches:
3941                                  * L* (L | LVT T* | V  V* T* | LV  V* T*) */
3942
3943                                 /* Match L*           */
3944                                 while (locinput < PL_regeol
3945                                         && swash_fetch(PL_utf8_X_L,
3946                                                         (U8*)locinput, utf8_target))
3947                                 {
3948                                     locinput += UTF8SKIP(locinput);
3949                                 }
3950
3951                                 /* Here, have exhausted L*.  If the next
3952                                  * character is not an LV, LVT nor V, it means
3953                                  * we had to have at least one L, so matches L+
3954                                  * in the original equation, we have a complete
3955                                  * hangul syllable.  Are done. */
3956
3957                                 if (locinput < PL_regeol
3958                                     && swash_fetch(PL_utf8_X_LV_LVT_V,
3959                                                     (U8*)locinput, utf8_target))
3960                                 {
3961
3962                                     /* Otherwise keep going.  Must be LV, LVT
3963                                      * or V.  See if LVT */
3964                                     if (swash_fetch(PL_utf8_X_LVT,
3965                                                     (U8*)locinput, utf8_target))
3966                                     {
3967                                         locinput += UTF8SKIP(locinput);
3968                                     } else {
3969
3970                                         /* Must be  V or LV.  Take it, then
3971                                          * match V*     */
3972                                         locinput += UTF8SKIP(locinput);
3973                                         while (locinput < PL_regeol
3974                                                 && swash_fetch(PL_utf8_X_V,
3975                                                          (U8*)locinput, utf8_target))
3976                                         {
3977                                             locinput += UTF8SKIP(locinput);
3978                                         }
3979                                     }
3980
3981                                     /* And any of LV, LVT, or V can be followed
3982                                      * by T*            */
3983                                     while (locinput < PL_regeol
3984                                            && swash_fetch(PL_utf8_X_T,
3985                                                            (U8*)locinput,
3986                                                            utf8_target))
3987                                     {
3988                                         locinput += UTF8SKIP(locinput);
3989                                     }
3990                                 }
3991                             }
3992                         }
3993
3994                         /* Match any extender */
3995                         while (locinput < PL_regeol
3996                                 && swash_fetch(PL_utf8_X_extend,
3997                                                 (U8*)locinput, utf8_target))
3998                         {
3999                             locinput += UTF8SKIP(locinput);
4000                         }
4001                     }
4002                 }
4003                 if (locinput > PL_regeol) sayNO;
4004             }
4005             nextchr = UCHARAT(locinput);
4006             break;
4007
4008         case NREFFL:
4009         {   /* The capture buffer cases.  The ones beginning with N for the
4010                named buffers just convert to the equivalent numbered and
4011                pretend they were called as the corresponding numbered buffer
4012                op.  */
4013             /* don't initialize these in the declaration, it makes C++
4014                unhappy */
4015             char *s;
4016             char type;
4017             re_fold_t folder;
4018             const U8 *fold_array;
4019             UV utf8_fold_flags;
4020
4021             PL_reg_flags |= RF_tainted;
4022             folder = foldEQ_locale;
4023             fold_array = PL_fold_locale;
4024             type = REFFL;
4025             utf8_fold_flags = FOLDEQ_UTF8_LOCALE;
4026             goto do_nref;
4027
4028         case NREFFA:
4029             folder = foldEQ_latin1;
4030             fold_array = PL_fold_latin1;
4031             type = REFFA;
4032             utf8_fold_flags = FOLDEQ_UTF8_NOMIX_ASCII;
4033             goto do_nref;
4034
4035         case NREFFU:
4036             folder = foldEQ_latin1;
4037             fold_array = PL_fold_latin1;
4038             type = REFFU;
4039             utf8_fold_flags = 0;
4040             goto do_nref;
4041
4042         case NREFF:
4043             folder = foldEQ;
4044             fold_array = PL_fold;
4045             type = REFF;
4046             utf8_fold_flags = 0;
4047             goto do_nref;
4048
4049         case NREF:
4050             type = REF;
4051             folder = NULL;
4052             fold_array = NULL;
4053             utf8_fold_flags = 0;
4054           do_nref:
4055
4056             /* For the named back references, find the corresponding buffer
4057              * number */
4058             n = reg_check_named_buff_matched(rex,scan);
4059
4060             if ( ! n ) {
4061                 sayNO;
4062             }
4063             goto do_nref_ref_common;
4064
4065         case REFFL:
4066             PL_reg_flags |= RF_tainted;
4067             folder = foldEQ_locale;
4068             fold_array = PL_fold_locale;
4069             utf8_fold_flags = FOLDEQ_UTF8_LOCALE;
4070             goto do_ref;
4071
4072         case REFFA:
4073             folder = foldEQ_latin1;
4074             fold_array = PL_fold_latin1;
4075             utf8_fold_flags = FOLDEQ_UTF8_NOMIX_ASCII;
4076             goto do_ref;
4077
4078         case REFFU:
4079             folder = foldEQ_latin1;
4080             fold_array = PL_fold_latin1;
4081             utf8_fold_flags = 0;
4082             goto do_ref;
4083
4084         case REFF:
4085             folder = foldEQ;
4086             fold_array = PL_fold;
4087             utf8_fold_flags = 0;
4088             goto do_ref;
4089
4090         case REF:
4091             folder = NULL;
4092             fold_array = NULL;
4093             utf8_fold_flags = 0;
4094
4095           do_ref:
4096             type = OP(scan);
4097             n = ARG(scan);  /* which paren pair */
4098
4099           do_nref_ref_common:
4100             ln = PL_regoffs[n].start;
4101             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
4102             if (*PL_reglastparen < n || ln == -1)
4103                 sayNO;                  /* Do not match unless seen CLOSEn. */
4104             if (ln == PL_regoffs[n].end)
4105                 break;
4106
4107             s = PL_bostr + ln;
4108             if (type != REF     /* REF can do byte comparison */
4109                 && (utf8_target || type == REFFU))
4110             { /* XXX handle REFFL better */
4111                 char * limit = PL_regeol;
4112
4113                 /* This call case insensitively compares the entire buffer
4114                     * at s, with the current input starting at locinput, but
4115                     * not going off the end given by PL_regeol, and returns in
4116                     * limit upon success, how much of the current input was
4117                     * matched */
4118                 if (! foldEQ_utf8_flags(s, NULL, PL_regoffs[n].end - ln, utf8_target,
4119                                     locinput, &limit, 0, utf8_target, utf8_fold_flags))
4120                 {
4121                     sayNO;
4122                 }
4123                 locinput = limit;
4124                 nextchr = UCHARAT(locinput);
4125                 break;
4126             }
4127
4128             /* Not utf8:  Inline the first character, for speed. */
4129             if (UCHARAT(s) != nextchr &&
4130                 (type == REF ||
4131                  UCHARAT(s) != fold_array[nextchr]))
4132                 sayNO;
4133             ln = PL_regoffs[n].end - ln;
4134             if (locinput + ln > PL_regeol)
4135                 sayNO;
4136             if (ln > 1 && (type == REF
4137                            ? memNE(s, locinput, ln)
4138                            : ! folder(s, locinput, ln)))
4139                 sayNO;
4140             locinput += ln;
4141             nextchr = UCHARAT(locinput);
4142             break;
4143         }
4144         case NOTHING:
4145         case TAIL:
4146             break;
4147         case BACK:
4148             break;
4149
4150 #undef  ST
4151 #define ST st->u.eval
4152         {
4153             SV *ret;
4154             REGEXP *re_sv;
4155             regexp *re;
4156             regexp_internal *rei;
4157             regnode *startpoint;
4158
4159         case GOSTART:
4160         case GOSUB: /*    /(...(?1))/   /(...(?&foo))/   */
4161             if (cur_eval && cur_eval->locinput==locinput) {
4162                 if (cur_eval->u.eval.close_paren == (U32)ARG(scan))
4163                     Perl_croak(aTHX_ "Infinite recursion in regex");
4164                 if ( ++nochange_depth > max_nochange_depth )
4165                     Perl_croak(aTHX_
4166                         "Pattern subroutine nesting without pos change"
4167                         " exceeded limit in regex");
4168             } else {
4169                 nochange_depth = 0;
4170             }
4171             re_sv = rex_sv;
4172             re = rex;
4173             rei = rexi;
4174             (void)ReREFCNT_inc(rex_sv);
4175             if (OP(scan)==GOSUB) {
4176                 startpoint = scan + ARG2L(scan);
4177                 ST.close_paren = ARG(scan);
4178             } else {
4179                 startpoint = rei->program+1;
4180                 ST.close_paren = 0;
4181             }
4182             goto eval_recurse_doit;
4183             /* NOTREACHED */
4184         case EVAL:  /*   /(?{A})B/   /(??{A})B/  and /(?(?{A})X|Y)B/   */
4185             if (cur_eval && cur_eval->locinput==locinput) {
4186                 if ( ++nochange_depth > max_nochange_depth )
4187                     Perl_croak(aTHX_ "EVAL without pos change exceeded limit in regex");
4188             } else {
4189                 nochange_depth = 0;
4190             }
4191             {
4192                 /* execute the code in the {...} */
4193                 dSP;
4194                 SV ** const before = SP;
4195                 OP_4tree * const oop = PL_op;
4196                 COP * const ocurcop = PL_curcop;
4197                 PAD *old_comppad;
4198                 char *saved_regeol = PL_regeol;
4199                 struct re_save_state saved_state;
4200
4201                 /* To not corrupt the existing regex state while executing the
4202                  * eval we would normally put it on the save stack, like with
4203                  * save_re_context. However, re-evals have a weird scoping so we
4204                  * can't just add ENTER/LEAVE here. With that, things like
4205                  *
4206                  *    (?{$a=2})(a(?{local$a=$a+1}))*aak*c(?{$b=$a})
4207                  *
4208                  * would break, as they expect the localisation to be unwound
4209                  * only when the re-engine backtracks through the bit that
4210                  * localised it.
4211                  *
4212                  * What we do instead is just saving the state in a local c
4213                  * variable.
4214                  */
4215                 Copy(&PL_reg_state, &saved_state, 1, struct re_save_state);
4216
4217                 n = ARG(scan);
4218                 PL_op = (OP_4tree*)rexi->data->data[n];
4219                 DEBUG_STATE_r( PerlIO_printf(Perl_debug_log,
4220                     "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
4221                 /* wrap the call in two SAVECOMPPADs. This ensures that
4222                  * when the save stack is eventually unwound, all the
4223                  * accumulated SAVEt_CLEARSV's will be processed with
4224                  * interspersed SAVEt_COMPPAD's to ensure that lexicals
4225                  * are cleared in the right pad */
4226                 SAVECOMPPAD();
4227                 PAD_SAVE_LOCAL(old_comppad, (PAD*)rexi->data->data[n + 2]);
4228                 PL_regoffs[0].end = PL_reg_magic->mg_len = locinput - PL_bostr;
4229
4230                 if (sv_yes_mark) {
4231                     SV *sv_mrk = get_sv("REGMARK", 1);
4232                     sv_setsv(sv_mrk, sv_yes_mark);
4233                 }
4234
4235                 CALLRUNOPS(aTHX);                       /* Scalar context. */
4236                 SPAGAIN;
4237                 if (SP == before)
4238                     ret = &PL_sv_undef;   /* protect against empty (?{}) blocks. */
4239                 else {
4240                     ret = POPs;
4241                     PUTBACK;
4242                 }
4243
4244                 Copy(&saved_state, &PL_reg_state, 1, struct re_save_state);
4245
4246                 PL_op = oop;
4247                 SAVECOMPPAD();
4248                 PAD_RESTORE_LOCAL(old_comppad);
4249                 PL_curcop = ocurcop;
4250                 PL_regeol = saved_regeol;
4251                 if (!logical) {
4252                     /* /(?{...})/ */
4253                     sv_setsv(save_scalar(PL_replgv), ret);
4254                     break;
4255                 }
4256             }
4257             if (logical == 2) { /* Postponed subexpression: /(??{...})/ */
4258                 logical = 0;
4259                 {
4260                     /* extract RE object from returned value; compiling if
4261                      * necessary */
4262                     MAGIC *mg = NULL;
4263                     REGEXP *rx = NULL;
4264
4265                     if (SvROK(ret)) {
4266                         SV *const sv = SvRV(ret);
4267
4268                         if (SvTYPE(sv) == SVt_REGEXP) {
4269                             rx = (REGEXP*) sv;
4270                         } else if (SvSMAGICAL(sv)) {
4271                             mg = mg_find(sv, PERL_MAGIC_qr);
4272                             assert(mg);
4273                         }
4274                     } else if (SvTYPE(ret) == SVt_REGEXP) {
4275                         rx = (REGEXP*) ret;
4276                     } else if (SvSMAGICAL(ret)) {
4277                         if (SvGMAGICAL(ret)) {
4278                             /* I don't believe that there is ever qr magic
4279                                here.  */
4280                             assert(!mg_find(ret, PERL_MAGIC_qr));
4281                             sv_unmagic(ret, PERL_MAGIC_qr);
4282                         }
4283                         else {
4284                             mg = mg_find(ret, PERL_MAGIC_qr);
4285                             /* testing suggests mg only ends up non-NULL for
4286                                scalars who were upgraded and compiled in the
4287                                else block below. In turn, this is only
4288                                triggered in the "postponed utf8 string" tests
4289                                in t/op/pat.t  */
4290                         }
4291                     }
4292
4293                     if (mg) {
4294                         rx = (REGEXP *) mg->mg_obj; /*XXX:dmq*/
4295                         assert(rx);
4296                     }
4297                     if (rx) {
4298                         rx = reg_temp_copy(NULL, rx);
4299                     }
4300                     else {
4301                         U32 pm_flags = 0;
4302                         const I32 osize = PL_regsize;
4303
4304                         if (DO_UTF8(ret)) {
4305                             assert (SvUTF8(ret));
4306                         } else if (SvUTF8(ret)) {
4307                             /* Not doing UTF-8, despite what the SV says. Is
4308                                this only if we're trapped in use 'bytes'?  */
4309                             /* Make a copy of the octet sequence, but without
4310                                the flag on, as the compiler now honours the
4311                                SvUTF8 flag on ret.  */
4312                             STRLEN len;
4313                             const char *const p = SvPV(ret, len);
4314                             ret = newSVpvn_flags(p, len, SVs_TEMP);
4315                         }
4316                         rx = CALLREGCOMP(ret, pm_flags);
4317                         if (!(SvFLAGS(ret)
4318                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
4319                                  | SVs_GMG))) {
4320                             /* This isn't a first class regexp. Instead, it's
4321                                caching a regexp onto an existing, Perl visible
4322                                scalar.  */
4323                             sv_magic(ret, MUTABLE_SV(rx), PERL_MAGIC_qr, 0, 0);
4324                         }
4325                         PL_regsize = osize;
4326                     }
4327                     re_sv = rx;
4328                     re = (struct regexp *)SvANY(rx);
4329                 }
4330                 RXp_MATCH_COPIED_off(re);
4331                 re->subbeg = rex->subbeg;
4332                 re->sublen = rex->sublen;
4333                 rei = RXi_GET(re);
4334                 DEBUG_EXECUTE_r(
4335                     debug_start_match(re_sv, utf8_target, locinput, PL_regeol,
4336                         "Matching embedded");
4337                 );
4338                 startpoint = rei->program + 1;
4339                 ST.close_paren = 0; /* only used for GOSUB */
4340                 /* borrowed from regtry */
4341                 if (PL_reg_start_tmpl <= re->nparens) {
4342                     PL_reg_start_tmpl = re->nparens*3/2 + 3;
4343                     if(PL_reg_start_tmp)
4344                         Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
4345                     else
4346                         Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
4347                 }
4348
4349         eval_recurse_doit: /* Share code with GOSUB below this line */
4350                 /* run the pattern returned from (??{...}) */
4351                 ST.cp = regcppush(0);   /* Save *all* the positions. */
4352                 REGCP_SET(ST.lastcp);
4353
4354                 PL_regoffs = re->offs; /* essentially NOOP on GOSUB */
4355
4356                 /* see regtry, specifically PL_reglast(?:close)?paren is a pointer! (i dont know why) :dmq */
4357                 PL_reglastparen = &re->lastparen;
4358                 PL_reglastcloseparen = &re->lastcloseparen;
4359                 re->lastparen = 0;
4360                 re->lastcloseparen = 0;
4361
4362                 PL_reginput = locinput;
4363                 PL_regsize = 0;
4364
4365                 /* XXXX This is too dramatic a measure... */
4366                 PL_reg_maxiter = 0;
4367
4368                 ST.toggle_reg_flags = PL_reg_flags;
4369                 if (RX_UTF8(re_sv))
4370                     PL_reg_flags |= RF_utf8;
4371                 else
4372                     PL_reg_flags &= ~RF_utf8;
4373                 ST.toggle_reg_flags ^= PL_reg_flags; /* diff of old and new */
4374
4375                 ST.prev_rex = rex_sv;
4376                 ST.prev_curlyx = cur_curlyx;
4377                 SETREX(rex_sv,re_sv);
4378                 rex = re;
4379                 rexi = rei;
4380                 cur_curlyx = NULL;
4381                 ST.B = next;
4382                 ST.prev_eval = cur_eval;
4383                 cur_eval = st;
4384                 /* now continue from first node in postoned RE */
4385                 PUSH_YES_STATE_GOTO(EVAL_AB, startpoint);
4386                 /* NOTREACHED */
4387             }
4388             /* logical is 1,   /(?(?{...})X|Y)/ */
4389             sw = cBOOL(SvTRUE(ret));
4390             logical = 0;
4391             break;
4392         }
4393
4394         case EVAL_AB: /* cleanup after a successful (??{A})B */
4395             /* note: this is called twice; first after popping B, then A */
4396             PL_reg_flags ^= ST.toggle_reg_flags;
4397             ReREFCNT_dec(rex_sv);
4398             SETREX(rex_sv,ST.prev_rex);
4399             rex = (struct regexp *)SvANY(rex_sv);
4400             rexi = RXi_GET(rex);
4401             regcpblow(ST.cp);
4402             cur_eval = ST.prev_eval;
4403             cur_curlyx = ST.prev_curlyx;
4404
4405             /* rex was changed so update the pointer in PL_reglastparen and PL_reglastcloseparen */
4406             PL_reglastparen = &rex->lastparen;
4407             PL_reglastcloseparen = &rex->lastcloseparen;
4408             /* also update PL_regoffs */
4409             PL_regoffs = rex->offs;
4410
4411             /* XXXX This is too dramatic a measure... */
4412             PL_reg_maxiter = 0;
4413             if ( nochange_depth )
4414                 nochange_depth--;
4415             sayYES;
4416
4417
4418         case EVAL_AB_fail: /* unsuccessfully ran A or B in (??{A})B */
4419             /* note: this is called twice; first after popping B, then A */
4420             PL_reg_flags ^= ST.toggle_reg_flags;
4421             ReREFCNT_dec(rex_sv);
4422             SETREX(rex_sv,ST.prev_rex);
4423             rex = (struct regexp *)SvANY(rex_sv);
4424             rexi = RXi_GET(rex);
4425             /* rex was changed so update the pointer in PL_reglastparen and PL_reglastcloseparen */
4426             PL_reglastparen = &rex->lastparen;
4427             PL_reglastcloseparen = &rex->lastcloseparen;
4428
4429             PL_reginput = locinput;
4430             REGCP_UNWIND(ST.lastcp);
4431             regcppop(rex);
4432             cur_eval = ST.prev_eval;
4433             cur_curlyx = ST.prev_curlyx;
4434             /* XXXX This is too dramatic a measure... */
4435             PL_reg_maxiter = 0;
4436             if ( nochange_depth )
4437                 nochange_depth--;
4438             sayNO_SILENT;
4439 #undef ST
4440
4441         case OPEN:
4442             n = ARG(scan);  /* which paren pair */
4443             PL_reg_start_tmp[n] = locinput;
4444             if (n > PL_regsize)
4445                 PL_regsize = n;
4446             lastopen = n;
4447             break;
4448         case CLOSE:
4449             n = ARG(scan);  /* which paren pair */
4450             PL_regoffs[n].start = PL_reg_start_tmp[n] - PL_bostr;
4451             PL_regoffs[n].end = locinput - PL_bostr;
4452             /*if (n > PL_regsize)
4453                 PL_regsize = n;*/
4454             if (n > *PL_reglastparen)
4455                 *PL_reglastparen = n;
4456             *PL_reglastcloseparen = n;
4457             if (cur_eval && cur_eval->u.eval.close_paren == n) {
4458                 goto fake_end;
4459             }
4460             break;
4461         case ACCEPT:
4462             if (ARG(scan)){
4463                 regnode *cursor;
4464                 for (cursor=scan;
4465                      cursor && OP(cursor)!=END;
4466                      cursor=regnext(cursor))
4467                 {
4468                     if ( OP(cursor)==CLOSE ){
4469                         n = ARG(cursor);
4470                         if ( n <= lastopen ) {
4471                             PL_regoffs[n].start
4472                                 = PL_reg_start_tmp[n] - PL_bostr;
4473                             PL_regoffs[n].end = locinput - PL_bostr;
4474                             /*if (n > PL_regsize)
4475                             PL_regsize = n;*/
4476                             if (n > *PL_reglastparen)
4477                                 *PL_reglastparen = n;
4478                             *PL_reglastcloseparen = n;
4479                             if ( n == ARG(scan) || (cur_eval &&
4480                                 cur_eval->u.eval.close_paren == n))
4481                                 break;
4482                         }
4483                     }
4484                 }
4485             }
4486             goto fake_end;
4487             /*NOTREACHED*/
4488         case GROUPP:
4489             n = ARG(scan);  /* which paren pair */
4490             sw = cBOOL(*PL_reglastparen >= n && PL_regoffs[n].end != -1);
4491             break;
4492         case NGROUPP:
4493             /* reg_check_named_buff_matched returns 0 for no match */
4494             sw = cBOOL(0 < reg_check_named_buff_matched(rex,scan));
4495             break;
4496         case INSUBP:
4497             n = ARG(scan);
4498             sw = (cur_eval && (!n || cur_eval->u.eval.close_paren == n));
4499             break;
4500         case DEFINEP:
4501             sw = 0;
4502             break;
4503         case IFTHEN:
4504             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
4505             if (sw)
4506                 next = NEXTOPER(NEXTOPER(scan));
4507             else {
4508                 next = scan + ARG(scan);
4509                 if (OP(next) == IFTHEN) /* Fake one. */
4510                     next = NEXTOPER(NEXTOPER(next));
4511             }
4512             break;
4513         case LOGICAL:
4514             logical = scan->flags;
4515             break;
4516
4517 /*******************************************************************
4518
4519 The CURLYX/WHILEM pair of ops handle the most generic case of the /A*B/
4520 pattern, where A and B are subpatterns. (For simple A, CURLYM or
4521 STAR/PLUS/CURLY/CURLYN are used instead.)
4522
4523 A*B is compiled as <CURLYX><A><WHILEM><B>
4524
4525 On entry to the subpattern, CURLYX is called. This pushes a CURLYX
4526 state, which contains the current count, initialised to -1. It also sets
4527 cur_curlyx to point to this state, with any previous value saved in the
4528 state block.
4529
4530 CURLYX then jumps straight to the WHILEM op, rather than executing A,
4531 since the pattern may possibly match zero times (i.e. it's a while {} loop
4532 rather than a do {} while loop).
4533
4534 Each entry to WHILEM represents a successful match of A. The count in the
4535 CURLYX block is incremented, another WHILEM state is pushed, and execution
4536 passes to A or B depending on greediness and the current count.
4537
4538 For example, if matching against the string a1a2a3b (where the aN are
4539 substrings that match /A/), then the match progresses as follows: (the
4540 pushed states are interspersed with the bits of strings matched so far):
4541
4542     <CURLYX cnt=-1>
4543     <CURLYX cnt=0><WHILEM>
4544     <CURLYX cnt=1><WHILEM> a1 <WHILEM>
4545     <CURLYX cnt=2><WHILEM> a1 <WHILEM> a2 <WHILEM>
4546     <CURLYX cnt=3><WHILEM> a1 <WHILEM> a2 <WHILEM> a3 <WHILEM>
4547     <CURLYX cnt=3><WHILEM> a1 <WHILEM> a2 <WHILEM> a3 <WHILEM> b
4548
4549 (Contrast this with something like CURLYM, which maintains only a single
4550 backtrack state:
4551
4552     <CURLYM cnt=0> a1
4553     a1 <CURLYM cnt=1> a2
4554     a1 a2 <CURLYM cnt=2> a3
4555     a1 a2 a3 <CURLYM cnt=3> b
4556 )
4557
4558 Each WHILEM state block marks a point to backtrack to upon partial failure
4559 of A or B, and also contains some minor state data related to that
4560 iteration.  The CURLYX block, pointed to by cur_curlyx, contains the
4561 overall state, such as the count, and pointers to the A and B ops.
4562
4563 This is complicated slightly by nested CURLYX/WHILEM's. Since cur_curlyx
4564 must always point to the *current* CURLYX block, the rules are:
4565
4566 When executing CURLYX, save the old cur_curlyx in the CURLYX state block,
4567 and set cur_curlyx to point the new block.
4568
4569 When popping the CURLYX block after a successful or unsuccessful match,
4570 restore the previous cur_curlyx.
4571
4572 When WHILEM is about to execute B, save the current cur_curlyx, and set it
4573 to the outer one saved in the CURLYX block.
4574
4575 When popping the WHILEM block after a successful or unsuccessful B match,
4576 restore the previous cur_curlyx.
4577
4578 Here's an example for the pattern (AI* BI)*BO
4579 I and O refer to inner and outer, C and W refer to CURLYX and WHILEM:
4580
4581 cur_
4582 curlyx backtrack stack
4583 ------ ---------------
4584 NULL
4585 CO     <CO prev=NULL> <WO>
4586 CI     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai
4587 CO     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi
4588 NULL   <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi <WO prev=CO> bo
4589
4590 At this point the pattern succeeds, and we work back down the stack to
4591 clean up, restoring as we go:
4592
4593 CO     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai <WI prev=CI> bi
4594 CI     <CO prev=NULL> <WO> <CI prev=CO> <WI> ai
4595 CO     <CO prev=NULL> <WO>
4596 NULL
4597
4598 *******************************************************************/
4599
4600 #define ST st->u.curlyx
4601
4602         case CURLYX:    /* start of /A*B/  (for complex A) */
4603         {
4604             /* No need to save/restore up to this paren */
4605             I32 parenfloor = scan->flags;
4606
4607             assert(next); /* keep Coverity happy */
4608             if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
4609                 next += ARG(next);
4610
4611             /* XXXX Probably it is better to teach regpush to support
4612                parenfloor > PL_regsize... */
4613             if (parenfloor > (I32)*PL_reglastparen)
4614                 parenfloor = *PL_reglastparen; /* Pessimization... */
4615
4616             ST.prev_curlyx= cur_curlyx;
4617             cur_curlyx = st;
4618             ST.cp = PL_savestack_ix;
4619
4620             /* these fields contain the state of the current curly.
4621              * they are accessed by subsequent WHILEMs */
4622             ST.parenfloor = parenfloor;
4623             ST.me = scan;
4624             ST.B = next;
4625             ST.minmod = minmod;
4626             minmod = 0;
4627             ST.count = -1;      /* this will be updated by WHILEM */
4628             ST.lastloc = NULL;  /* this will be updated by WHILEM */
4629
4630             PL_reginput = locinput;
4631             PUSH_YES_STATE_GOTO(CURLYX_end, PREVOPER(next));
4632             /* NOTREACHED */
4633         }
4634
4635         case CURLYX_end: /* just finished matching all of A*B */
4636             cur_curlyx = ST.prev_curlyx;
4637             sayYES;
4638             /* NOTREACHED */
4639
4640         case CURLYX_end_fail: /* just failed to match all of A*B */
4641             regcpblow(ST.cp);
4642             cur_curlyx = ST.prev_curlyx;
4643             sayNO;
4644             /* NOTREACHED */
4645
4646
4647 #undef ST
4648 #define ST st->u.whilem
4649
4650         case WHILEM:     /* just matched an A in /A*B/  (for complex A) */
4651         {
4652             /* see the discussion above about CURLYX/WHILEM */
4653             I32 n;
4654             int min = ARG1(cur_curlyx->u.curlyx.me);
4655             int max = ARG2(cur_curlyx->u.curlyx.me);
4656             regnode *A = NEXTOPER(cur_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS;
4657
4658             assert(cur_curlyx); /* keep Coverity happy */
4659             n = ++cur_curlyx->u.curlyx.count; /* how many A's matched */
4660             ST.save_lastloc = cur_curlyx->u.curlyx.lastloc;
4661             ST.cache_offset = 0;
4662             ST.cache_mask = 0;
4663
4664             PL_reginput = locinput;
4665
4666             DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4667                   "%*s  whilem: matched %ld out of %d..%d\n",
4668                   REPORT_CODE_OFF+depth*2, "", (long)n, min, max)
4669             );
4670
4671             /* First just match a string of min A's. */
4672
4673             if (n < min) {
4674                 ST.cp = regcppush(cur_curlyx->u.curlyx.parenfloor);
4675                 cur_curlyx->u.curlyx.lastloc = locinput;
4676                 REGCP_SET(ST.lastcp);
4677
4678                 PUSH_STATE_GOTO(WHILEM_A_pre, A);
4679                 /* NOTREACHED */
4680             }
4681
4682             /* If degenerate A matches "", assume A done. */
4683
4684             if (locinput == cur_curlyx->u.curlyx.lastloc) {
4685                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4686                    "%*s  whilem: empty match detected, trying continuation...\n",
4687                    REPORT_CODE_OFF+depth*2, "")
4688                 );
4689                 goto do_whilem_B_max;
4690             }
4691
4692             /* super-linear cache processing */
4693
4694             if (scan->flags) {
4695
4696                 if (!PL_reg_maxiter) {
4697                     /* start the countdown: Postpone detection until we
4698                      * know the match is not *that* much linear. */
4699                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
4700                     /* possible overflow for long strings and many CURLYX's */
4701                     if (PL_reg_maxiter < 0)
4702                         PL_reg_maxiter = I32_MAX;
4703                     PL_reg_leftiter = PL_reg_maxiter;
4704                 }
4705
4706                 if (PL_reg_leftiter-- == 0) {
4707                     /* initialise cache */
4708                     const I32 size = (PL_reg_maxiter + 7)/8;
4709                     if (PL_reg_poscache) {
4710                         if ((I32)PL_reg_poscache_size < size) {
4711                             Renew(PL_reg_poscache, size, char);
4712                             PL_reg_poscache_size = size;
4713                         }
4714                         Zero(PL_reg_poscache, size, char);
4715                     }
4716                     else {
4717                         PL_reg_poscache_size = size;
4718                         Newxz(PL_reg_poscache, size, char);
4719                     }
4720                     DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4721       "%swhilem: Detected a super-linear match, switching on caching%s...\n",
4722                               PL_colors[4], PL_colors[5])
4723                     );
4724                 }
4725
4726                 if (PL_reg_leftiter < 0) {
4727                     /* have we already failed at this position? */
4728                     I32 offset, mask;
4729                     offset  = (scan->flags & 0xf) - 1
4730                                 + (locinput - PL_bostr)  * (scan->flags>>4);
4731                     mask    = 1 << (offset % 8);
4732                     offset /= 8;
4733                     if (PL_reg_poscache[offset] & mask) {
4734                         DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
4735                             "%*s  whilem: (cache) already tried at this position...\n",
4736                             REPORT_CODE_OFF+depth*2, "")
4737                         );
4738                         sayNO; /* cache records failure */
4739                     }
4740                     ST.cache_offset = offset;
4741                     ST.cache_mask   = mask;
4742                 }
4743             }
4744
4745             /* Prefer B over A for minimal matching. */
4746
4747             if (cur_curlyx->u.curlyx.minmod) {
4748                 ST.save_curlyx = cur_curlyx;
4749                 cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
4750                 ST.cp = regcppush(ST.save_curlyx->u.curlyx.parenfloor);
4751                 REGCP_SET(ST.lastcp);
4752                 PUSH_YES_STATE_GOTO(WHILEM_B_min, ST.save_curlyx->u.curlyx.B);
4753                 /* NOTREACHED */
4754             }
4755
4756             /* Prefer A over B for maximal matching. */
4757
4758             if (n < max) { /* More greed allowed? */
4759                 ST.cp = regcppush(cur_curlyx->u.curlyx.parenfloor);
4760                 cur_curlyx->u.curlyx.lastloc = locinput;
4761                 REGCP_SET(ST.lastcp);
4762                 PUSH_STATE_GOTO(WHILEM_A_max, A);
4763                 /* NOTREACHED */
4764             }
4765             goto do_whilem_B_max;
4766         }
4767         /* NOTREACHED */
4768
4769         case WHILEM_B_min: /* just matched B in a minimal match */
4770         case WHILEM_B_max: /* just matched B in a maximal match */
4771             cur_curlyx = ST.save_curlyx;
4772             sayYES;
4773             /* NOTREACHED */
4774
4775         case WHILEM_B_max_fail: /* just failed to match B in a maximal match */
4776             cur_curlyx = ST.save_curlyx;
4777             cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
4778             cur_curlyx->u.curlyx.count--;
4779             CACHEsayNO;
4780             /* NOTREACHED */
4781
4782         case WHILEM_A_min_fail: /* just failed to match A in a minimal match */
4783             /* FALL THROUGH */
4784         case WHILEM_A_pre_fail: /* just failed to match even minimal A */
4785             REGCP_UNWIND(ST.lastcp);
4786             regcppop(rex);
4787             cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
4788             cur_curlyx->u.curlyx.count--;
4789             CACHEsayNO;
4790             /* NOTREACHED */
4791
4792         case WHILEM_A_max_fail: /* just failed to match A in a maximal match */
4793             REGCP_UNWIND(ST.lastcp);
4794             regcppop(rex);      /* Restore some previous $<digit>s? */
4795             PL_reginput = locinput;
4796             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4797                 "%*s  whilem: failed, trying continuation...\n",
4798                 REPORT_CODE_OFF+depth*2, "")
4799             );
4800           do_whilem_B_max:
4801             if (cur_curlyx->u.curlyx.count >= REG_INFTY
4802                 && ckWARN(WARN_REGEXP)
4803                 && !(PL_reg_flags & RF_warned))
4804             {
4805                 PL_reg_flags |= RF_warned;
4806                 Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
4807                      "Complex regular subexpression recursion",
4808                      REG_INFTY - 1);
4809             }
4810
4811             /* now try B */
4812             ST.save_curlyx = cur_curlyx;
4813             cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
4814             PUSH_YES_STATE_GOTO(WHILEM_B_max, ST.save_curlyx->u.curlyx.B);
4815             /* NOTREACHED */
4816
4817         case WHILEM_B_min_fail: /* just failed to match B in a minimal match */
4818             cur_curlyx = ST.save_curlyx;
4819             REGCP_UNWIND(ST.lastcp);
4820             regcppop(rex);
4821
4822             if (cur_curlyx->u.curlyx.count >= /*max*/ARG2(cur_curlyx->u.curlyx.me)) {
4823                 /* Maximum greed exceeded */
4824                 if (cur_curlyx->u.curlyx.count >= REG_INFTY
4825                     && ckWARN(WARN_REGEXP)
4826                     && !(PL_reg_flags & RF_warned))
4827                 {
4828                     PL_reg_flags |= RF_warned;
4829                     Perl_warner(aTHX_ packWARN(WARN_REGEXP),
4830                         "%s limit (%d) exceeded",
4831                         "Complex regular subexpression recursion",
4832                         REG_INFTY - 1);
4833                 }
4834                 cur_curlyx->u.curlyx.count--;
4835                 CACHEsayNO;
4836             }
4837
4838             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4839                 "%*s  trying longer...\n", REPORT_CODE_OFF+depth*2, "")
4840             );
4841             /* Try grabbing another A and see if it helps. */
4842             PL_reginput = locinput;
4843             cur_curlyx->u.curlyx.lastloc = locinput;
4844             ST.cp = regcppush(cur_curlyx->u.curlyx.parenfloor);
4845             REGCP_SET(ST.lastcp);
4846             PUSH_STATE_GOTO(WHILEM_A_min,
4847                 /*A*/ NEXTOPER(ST.save_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS);
4848             /* NOTREACHED */
4849
4850 #undef  ST
4851 #define ST st->u.branch
4852
4853         case BRANCHJ:       /*  /(...|A|...)/ with long next pointer */
4854             next = scan + ARG(scan);
4855             if (next == scan)
4856                 next = NULL;
4857             scan = NEXTOPER(scan);
4858             /* FALL THROUGH */
4859
4860         case BRANCH:        /*  /(...|A|...)/ */
4861             scan = NEXTOPER(scan); /* scan now points to inner node */
4862             ST.lastparen = *PL_reglastparen;
4863             ST.next_branch = next;
4864             REGCP_SET(ST.cp);
4865             PL_reginput = locinput;
4866
4867             /* Now go into the branch */
4868             if (has_cutgroup) {
4869                 PUSH_YES_STATE_GOTO(BRANCH_next, scan);
4870             } else {
4871                 PUSH_STATE_GOTO(BRANCH_next, scan);
4872             }
4873             /* NOTREACHED */
4874         case CUTGROUP:
4875             PL_reginput = locinput;
4876             sv_yes_mark = st->u.mark.mark_name = scan->flags ? NULL :
4877                 MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
4878             PUSH_STATE_GOTO(CUTGROUP_next,next);
4879             /* NOTREACHED */
4880         case CUTGROUP_next_fail:
4881             do_cutgroup = 1;
4882             no_final = 1;
4883             if (st->u.mark.mark_name)
4884                 sv_commit = st->u.mark.mark_name;
4885             sayNO;
4886             /* NOTREACHED */
4887         case BRANCH_next:
4888             sayYES;
4889             /* NOTREACHED */
4890         case BRANCH_next_fail: /* that branch failed; try the next, if any */
4891             if (do_cutgroup) {
4892                 do_cutgroup = 0;
4893                 no_final = 0;
4894             }
4895             REGCP_UNWIND(ST.cp);
4896             for (n = *PL_reglastparen; n > ST.lastparen; n--)
4897                 PL_regoffs[n].end = -1;
4898             *PL_reglastparen = n;
4899             /*dmq: *PL_reglastcloseparen = n; */
4900             scan = ST.next_branch;
4901             /* no more branches? */
4902             if (!scan || (OP(scan) != BRANCH && OP(scan) != BRANCHJ)) {
4903                 DEBUG_EXECUTE_r({
4904                     PerlIO_printf( Perl_debug_log,
4905                         "%*s  %sBRANCH failed...%s\n",
4906                         REPORT_CODE_OFF+depth*2, "",
4907                         PL_colors[4],
4908                         PL_colors[5] );
4909                 });
4910                 sayNO_SILENT;
4911             }
4912             continue; /* execute next BRANCH[J] op */
4913             /* NOTREACHED */
4914
4915         case MINMOD:
4916             minmod = 1;
4917             break;
4918
4919 #undef  ST
4920 #define ST st->u.curlym
4921
4922         case CURLYM:    /* /A{m,n}B/ where A is fixed-length */
4923
4924             /* This is an optimisation of CURLYX that enables us to push
4925              * only a single backtracking state, no matter how many matches
4926              * there are in {m,n}. It relies on the pattern being constant
4927              * length, with no parens to influence future backrefs
4928              */
4929
4930             ST.me = scan;
4931             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
4932
4933             /* if paren positive, emulate an OPEN/CLOSE around A */
4934             if (ST.me->flags) {
4935                 U32 paren = ST.me->flags;
4936                 if (paren > PL_regsize)
4937                     PL_regsize = paren;
4938                 if (paren > *PL_reglastparen)
4939                     *PL_reglastparen = paren;
4940                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
4941             }
4942             ST.A = scan;
4943             ST.B = next;
4944             ST.alen = 0;
4945             ST.count = 0;
4946             ST.minmod = minmod;
4947             minmod = 0;
4948             ST.c1 = CHRTEST_UNINIT;
4949             REGCP_SET(ST.cp);
4950
4951             if (!(ST.minmod ? ARG1(ST.me) : ARG2(ST.me))) /* min/max */
4952                 goto curlym_do_B;
4953
4954           curlym_do_A: /* execute the A in /A{m,n}B/  */
4955             PL_reginput = locinput;
4956             PUSH_YES_STATE_GOTO(CURLYM_A, ST.A); /* match A */
4957             /* NOTREACHED */
4958
4959         case CURLYM_A: /* we've just matched an A */
4960             locinput = st->locinput;
4961             nextchr = UCHARAT(locinput);
4962
4963             ST.count++;
4964             /* after first match, determine A's length: u.curlym.alen */
4965             if (ST.count == 1) {
4966                 if (PL_reg_match_utf8) {
4967                     char *s = locinput;
4968                     while (s < PL_reginput) {
4969                         ST.alen++;
4970                         s += UTF8SKIP(s);
4971                     }
4972                 }
4973                 else {
4974                     ST.alen = PL_reginput - locinput;
4975                 }
4976                 if (ST.alen == 0)
4977                     ST.count = ST.minmod ? ARG1(ST.me) : ARG2(ST.me);
4978             }
4979             DEBUG_EXECUTE_r(
4980                 PerlIO_printf(Perl_debug_log,
4981                           "%*s  CURLYM now matched %"IVdf" times, len=%"IVdf"...\n",
4982                           (int)(REPORT_CODE_OFF+(depth*2)), "",
4983                           (IV) ST.count, (IV)ST.alen)
4984             );
4985
4986             locinput = PL_reginput;
4987
4988             if (cur_eval && cur_eval->u.eval.close_paren &&
4989                 cur_eval->u.eval.close_paren == (U32)ST.me->flags)
4990                 goto fake_end;
4991
4992             {
4993                 I32 max = (ST.minmod ? ARG1(ST.me) : ARG2(ST.me));
4994                 if ( max == REG_INFTY || ST.count < max )
4995                     goto curlym_do_A; /* try to match another A */
4996             }
4997             goto curlym_do_B; /* try to match B */
4998
4999         case CURLYM_A_fail: /* just failed to match an A */
5000             REGCP_UNWIND(ST.cp);
5001
5002             if (ST.minmod || ST.count < ARG1(ST.me) /* min*/
5003                 || (cur_eval && cur_eval->u.eval.close_paren &&
5004                     cur_eval->u.eval.close_paren == (U32)ST.me->flags))
5005                 sayNO;
5006
5007           curlym_do_B: /* execute the B in /A{m,n}B/  */
5008             PL_reginput = locinput;
5009             if (ST.c1 == CHRTEST_UNINIT) {
5010                 /* calculate c1 and c2 for possible match of 1st char
5011                  * following curly */
5012                 ST.c1 = ST.c2 = CHRTEST_VOID;
5013                 if (HAS_TEXT(ST.B) || JUMPABLE(ST.B)) {
5014                     regnode *text_node = ST.B;
5015                     if (! HAS_TEXT(text_node))
5016                         FIND_NEXT_IMPT(text_node);
5017                     /* this used to be
5018
5019                         (HAS_TEXT(text_node) && PL_regkind[OP(text_node)] == EXACT)
5020
5021                         But the former is redundant in light of the latter.
5022
5023                         if this changes back then the macro for
5024                         IS_TEXT and friends need to change.
5025                      */
5026                     if (PL_regkind[OP(text_node)] == EXACT)
5027                     {
5028
5029                         ST.c1 = (U8)*STRING(text_node);
5030                         switch (OP(text_node)) {
5031                             case EXACTF: ST.c2 = PL_fold[ST.c1]; break;
5032                             case EXACTFA:
5033                             case EXACTFU: ST.c2 = PL_fold_latin1[ST.c1]; break;
5034                             case EXACTFL: ST.c2 = PL_fold_locale[ST.c1]; break;
5035                             default: ST.c2 = ST.c1;
5036                         }
5037                     }
5038                 }
5039             }
5040
5041             DEBUG_EXECUTE_r(
5042                 PerlIO_printf(Perl_debug_log,
5043                     "%*s  CURLYM trying tail with matches=%"IVdf"...\n",
5044                     (int)(REPORT_CODE_OFF+(depth*2)),
5045                     "", (IV)ST.count)
5046                 );
5047             if (ST.c1 != CHRTEST_VOID
5048                     && UCHARAT(PL_reginput) != ST.c1
5049                     && UCHARAT(PL_reginput) != ST.c2)
5050             {
5051                 /* simulate B failing */
5052                 DEBUG_OPTIMISE_r(
5053                     PerlIO_printf(Perl_debug_log,
5054                         "%*s  CURLYM Fast bail c1=%"IVdf" c2=%"IVdf"\n",
5055                         (int)(REPORT_CODE_OFF+(depth*2)),"",
5056                         (IV)ST.c1,(IV)ST.c2
5057                 ));
5058                 state_num = CURLYM_B_fail;
5059                 goto reenter_switch;
5060             }
5061
5062             if (ST.me->flags) {
5063                 /* mark current A as captured */
5064                 I32 paren = ST.me->flags;
5065                 if (ST.count) {
5066                     PL_regoffs[paren].start
5067                         = HOPc(PL_reginput, -ST.alen) - PL_bostr;
5068                     PL_regoffs[paren].end = PL_reginput - PL_bostr;
5069                     /*dmq: *PL_reglastcloseparen = paren; */
5070                 }
5071                 else
5072                     PL_regoffs[paren].end = -1;
5073                 if (cur_eval && cur_eval->u.eval.close_paren &&
5074                     cur_eval->u.eval.close_paren == (U32)ST.me->flags)
5075                 {
5076                     if (ST.count)
5077                         goto fake_end;
5078                     else
5079                         sayNO;
5080                 }
5081             }
5082
5083             PUSH_STATE_GOTO(CURLYM_B, ST.B); /* match B */
5084             /* NOTREACHED */
5085
5086         case CURLYM_B_fail: /* just failed to match a B */
5087             REGCP_UNWIND(ST.cp);
5088             if (ST.minmod) {
5089                 I32 max = ARG2(ST.me);
5090                 if (max != REG_INFTY && ST.count == max)
5091                     sayNO;
5092                 goto curlym_do_A; /* try to match a further A */
5093             }
5094             /* backtrack one A */
5095             if (ST.count == ARG1(ST.me) /* min */)
5096                 sayNO;
5097             ST.count--;
5098             locinput = HOPc(locinput, -ST.alen);
5099             goto curlym_do_B; /* try to match B */
5100
5101 #undef ST
5102 #define ST st->u.curly
5103
5104 #define CURLY_SETPAREN(paren, success) \
5105     if (paren) { \
5106         if (success) { \
5107             PL_regoffs[paren].start = HOPc(locinput, -1) - PL_bostr; \
5108             PL_regoffs[paren].end = locinput - PL_bostr; \
5109             *PL_reglastcloseparen = paren; \
5110         } \
5111         else \
5112             PL_regoffs[paren].end = -1; \
5113     }
5114
5115         case STAR:              /*  /A*B/ where A is width 1 */
5116             ST.paren = 0;
5117             ST.min = 0;
5118             ST.max = REG_INFTY;
5119             scan = NEXTOPER(scan);
5120             goto repeat;
5121         case PLUS:              /*  /A+B/ where A is width 1 */
5122             ST.paren = 0;
5123             ST.min = 1;
5124             ST.max = REG_INFTY;
5125             scan = NEXTOPER(scan);
5126             goto repeat;
5127         case CURLYN:            /*  /(A){m,n}B/ where A is width 1 */
5128             ST.paren = scan->flags;     /* Which paren to set */
5129             if (ST.paren > PL_regsize)
5130                 PL_regsize = ST.paren;
5131             if (ST.paren > *PL_reglastparen)
5132                 *PL_reglastparen = ST.paren;
5133             ST.min = ARG1(scan);  /* min to match */
5134             ST.max = ARG2(scan);  /* max to match */
5135             if (cur_eval && cur_eval->u.eval.close_paren &&
5136                 cur_eval->u.eval.close_paren == (U32)ST.paren) {
5137                 ST.min=1;
5138                 ST.max=1;
5139             }
5140             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
5141             goto repeat;
5142         case CURLY:             /*  /A{m,n}B/ where A is width 1 */
5143             ST.paren = 0;
5144             ST.min = ARG1(scan);  /* min to match */
5145             ST.max = ARG2(scan);  /* max to match */
5146             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
5147           repeat:
5148             /*
5149             * Lookahead to avoid useless match attempts
5150             * when we know what character comes next.
5151             *
5152             * Used to only do .*x and .*?x, but now it allows
5153             * for )'s, ('s and (?{ ... })'s to be in the way
5154             * of the quantifier and the EXACT-like node.  -- japhy
5155             */
5156
5157             if (ST.min > ST.max) /* XXX make this a compile-time check? */
5158                 sayNO;
5159             if (HAS_TEXT(next) || JUMPABLE(next)) {
5160                 U8 *s;
5161                 regnode *text_node = next;
5162
5163                 if (! HAS_TEXT(text_node))
5164                     FIND_NEXT_IMPT(text_node);
5165
5166                 if (! HAS_TEXT(text_node))
5167                     ST.c1 = ST.c2 = CHRTEST_VOID;
5168                 else {
5169                     if ( PL_regkind[OP(text_node)] != EXACT ) {
5170                         ST.c1 = ST.c2 = CHRTEST_VOID;
5171                         goto assume_ok_easy;
5172                     }
5173                     else
5174                         s = (U8*)STRING(text_node);
5175
5176                     /*  Currently we only get here when
5177
5178                         PL_rekind[OP(text_node)] == EXACT
5179
5180                         if this changes back then the macro for IS_TEXT and
5181                         friends need to change. */
5182                     if (!UTF_PATTERN) {
5183                         ST.c1 = *s;
5184                         switch (OP(text_node)) {
5185                             case EXACTF: ST.c2 = PL_fold[ST.c1]; break;
5186                             case EXACTFA:
5187                             case EXACTFU: ST.c2 = PL_fold_latin1[ST.c1]; break;
5188                             case EXACTFL: ST.c2 = PL_fold_locale[ST.c1]; break;
5189                             default: ST.c2 = ST.c1; break;
5190                         }
5191                     }
5192                     else { /* UTF_PATTERN */
5193                         if (IS_TEXTFU(text_node) || IS_TEXTF(text_node)) {
5194                              STRLEN ulen1, ulen2;
5195                              U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
5196                              U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
5197
5198                              to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
5199                              to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
5200 #ifdef EBCDIC
5201                              ST.c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXLEN, 0,
5202                                                     ckWARN(WARN_UTF8) ?
5203                                                     0 : UTF8_ALLOW_ANY);
5204                              ST.c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXLEN, 0,
5205                                                     ckWARN(WARN_UTF8) ?
5206                                                     0 : UTF8_ALLOW_ANY);
5207 #else
5208                              ST.c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
5209                                                     uniflags);
5210                              ST.c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
5211                                                     uniflags);
5212 #endif
5213                         }
5214                         else {
5215                             ST.c2 = ST.c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
5216                                                      uniflags);
5217                         }
5218                     }
5219                 }
5220             }
5221             else
5222                 ST.c1 = ST.c2 = CHRTEST_VOID;
5223         assume_ok_easy:
5224
5225             ST.A = scan;
5226             ST.B = next;
5227             PL_reginput = locinput;
5228             if (minmod) {
5229                 minmod = 0;
5230                 if (ST.min && regrepeat(rex, ST.A, ST.min, depth) < ST.min)
5231                     sayNO;
5232                 ST.count = ST.min;
5233                 locinput = PL_reginput;
5234                 REGCP_SET(ST.cp);
5235                 if (ST.c1 == CHRTEST_VOID)
5236                     goto curly_try_B_min;
5237
5238                 ST.oldloc = locinput;
5239
5240                 /* set ST.maxpos to the furthest point along the
5241                  * string that could possibly match */
5242                 if  (ST.max == REG_INFTY) {
5243                     ST.maxpos = PL_regeol - 1;
5244                     if (utf8_target)
5245                         while (UTF8_IS_CONTINUATION(*(U8*)ST.maxpos))
5246                             ST.maxpos--;
5247                 }
5248                 else if (utf8_target) {
5249                     int m = ST.max - ST.min;
5250                     for (ST.maxpos = locinput;
5251                          m >0 && ST.maxpos + UTF8SKIP(ST.maxpos) <= PL_regeol; m--)
5252                         ST.maxpos += UTF8SKIP(ST.maxpos);
5253                 }
5254                 else {
5255                     ST.maxpos = locinput + ST.max - ST.min;
5256                     if (ST.maxpos >= PL_regeol)
5257                         ST.maxpos = PL_regeol - 1;
5258                 }
5259                 goto curly_try_B_min_known;
5260
5261             }
5262             else {
5263                 ST.count = regrepeat(rex, ST.A, ST.max, depth);
5264                 locinput = PL_reginput;
5265                 if (ST.count < ST.min)
5266                     sayNO;
5267                 if ((ST.count > ST.min)
5268                     && (PL_regkind[OP(ST.B)] == EOL) && (OP(ST.B) != MEOL))
5269                 {
5270                     /* A{m,n} must come at the end of the string, there's
5271                      * no point in backing off ... */
5272                     ST.min = ST.count;
5273                     /* ...except that $ and \Z can match before *and* after
5274                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
5275                        We may back off by one in this case. */
5276                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(ST.B) != EOS)
5277                         ST.min--;
5278                 }
5279                 REGCP_SET(ST.cp);
5280                 goto curly_try_B_max;
5281             }
5282             /* NOTREACHED */
5283
5284
5285         case CURLY_B_min_known_fail:
5286             /* failed to find B in a non-greedy match where c1,c2 valid */
5287             if (ST.paren && ST.count)
5288                 PL_regoffs[ST.paren].end = -1;
5289
5290             PL_reginput = locinput;     /* Could be reset... */
5291             REGCP_UNWIND(ST.cp);
5292             /* Couldn't or didn't -- move forward. */
5293             ST.oldloc = locinput;
5294             if (utf8_target)
5295                 locinput += UTF8SKIP(locinput);
5296             else
5297                 locinput++;
5298             ST.count++;
5299           curly_try_B_min_known:
5300              /* find the next place where 'B' could work, then call B */
5301             {
5302                 int n;
5303                 if (utf8_target) {
5304                     n = (ST.oldloc == locinput) ? 0 : 1;
5305                     if (ST.c1 == ST.c2) {
5306                         STRLEN len;
5307                         /* set n to utf8_distance(oldloc, locinput) */
5308                         while (locinput <= ST.maxpos &&
5309                                utf8n_to_uvchr((U8*)locinput,
5310                                               UTF8_MAXBYTES, &len,
5311                                               uniflags) != (UV)ST.c1) {
5312                             locinput += len;
5313                             n++;
5314                         }
5315                     }
5316                     else {
5317                         /* set n to utf8_distance(oldloc, locinput) */
5318                         while (locinput <= ST.maxpos) {
5319                             STRLEN len;
5320                             const UV c = utf8n_to_uvchr((U8*)locinput,
5321                                                   UTF8_MAXBYTES, &len,
5322                                                   uniflags);
5323                             if (c == (UV)ST.c1 || c == (UV)ST.c2)
5324                                 break;
5325                             locinput += len;
5326                             n++;
5327                         }
5328                     }
5329                 }
5330                 else {
5331                     if (ST.c1 == ST.c2) {
5332                         while (locinput <= ST.maxpos &&
5333                                UCHARAT(locinput) != ST.c1)
5334                             locinput++;
5335                     }
5336                     else {
5337                         while (locinput <= ST.maxpos
5338                                && UCHARAT(locinput) != ST.c1
5339                                && UCHARAT(locinput) != ST.c2)
5340                             locinput++;
5341                     }
5342                     n = locinput - ST.oldloc;
5343                 }
5344                 if (locinput > ST.maxpos)
5345                     sayNO;
5346                 /* PL_reginput == oldloc now */
5347                 if (n) {
5348                     ST.count += n;
5349                     if (regrepeat(rex, ST.A, n, depth) < n)
5350                         sayNO;
5351                 }
5352                 PL_reginput = locinput;
5353                 CURLY_SETPAREN(ST.paren, ST.count);
5354                 if (cur_eval && cur_eval->u.eval.close_paren &&
5355                     cur_eval->u.eval.close_paren == (U32)ST.paren) {
5356                     goto fake_end;
5357                 }
5358                 PUSH_STATE_GOTO(CURLY_B_min_known, ST.B);
5359             }
5360             /* NOTREACHED */
5361
5362
5363         case CURLY_B_min_fail:
5364             /* failed to find B in a non-greedy match where c1,c2 invalid */
5365             if (ST.paren && ST.count)
5366                 PL_regoffs[ST.paren].end = -1;
5367
5368             REGCP_UNWIND(ST.cp);
5369             /* failed -- move forward one */
5370             PL_reginput = locinput;
5371             if (regrepeat(rex, ST.A, 1, depth)) {
5372                 ST.count++;
5373                 locinput = PL_reginput;
5374                 if (ST.count <= ST.max || (ST.max == REG_INFTY &&
5375                         ST.count > 0)) /* count overflow ? */
5376                 {
5377                   curly_try_B_min:
5378                     CURLY_SETPAREN(ST.paren, ST.count);
5379                     if (cur_eval && cur_eval->u.eval.close_paren &&
5380                         cur_eval->u.eval.close_paren == (U32)ST.paren) {
5381                         goto fake_end;
5382                     }
5383                     PUSH_STATE_GOTO(CURLY_B_min, ST.B);
5384                 }
5385             }
5386             sayNO;
5387             /* NOTREACHED */
5388
5389
5390         curly_try_B_max:
5391             /* a successful greedy match: now try to match B */
5392             if (cur_eval && cur_eval->u.eval.close_paren &&
5393                 cur_eval->u.eval.close_paren == (U32)ST.paren) {
5394                 goto fake_end;
5395             }
5396             {
5397                 UV c = 0;
5398                 if (ST.c1 != CHRTEST_VOID)
5399                     c = utf8_target ? utf8n_to_uvchr((U8*)PL_reginput,
5400                                            UTF8_MAXBYTES, 0, uniflags)
5401                                 : (UV) UCHARAT(PL_reginput);
5402                 /* If it could work, try it. */
5403                 if (ST.c1 == CHRTEST_VOID || c == (UV)ST.c1 || c == (UV)ST.c2) {
5404                     CURLY_SETPAREN(ST.paren, ST.count);
5405                     PUSH_STATE_GOTO(CURLY_B_max, ST.B);
5406                     /* NOTREACHED */
5407                 }
5408             }
5409             /* FALL THROUGH */
5410         case CURLY_B_max_fail:
5411             /* failed to find B in a greedy match */
5412             if (ST.paren && ST.count)
5413                 PL_regoffs[ST.paren].end = -1;
5414
5415             REGCP_UNWIND(ST.cp);
5416             /*  back up. */
5417             if (--ST.count < ST.min)
5418                 sayNO;
5419             PL_reginput = locinput = HOPc(locinput, -1);
5420             goto curly_try_B_max;
5421
5422 #undef ST
5423
5424         case END:
5425             fake_end:
5426             if (cur_eval) {
5427                 /* we've just finished A in /(??{A})B/; now continue with B */
5428                 I32 tmpix;
5429                 st->u.eval.toggle_reg_flags
5430                             = cur_eval->u.eval.toggle_reg_flags;
5431                 PL_reg_flags ^= st->u.eval.toggle_reg_flags;
5432
5433                 st->u.eval.prev_rex = rex_sv;           /* inner */
5434                 SETREX(rex_sv,cur_eval->u.eval.prev_rex);
5435                 rex = (struct regexp *)SvANY(rex_sv);
5436                 rexi = RXi_GET(rex);
5437                 cur_curlyx = cur_eval->u.eval.prev_curlyx;
5438                 (void)ReREFCNT_inc(rex_sv);
5439                 st->u.eval.cp = regcppush(0);   /* Save *all* the positions. */
5440
5441                 /* rex was changed so update the pointer in PL_reglastparen and PL_reglastcloseparen */
5442                 PL_reglastparen = &rex->lastparen;
5443                 PL_reglastcloseparen = &rex->lastcloseparen;
5444
5445                 REGCP_SET(st->u.eval.lastcp);
5446                 PL_reginput = locinput;
5447
5448                 /* Restore parens of the outer rex without popping the
5449                  * savestack */
5450                 tmpix = PL_savestack_ix;
5451                 PL_savestack_ix = cur_eval->u.eval.lastcp;
5452                 regcppop(rex);
5453                 PL_savestack_ix = tmpix;
5454
5455                 st->u.eval.prev_eval = cur_eval;
5456                 cur_eval = cur_eval->u.eval.prev_eval;
5457                 DEBUG_EXECUTE_r(
5458                     PerlIO_printf(Perl_debug_log, "%*s  EVAL trying tail ... %"UVxf"\n",
5459                                       REPORT_CODE_OFF+depth*2, "",PTR2UV(cur_eval)););
5460                 if ( nochange_depth )
5461                     nochange_depth--;
5462
5463                 PUSH_YES_STATE_GOTO(EVAL_AB,
5464                         st->u.eval.prev_eval->u.eval.B); /* match B */
5465             }
5466
5467             if (locinput < reginfo->till) {
5468                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
5469                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
5470                                       PL_colors[4],
5471                                       (long)(locinput - PL_reg_starttry),
5472                                       (long)(reginfo->till - PL_reg_starttry),
5473                                       PL_colors[5]));
5474
5475                 sayNO_SILENT;           /* Cannot match: too short. */
5476             }
5477             PL_reginput = locinput;     /* put where regtry can find it */
5478             sayYES;                     /* Success! */
5479
5480         case SUCCEED: /* successful SUSPEND/UNLESSM/IFMATCH/CURLYM */
5481             DEBUG_EXECUTE_r(
5482             PerlIO_printf(Perl_debug_log,
5483                 "%*s  %ssubpattern success...%s\n",
5484                 REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5]));
5485             PL_reginput = locinput;     /* put where regtry can find it */
5486             sayYES;                     /* Success! */
5487
5488 #undef  ST
5489 #define ST st->u.ifmatch
5490
5491         case SUSPEND:   /* (?>A) */
5492             ST.wanted = 1;
5493             PL_reginput = locinput;
5494             goto do_ifmatch;
5495
5496         case UNLESSM:   /* -ve lookaround: (?!A), or with flags, (?<!A) */
5497             ST.wanted = 0;
5498             goto ifmatch_trivial_fail_test;
5499
5500         case IFMATCH:   /* +ve lookaround: (?=A), or with flags, (?<=A) */
5501             ST.wanted = 1;
5502           ifmatch_trivial_fail_test:
5503             if (scan->flags) {
5504                 char * const s = HOPBACKc(locinput, scan->flags);
5505                 if (!s) {
5506                     /* trivial fail */
5507                     if (logical) {
5508                         logical = 0;
5509                         sw = 1 - cBOOL(ST.wanted);
5510                     }
5511                     else if (ST.wanted)
5512                         sayNO;
5513                     next = scan + ARG(scan);
5514                     if (next == scan)
5515                         next = NULL;
5516                     break;
5517                 }
5518                 PL_reginput = s;
5519             }
5520             else
5521                 PL_reginput = locinput;
5522
5523           do_ifmatch:
5524             ST.me = scan;
5525             ST.logical = logical;
5526             logical = 0; /* XXX: reset state of logical once it has been saved into ST */
5527
5528             /* execute body of (?...A) */
5529             PUSH_YES_STATE_GOTO(IFMATCH_A, NEXTOPER(NEXTOPER(scan)));
5530             /* NOTREACHED */
5531
5532         case IFMATCH_A_fail: /* body of (?...A) failed */
5533             ST.wanted = !ST.wanted;
5534             /* FALL THROUGH */
5535
5536         case IFMATCH_A: /* body of (?...A) succeeded */
5537             if (ST.logical) {
5538                 sw = cBOOL(ST.wanted);
5539             }
5540             else if (!ST.wanted)
5541                 sayNO;
5542
5543             if (OP(ST.me) == SUSPEND)
5544                 locinput = PL_reginput;
5545             else {
5546                 locinput = PL_reginput = st->locinput;
5547                 nextchr = UCHARAT(locinput);
5548             }
5549             scan = ST.me + ARG(ST.me);
5550             if (scan == ST.me)
5551                 scan = NULL;
5552             continue; /* execute B */
5553
5554 #undef ST
5555
5556         case LONGJMP:
5557             next = scan + ARG(scan);
5558             if (next == scan)
5559                 next = NULL;
5560             break;
5561         case COMMIT:
5562             reginfo->cutpoint = PL_regeol;
5563             /* FALLTHROUGH */
5564         case PRUNE:
5565             PL_reginput = locinput;
5566             if (!scan->flags)
5567                 sv_yes_mark = sv_commit = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
5568             PUSH_STATE_GOTO(COMMIT_next,next);
5569             /* NOTREACHED */
5570         case COMMIT_next_fail:
5571             no_final = 1;
5572             /* FALLTHROUGH */
5573         case OPFAIL:
5574             sayNO;
5575             /* NOTREACHED */
5576
5577 #define ST st->u.mark
5578         case MARKPOINT:
5579             ST.prev_mark = mark_state;
5580             ST.mark_name = sv_commit = sv_yes_mark
5581                 = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
5582             mark_state = st;
5583             ST.mark_loc = PL_reginput = locinput;
5584             PUSH_YES_STATE_GOTO(MARKPOINT_next,next);
5585             /* NOTREACHED */
5586         case MARKPOINT_next:
5587             mark_state = ST.prev_mark;
5588             sayYES;
5589             /* NOTREACHED */
5590         case MARKPOINT_next_fail:
5591             if (popmark && sv_eq(ST.mark_name,popmark))
5592             {
5593                 if (ST.mark_loc > startpoint)
5594                     reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1);
5595                 popmark = NULL; /* we found our mark */
5596                 sv_commit = ST.mark_name;
5597
5598                 DEBUG_EXECUTE_r({
5599                         PerlIO_printf(Perl_debug_log,
5600                             "%*s  %ssetting cutpoint to mark:%"SVf"...%s\n",
5601                             REPORT_CODE_OFF+depth*2, "",
5602                             PL_colors[4], SVfARG(sv_commit), PL_colors[5]);
5603                 });
5604             }
5605             mark_state = ST.prev_mark;
5606             sv_yes_mark = mark_state ?
5607                 mark_state->u.mark.mark_name : NULL;
5608             sayNO;
5609             /* NOTREACHED */
5610         case SKIP:
5611             PL_reginput = locinput;
5612             if (scan->flags) {
5613                 /* (*SKIP) : if we fail we cut here*/
5614                 ST.mark_name = NULL;
5615                 ST.mark_loc = locinput;
5616                 PUSH_STATE_GOTO(SKIP_next,next);
5617             } else {
5618                 /* (*SKIP:NAME) : if there is a (*MARK:NAME) fail where it was,
5619                    otherwise do nothing.  Meaning we need to scan
5620                  */
5621                 regmatch_state *cur = mark_state;
5622                 SV *find = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
5623
5624                 while (cur) {
5625                     if ( sv_eq( cur->u.mark.mark_name,
5626                                 find ) )
5627                     {
5628                         ST.mark_name = find;
5629                         PUSH_STATE_GOTO( SKIP_next, next );
5630                     }
5631                     cur = cur->u.mark.prev_mark;
5632                 }
5633             }
5634             /* Didn't find our (*MARK:NAME) so ignore this (*SKIP:NAME) */
5635             break;
5636         case SKIP_next_fail:
5637             if (ST.mark_name) {
5638                 /* (*CUT:NAME) - Set up to search for the name as we
5639                    collapse the stack*/
5640                 popmark = ST.mark_name;
5641             } else {
5642                 /* (*CUT) - No name, we cut here.*/
5643                 if (ST.mark_loc > startpoint)
5644                     reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1);
5645                 /* but we set sv_commit to latest mark_name if there
5646                    is one so they can test to see how things lead to this
5647                    cut */
5648                 if (mark_state)
5649                     sv_commit=mark_state->u.mark.mark_name;
5650             }
5651             no_final = 1;
5652             sayNO;
5653             /* NOTREACHED */
5654 #undef ST
5655         case FOLDCHAR:
5656             n = ARG(scan);
5657             if ( n == (U32)what_len_TRICKYFOLD(locinput,utf8_target,ln) ) {
5658                 locinput += ln;
5659             } else if ( LATIN_SMALL_LETTER_SHARP_S == n && !utf8_target && !UTF_PATTERN ) {
5660                 sayNO;
5661             } else  {
5662                 U8 folded[UTF8_MAXBYTES_CASE+1];
5663                 STRLEN foldlen;
5664                 const char * const l = locinput;
5665                 char *e = PL_regeol;
5666                 to_uni_fold(n, folded, &foldlen);
5667
5668                 if (! foldEQ_utf8((const char*) folded, 0,  foldlen, 1,
5669                                l, &e, 0,  utf8_target)) {
5670                         sayNO;
5671                 }
5672                 locinput = e;
5673             }
5674             nextchr = UCHARAT(locinput);
5675             break;
5676         case LNBREAK:
5677             if ((n=is_LNBREAK(locinput,utf8_target))) {
5678                 locinput += n;
5679                 nextchr = UCHARAT(locinput);
5680             } else
5681                 sayNO;
5682             break;
5683
5684 #define CASE_CLASS(nAmE)                              \
5685         case nAmE:                                    \
5686             if (locinput >= PL_regeol)                \
5687                 sayNO;                                \
5688             if ((n=is_##nAmE(locinput,utf8_target))) {    \
5689                 locinput += n;                        \
5690                 nextchr = UCHARAT(locinput);          \
5691             } else                                    \
5692                 sayNO;                                \
5693             break;                                    \
5694         case N##nAmE:                                 \
5695             if (locinput >= PL_regeol)                \
5696                 sayNO;                                \
5697             if ((n=is_##nAmE(locinput,utf8_target))) {    \
5698                 sayNO;                                \
5699             } else {                                  \
5700                 locinput += UTF8SKIP(locinput);       \
5701                 nextchr = UCHARAT(locinput);          \
5702             }                                         \
5703             break
5704
5705         CASE_CLASS(VERTWS);
5706         CASE_CLASS(HORIZWS);
5707 #undef CASE_CLASS
5708
5709         default:
5710             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
5711                           PTR2UV(scan), OP(scan));
5712             Perl_croak(aTHX_ "regexp memory corruption");
5713
5714         } /* end switch */
5715
5716         /* switch break jumps here */
5717         scan = next; /* prepare to execute the next op and ... */
5718         continue;    /* ... jump back to the top, reusing st */
5719         /* NOTREACHED */
5720
5721       push_yes_state:
5722         /* push a state that backtracks on success */
5723         st->u.yes.prev_yes_state = yes_state;
5724         yes_state = st;
5725         /* FALL THROUGH */
5726       push_state:
5727         /* push a new regex state, then continue at scan  */
5728         {
5729             regmatch_state *newst;
5730
5731             DEBUG_STACK_r({
5732                 regmatch_state *cur = st;
5733                 regmatch_state *curyes = yes_state;
5734                 int curd = depth;
5735                 regmatch_slab *slab = PL_regmatch_slab;
5736                 for (;curd > -1;cur--,curd--) {
5737                     if (cur < SLAB_FIRST(slab)) {
5738                         slab = slab->prev;
5739                         cur = SLAB_LAST(slab);
5740                     }
5741                     PerlIO_printf(Perl_error_log, "%*s#%-3d %-10s %s\n",
5742                         REPORT_CODE_OFF + 2 + depth * 2,"",
5743                         curd, PL_reg_name[cur->resume_state],
5744                         (curyes == cur) ? "yes" : ""
5745                     );
5746                     if (curyes == cur)
5747                         curyes = cur->u.yes.prev_yes_state;
5748                 }
5749             } else
5750                 DEBUG_STATE_pp("push")
5751             );
5752             depth++;
5753             st->locinput = locinput;
5754             newst = st+1;
5755             if (newst >  SLAB_LAST(PL_regmatch_slab))
5756                 newst = S_push_slab(aTHX);
5757             PL_regmatch_state = newst;
5758
5759             locinput = PL_reginput;
5760             nextchr = UCHARAT(locinput);
5761             st = newst;
5762             continue;
5763             /* NOTREACHED */
5764         }
5765     }
5766
5767     /*
5768     * We get here only if there's trouble -- normally "case END" is
5769     * the terminating point.
5770     */
5771     Perl_croak(aTHX_ "corrupted regexp pointers");
5772     /*NOTREACHED*/
5773     sayNO;
5774
5775 yes:
5776     if (yes_state) {
5777         /* we have successfully completed a subexpression, but we must now
5778          * pop to the state marked by yes_state and continue from there */
5779         assert(st != yes_state);
5780 #ifdef DEBUGGING
5781         while (st != yes_state) {
5782             st--;
5783             if (st < SLAB_FIRST(PL_regmatch_slab)) {
5784                 PL_regmatch_slab = PL_regmatch_slab->prev;
5785                 st = SLAB_LAST(PL_regmatch_slab);
5786             }
5787             DEBUG_STATE_r({
5788                 if (no_final) {
5789                     DEBUG_STATE_pp("pop (no final)");
5790                 } else {
5791                     DEBUG_STATE_pp("pop (yes)");
5792                 }
5793             });
5794             depth--;
5795         }
5796 #else
5797         while (yes_state < SLAB_FIRST(PL_regmatch_slab)
5798             || yes_state > SLAB_LAST(PL_regmatch_slab))
5799         {
5800             /* not in this slab, pop slab */
5801             depth -= (st - SLAB_FIRST(PL_regmatch_slab) + 1);
5802             PL_regmatch_slab = PL_regmatch_slab->prev;
5803             st = SLAB_LAST(PL_regmatch_slab);
5804         }
5805         depth -= (st - yes_state);
5806 #endif
5807         st = yes_state;
5808         yes_state = st->u.yes.prev_yes_state;
5809         PL_regmatch_state = st;
5810
5811         if (no_final) {
5812             locinput= st->locinput;
5813             nextchr = UCHARAT(locinput);
5814         }
5815         state_num = st->resume_state + no_final;
5816         goto reenter_switch;
5817     }
5818
5819     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
5820                           PL_colors[4], PL_colors[5]));
5821
5822     if (PL_reg_eval_set) {
5823         /* each successfully executed (?{...}) block does the equivalent of
5824          *   local $^R = do {...}
5825          * When popping the save stack, all these locals would be undone;
5826          * bypass this by setting the outermost saved $^R to the latest
5827          * value */
5828         if (oreplsv != GvSV(PL_replgv))
5829             sv_setsv(oreplsv, GvSV(PL_replgv));
5830     }
5831     result = 1;
5832     goto final_exit;
5833
5834 no:
5835     DEBUG_EXECUTE_r(
5836         PerlIO_printf(Perl_debug_log,
5837             "%*s  %sfailed...%s\n",
5838             REPORT_CODE_OFF+depth*2, "",
5839             PL_colors[4], PL_colors[5])
5840         );
5841
5842 no_silent:
5843     if (no_final) {
5844         if (yes_state) {
5845             goto yes;
5846         } else {
5847             goto final_exit;
5848         }
5849     }
5850     if (depth) {
5851         /* there's a previous state to backtrack to */
5852         st--;
5853         if (st < SLAB_FIRST(PL_regmatch_slab)) {
5854             PL_regmatch_slab = PL_regmatch_slab->prev;
5855             st = SLAB_LAST(PL_regmatch_slab);
5856         }
5857         PL_regmatch_state = st;
5858         locinput= st->locinput;
5859         nextchr = UCHARAT(locinput);
5860
5861         DEBUG_STATE_pp("pop");
5862         depth--;
5863         if (yes_state == st)
5864             yes_state = st->u.yes.prev_yes_state;
5865
5866         state_num = st->resume_state + 1; /* failure = success + 1 */
5867         goto reenter_switch;
5868     }
5869     result = 0;
5870
5871   final_exit:
5872     if (rex->intflags & PREGf_VERBARG_SEEN) {
5873         SV *sv_err = get_sv("REGERROR", 1);
5874         SV *sv_mrk = get_sv("REGMARK", 1);
5875         if (result) {
5876             sv_commit = &PL_sv_no;
5877             if (!sv_yes_mark)
5878                 sv_yes_mark = &PL_sv_yes;
5879         } else {
5880             if (!sv_commit)
5881                 sv_commit = &PL_sv_yes;
5882             sv_yes_mark = &PL_sv_no;
5883         }
5884         sv_setsv(sv_err, sv_commit);
5885         sv_setsv(sv_mrk, sv_yes_mark);
5886     }
5887
5888     /* clean up; in particular, free all slabs above current one */
5889     LEAVE_SCOPE(oldsave);
5890
5891     return result;
5892 }
5893
5894 /*
5895  - regrepeat - repeatedly match something simple, report how many
5896  */
5897 /*
5898  * [This routine now assumes that it will only match on things of length 1.
5899  * That was true before, but now we assume scan - reginput is the count,
5900  * rather than incrementing count on every character.  [Er, except utf8.]]
5901  */
5902 STATIC I32
5903 S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth)
5904 {
5905     dVAR;
5906     register char *scan;
5907     register I32 c;
5908     register char *loceol = PL_regeol;
5909     register I32 hardcount = 0;
5910     register bool utf8_target = PL_reg_match_utf8;
5911     UV utf8_flags;
5912 #ifndef DEBUGGING
5913     PERL_UNUSED_ARG(depth);
5914 #endif
5915
5916     PERL_ARGS_ASSERT_REGREPEAT;
5917
5918     scan = PL_reginput;
5919     if (max == REG_INFTY)
5920         max = I32_MAX;
5921     else if (max < loceol - scan)
5922         loceol = scan + max;
5923     switch (OP(p)) {
5924     case REG_ANY:
5925         if (utf8_target) {
5926             loceol = PL_regeol;
5927             while (scan < loceol && hardcount < max && *scan != '\n') {
5928                 scan += UTF8SKIP(scan);
5929                 hardcount++;
5930             }
5931         } else {
5932             while (scan < loceol && *scan != '\n')
5933                 scan++;
5934         }
5935         break;
5936     case SANY:
5937         if (utf8_target) {
5938             loceol = PL_regeol;
5939             while (scan < loceol && hardcount < max) {
5940                 scan += UTF8SKIP(scan);
5941                 hardcount++;
5942             }
5943         }
5944         else
5945             scan = loceol;
5946         break;
5947     case CANY:
5948         scan = loceol;
5949         break;
5950     case EXACT:
5951         /* To get here, EXACTish nodes must have *byte* length == 1.  That
5952          * means they match only characters in the string that can be expressed
5953          * as a single byte.  For non-utf8 strings, that means a simple match.
5954          * For utf8 strings, the character matched must be an invariant, or
5955          * downgradable to a single byte.  The pattern's utf8ness is
5956          * irrelevant, as since it's a single byte, it either isn't utf8, or if
5957          * it is, it's an invariant */
5958
5959         c = (U8)*STRING(p);
5960         assert(! UTF_PATTERN || UNI_IS_INVARIANT(c));
5961
5962         if (! utf8_target || UNI_IS_INVARIANT(c)) {
5963             while (scan < loceol && UCHARAT(scan) == c) {
5964                 scan++;
5965             }
5966         }
5967         else {
5968
5969             /* Here, the string is utf8, and the pattern char is different
5970              * in utf8 than not, so can't compare them directly.  Outside the
5971              * loop, find find the two utf8 bytes that represent c, and then
5972              * look for those in sequence in the utf8 string */
5973             U8 high = UTF8_TWO_BYTE_HI(c);
5974             U8 low = UTF8_TWO_BYTE_LO(c);
5975             loceol = PL_regeol;
5976
5977             while (hardcount < max
5978                     && scan + 1 < loceol
5979                     && UCHARAT(scan) == high
5980                     && UCHARAT(scan + 1) == low)
5981             {
5982                 scan += 2;
5983                 hardcount++;
5984             }
5985         }
5986         break;
5987     case EXACTFA:
5988         utf8_flags = FOLDEQ_UTF8_NOMIX_ASCII;
5989         goto do_exactf;
5990
5991     case EXACTFL:
5992         PL_reg_flags |= RF_tainted;
5993         utf8_flags = FOLDEQ_UTF8_LOCALE;
5994         goto do_exactf;
5995
5996     case EXACTF:
5997     case EXACTFU:
5998         utf8_flags = 0;
5999
6000         /* The comments for the EXACT case above apply as well to these fold
6001          * ones */
6002
6003     do_exactf:
6004         c = (U8)*STRING(p);
6005         assert(! UTF_PATTERN || UNI_IS_INVARIANT(c));
6006
6007         if (utf8_target) { /* Use full Unicode fold matching */
6008             char *tmpeol = loceol;
6009             while (hardcount < max
6010                     && foldEQ_utf8_flags(scan, &tmpeol, 0, utf8_target,
6011                                    STRING(p), NULL, 1, cBOOL(UTF_PATTERN), utf8_flags))
6012             {
6013                 scan = tmpeol;
6014                 tmpeol = loceol;
6015                 hardcount++;
6016             }
6017
6018             /* XXX Note that the above handles properly the German sharp s in
6019              * the pattern matching ss in the string.  But it doesn't handle
6020              * properly cases where the string contains say 'LIGATURE ff' and
6021              * the pattern is 'f+'.  This would require, say, a new function or
6022              * revised interface to foldEQ_utf8(), in which the maximum number
6023              * of characters to match could be passed and it would return how
6024              * many actually did.  This is just one of many cases where
6025              * multi-char folds don't work properly, and so the fix is being
6026              * deferred */
6027         }
6028         else {
6029             U8 folded;
6030
6031             /* Here, the string isn't utf8 and c is a single byte; and either
6032              * the pattern isn't utf8 or c is an invariant, so its utf8ness
6033              * doesn't affect c.  Can just do simple comparisons for exact or
6034              * fold matching. */
6035             switch (OP(p)) {
6036                 case EXACTF: folded = PL_fold[c]; break;
6037                 case EXACTFA:
6038                 case EXACTFU: folded = PL_fold_latin1[c]; break;
6039                 case EXACTFL: folded = PL_fold_locale[c]; break;
6040                 default: Perl_croak(aTHX_ "panic: Unexpected op %u", OP(p));
6041             }
6042             while (scan < loceol &&
6043                    (UCHARAT(scan) == c || UCHARAT(scan) == folded))
6044             {
6045                 scan++;
6046             }
6047         }
6048         break;
6049     case ANYOFV:
6050     case ANYOF:
6051         if (utf8_target || OP(p) == ANYOFV) {
6052             STRLEN inclasslen;
6053             loceol = PL_regeol;
6054             inclasslen = loceol - scan;
6055             while (hardcount < max
6056                    && ((inclasslen = loceol - scan) > 0)
6057                    && reginclass(prog, p, (U8*)scan, &inclasslen, utf8_target))
6058             {
6059                 scan += inclasslen;
6060                 hardcount++;
6061             }
6062         } else {
6063             while (scan < loceol && REGINCLASS(prog, p, (U8*)scan))
6064                 scan++;
6065         }
6066         break;
6067     case ALNUMU:
6068         if (utf8_target) {
6069     utf8_wordchar:
6070             loceol = PL_regeol;
6071             LOAD_UTF8_CHARCLASS_ALNUM();
6072             while (hardcount < max && scan < loceol &&
6073                    swash_fetch(PL_utf8_alnum, (U8*)scan, utf8_target))
6074             {
6075                 scan += UTF8SKIP(scan);
6076                 hardcount++;
6077             }
6078         } else {
6079             while (scan < loceol && isWORDCHAR_L1((U8) *scan)) {
6080                 scan++;
6081             }
6082         }
6083         break;
6084     case ALNUM:
6085         if (utf8_target)
6086             goto utf8_wordchar;
6087         while (scan < loceol && isALNUM((U8) *scan)) {
6088             scan++;
6089         }
6090         break;
6091     case ALNUMA:
6092         while (scan < loceol && isWORDCHAR_A((U8) *scan)) {
6093             scan++;
6094         }
6095         break;
6096     case ALNUML:
6097         PL_reg_flags |= RF_tainted;
6098         if (utf8_target) {
6099             loceol = PL_regeol;
6100             while (hardcount < max && scan < loceol &&
6101                    isALNUM_LC_utf8((U8*)scan)) {
6102                 scan += UTF8SKIP(scan);
6103                 hardcount++;
6104             }
6105         } else {
6106             while (scan < loceol && isALNUM_LC(*scan))
6107                 scan++;
6108         }
6109         break;
6110     case NALNUMU:
6111         if (utf8_target) {
6112
6113     utf8_Nwordchar:
6114
6115             loceol = PL_regeol;
6116             LOAD_UTF8_CHARCLASS_ALNUM();
6117             while (hardcount < max && scan < loceol &&
6118                    ! swash_fetch(PL_utf8_alnum, (U8*)scan, utf8_target))
6119             {
6120                 scan += UTF8SKIP(scan);
6121                 hardcount++;
6122             }
6123         } else {
6124             while (scan < loceol && ! isWORDCHAR_L1((U8) *scan)) {
6125                 scan++;
6126             }
6127         }
6128         break;
6129     case NALNUM:
6130         if (utf8_target)
6131             goto utf8_Nwordchar;
6132         while (scan < loceol && ! isALNUM((U8) *scan)) {
6133             scan++;
6134         }
6135         break;
6136     case NALNUMA:
6137         if (utf8_target) {
6138             while (scan < loceol && ! isWORDCHAR_A((U8) *scan)) {
6139                 scan += UTF8SKIP(scan);
6140             }
6141         }
6142         else {
6143             while (scan < loceol && ! isWORDCHAR_A((U8) *scan)) {
6144                 scan++;
6145             }
6146         }
6147         break;
6148     case NALNUML:
6149         PL_reg_flags |= RF_tainted;
6150         if (utf8_target) {
6151             loceol = PL_regeol;
6152             while (hardcount < max && scan < loceol &&
6153                    !isALNUM_LC_utf8((U8*)scan)) {
6154                 scan += UTF8SKIP(scan);
6155                 hardcount++;
6156             }
6157         } else {
6158             while (scan < loceol && !isALNUM_LC(*scan))
6159                 scan++;
6160         }
6161         break;
6162     case SPACEU:
6163         if (utf8_target) {
6164
6165     utf8_space:
6166
6167             loceol = PL_regeol;
6168             LOAD_UTF8_CHARCLASS_SPACE();
6169             while (hardcount < max && scan < loceol &&
6170                    (*scan == ' ' ||
6171                     swash_fetch(PL_utf8_space,(U8*)scan, utf8_target)))
6172             {
6173                 scan += UTF8SKIP(scan);
6174                 hardcount++;
6175             }
6176             break;
6177         }
6178         else {
6179             while (scan < loceol && isSPACE_L1((U8) *scan)) {
6180                 scan++;
6181             }
6182             break;
6183         }
6184     case SPACE:
6185         if (utf8_target)
6186             goto utf8_space;
6187
6188         while (scan < loceol && isSPACE((U8) *scan)) {
6189             scan++;
6190         }
6191         break;
6192     case SPACEA:
6193         while (scan < loceol && isSPACE_A((U8) *scan)) {
6194             scan++;
6195         }
6196         break;
6197     case SPACEL:
6198         PL_reg_flags |= RF_tainted;
6199         if (utf8_target) {
6200             loceol = PL_regeol;
6201             while (hardcount < max && scan < loceol &&
6202                    isSPACE_LC_utf8((U8*)scan)) {
6203                 scan += UTF8SKIP(scan);
6204                 hardcount++;
6205             }
6206         } else {
6207             while (scan < loceol && isSPACE_LC(*scan))
6208                 scan++;
6209         }
6210         break;
6211     case NSPACEU:
6212         if (utf8_target) {
6213
6214     utf8_Nspace:
6215
6216             loceol = PL_regeol;
6217             LOAD_UTF8_CHARCLASS_SPACE();
6218             while (hardcount < max && scan < loceol &&
6219                    ! (*scan == ' ' ||
6220                       swash_fetch(PL_utf8_space,(U8*)scan, utf8_target)))
6221             {
6222                 scan += UTF8SKIP(scan);
6223                 hardcount++;
6224             }
6225             break;
6226         }
6227         else {
6228             while (scan < loceol && ! isSPACE_L1((U8) *scan)) {
6229                 scan++;
6230             }
6231         }
6232         break;
6233     case NSPACE:
6234         if (utf8_target)
6235             goto utf8_Nspace;
6236
6237         while (scan < loceol && ! isSPACE((U8) *scan)) {
6238             scan++;
6239         }
6240         break;
6241     case NSPACEA:
6242         if (utf8_target) {
6243             while (scan < loceol && ! isSPACE_A((U8) *scan)) {
6244                 scan += UTF8SKIP(scan);
6245             }
6246         }
6247         else {
6248             while (scan < loceol && ! isSPACE_A((U8) *scan)) {
6249                 scan++;
6250             }
6251         }
6252         break;
6253     case NSPACEL:
6254         PL_reg_flags |= RF_tainted;
6255         if (utf8_target) {
6256             loceol = PL_regeol;
6257             while (hardcount < max && scan < loceol &&
6258                    !isSPACE_LC_utf8((U8*)scan)) {
6259                 scan += UTF8SKIP(scan);
6260                 hardcount++;
6261             }
6262         } else {
6263             while (scan < loceol && !isSPACE_LC(*scan))
6264                 scan++;
6265         }
6266         break;
6267     case DIGIT:
6268         if (utf8_target) {
6269             loceol = PL_regeol;
6270             LOAD_UTF8_CHARCLASS_DIGIT();
6271             while (hardcount < max && scan < loceol &&
6272                    swash_fetch(PL_utf8_digit, (U8*)scan, utf8_target)) {
6273                 scan += UTF8SKIP(scan);
6274                 hardcount++;
6275             }
6276         } else {
6277             while (scan < loceol && isDIGIT(*scan))
6278                 scan++;
6279         }
6280         break;
6281     case DIGITA:
6282         while (scan < loceol && isDIGIT_A((U8) *scan)) {
6283             scan++;
6284         }
6285         break;
6286     case DIGITL:
6287         PL_reg_flags |= RF_tainted;
6288         if (utf8_target) {
6289             loceol = PL_regeol;
6290             while (hardcount < max && scan < loceol &&
6291                    isDIGIT_LC_utf8((U8*)scan)) {
6292                 scan += UTF8SKIP(scan);
6293                 hardcount++;
6294             }
6295         } else {
6296             while (scan < loceol && isDIGIT_LC(*scan))
6297                 scan++;
6298         }
6299         break;
6300     case NDIGIT:
6301         if (utf8_target) {
6302             loceol = PL_regeol;
6303             LOAD_UTF8_CHARCLASS_DIGIT();
6304             while (hardcount < max && scan < loceol &&
6305                    !swash_fetch(PL_utf8_digit, (U8*)scan, utf8_target)) {
6306                 scan += UTF8SKIP(scan);
6307                 hardcount++;
6308             }
6309         } else {
6310             while (scan < loceol && !isDIGIT(*scan))
6311                 scan++;
6312         }
6313         break;
6314     case NDIGITA:
6315         if (utf8_target) {
6316             while (scan < loceol && ! isDIGIT_A((U8) *scan)) {
6317                 scan += UTF8SKIP(scan);
6318             }
6319         }
6320         else {
6321             while (scan < loceol && ! isDIGIT_A((U8) *scan)) {
6322                 scan++;
6323             }
6324         }
6325         break;
6326     case NDIGITL:
6327         PL_reg_flags |= RF_tainted;
6328         if (utf8_target) {
6329             loceol = PL_regeol;
6330             while (hardcount < max && scan < loceol &&
6331                    !isDIGIT_LC_utf8((U8*)scan)) {
6332                 scan += UTF8SKIP(scan);
6333                 hardcount++;
6334             }
6335         } else {
6336             while (scan < loceol && !isDIGIT_LC(*scan))
6337                 scan++;
6338         }
6339         break;
6340     case LNBREAK:
6341         if (utf8_target) {
6342             loceol = PL_regeol;
6343             while (hardcount < max && scan < loceol && (c=is_LNBREAK_utf8(scan))) {
6344                 scan += c;
6345                 hardcount++;
6346             }
6347         } else {
6348             /*
6349               LNBREAK can match two latin chars, which is ok,
6350               because we have a null terminated string, but we
6351               have to use hardcount in this situation
6352             */
6353             while (scan < loceol && (c=is_LNBREAK_latin1(scan)))  {
6354                 scan+=c;
6355                 hardcount++;
6356             }
6357         }
6358         break;
6359     case HORIZWS:
6360         if (utf8_target) {
6361             loceol = PL_regeol;
6362             while (hardcount < max && scan < loceol && (c=is_HORIZWS_utf8(scan))) {
6363                 scan += c;
6364                 hardcount++;
6365             }
6366         } else {
6367             while (scan < loceol && is_HORIZWS_latin1(scan))
6368                 scan++;
6369         }
6370         break;
6371     case NHORIZWS:
6372         if (utf8_target) {
6373             loceol = PL_regeol;
6374             while (hardcount < max && scan < loceol && !is_HORIZWS_utf8(scan)) {
6375                 scan += UTF8SKIP(scan);
6376                 hardcount++;
6377             }
6378         } else {
6379             while (scan < loceol && !is_HORIZWS_latin1(scan))
6380                 scan++;
6381
6382         }
6383         break;
6384     case VERTWS:
6385         if (utf8_target) {
6386             loceol = PL_regeol;
6387             while (hardcount < max && scan < loceol && (c=is_VERTWS_utf8(scan))) {
6388                 scan += c;
6389                 hardcount++;
6390             }
6391         } else {
6392             while (scan < loceol && is_VERTWS_latin1(scan))
6393                 scan++;
6394
6395         }
6396         break;
6397     case NVERTWS:
6398         if (utf8_target) {
6399             loceol = PL_regeol;
6400             while (hardcount < max && scan < loceol && !is_VERTWS_utf8(scan)) {
6401                 scan += UTF8SKIP(scan);
6402                 hardcount++;
6403             }
6404         } else {
6405             while (scan < loceol && !is_VERTWS_latin1(scan))
6406                 scan++;
6407
6408         }
6409         break;
6410
6411     default:            /* Called on something of 0 width. */
6412         break;          /* So match right here or not at all. */
6413     }
6414
6415     if (hardcount)
6416         c = hardcount;
6417     else
6418         c = scan - PL_reginput;
6419     PL_reginput = scan;
6420
6421     DEBUG_r({
6422         GET_RE_DEBUG_FLAGS_DECL;
6423         DEBUG_EXECUTE_r({
6424             SV * const prop = sv_newmortal();
6425             regprop(prog, prop, p);
6426             PerlIO_printf(Perl_debug_log,
6427                         "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
6428                         REPORT_CODE_OFF + depth*2, "", SvPVX_const(prop),(IV)c,(IV)max);
6429         });
6430     });
6431
6432     return(c);
6433 }
6434
6435
6436 #if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION)
6437 /*
6438 - regclass_swash - prepare the utf8 swash
6439 */
6440
6441 SV *
6442 Perl_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool doinit, SV** listsvp, SV **altsvp)
6443 {
6444     dVAR;
6445     SV *sw  = NULL;
6446     SV *si  = NULL;
6447     SV *alt = NULL;
6448     RXi_GET_DECL(prog,progi);
6449     const struct reg_data * const data = prog ? progi->data : NULL;
6450
6451     PERL_ARGS_ASSERT_REGCLASS_SWASH;
6452
6453     assert(ANYOF_NONBITMAP(node));
6454
6455     if (data && data->count) {
6456         const U32 n = ARG(node);
6457
6458         if (data->what[n] == 's') {
6459             SV * const rv = MUTABLE_SV(data->data[n]);
6460             AV * const av = MUTABLE_AV(SvRV(rv));
6461             SV **const ary = AvARRAY(av);
6462             SV **a, **b;
6463
6464             /* See the end of regcomp.c:S_regclass() for
6465              * documentation of these array elements. */
6466
6467             si = *ary;
6468             a  = SvROK(ary[1]) ? &ary[1] : NULL;
6469             b  = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : NULL;
6470
6471             if (a)
6472                 sw = *a;
6473             else if (si && doinit) {
6474                 sw = swash_init("utf8", "", si, 1, 0);
6475                 (void)av_store(av, 1, sw);
6476             }
6477             if (b)
6478                 alt = *b;
6479         }
6480     }
6481
6482     if (listsvp)
6483         *listsvp = si;
6484     if (altsvp)
6485         *altsvp  = alt;
6486
6487     return sw;
6488 }
6489 #endif
6490
6491 /*
6492  - reginclass - determine if a character falls into a character class
6493
6494   n is the ANYOF regnode
6495   p is the target string
6496   lenp is pointer to the maximum number of bytes of how far to go in p
6497     (This is assumed wthout checking to always be at least the current
6498     character's size)
6499   utf8_target tells whether p is in UTF-8.
6500
6501   Returns true if matched; false otherwise.  If lenp is not NULL, on return
6502   from a successful match, the value it points to will be updated to how many
6503   bytes in p were matched.  If there was no match, the value is undefined,
6504   possibly changed from the input.
6505
6506   Note that this can be a synthetic start class, a combination of various
6507   nodes, so things you think might be mutually exclusive, such as locale,
6508   aren't.  It can match both locale and non-locale
6509
6510  */
6511
6512 STATIC bool
6513 S_reginclass(pTHX_ const regexp * const prog, register const regnode * const n, register const U8* const p, STRLEN* lenp, register const bool utf8_target)
6514 {
6515     dVAR;
6516     const char flags = ANYOF_FLAGS(n);
6517     bool match = FALSE;
6518     UV c = *p;
6519     STRLEN c_len = 0;
6520     STRLEN maxlen;
6521
6522     PERL_ARGS_ASSERT_REGINCLASS;
6523
6524     /* If c is not already the code point, get it */
6525     if (utf8_target && !UTF8_IS_INVARIANT(c)) {
6526         c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &c_len,
6527                 (UTF8_ALLOW_DEFAULT & UTF8_ALLOW_ANYUV)
6528                 | UTF8_ALLOW_FFFF | UTF8_CHECK_ONLY);
6529                 /* see [perl #37836] for UTF8_ALLOW_ANYUV; [perl #38293] for
6530                  * UTF8_ALLOW_FFFF */
6531         if (c_len == (STRLEN)-1)
6532             Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
6533     }
6534     else {
6535         c_len = 1;
6536     }
6537
6538     /* Use passed in max length, or one character if none passed in or less
6539      * than one character.  And assume will match just one character.  This is
6540      * overwritten later if matched more. */
6541     if (lenp) {
6542         maxlen = (*lenp > c_len) ? *lenp : c_len;
6543         *lenp = c_len;
6544
6545     }
6546     else {
6547         maxlen = c_len;
6548     }
6549
6550     /* If this character is potentially in the bitmap, check it */
6551     if (c < 256) {
6552         if (ANYOF_BITMAP_TEST(n, c))
6553             match = TRUE;
6554         else if (flags & ANYOF_NON_UTF8_LATIN1_ALL
6555                 && ! utf8_target
6556                 && ! isASCII(c))
6557         {
6558             match = TRUE;
6559         }
6560
6561         else if (flags & ANYOF_LOCALE) {
6562             PL_reg_flags |= RF_tainted;
6563
6564             if ((flags & ANYOF_LOC_NONBITMAP_FOLD)
6565                  && ANYOF_BITMAP_TEST(n, PL_fold_locale[c]))
6566             {
6567                 match = TRUE;
6568             }
6569             else if (ANYOF_CLASS_TEST_ANY_SET(n) &&
6570                      ((ANYOF_CLASS_TEST(n, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
6571                       (ANYOF_CLASS_TEST(n, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
6572                       (ANYOF_CLASS_TEST(n, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
6573                       (ANYOF_CLASS_TEST(n, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
6574                       (ANYOF_CLASS_TEST(n, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
6575                       (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
6576                       (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
6577                       (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
6578                       (ANYOF_CLASS_TEST(n, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
6579                       (ANYOF_CLASS_TEST(n, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
6580                       (ANYOF_CLASS_TEST(n, ANYOF_ASCII)   &&  isASCII(c))     ||
6581                       (ANYOF_CLASS_TEST(n, ANYOF_NASCII)  && !isASCII(c))     ||
6582                       (ANYOF_CLASS_TEST(n, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
6583                       (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
6584                       (ANYOF_CLASS_TEST(n, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
6585                       (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
6586                       (ANYOF_CLASS_TEST(n, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
6587                       (ANYOF_CLASS_TEST(n, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
6588                       (ANYOF_CLASS_TEST(n, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
6589                       (ANYOF_CLASS_TEST(n, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
6590                       (ANYOF_CLASS_TEST(n, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
6591                       (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
6592                       (ANYOF_CLASS_TEST(n, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
6593                       (ANYOF_CLASS_TEST(n, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
6594                       (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
6595                       (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c))    ||
6596                       (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC)  &&  isPSXSPC(c))    ||
6597                       (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c))    ||
6598                       (ANYOF_CLASS_TEST(n, ANYOF_BLANK)   &&  isBLANK(c))     ||
6599                       (ANYOF_CLASS_TEST(n, ANYOF_NBLANK)  && !isBLANK(c))
6600                      ) /* How's that for a conditional? */
6601             ) {
6602                 match = TRUE;
6603             }
6604         }
6605     }
6606
6607     /* If the bitmap didn't (or couldn't) match, and something outside the
6608      * bitmap could match, try that.  Locale nodes specifiy completely the
6609      * behavior of code points in the bit map (otherwise, a utf8 target would
6610      * cause them to be treated as Unicode and not locale), except in
6611      * the very unlikely event when this node is a synthetic start class, which
6612      * could be a combination of locale and non-locale nodes.  So allow locale
6613      * to match for the synthetic start class, which will give a false
6614      * positive that will be resolved when the match is done again as not part
6615      * of the synthetic start class */
6616     if (!match) {
6617         if (utf8_target && (flags & ANYOF_UNICODE_ALL) && c >= 256) {
6618             match = TRUE;       /* Everything above 255 matches */
6619         }
6620         else if (ANYOF_NONBITMAP(n)
6621                  && ((flags & ANYOF_NONBITMAP_NON_UTF8)
6622                      || (utf8_target
6623                          && (c >=256
6624                              || (! (flags & ANYOF_LOCALE))
6625                              || (flags & ANYOF_IS_SYNTHETIC)))))
6626         {
6627             AV *av;
6628             SV * const sw = regclass_swash(prog, n, TRUE, 0, (SV**)&av);
6629
6630             if (sw) {
6631                 U8 * utf8_p;
6632                 if (utf8_target) {
6633                     utf8_p = (U8 *) p;
6634                 } else {
6635
6636                     /* Not utf8.  Convert as much of the string as available up
6637                      * to the limit of how far the (single) character in the
6638                      * pattern can possibly match (no need to go further).  If
6639                      * the node is a straight ANYOF or not folding, it can't
6640                      * match more than one.  Otherwise, It can match up to how
6641                      * far a single char can fold to.  Since not utf8, each
6642                      * character is a single byte, so the max it can be in
6643                      * bytes is the same as the max it can be in characters */
6644                     STRLEN len = (OP(n) == ANYOF
6645                                   || ! (flags & ANYOF_LOC_NONBITMAP_FOLD))
6646                                   ? 1
6647                                   : (maxlen < UTF8_MAX_FOLD_CHAR_EXPAND)
6648                                     ? maxlen
6649                                     : UTF8_MAX_FOLD_CHAR_EXPAND;
6650                     utf8_p = bytes_to_utf8(p, &len);
6651                 }
6652
6653                 if (swash_fetch(sw, utf8_p, TRUE))
6654                     match = TRUE;
6655                 else if (flags & ANYOF_LOC_NONBITMAP_FOLD) {
6656
6657                     /* Here, we need to test if the fold of the target string
6658                      * matches.  The non-multi char folds have all been moved to
6659                      * the compilation phase, and the multi-char folds have
6660                      * been stored by regcomp into 'av'; we linearly check to
6661                      * see if any match the target string (folded).   We know
6662                      * that the originals were each one character, but we don't
6663                      * currently know how many characters/bytes each folded to,
6664                      * except we do know that there are small limits imposed by
6665                      * Unicode.  XXX A performance enhancement would be to have
6666                      * regcomp.c store the max number of chars/bytes that are
6667                      * in an av entry, as, say the 0th element.  Even better
6668                      * would be to have a hash of the few characters that can
6669                      * start a multi-char fold to the max number of chars of
6670                      * those folds.
6671                      *
6672                      * If there is a match, we will need to advance (if lenp is
6673                      * specified) the match pointer in the target string.  But
6674                      * what we are comparing here isn't that string directly,
6675                      * but its fold, whose length may differ from the original.
6676                      * As we go along in constructing the fold, therefore, we
6677                      * create a map so that we know how many bytes in the
6678                      * source to advance given that we have matched a certain
6679                      * number of bytes in the fold.  This map is stored in
6680                      * 'map_fold_len_back'.  Let n mean the number of bytes in
6681                      * the fold of the first character that we are folding.
6682                      * Then map_fold_len_back[n] is set to the number of bytes
6683                      * in that first character.  Similarly let m be the
6684                      * corresponding number for the second character to be
6685                      * folded.  Then map_fold_len_back[n+m] is set to the
6686                      * number of bytes occupied by the first two source
6687                      * characters. ... */
6688                     U8 map_fold_len_back[UTF8_MAXBYTES_CASE+1] = { 0 };
6689                     U8 folded[UTF8_MAXBYTES_CASE+1];
6690                     STRLEN foldlen = 0; /* num bytes in fold of 1st char */
6691                     STRLEN total_foldlen = 0; /* num bytes in fold of all
6692                                                   chars */
6693
6694                     if (OP(n) == ANYOF || maxlen == 1 || ! lenp || ! av) {
6695
6696                         /* Here, only need to fold the first char of the target
6697                          * string.  It the source wasn't utf8, is 1 byte long */
6698                         to_utf8_fold(utf8_p, folded, &foldlen);
6699                         total_foldlen = foldlen;
6700                         map_fold_len_back[foldlen] = (utf8_target)
6701                                                      ? UTF8SKIP(utf8_p)
6702                                                      : 1;
6703                     }
6704                     else {
6705
6706                         /* Here, need to fold more than the first char.  Do so
6707                          * up to the limits */
6708                         U8* source_ptr = utf8_p;    /* The source for the fold
6709                                                        is the regex target
6710                                                        string */
6711                         U8* folded_ptr = folded;
6712                         U8* e = utf8_p + maxlen;    /* Can't go beyond last
6713                                                        available byte in the
6714                                                        target string */
6715                         U8 i;
6716                         for (i = 0;
6717                              i < UTF8_MAX_FOLD_CHAR_EXPAND && source_ptr < e;
6718                              i++)
6719                         {
6720
6721                             /* Fold the next character */
6722                             U8 this_char_folded[UTF8_MAXBYTES_CASE+1];
6723                             STRLEN this_char_foldlen;
6724                             to_utf8_fold(source_ptr,
6725                                          this_char_folded,
6726                                          &this_char_foldlen);
6727
6728                             /* Bail if it would exceed the byte limit for
6729                              * folding a single char. */
6730                             if (this_char_foldlen + folded_ptr - folded >
6731                                                             UTF8_MAXBYTES_CASE)
6732                             {
6733                                 break;
6734                             }
6735
6736                             /* Add the fold of this character */
6737                             Copy(this_char_folded,
6738                                  folded_ptr,
6739                                  this_char_foldlen,
6740                                  U8);
6741                             source_ptr += UTF8SKIP(source_ptr);
6742                             folded_ptr += this_char_foldlen;
6743                             total_foldlen = folded_ptr - folded;
6744
6745                             /* Create map from the number of bytes in the fold
6746                              * back to the number of bytes in the source.  If
6747                              * the source isn't utf8, the byte count is just
6748                              * the number of characters so far */
6749                             map_fold_len_back[total_foldlen]
6750                                                       = (utf8_target)
6751                                                         ? source_ptr - utf8_p
6752                                                         : i + 1;
6753                         }
6754                         *folded_ptr = '\0';
6755                     }
6756
6757
6758                     /* Do the linear search to see if the fold is in the list
6759                      * of multi-char folds. */
6760                     if (av) {
6761                         I32 i;
6762                         for (i = 0; i <= av_len(av); i++) {
6763                             SV* const sv = *av_fetch(av, i, FALSE);
6764                             STRLEN len;
6765                             const char * const s = SvPV_const(sv, len);
6766
6767                             if (len <= total_foldlen
6768                                 && memEQ(s, (char*)folded, len)
6769
6770                                    /* If 0, means matched a partial char. See
6771                                     * [perl #90536] */
6772                                 && map_fold_len_back[len])
6773                             {
6774
6775                                 /* Advance the target string ptr to account for
6776                                  * this fold, but have to translate from the
6777                                  * folded length to the corresponding source
6778                                  * length. */
6779                                 if (lenp) {
6780                                     *lenp = map_fold_len_back[len];
6781                                 }
6782                                 match = TRUE;
6783                                 break;
6784                             }
6785                         }
6786                     }
6787                 }
6788
6789                 /* If we allocated a string above, free it */
6790                 if (! utf8_target) Safefree(utf8_p);
6791             }
6792         }
6793     }
6794
6795     return (flags & ANYOF_INVERT) ? !match : match;
6796 }
6797
6798 STATIC U8 *
6799 S_reghop3(U8 *s, I32 off, const U8* lim)
6800 {
6801     dVAR;
6802
6803     PERL_ARGS_ASSERT_REGHOP3;
6804
6805     if (off >= 0) {
6806         while (off-- && s < lim) {
6807             /* XXX could check well-formedness here */
6808             s += UTF8SKIP(s);
6809         }
6810     }
6811     else {
6812         while (off++ && s > lim) {
6813             s--;
6814             if (UTF8_IS_CONTINUED(*s)) {
6815                 while (s > lim && UTF8_IS_CONTINUATION(*s))
6816                     s--;
6817             }
6818             /* XXX could check well-formedness here */
6819         }
6820     }
6821     return s;
6822 }
6823
6824 #ifdef XXX_dmq
6825 /* there are a bunch of places where we use two reghop3's that should
6826    be replaced with this routine. but since thats not done yet
6827    we ifdef it out - dmq
6828 */
6829 STATIC U8 *
6830 S_reghop4(U8 *s, I32 off, const U8* llim, const U8* rlim)
6831 {
6832     dVAR;
6833
6834     PERL_ARGS_ASSERT_REGHOP4;
6835
6836     if (off >= 0) {
6837         while (off-- && s < rlim) {
6838             /* XXX could check well-formedness here */
6839             s += UTF8SKIP(s);
6840         }
6841     }
6842     else {
6843         while (off++ && s > llim) {
6844             s--;
6845             if (UTF8_IS_CONTINUED(*s)) {
6846                 while (s > llim && UTF8_IS_CONTINUATION(*s))
6847                     s--;
6848             }
6849             /* XXX could check well-formedness here */
6850         }
6851     }
6852     return s;
6853 }
6854 #endif
6855
6856 STATIC U8 *
6857 S_reghopmaybe3(U8* s, I32 off, const U8* lim)
6858 {
6859     dVAR;
6860
6861     PERL_ARGS_ASSERT_REGHOPMAYBE3;
6862
6863     if (off >= 0) {
6864         while (off-- && s < lim) {
6865             /* XXX could check well-formedness here */
6866             s += UTF8SKIP(s);
6867         }
6868         if (off >= 0)
6869             return NULL;
6870     }
6871     else {
6872         while (off++ && s > lim) {
6873             s--;
6874             if (UTF8_IS_CONTINUED(*s)) {
6875                 while (s > lim && UTF8_IS_CONTINUATION(*s))
6876                     s--;
6877             }
6878             /* XXX could check well-formedness here */
6879         }
6880         if (off <= 0)
6881             return NULL;
6882     }
6883     return s;
6884 }
6885
6886 static void
6887 restore_pos(pTHX_ void *arg)
6888 {
6889     dVAR;
6890     regexp * const rex = (regexp *)arg;
6891     if (PL_reg_eval_set) {
6892         if (PL_reg_oldsaved) {
6893             rex->subbeg = PL_reg_oldsaved;
6894             rex->sublen = PL_reg_oldsavedlen;
6895 #ifdef PERL_OLD_COPY_ON_WRITE
6896             rex->saved_copy = PL_nrs;
6897 #endif
6898             RXp_MATCH_COPIED_on(rex);
6899         }
6900         PL_reg_magic->mg_len = PL_reg_oldpos;
6901         PL_reg_eval_set = 0;
6902         PL_curpm = PL_reg_oldcurpm;
6903     }
6904 }
6905
6906 STATIC void
6907 S_to_utf8_substr(pTHX_ register regexp *prog)
6908 {
6909     int i = 1;
6910
6911     PERL_ARGS_ASSERT_TO_UTF8_SUBSTR;
6912
6913     do {
6914         if (prog->substrs->data[i].substr
6915             && !prog->substrs->data[i].utf8_substr) {
6916             SV* const sv = newSVsv(prog->substrs->data[i].substr);
6917             prog->substrs->data[i].utf8_substr = sv;
6918             sv_utf8_upgrade(sv);
6919             if (SvVALID(prog->substrs->data[i].substr)) {
6920                 if (SvTAIL(prog->substrs->data[i].substr)) {
6921                     /* Trim the trailing \n that fbm_compile added last
6922                        time.  */
6923                     SvCUR_set(sv, SvCUR(sv) - 1);
6924                     /* Whilst this makes the SV technically "invalid" (as its
6925                        buffer is no longer followed by "\0") when fbm_compile()
6926                        adds the "\n" back, a "\0" is restored.  */
6927                     fbm_compile(sv, FBMcf_TAIL);
6928                 } else
6929                     fbm_compile(sv, 0);
6930             }
6931             if (prog->substrs->data[i].substr == prog->check_substr)
6932                 prog->check_utf8 = sv;
6933         }
6934     } while (i--);
6935 }
6936
6937 STATIC void
6938 S_to_byte_substr(pTHX_ register regexp *prog)
6939 {
6940     dVAR;
6941     int i = 1;
6942
6943     PERL_ARGS_ASSERT_TO_BYTE_SUBSTR;
6944
6945     do {
6946         if (prog->substrs->data[i].utf8_substr
6947             && !prog->substrs->data[i].substr) {
6948             SV* sv = newSVsv(prog->substrs->data[i].utf8_substr);
6949             if (sv_utf8_downgrade(sv, TRUE)) {
6950                 if (SvVALID(prog->substrs->data[i].utf8_substr)) {
6951                     if (SvTAIL(prog->substrs->data[i].utf8_substr)) {
6952                         /* Trim the trailing \n that fbm_compile added last
6953                            time.  */
6954                         SvCUR_set(sv, SvCUR(sv) - 1);
6955                         fbm_compile(sv, FBMcf_TAIL);
6956                     } else
6957                         fbm_compile(sv, 0);
6958                 }
6959             } else {
6960                 SvREFCNT_dec(sv);
6961                 sv = &PL_sv_undef;
6962             }
6963             prog->substrs->data[i].substr = sv;
6964             if (prog->substrs->data[i].utf8_substr == prog->check_utf8)
6965                 prog->check_substr = sv;
6966         }
6967     } while (i--);
6968 }
6969
6970 /*
6971  * Local variables:
6972  * c-indentation-style: bsd
6973  * c-basic-offset: 4
6974  * indent-tabs-mode: t
6975  * End:
6976  *
6977  * ex: set ts=8 sts=4 sw=4 noet:
6978  */