regexec.c

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