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