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
1619     /* Be paranoid... */
1620     if (prog == NULL || startpos == NULL) {
1621         Perl_croak(aTHX_ "NULL regexp parameter");
1622         return 0;
1623     }
1624
1625     PL_reg_re = prog;
1626 #ifdef DEBUGGING
1627     PL_regnarrate = DEBUG_r_TEST;
1628 #endif
1629
1630     RX_MATCH_UTF8_set(prog, do_utf8);
1631
1632     minlen = prog->minlen;
1633     if (strend - startpos < minlen) {
1634         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
1635                               "String too short [regexec_flags]...\n"));
1636         goto phooey;
1637     }
1638
1639     /* Check validity of program. */
1640     if (UCHARAT(prog->program) != REG_MAGIC) {
1641         Perl_croak(aTHX_ "corrupted regexp program");
1642     }
1643
1644     PL_reg_flags = 0;
1645     PL_reg_eval_set = 0;
1646     PL_reg_maxiter = 0;
1647
1648     if (prog->reganch & ROPT_UTF8)
1649         PL_reg_flags |= RF_utf8;
1650
1651     /* Mark beginning of line for ^ and lookbehind. */
1652     PL_regbol = startpos;
1653     PL_bostr  = strbeg;
1654     PL_reg_sv = sv;
1655
1656     /* Mark end of line for $ (and such) */
1657     PL_regeol = strend;
1658
1659     /* see how far we have to get to not match where we matched before */
1660     PL_regtill = startpos+minend;
1661
1662     /* If there is a "must appear" string, look for it. */
1663     s = startpos;
1664
1665     if (prog->reganch & ROPT_GPOS_SEEN) { /* Need to have PL_reg_ganch */
1666         MAGIC *mg;
1667
1668         if (flags & REXEC_IGNOREPOS)    /* Means: check only at start */
1669             PL_reg_ganch = startpos;
1670         else if (sv && SvTYPE(sv) >= SVt_PVMG
1671                   && SvMAGIC(sv)
1672                   && (mg = mg_find(sv, PERL_MAGIC_regex_global))
1673                   && mg->mg_len >= 0) {
1674             PL_reg_ganch = strbeg + mg->mg_len; /* Defined pos() */
1675             if (prog->reganch & ROPT_ANCH_GPOS) {
1676                 if (s > PL_reg_ganch)
1677                     goto phooey;
1678                 s = PL_reg_ganch;
1679             }
1680         }
1681         else                            /* pos() not defined */
1682             PL_reg_ganch = strbeg;
1683     }
1684
1685     if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) {
1686         re_scream_pos_data d;
1687
1688         d.scream_olds = &scream_olds;
1689         d.scream_pos = &scream_pos;
1690         s = re_intuit_start(prog, sv, s, strend, flags, &d);
1691         if (!s) {
1692             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
1693             goto phooey;        /* not present */
1694         }
1695     }
1696
1697     DEBUG_EXECUTE_r({
1698         const char * const s0   = UTF
1699             ? pv_uni_display(dsv0, (U8*)prog->precomp, prog->prelen, 60,
1700                           UNI_DISPLAY_REGEX)
1701             : prog->precomp;
1702         const int len0 = UTF ? SvCUR(dsv0) : prog->prelen;
1703         const char * const s1 = do_utf8 ? sv_uni_display(dsv1, sv, 60,
1704                                                UNI_DISPLAY_REGEX) : startpos;
1705         const int len1 = do_utf8 ? SvCUR(dsv1) : strend - startpos;
1706          if (!PL_colorset)
1707              reginitcolors();
1708          PerlIO_printf(Perl_debug_log,
1709                        "%sMatching REx%s \"%s%*.*s%s%s\" against \"%s%.*s%s%s\"\n",
1710                        PL_colors[4], PL_colors[5], PL_colors[0],
1711                        len0, len0, s0,
1712                        PL_colors[1],
1713                        len0 > 60 ? "..." : "",
1714                        PL_colors[0],
1715                        (int)(len1 > 60 ? 60 : len1),
1716                        s1, PL_colors[1],
1717                        (len1 > 60 ? "..." : "")
1718               );
1719     });
1720
1721     /* Simplest case:  anchored match need be tried only once. */
1722     /*  [unless only anchor is BOL and multiline is set] */
1723     if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
1724         if (s == startpos && regtry(prog, startpos))
1725             goto got_it;
1726         else if (multiline || (prog->reganch & ROPT_IMPLICIT)
1727                  || (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
1728         {
1729             char *end;
1730
1731             if (minlen)
1732                 dontbother = minlen - 1;
1733             end = HOP3c(strend, -dontbother, strbeg) - 1;
1734             /* for multiline we only have to try after newlines */
1735             if (prog->check_substr || prog->check_utf8) {
1736                 if (s == startpos)
1737                     goto after_try;
1738                 while (1) {
1739                     if (regtry(prog, s))
1740                         goto got_it;
1741                   after_try:
1742                     if (s >= end)
1743                         goto phooey;
1744                     if (prog->reganch & RE_USE_INTUIT) {
1745                         s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
1746                         if (!s)
1747                             goto phooey;
1748                     }
1749                     else
1750                         s++;
1751                 }
1752             } else {
1753                 if (s > startpos)
1754                     s--;
1755                 while (s < end) {
1756                     if (*s++ == '\n') { /* don't need PL_utf8skip here */
1757                         if (regtry(prog, s))
1758                             goto got_it;
1759                     }
1760                 }
1761             }
1762         }
1763         goto phooey;
1764     } else if (prog->reganch & ROPT_ANCH_GPOS) {
1765         if (regtry(prog, PL_reg_ganch))
1766             goto got_it;
1767         goto phooey;
1768     }
1769
1770     /* Messy cases:  unanchored match. */
1771     if ((prog->anchored_substr || prog->anchored_utf8) && prog->reganch & ROPT_SKIP) {
1772         /* we have /x+whatever/ */
1773         /* it must be a one character string (XXXX Except UTF?) */
1774         char ch;
1775 #ifdef DEBUGGING
1776         int did_match = 0;
1777 #endif
1778         if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1779             do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1780         ch = SvPVX_const(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr)[0];
1781
1782         if (do_utf8) {
1783             while (s < strend) {
1784                 if (*s == ch) {
1785                     DEBUG_EXECUTE_r( did_match = 1 );
1786                     if (regtry(prog, s)) goto got_it;
1787                     s += UTF8SKIP(s);
1788                     while (s < strend && *s == ch)
1789                         s += UTF8SKIP(s);
1790                 }
1791                 s += UTF8SKIP(s);
1792             }
1793         }
1794         else {
1795             while (s < strend) {
1796                 if (*s == ch) {
1797                     DEBUG_EXECUTE_r( did_match = 1 );
1798                     if (regtry(prog, s)) goto got_it;
1799                     s++;
1800                     while (s < strend && *s == ch)
1801                         s++;
1802                 }
1803                 s++;
1804             }
1805         }
1806         DEBUG_EXECUTE_r(if (!did_match)
1807                 PerlIO_printf(Perl_debug_log,
1808                                   "Did not find anchored character...\n")
1809                );
1810     }
1811     else if (prog->anchored_substr != NULL
1812               || prog->anchored_utf8 != NULL
1813               || ((prog->float_substr != NULL || prog->float_utf8 != NULL)
1814                   && prog->float_max_offset < strend - s)) {
1815         SV *must;
1816         I32 back_max;
1817         I32 back_min;
1818         char *last;
1819         char *last1;            /* Last position checked before */
1820 #ifdef DEBUGGING
1821         int did_match = 0;
1822 #endif
1823         if (prog->anchored_substr || prog->anchored_utf8) {
1824             if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1825                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1826             must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
1827             back_max = back_min = prog->anchored_offset;
1828         } else {
1829             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
1830                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1831             must = do_utf8 ? prog->float_utf8 : prog->float_substr;
1832             back_max = prog->float_max_offset;
1833             back_min = prog->float_min_offset;
1834         }
1835         if (must == &PL_sv_undef)
1836             /* could not downgrade utf8 check substring, so must fail */
1837             goto phooey;
1838
1839         last = HOP3c(strend,    /* Cannot start after this */
1840                           -(I32)(CHR_SVLEN(must)
1841                                  - (SvTAIL(must) != 0) + back_min), strbeg);
1842
1843         if (s > PL_bostr)
1844             last1 = HOPc(s, -1);
1845         else
1846             last1 = s - 1;      /* bogus */
1847
1848         /* XXXX check_substr already used to find "s", can optimize if
1849            check_substr==must. */
1850         scream_pos = -1;
1851         dontbother = end_shift;
1852         strend = HOPc(strend, -dontbother);
1853         while ( (s <= last) &&
1854                 ((flags & REXEC_SCREAM)
1855                  ? (s = screaminstr(sv, must, HOP3c(s, back_min, strend) - strbeg,
1856                                     end_shift, &scream_pos, 0))
1857                  : (s = fbm_instr((unsigned char*)HOP3(s, back_min, strend),
1858                                   (unsigned char*)strend, must,
1859                                   multiline ? FBMrf_MULTILINE : 0))) ) {
1860             /* we may be pointing at the wrong string */
1861             if ((flags & REXEC_SCREAM) && RX_MATCH_COPIED(prog))
1862                 s = strbeg + (s - SvPVX_const(sv));
1863             DEBUG_EXECUTE_r( did_match = 1 );
1864             if (HOPc(s, -back_max) > last1) {
1865                 last1 = HOPc(s, -back_min);
1866                 s = HOPc(s, -back_max);
1867             }
1868             else {
1869                 char * const t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
1870
1871                 last1 = HOPc(s, -back_min);
1872                 s = t;
1873             }
1874             if (do_utf8) {
1875                 while (s <= last1) {
1876                     if (regtry(prog, s))
1877                         goto got_it;
1878                     s += UTF8SKIP(s);
1879                 }
1880             }
1881             else {
1882                 while (s <= last1) {
1883                     if (regtry(prog, s))
1884                         goto got_it;
1885                     s++;
1886                 }
1887             }
1888         }
1889         DEBUG_EXECUTE_r(if (!did_match)
1890                     PerlIO_printf(Perl_debug_log,
1891                                   "Did not find %s substr \"%s%.*s%s\"%s...\n",
1892                               ((must == prog->anchored_substr || must == prog->anchored_utf8)
1893                                ? "anchored" : "floating"),
1894                               PL_colors[0],
1895                               (int)(SvCUR(must) - (SvTAIL(must)!=0)),
1896                               SvPVX_const(must),
1897                                   PL_colors[1], (SvTAIL(must) ? "$" : ""))
1898                );
1899         goto phooey;
1900     }
1901     else if ((c = prog->regstclass)) {
1902         if (minlen) {
1903             I32 op = (U8)OP(prog->regstclass);
1904             /* don't bother with what can't match */
1905             if (PL_regkind[op] != EXACT && op != CANY)
1906                 strend = HOPc(strend, -(minlen - 1));
1907         }
1908         DEBUG_EXECUTE_r({
1909             SV *prop = sv_newmortal();
1910             const char *s0;
1911             const char *s1;
1912             int len0;
1913             int len1;
1914
1915             regprop(prop, c);
1916             s0 = UTF ?
1917               pv_uni_display(dsv0, (U8*)SvPVX_const(prop), SvCUR(prop), 60,
1918                              UNI_DISPLAY_REGEX) :
1919               SvPVX_const(prop);
1920             len0 = UTF ? SvCUR(dsv0) : SvCUR(prop);
1921             s1 = UTF ?
1922               sv_uni_display(dsv1, sv, 60, UNI_DISPLAY_REGEX) : s;
1923             len1 = UTF ? SvCUR(dsv1) : strend - s;
1924             PerlIO_printf(Perl_debug_log,
1925                           "Matching stclass \"%*.*s\" against \"%*.*s\"\n",
1926                           len0, len0, s0,
1927                           len1, len1, s1);
1928         });
1929         if (find_byclass(prog, c, s, strend, 0))
1930             goto got_it;
1931         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass...\n"));
1932     }
1933     else {
1934         dontbother = 0;
1935         if (prog->float_substr != NULL || prog->float_utf8 != NULL) {
1936             /* Trim the end. */
1937             char *last;
1938             SV* float_real;
1939
1940             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
1941                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1942             float_real = do_utf8 ? prog->float_utf8 : prog->float_substr;
1943
1944             if (flags & REXEC_SCREAM) {
1945                 last = screaminstr(sv, float_real, s - strbeg,
1946                                    end_shift, &scream_pos, 1); /* last one */
1947                 if (!last)
1948                     last = scream_olds; /* Only one occurrence. */
1949                 /* we may be pointing at the wrong string */
1950                 else if (RX_MATCH_COPIED(prog))
1951                     s = strbeg + (s - SvPVX_const(sv));
1952             }
1953             else {
1954                 STRLEN len;
1955                 const char * const little = SvPV_const(float_real, len);
1956
1957                 if (SvTAIL(float_real)) {
1958                     if (memEQ(strend - len + 1, little, len - 1))
1959                         last = strend - len + 1;
1960                     else if (!multiline)
1961                         last = memEQ(strend - len, little, len)
1962                             ? strend - len : NULL;
1963                     else
1964                         goto find_last;
1965                 } else {
1966                   find_last:
1967                     if (len)
1968                         last = rninstr(s, strend, little, little + len);
1969                     else
1970                         last = strend;  /* matching "$" */
1971                 }
1972             }
1973             if (last == NULL) {
1974                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
1975                                       "%sCan't trim the tail, match fails (should not happen)%s\n",
1976                                       PL_colors[4], PL_colors[5]));
1977                 goto phooey; /* Should not happen! */
1978             }
1979             dontbother = strend - last + prog->float_min_offset;
1980         }
1981         if (minlen && (dontbother < minlen))
1982             dontbother = minlen - 1;
1983         strend -= dontbother;              /* this one's always in bytes! */
1984         /* We don't know much -- general case. */
1985         if (do_utf8) {
1986             for (;;) {
1987                 if (regtry(prog, s))
1988                     goto got_it;
1989                 if (s >= strend)
1990                     break;
1991                 s += UTF8SKIP(s);
1992             };
1993         }
1994         else {
1995             do {
1996                 if (regtry(prog, s))
1997                     goto got_it;
1998             } while (s++ < strend);
1999         }
2000     }
2001
2002     /* Failure. */
2003     goto phooey;
2004
2005 got_it:
2006     RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
2007
2008     if (PL_reg_eval_set) {
2009         /* Preserve the current value of $^R */
2010         if (oreplsv != GvSV(PL_replgv))
2011             sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
2012                                                   restored, the value remains
2013                                                   the same. */
2014         restore_pos(aTHX_ prog);
2015     }
2016
2017     /* make sure $`, $&, $', and $digit will work later */
2018     if ( !(flags & REXEC_NOT_FIRST) ) {
2019         RX_MATCH_COPY_FREE(prog);
2020         if (flags & REXEC_COPY_STR) {
2021             I32 i = PL_regeol - startpos + (stringarg - strbeg);
2022 #ifdef PERL_OLD_COPY_ON_WRITE
2023             if ((SvIsCOW(sv)
2024                  || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) {
2025                 if (DEBUG_C_TEST) {
2026                     PerlIO_printf(Perl_debug_log,
2027                                   "Copy on write: regexp capture, type %d\n",
2028                                   (int) SvTYPE(sv));
2029                 }
2030                 prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
2031                 prog->subbeg = (char *)SvPVX_const(prog->saved_copy);
2032                 assert (SvPOKp(prog->saved_copy));
2033             } else
2034 #endif
2035             {
2036                 RX_MATCH_COPIED_on(prog);
2037                 s = savepvn(strbeg, i);
2038                 prog->subbeg = s;
2039             }
2040             prog->sublen = i;
2041         }
2042         else {
2043             prog->subbeg = strbeg;
2044             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
2045         }
2046     }
2047
2048     return 1;
2049
2050 phooey:
2051     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
2052                           PL_colors[4], PL_colors[5]));
2053     if (PL_reg_eval_set)
2054         restore_pos(aTHX_ prog);
2055     return 0;
2056 }
2057
2058 /*
2059  - regtry - try match at specific point
2060  */
2061 STATIC I32                      /* 0 failure, 1 success */
2062 S_regtry(pTHX_ regexp *prog, char *startpos)
2063 {
2064     dVAR;
2065     register I32 *sp;
2066     register I32 *ep;
2067     CHECKPOINT lastcp;
2068     GET_RE_DEBUG_FLAGS_DECL;
2069
2070 #ifdef DEBUGGING
2071     PL_regindent = 0;   /* XXXX Not good when matches are reenterable... */
2072 #endif
2073     if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
2074         MAGIC *mg;
2075
2076         PL_reg_eval_set = RS_init;
2077         DEBUG_EXECUTE_r(DEBUG_s(
2078             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %"IVdf"\n",
2079                           (IV)(PL_stack_sp - PL_stack_base));
2080             ));
2081         SAVEI32(cxstack[cxstack_ix].blk_oldsp);
2082         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
2083         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
2084         SAVETMPS;
2085         /* Apparently this is not needed, judging by wantarray. */
2086         /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
2087            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
2088
2089         if (PL_reg_sv) {
2090             /* Make $_ available to executed code. */
2091             if (PL_reg_sv != DEFSV) {
2092                 SAVE_DEFSV;
2093                 DEFSV = PL_reg_sv;
2094             }
2095
2096             if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv)
2097                   && (mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global)))) {
2098                 /* prepare for quick setting of pos */
2099 #ifdef PERL_OLD_COPY_ON_WRITE
2100                 if (SvIsCOW(sv))
2101                     sv_force_normal_flags(sv, 0);
2102 #endif
2103                 mg = sv_magicext(PL_reg_sv, (SV*)0, PERL_MAGIC_regex_global,
2104                                  &PL_vtbl_mglob, NULL, 0);
2105                 mg->mg_len = -1;
2106             }
2107             PL_reg_magic    = mg;
2108             PL_reg_oldpos   = mg->mg_len;
2109             SAVEDESTRUCTOR_X(restore_pos, prog);
2110         }
2111         if (!PL_reg_curpm) {
2112             Newxz(PL_reg_curpm, 1, PMOP);
2113 #ifdef USE_ITHREADS
2114             {
2115                 SV* repointer = newSViv(0);
2116                 /* so we know which PL_regex_padav element is PL_reg_curpm */
2117                 SvFLAGS(repointer) |= SVf_BREAK;
2118                 av_push(PL_regex_padav,repointer);
2119                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
2120                 PL_regex_pad = AvARRAY(PL_regex_padav);
2121             }
2122 #endif
2123         }
2124         PM_SETRE(PL_reg_curpm, prog);
2125         PL_reg_oldcurpm = PL_curpm;
2126         PL_curpm = PL_reg_curpm;
2127         if (RX_MATCH_COPIED(prog)) {
2128             /*  Here is a serious problem: we cannot rewrite subbeg,
2129                 since it may be needed if this match fails.  Thus
2130                 $` inside (?{}) could fail... */
2131             PL_reg_oldsaved = prog->subbeg;
2132             PL_reg_oldsavedlen = prog->sublen;
2133 #ifdef PERL_OLD_COPY_ON_WRITE
2134             PL_nrs = prog->saved_copy;
2135 #endif
2136             RX_MATCH_COPIED_off(prog);
2137         }
2138         else
2139             PL_reg_oldsaved = NULL;
2140         prog->subbeg = PL_bostr;
2141         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
2142     }
2143     prog->startp[0] = startpos - PL_bostr;
2144     PL_reginput = startpos;
2145     PL_regstartp = prog->startp;
2146     PL_regendp = prog->endp;
2147     PL_reglastparen = &prog->lastparen;
2148     PL_reglastcloseparen = &prog->lastcloseparen;
2149     prog->lastparen = 0;
2150     prog->lastcloseparen = 0;
2151     PL_regsize = 0;
2152     DEBUG_EXECUTE_r(PL_reg_starttry = startpos);
2153     if (PL_reg_start_tmpl <= prog->nparens) {
2154         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
2155         if(PL_reg_start_tmp)
2156             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2157         else
2158             Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2159     }
2160
2161     /* XXXX What this code is doing here?!!!  There should be no need
2162        to do this again and again, PL_reglastparen should take care of
2163        this!  --ilya*/
2164
2165     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
2166      * Actually, the code in regcppop() (which Ilya may be meaning by
2167      * PL_reglastparen), is not needed at all by the test suite
2168      * (op/regexp, op/pat, op/split), but that code is needed, oddly
2169      * enough, for building DynaLoader, or otherwise this
2170      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
2171      * will happen.  Meanwhile, this code *is* needed for the
2172      * above-mentioned test suite tests to succeed.  The common theme
2173      * on those tests seems to be returning null fields from matches.
2174      * --jhi */
2175 #if 1
2176     sp = prog->startp;
2177     ep = prog->endp;
2178     if (prog->nparens) {
2179         register I32 i;
2180         for (i = prog->nparens; i > (I32)*PL_reglastparen; i--) {
2181             *++sp = -1;
2182             *++ep = -1;
2183         }
2184     }
2185 #endif
2186     REGCP_SET(lastcp);
2187     if (regmatch(prog, prog->program + 1)) {
2188         prog->endp[0] = PL_reginput - PL_bostr;
2189         return 1;
2190     }
2191     REGCP_UNWIND(lastcp);
2192     return 0;
2193 }
2194
2195 #define RE_UNWIND_BRANCH        1
2196 #define RE_UNWIND_BRANCHJ       2
2197
2198 union re_unwind_t;
2199
2200 typedef struct {                /* XX: makes sense to enlarge it... */
2201     I32 type;
2202     I32 prev;
2203     CHECKPOINT lastcp;
2204 } re_unwind_generic_t;
2205
2206 typedef struct {
2207     I32 type;
2208     I32 prev;
2209     CHECKPOINT lastcp;
2210     I32 lastparen;
2211     regnode *next;
2212     char *locinput;
2213     I32 nextchr;
2214     int minmod;
2215 #ifdef DEBUGGING
2216     int regindent;
2217 #endif
2218 } re_unwind_branch_t;
2219
2220 typedef union re_unwind_t {
2221     I32 type;
2222     re_unwind_generic_t generic;
2223     re_unwind_branch_t branch;
2224 } re_unwind_t;
2225
2226 #define sayYES goto yes
2227 #define sayNO goto no
2228 #define sayNO_ANYOF goto no_anyof
2229 #define sayYES_FINAL goto yes_final
2230 #define sayYES_LOUD  goto yes_loud
2231 #define sayNO_FINAL  goto no_final
2232 #define sayNO_SILENT goto do_no
2233 #define saySAME(x) if (x) goto yes; else goto no
2234
2235 #define POSCACHE_SUCCESS 0      /* caching success rather than failure */
2236 #define POSCACHE_SEEN 1         /* we know what we're caching */
2237 #define POSCACHE_START 2        /* the real cache: this bit maps to pos 0 */
2238 #define CACHEsayYES STMT_START { \
2239     if (st->u.whilem.cache_offset | st->u.whilem.cache_bit) { \
2240         if (!(PL_reg_poscache[0] & (1<<POSCACHE_SEEN))) \
2241             PL_reg_poscache[0] |= (1<<POSCACHE_SUCCESS) || (1<<POSCACHE_SEEN); \
2242         else if (!(PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))) { \
2243             /* cache records failure, but this is success */ \
2244             DEBUG_r( \
2245                 PerlIO_printf(Perl_debug_log, \
2246                     "%*s  (remove success from failure cache)\n", \
2247                     REPORT_CODE_OFF+PL_regindent*2, "") \
2248             ); \
2249             PL_reg_poscache[st->u.whilem.cache_offset] &= ~(1<<st->u.whilem.cache_bit); \
2250         } \
2251     } \
2252     sayYES; \
2253 } STMT_END
2254 #define CACHEsayNO STMT_START { \
2255     if (st->u.whilem.cache_offset | st->u.whilem.cache_bit) { \
2256         if (!(PL_reg_poscache[0] & (1<<POSCACHE_SEEN))) \
2257             PL_reg_poscache[0] |= (1<<POSCACHE_SEEN); \
2258         else if ((PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))) { \
2259             /* cache records success, but this is failure */ \
2260             DEBUG_r( \
2261                 PerlIO_printf(Perl_debug_log, \
2262                     "%*s  (remove failure from success cache)\n", \
2263                     REPORT_CODE_OFF+PL_regindent*2, "") \
2264             ); \
2265             PL_reg_poscache[st->u.whilem.cache_offset] &= ~(1<<st->u.whilem.cache_bit); \
2266         } \
2267     } \
2268     sayNO; \
2269 } STMT_END
2270
2271 /* this is used to determine how far from the left messages like
2272    'failed...' are printed. Currently 29 makes these messages line
2273    up with the opcode they refer to. Earlier perls used 25 which
2274    left these messages outdented making reviewing a debug output
2275    quite difficult.
2276 */
2277 #define REPORT_CODE_OFF 29
2278
2279
2280 /* Make sure there is a test for this +1 options in re_tests */
2281 #define TRIE_INITAL_ACCEPT_BUFFLEN 4;
2282
2283 /* grab a new slab and return the first slot in it */
2284
2285 STATIC regmatch_state *
2286 S_push_slab(pTHX)
2287 {
2288     regmatch_slab *s = PL_regmatch_slab->next;
2289     if (!s) {
2290         Newx(s, 1, regmatch_slab);
2291         s->prev = PL_regmatch_slab;
2292         s->next = NULL;
2293         PL_regmatch_slab->next = s;
2294     }
2295     PL_regmatch_slab = s;
2296     return &s->states[0];
2297 }
2298
2299 /* simulate a recursive call to regmatch */
2300
2301 #define REGMATCH(ns, where) \
2302     st->scan = scan; \
2303     scan = (ns); \
2304     st->resume_state = resume_##where; \
2305     goto start_recurse; \
2306     resume_point_##where:
2307
2308
2309 /* push a new regex state. Set newst to point to it */
2310
2311 #define PUSH_STATE(newst, resume) \
2312     depth++;    \
2313     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "PUSH STATE(%d)\n", depth)); \
2314     st->scan = scan;    \
2315     st->next = next;    \
2316     st->n = n;  \
2317     st->locinput = locinput;    \
2318     st->resume_state = resume;  \
2319     newst = st+1;   \
2320     if (newst >  &(PL_regmatch_slab->states[PERL_REGMATCH_SLAB_SLOTS-1])) \
2321         newst = S_push_slab(aTHX);  \
2322     PL_regmatch_state = newst;  \
2323     newst->cc = 0;  \
2324     newst->minmod = 0;  \
2325     newst->sw = 0;  \
2326     newst->logical = 0; \
2327     newst->unwind = 0;  \
2328     locinput = PL_reginput; \
2329     nextchr = UCHARAT(locinput);
2330
2331 #define POP_STATE \
2332     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "POP STATE(%d)\n", depth)); \
2333     depth--; \
2334     st--; \
2335     if (st < &PL_regmatch_slab->states[0]) { \
2336         PL_regmatch_slab = PL_regmatch_slab->prev; \
2337         st = &PL_regmatch_slab->states[PERL_REGMATCH_SLAB_SLOTS-1]; \
2338     } \
2339     PL_regmatch_state = st; \
2340     scan        = st->scan; \
2341     next        = st->next; \
2342     n           = st->n; \
2343     locinput    = st->locinput; \
2344     nextchr = UCHARAT(locinput);
2345
2346 /*
2347  - regmatch - main matching routine
2348  *
2349  * Conceptually the strategy is simple:  check to see whether the current
2350  * node matches, call self recursively to see whether the rest matches,
2351  * and then act accordingly.  In practice we make some effort to avoid
2352  * recursion, in particular by going through "ordinary" nodes (that don't
2353  * need to know whether the rest of the match failed) by a loop instead of
2354  * by recursion.
2355  */
2356 /* [lwall] I've hoisted the register declarations to the outer block in order to
2357  * maybe save a little bit of pushing and popping on the stack.  It also takes
2358  * advantage of machines that use a register save mask on subroutine entry.
2359  *
2360  * This function used to be heavily recursive, but since this had the
2361  * effect of blowing the CPU stack on complex regexes, it has been
2362  * restructured to be iterative, and to save state onto the heap rather
2363  * than the stack. Essentially whereever regmatch() used to be called, it
2364  * pushes the current state, notes where to return, then jumps back into
2365  * the main loop.
2366  *
2367  * Originally the structure of this function used to look something like
2368
2369     S_regmatch() {
2370         int a = 1, b = 2;
2371         ...
2372         while (scan != NULL) {
2373             a++; // do stuff with a and b
2374             ...
2375             switch (OP(scan)) {
2376                 case FOO: {
2377                     int local = 3;
2378                     ...
2379                     if (regmatch(...))  // recurse
2380                         goto yes;
2381                 }
2382                 ...
2383             }
2384         }
2385         yes:
2386         return 1;
2387     }
2388
2389  * Now it looks something like this:
2390
2391     typedef struct {
2392         int a, b, local;
2393         int resume_state;
2394     } regmatch_state;
2395
2396     S_regmatch() {
2397         regmatch_state *st = new();
2398         int depth=0;
2399         st->a++; // do stuff with a and b
2400         ...
2401         while (scan != NULL) {
2402             ...
2403             switch (OP(scan)) {
2404                 case FOO: {
2405                     st->local = 3;
2406                     ...
2407                     st->scan = scan;
2408                     scan = ...;
2409                     st->resume_state = resume_FOO;
2410                     goto start_recurse; // recurse
2411
2412                     resume_point_FOO:
2413                     if (result)
2414                         goto yes;
2415                 }
2416                 ...
2417             }
2418           start_recurse:
2419             st = new(); push a new state
2420             st->a = 1; st->b = 2;
2421             depth++;
2422         }
2423       yes:
2424         result = 1;
2425         if (depth--) {
2426             st = pop();
2427             switch (resume_state) {
2428             case resume_FOO:
2429                 goto resume_point_FOO;
2430             ...
2431             }
2432         }
2433         return result
2434     }
2435
2436  * WARNING: this means that any line in this function that contains a
2437  * REGMATCH() or TRYPAREN() is actually simulating a recursive call to
2438  * regmatch() using gotos instead. Thus the values of any local variables
2439  * not saved in the regmatch_state structure will have been lost when
2440  * execution resumes on the next line .
2441  *
2442  * States (ie the st pointer) are allocated in slabs of about 4K in size.
2443  * PL_regmatch_state always points to the currently active state, and
2444  * PL_regmatch_slab points to the slab currently containing PL_regmatch_state.
2445  * The first time regmatch is called, the first slab is allocated, and is
2446  * never freed until interpreter desctruction. When the slab is full,
2447  * a new one is allocated chained to the end. At exit from regmatch, slabs
2448  * allocated since entry are freed.
2449  */
2450
2451
2452 STATIC I32                      /* 0 failure, 1 success */
2453 S_regmatch(pTHX_ regexp *rex, regnode *prog)
2454 {
2455     dVAR;
2456     register const bool do_utf8 = PL_reg_match_utf8;
2457     const U32 uniflags = UTF8_ALLOW_DEFAULT;
2458
2459     regmatch_slab  *orig_slab;
2460     regmatch_state *orig_state;
2461
2462     /* the current state. This is a cached copy of PL_regmatch_state */
2463     register regmatch_state *st;
2464
2465     /* cache heavy used fields of st in registers */
2466     register regnode *scan;
2467     register regnode *next;
2468     register I32 n = 0; /* initialize to shut up compiler warning */
2469     register char *locinput = PL_reginput;
2470
2471     /* these variables are NOT saved during a recusive RFEGMATCH: */
2472     register I32 nextchr;   /* is always set to UCHARAT(locinput) */
2473     bool result;            /* return value of S_regmatch */
2474     regnode *inner;         /* Next node in internal branch. */
2475     int depth = 0;          /* depth of recursion */
2476     regmatch_state *newst;  /* when pushing a state, this is the new one */
2477     regmatch_state *cur_eval = NULL;  /* most recent (??{}) state */
2478
2479 #ifdef DEBUGGING
2480     SV *re_debug_flags = NULL;
2481     GET_RE_DEBUG_FLAGS;
2482     PL_regindent++;
2483 #endif
2484
2485     /* on first ever call to regmatch, allocate first slab */
2486     if (!PL_regmatch_slab) {
2487         Newx(PL_regmatch_slab, 1, regmatch_slab);
2488         PL_regmatch_slab->prev = NULL;
2489         PL_regmatch_slab->next = NULL;
2490         PL_regmatch_state = &PL_regmatch_slab->states[0] - 1;
2491     }
2492
2493     /* remember current high-water mark for exit */
2494     /* XXX this should be done with SAVE* instead */
2495     orig_slab  = PL_regmatch_slab;
2496     orig_state = PL_regmatch_state;
2497
2498     /* grab next free state slot */
2499     st = ++PL_regmatch_state;
2500     if (st >  &(PL_regmatch_slab->states[PERL_REGMATCH_SLAB_SLOTS-1]))
2501         st = PL_regmatch_state = S_push_slab(aTHX);
2502
2503     st->minmod = 0;
2504     st->sw = 0;
2505     st->logical = 0;
2506     st->unwind = 0;
2507     st->cc = NULL;
2508     /* Note that nextchr is a byte even in UTF */
2509     nextchr = UCHARAT(locinput);
2510     scan = prog;
2511     while (scan != NULL) {
2512
2513         DEBUG_EXECUTE_r( {
2514             SV * const prop = sv_newmortal();
2515             const int docolor = *PL_colors[0];
2516             const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
2517             int l = (PL_regeol - locinput) > taill ? taill : (PL_regeol - locinput);
2518             /* The part of the string before starttry has one color
2519                (pref0_len chars), between starttry and current
2520                position another one (pref_len - pref0_len chars),
2521                after the current position the third one.
2522                We assume that pref0_len <= pref_len, otherwise we
2523                decrease pref0_len.  */
2524             int pref_len = (locinput - PL_bostr) > (5 + taill) - l
2525                 ? (5 + taill) - l : locinput - PL_bostr;
2526             int pref0_len;
2527
2528             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
2529                 pref_len++;
2530             pref0_len = pref_len  - (locinput - PL_reg_starttry);
2531             if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
2532                 l = ( PL_regeol - locinput > (5 + taill) - pref_len
2533                       ? (5 + taill) - pref_len : PL_regeol - locinput);
2534             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
2535                 l--;
2536             if (pref0_len < 0)
2537                 pref0_len = 0;
2538             if (pref0_len > pref_len)
2539                 pref0_len = pref_len;
2540             regprop(prop, scan);
2541             {
2542               const char * const s0 =
2543                 do_utf8 && OP(scan) != CANY ?
2544                 pv_uni_display(PERL_DEBUG_PAD(0), (U8*)(locinput - pref_len),
2545                                pref0_len, 60, UNI_DISPLAY_REGEX) :
2546                 locinput - pref_len;
2547               const int len0 = do_utf8 ? strlen(s0) : pref0_len;
2548               const char * const s1 = do_utf8 && OP(scan) != CANY ?
2549                 pv_uni_display(PERL_DEBUG_PAD(1),
2550                                (U8*)(locinput - pref_len + pref0_len),
2551                                pref_len - pref0_len, 60, UNI_DISPLAY_REGEX) :
2552                 locinput - pref_len + pref0_len;
2553               const int len1 = do_utf8 ? strlen(s1) : pref_len - pref0_len;
2554               const char * const s2 = do_utf8 && OP(scan) != CANY ?
2555                 pv_uni_display(PERL_DEBUG_PAD(2), (U8*)locinput,
2556                                PL_regeol - locinput, 60, UNI_DISPLAY_REGEX) :
2557                 locinput;
2558               const int len2 = do_utf8 ? strlen(s2) : l;
2559               PerlIO_printf(Perl_debug_log,
2560                             "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n",
2561                             (IV)(locinput - PL_bostr),
2562                             PL_colors[4],
2563                             len0, s0,
2564                             PL_colors[5],
2565                             PL_colors[2],
2566                             len1, s1,
2567                             PL_colors[3],
2568                             (docolor ? "" : "> <"),
2569                             PL_colors[0],
2570                             len2, s2,
2571                             PL_colors[1],
2572                             15 - l - pref_len + 1,
2573                             "",
2574                             (IV)(scan - rex->program), PL_regindent*2, "",
2575                             SvPVX_const(prop));
2576             }
2577         });
2578
2579         next = scan + NEXT_OFF(scan);
2580         if (next == scan)
2581             next = NULL;
2582
2583         switch (OP(scan)) {
2584         case BOL:
2585             if (locinput == PL_bostr)
2586             {
2587                 /* regtill = regbol; */
2588                 break;
2589             }
2590             sayNO;
2591         case MBOL:
2592             if (locinput == PL_bostr ||
2593                 ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n'))
2594             {
2595                 break;
2596             }
2597             sayNO;
2598         case SBOL:
2599             if (locinput == PL_bostr)
2600                 break;
2601             sayNO;
2602         case GPOS:
2603             if (locinput == PL_reg_ganch)
2604                 break;
2605             sayNO;
2606         case EOL:
2607                 goto seol;
2608         case MEOL:
2609             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2610                 sayNO;
2611             break;
2612         case SEOL:
2613           seol:
2614             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2615                 sayNO;
2616             if (PL_regeol - locinput > 1)
2617                 sayNO;
2618             break;
2619         case EOS:
2620             if (PL_regeol != locinput)
2621                 sayNO;
2622             break;
2623         case SANY:
2624             if (!nextchr && locinput >= PL_regeol)
2625                 sayNO;
2626             if (do_utf8) {
2627                 locinput += PL_utf8skip[nextchr];
2628                 if (locinput > PL_regeol)
2629                     sayNO;
2630                 nextchr = UCHARAT(locinput);
2631             }
2632             else
2633                 nextchr = UCHARAT(++locinput);
2634             break;
2635         case CANY:
2636             if (!nextchr && locinput >= PL_regeol)
2637                 sayNO;
2638             nextchr = UCHARAT(++locinput);
2639             break;
2640         case REG_ANY:
2641             if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
2642                 sayNO;
2643             if (do_utf8) {
2644                 locinput += PL_utf8skip[nextchr];
2645                 if (locinput > PL_regeol)
2646                     sayNO;
2647                 nextchr = UCHARAT(locinput);
2648             }
2649             else
2650                 nextchr = UCHARAT(++locinput);
2651             break;
2652
2653
2654
2655         /*
2656            traverse the TRIE keeping track of all accepting states
2657            we transition through until we get to a failing node.
2658
2659
2660         */
2661         case TRIE:
2662         case TRIEF:
2663         case TRIEFL:
2664             {
2665                 U8 *uc = ( U8* )locinput;
2666                 U32 state = 1;
2667                 U16 charid = 0;
2668                 U32 base = 0;
2669                 UV uvc = 0;
2670                 STRLEN len = 0;
2671                 STRLEN foldlen = 0;
2672                 U8 *uscan = (U8*)NULL;
2673                 STRLEN bufflen=0;
2674                 SV *sv_accept_buff = NULL;
2675                 const enum { trie_plain, trie_utf8, trie_uft8_fold }
2676                     trie_type = do_utf8 ?
2677                           (OP(scan) == TRIE ? trie_utf8 : trie_uft8_fold)
2678                         : trie_plain;
2679
2680                 /* what trie are we using right now */
2681                 reg_trie_data *trie
2682                     = (reg_trie_data*)PL_reg_re->data->data[ ARG( scan ) ];
2683                 st->u.trie.accepted = 0; /* how many accepting states we have seen */
2684                 result = 0;
2685
2686                 while ( state && uc <= (U8*)PL_regeol ) {
2687
2688                     if (trie->states[ state ].wordnum) {
2689                         if (!st->u.trie.accepted ) {
2690                             ENTER;
2691                             SAVETMPS;
2692                             bufflen = TRIE_INITAL_ACCEPT_BUFFLEN;
2693                             sv_accept_buff=newSV(bufflen *
2694                                             sizeof(reg_trie_accepted) - 1);
2695                             SvCUR_set(sv_accept_buff,
2696                                                 sizeof(reg_trie_accepted));
2697                             SvPOK_on(sv_accept_buff);
2698                             sv_2mortal(sv_accept_buff);
2699                             st->u.trie.accept_buff =
2700                                 (reg_trie_accepted*)SvPV_nolen(sv_accept_buff );
2701                         }
2702                         else {
2703                             if (st->u.trie.accepted >= bufflen) {
2704                                 bufflen *= 2;
2705                                 st->u.trie.accept_buff =(reg_trie_accepted*)
2706                                     SvGROW(sv_accept_buff,
2707                                         bufflen * sizeof(reg_trie_accepted));
2708                             }
2709                             SvCUR_set(sv_accept_buff,SvCUR(sv_accept_buff)
2710                                 + sizeof(reg_trie_accepted));
2711                         }
2712                         st->u.trie.accept_buff[st->u.trie.accepted].wordnum = trie->states[state].wordnum;
2713                         st->u.trie.accept_buff[st->u.trie.accepted].endpos = uc;
2714                         ++st->u.trie.accepted;
2715                     }
2716
2717                     base = trie->states[ state ].trans.base;
2718
2719                     DEBUG_TRIE_EXECUTE_r(
2720                                 PerlIO_printf( Perl_debug_log,
2721                                     "%*s  %sState: %4"UVxf", Base: %4"UVxf", Accepted: %4"UVxf" ",
2722                                     REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
2723                                     (UV)state, (UV)base, (UV)st->u.trie.accepted );
2724                     );
2725
2726                     if ( base ) {
2727                         switch (trie_type) {
2728                         case trie_uft8_fold:
2729                             if ( foldlen>0 ) {
2730                                 uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags );
2731                                 foldlen -= len;
2732                                 uscan += len;
2733                                 len=0;
2734                             } else {
2735                                 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
2736                                 uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );
2737                                 uvc = to_uni_fold( uvc, foldbuf, &foldlen );
2738                                 foldlen -= UNISKIP( uvc );
2739                                 uscan = foldbuf + UNISKIP( uvc );
2740                             }
2741                             break;
2742                         case trie_utf8:
2743                             uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN,
2744                                                             &len, uniflags );
2745                             break;
2746                         case trie_plain:
2747                             uvc = (UV)*uc;
2748                             len = 1;
2749                         }
2750
2751                         if (uvc < 256) {
2752                             charid = trie->charmap[ uvc ];
2753                         }
2754                         else {
2755                             charid = 0;
2756                             if (trie->widecharmap) {
2757                                 SV** svpp = (SV**)NULL;
2758                                 svpp = hv_fetch(trie->widecharmap,
2759                                             (char*)&uvc, sizeof(UV), 0);
2760                                 if (svpp)
2761                                     charid = (U16)SvIV(*svpp);
2762                             }
2763                         }
2764
2765                         if (charid &&
2766                              (base + charid > trie->uniquecharcount )
2767                              && (base + charid - 1 - trie->uniquecharcount
2768                                     < trie->lasttrans)
2769                              && trie->trans[base + charid - 1 -
2770                                     trie->uniquecharcount].check == state)
2771                         {
2772                             state = trie->trans[base + charid - 1 -
2773                                 trie->uniquecharcount ].next;
2774                         }
2775                         else {
2776                             state = 0;
2777                         }
2778                         uc += len;
2779
2780                     }
2781                     else {
2782                         state = 0;
2783                     }
2784                     DEBUG_TRIE_EXECUTE_r(
2785                         PerlIO_printf( Perl_debug_log,
2786                             "Charid:%3x CV:%4"UVxf" After State: %4"UVxf"%s\n",
2787                             charid, uvc, (UV)state, PL_colors[5] );
2788                     );
2789                 }
2790                 if (!st->u.trie.accepted )
2791                    sayNO;
2792
2793             /*
2794                There was at least one accepting state that we
2795                transitioned through. Presumably the number of accepting
2796                states is going to be low, typically one or two. So we
2797                simply scan through to find the one with lowest wordnum.
2798                Once we find it, we swap the last state into its place
2799                and decrement the size. We then try to match the rest of
2800                the pattern at the point where the word ends, if we
2801                succeed then we end the loop, otherwise the loop
2802                eventually terminates once all of the accepting states
2803                have been tried.
2804             */
2805
2806                 if ( st->u.trie.accepted == 1 ) {
2807                     DEBUG_EXECUTE_r({
2808                         SV ** const tmp = av_fetch( trie->words, st->u.trie.accept_buff[ 0 ].wordnum-1, 0 );
2809                         PerlIO_printf( Perl_debug_log,
2810                             "%*s  %sonly one match : #%d <%s>%s\n",
2811                             REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
2812                             st->u.trie.accept_buff[ 0 ].wordnum,
2813                             tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",
2814                             PL_colors[5] );
2815                     });
2816                     PL_reginput = (char *)st->u.trie.accept_buff[ 0 ].endpos;
2817                     /* in this case we free tmps/leave before we call regmatch
2818                        as we wont be using accept_buff again. */
2819                     FREETMPS;
2820                     LEAVE;
2821                     REGMATCH(scan + NEXT_OFF(scan), TRIE1);
2822                     /*** all unsaved local vars undefined at this point */
2823                 } else {
2824                     DEBUG_EXECUTE_r(
2825                         PerlIO_printf( Perl_debug_log,"%*s  %sgot %"IVdf" possible matches%s\n",
2826                             REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4], (IV)st->u.trie.accepted,
2827                             PL_colors[5] );
2828                     );
2829                     while ( !result && st->u.trie.accepted-- ) {
2830                         U32 best = 0;
2831                         U32 cur;
2832                         for( cur = 1 ; cur <= st->u.trie.accepted ; cur++ ) {
2833                             DEBUG_TRIE_EXECUTE_r(
2834                                 PerlIO_printf( Perl_debug_log,
2835                                     "%*s  %sgot %"IVdf" (%d) as best, looking at %"IVdf" (%d)%s\n",
2836                                     REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
2837                                     (IV)best, st->u.trie.accept_buff[ best ].wordnum, (IV)cur,
2838                                     st->u.trie.accept_buff[ cur ].wordnum, PL_colors[5] );
2839                             );
2840
2841                             if (st->u.trie.accept_buff[cur].wordnum <
2842                                     st->u.trie.accept_buff[best].wordnum)
2843                                 best = cur;
2844                         }
2845                         DEBUG_EXECUTE_r({
2846                             reg_trie_data * const trie = (reg_trie_data*)
2847                                             PL_reg_re->data->data[ARG(scan)];
2848                             SV ** const tmp = av_fetch( trie->words, st->u.trie.accept_buff[ best ].wordnum - 1, 0 );
2849                             PerlIO_printf( Perl_debug_log, "%*s  %strying alternation #%d <%s> at 0x%p%s\n",
2850                                 REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
2851                                 st->u.trie.accept_buff[best].wordnum,
2852                                 tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",scan,
2853                                 PL_colors[5] );
2854                         });
2855                         if ( best<st->u.trie.accepted ) {
2856                             reg_trie_accepted tmp = st->u.trie.accept_buff[ best ];
2857                             st->u.trie.accept_buff[ best ] = st->u.trie.accept_buff[ st->u.trie.accepted ];
2858                             st->u.trie.accept_buff[ st->u.trie.accepted ] = tmp;
2859                             best = st->u.trie.accepted;
2860                         }
2861                         PL_reginput = (char *)st->u.trie.accept_buff[ best ].endpos;
2862
2863                         /*
2864                            as far as I can tell we only need the SAVETMPS/FREETMPS
2865                            for re's with EVAL in them but I'm leaving them in for
2866                            all until I can be sure.
2867                          */
2868                         SAVETMPS;
2869                         REGMATCH(scan + NEXT_OFF(scan), TRIE2);
2870                         /*** all unsaved local vars undefined at this point */
2871                         FREETMPS;
2872                     }
2873                     FREETMPS;
2874                     LEAVE;
2875                 }
2876
2877                 if (result) {
2878                     sayYES;
2879                 } else {
2880                     sayNO;
2881                 }
2882             }
2883             /* unreached codepoint */
2884         case EXACT: {
2885             char *s = STRING(scan);
2886             st->ln = STR_LEN(scan);
2887             if (do_utf8 != UTF) {
2888                 /* The target and the pattern have differing utf8ness. */
2889                 char *l = locinput;
2890                 const char *e = s + st->ln;
2891
2892                 if (do_utf8) {
2893                     /* The target is utf8, the pattern is not utf8. */
2894                     while (s < e) {
2895                         STRLEN ulen;
2896                         if (l >= PL_regeol)
2897                              sayNO;
2898                         if (NATIVE_TO_UNI(*(U8*)s) !=
2899                             utf8n_to_uvuni((U8*)l, UTF8_MAXBYTES, &ulen,
2900                                             uniflags))
2901                              sayNO;
2902                         l += ulen;
2903                         s ++;
2904                     }
2905                 }
2906                 else {
2907                     /* The target is not utf8, the pattern is utf8. */
2908                     while (s < e) {
2909                         STRLEN ulen;
2910                         if (l >= PL_regeol)
2911                             sayNO;
2912                         if (NATIVE_TO_UNI(*((U8*)l)) !=
2913                             utf8n_to_uvuni((U8*)s, UTF8_MAXBYTES, &ulen,
2914                                            uniflags))
2915                             sayNO;
2916                         s += ulen;
2917                         l ++;
2918                     }
2919                 }
2920                 locinput = l;
2921                 nextchr = UCHARAT(locinput);
2922                 break;
2923             }
2924             /* The target and the pattern have the same utf8ness. */
2925             /* Inline the first character, for speed. */
2926             if (UCHARAT(s) != nextchr)
2927                 sayNO;
2928             if (PL_regeol - locinput < st->ln)
2929                 sayNO;
2930             if (st->ln > 1 && memNE(s, locinput, st->ln))
2931                 sayNO;
2932             locinput += st->ln;
2933             nextchr = UCHARAT(locinput);
2934             break;
2935             }
2936         case EXACTFL:
2937             PL_reg_flags |= RF_tainted;
2938             /* FALL THROUGH */
2939         case EXACTF: {
2940             char *s = STRING(scan);
2941             st->ln = STR_LEN(scan);
2942
2943             if (do_utf8 || UTF) {
2944               /* Either target or the pattern are utf8. */
2945                 char *l = locinput;
2946                 char *e = PL_regeol;
2947
2948                 if (ibcmp_utf8(s, 0,  st->ln, (bool)UTF,
2949                                l, &e, 0,  do_utf8)) {
2950                      /* One more case for the sharp s:
2951                       * pack("U0U*", 0xDF) =~ /ss/i,
2952                       * the 0xC3 0x9F are the UTF-8
2953                       * byte sequence for the U+00DF. */
2954                      if (!(do_utf8 &&
2955                            toLOWER(s[0]) == 's' &&
2956                            st->ln >= 2 &&
2957                            toLOWER(s[1]) == 's' &&
2958                            (U8)l[0] == 0xC3 &&
2959                            e - l >= 2 &&
2960                            (U8)l[1] == 0x9F))
2961                           sayNO;
2962                 }
2963                 locinput = e;
2964                 nextchr = UCHARAT(locinput);
2965                 break;
2966             }
2967
2968             /* Neither the target and the pattern are utf8. */
2969
2970             /* Inline the first character, for speed. */
2971             if (UCHARAT(s) != nextchr &&
2972                 UCHARAT(s) != ((OP(scan) == EXACTF)
2973                                ? PL_fold : PL_fold_locale)[nextchr])
2974                 sayNO;
2975             if (PL_regeol - locinput < st->ln)
2976                 sayNO;
2977             if (st->ln > 1 && (OP(scan) == EXACTF
2978                            ? ibcmp(s, locinput, st->ln)
2979                            : ibcmp_locale(s, locinput, st->ln)))
2980                 sayNO;
2981             locinput += st->ln;
2982             nextchr = UCHARAT(locinput);
2983             break;
2984             }
2985         case ANYOF:
2986             if (do_utf8) {
2987                 STRLEN inclasslen = PL_regeol - locinput;
2988
2989                 if (!reginclass(scan, (U8*)locinput, &inclasslen, do_utf8))
2990                     sayNO_ANYOF;
2991                 if (locinput >= PL_regeol)
2992                     sayNO;
2993                 locinput += inclasslen ? inclasslen : UTF8SKIP(locinput);
2994                 nextchr = UCHARAT(locinput);
2995                 break;
2996             }
2997             else {
2998                 if (nextchr < 0)
2999                     nextchr = UCHARAT(locinput);
3000                 if (!REGINCLASS(scan, (U8*)locinput))
3001                     sayNO_ANYOF;
3002                 if (!nextchr && locinput >= PL_regeol)
3003                     sayNO;
3004                 nextchr = UCHARAT(++locinput);
3005                 break;
3006             }
3007         no_anyof:
3008             /* If we might have the case of the German sharp s
3009              * in a casefolding Unicode character class. */
3010
3011             if (ANYOF_FOLD_SHARP_S(scan, locinput, PL_regeol)) {
3012                  locinput += SHARP_S_SKIP;
3013                  nextchr = UCHARAT(locinput);
3014             }
3015             else
3016                  sayNO;
3017             break;
3018         case ALNUML:
3019             PL_reg_flags |= RF_tainted;
3020             /* FALL THROUGH */
3021         case ALNUM:
3022             if (!nextchr)
3023                 sayNO;
3024             if (do_utf8) {
3025                 LOAD_UTF8_CHARCLASS_ALNUM();
3026                 if (!(OP(scan) == ALNUM
3027                       ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
3028                       : isALNUM_LC_utf8((U8*)locinput)))
3029                 {
3030                     sayNO;
3031                 }
3032                 locinput += PL_utf8skip[nextchr];
3033                 nextchr = UCHARAT(locinput);
3034                 break;
3035             }
3036             if (!(OP(scan) == ALNUM
3037                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
3038                 sayNO;
3039             nextchr = UCHARAT(++locinput);
3040             break;
3041         case NALNUML:
3042             PL_reg_flags |= RF_tainted;
3043             /* FALL THROUGH */
3044         case NALNUM:
3045             if (!nextchr && locinput >= PL_regeol)
3046                 sayNO;
3047             if (do_utf8) {
3048                 LOAD_UTF8_CHARCLASS_ALNUM();
3049                 if (OP(scan) == NALNUM
3050                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
3051                     : isALNUM_LC_utf8((U8*)locinput))
3052                 {
3053                     sayNO;
3054                 }
3055                 locinput += PL_utf8skip[nextchr];
3056                 nextchr = UCHARAT(locinput);
3057                 break;
3058             }
3059             if (OP(scan) == NALNUM
3060                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
3061                 sayNO;
3062             nextchr = UCHARAT(++locinput);
3063             break;
3064         case BOUNDL:
3065         case NBOUNDL:
3066             PL_reg_flags |= RF_tainted;
3067             /* FALL THROUGH */
3068         case BOUND:
3069         case NBOUND:
3070             /* was last char in word? */
3071             if (do_utf8) {
3072                 if (locinput == PL_bostr)
3073                     st->ln = '\n';
3074                 else {
3075                     const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
3076
3077                     st->ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, uniflags);
3078                 }
3079                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
3080                     st->ln = isALNUM_uni(st->ln);
3081                     LOAD_UTF8_CHARCLASS_ALNUM();
3082                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
3083                 }
3084                 else {
3085                     st->ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(st->ln));
3086                     n = isALNUM_LC_utf8((U8*)locinput);
3087                 }
3088             }
3089             else {
3090                 st->ln = (locinput != PL_bostr) ?
3091                     UCHARAT(locinput - 1) : '\n';
3092                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
3093                     st->ln = isALNUM(st->ln);
3094                     n = isALNUM(nextchr);
3095                 }
3096                 else {
3097                     st->ln = isALNUM_LC(st->ln);
3098                     n = isALNUM_LC(nextchr);
3099                 }
3100             }
3101             if (((!st->ln) == (!n)) == (OP(scan) == BOUND ||
3102                                     OP(scan) == BOUNDL))
3103                     sayNO;
3104             break;
3105         case SPACEL:
3106             PL_reg_flags |= RF_tainted;
3107             /* FALL THROUGH */
3108         case SPACE:
3109             if (!nextchr)
3110                 sayNO;
3111             if (do_utf8) {
3112                 if (UTF8_IS_CONTINUED(nextchr)) {
3113                     LOAD_UTF8_CHARCLASS_SPACE();
3114                     if (!(OP(scan) == SPACE
3115                           ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3116                           : isSPACE_LC_utf8((U8*)locinput)))
3117                     {
3118                         sayNO;
3119                     }
3120                     locinput += PL_utf8skip[nextchr];
3121                     nextchr = UCHARAT(locinput);
3122                     break;
3123                 }
3124                 if (!(OP(scan) == SPACE
3125                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3126                     sayNO;
3127                 nextchr = UCHARAT(++locinput);
3128             }
3129             else {
3130                 if (!(OP(scan) == SPACE
3131                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3132                     sayNO;
3133                 nextchr = UCHARAT(++locinput);
3134             }
3135             break;
3136         case NSPACEL:
3137             PL_reg_flags |= RF_tainted;
3138             /* FALL THROUGH */
3139         case NSPACE:
3140             if (!nextchr && locinput >= PL_regeol)
3141                 sayNO;
3142             if (do_utf8) {
3143                 LOAD_UTF8_CHARCLASS_SPACE();
3144                 if (OP(scan) == NSPACE
3145                     ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3146                     : isSPACE_LC_utf8((U8*)locinput))
3147                 {
3148                     sayNO;
3149                 }
3150                 locinput += PL_utf8skip[nextchr];
3151                 nextchr = UCHARAT(locinput);
3152                 break;
3153             }
3154             if (OP(scan) == NSPACE
3155                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
3156                 sayNO;
3157             nextchr = UCHARAT(++locinput);
3158             break;
3159         case DIGITL:
3160             PL_reg_flags |= RF_tainted;
3161             /* FALL THROUGH */
3162         case DIGIT:
3163             if (!nextchr)
3164                 sayNO;
3165             if (do_utf8) {
3166                 LOAD_UTF8_CHARCLASS_DIGIT();
3167                 if (!(OP(scan) == DIGIT
3168                       ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3169                       : isDIGIT_LC_utf8((U8*)locinput)))
3170                 {
3171                     sayNO;
3172                 }
3173                 locinput += PL_utf8skip[nextchr];
3174                 nextchr = UCHARAT(locinput);
3175                 break;
3176             }
3177             if (!(OP(scan) == DIGIT
3178                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
3179                 sayNO;
3180             nextchr = UCHARAT(++locinput);
3181             break;
3182         case NDIGITL:
3183             PL_reg_flags |= RF_tainted;
3184             /* FALL THROUGH */
3185         case NDIGIT:
3186             if (!nextchr && locinput >= PL_regeol)
3187                 sayNO;
3188             if (do_utf8) {
3189                 LOAD_UTF8_CHARCLASS_DIGIT();
3190                 if (OP(scan) == NDIGIT
3191                     ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3192                     : isDIGIT_LC_utf8((U8*)locinput))
3193                 {
3194                     sayNO;
3195                 }
3196                 locinput += PL_utf8skip[nextchr];
3197                 nextchr = UCHARAT(locinput);
3198                 break;
3199             }
3200             if (OP(scan) == NDIGIT
3201                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
3202                 sayNO;
3203             nextchr = UCHARAT(++locinput);
3204             break;
3205         case CLUMP:
3206             if (locinput >= PL_regeol)
3207                 sayNO;
3208             if  (do_utf8) {
3209                 LOAD_UTF8_CHARCLASS_MARK();
3210                 if (swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3211                     sayNO;
3212                 locinput += PL_utf8skip[nextchr];
3213                 while (locinput < PL_regeol &&
3214                        swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3215                     locinput += UTF8SKIP(locinput);
3216                 if (locinput > PL_regeol)
3217                     sayNO;
3218             }
3219             else
3220                locinput++;
3221             nextchr = UCHARAT(locinput);
3222             break;
3223         case REFFL:
3224             PL_reg_flags |= RF_tainted;
3225             /* FALL THROUGH */
3226         case REF:
3227         case REFF: {
3228             char *s;
3229             n = ARG(scan);  /* which paren pair */
3230             st->ln = PL_regstartp[n];
3231             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3232             if ((I32)*PL_reglastparen < n || st->ln == -1)
3233                 sayNO;                  /* Do not match unless seen CLOSEn. */
3234             if (st->ln == PL_regendp[n])
3235                 break;
3236
3237             s = PL_bostr + st->ln;
3238             if (do_utf8 && OP(scan) != REF) {   /* REF can do byte comparison */
3239                 char *l = locinput;
3240                 const char *e = PL_bostr + PL_regendp[n];
3241                 /*
3242                  * Note that we can't do the "other character" lookup trick as
3243                  * in the 8-bit case (no pun intended) because in Unicode we
3244                  * have to map both upper and title case to lower case.
3245                  */
3246                 if (OP(scan) == REFF) {
3247                     while (s < e) {
3248                         STRLEN ulen1, ulen2;
3249                         U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
3250                         U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
3251
3252                         if (l >= PL_regeol)
3253                             sayNO;
3254                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
3255                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
3256                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
3257                             sayNO;
3258                         s += ulen1;
3259                         l += ulen2;
3260                     }
3261                 }
3262                 locinput = l;
3263                 nextchr = UCHARAT(locinput);
3264                 break;
3265             }
3266
3267             /* Inline the first character, for speed. */
3268             if (UCHARAT(s) != nextchr &&
3269                 (OP(scan) == REF ||
3270                  (UCHARAT(s) != ((OP(scan) == REFF
3271                                   ? PL_fold : PL_fold_locale)[nextchr]))))
3272                 sayNO;
3273             st->ln = PL_regendp[n] - st->ln;
3274             if (locinput + st->ln > PL_regeol)
3275                 sayNO;
3276             if (st->ln > 1 && (OP(scan) == REF
3277                            ? memNE(s, locinput, st->ln)
3278                            : (OP(scan) == REFF
3279                               ? ibcmp(s, locinput, st->ln)
3280                               : ibcmp_locale(s, locinput, st->ln))))
3281                 sayNO;
3282             locinput += st->ln;
3283             nextchr = UCHARAT(locinput);
3284             break;
3285             }
3286
3287         case NOTHING:
3288         case TAIL:
3289             break;
3290         case BACK:
3291             break;
3292         case EVAL:
3293         {
3294             SV *ret;
3295             {
3296                 /* execute the code in the {...} */
3297                 dSP;
3298                 SV ** const before = SP;
3299                 OP_4tree * const oop = PL_op;
3300                 COP * const ocurcop = PL_curcop;
3301                 PAD *old_comppad;
3302                 struct regexp * const oreg = PL_reg_re;
3303
3304                 n = ARG(scan);
3305                 PL_op = (OP_4tree*)PL_reg_re->data->data[n];
3306                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
3307                 PAD_SAVE_LOCAL(old_comppad, (PAD*)PL_reg_re->data->data[n + 2]);
3308                 PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
3309
3310                 CALLRUNOPS(aTHX);                       /* Scalar context. */
3311                 SPAGAIN;
3312                 if (SP == before)
3313                     ret = &PL_sv_undef;   /* protect against empty (?{}) blocks. */
3314                 else {
3315                     ret = POPs;
3316                     PUTBACK;
3317                 }
3318
3319                 PL_op = oop;
3320                 PAD_RESTORE_LOCAL(old_comppad);
3321                 PL_curcop = ocurcop;
3322                 PL_reg_re = oreg;
3323                 if (!st->logical) {
3324                     /* /(?{...})/ */
3325                     sv_setsv(save_scalar(PL_replgv), ret);
3326                     break;
3327                 }
3328             }
3329             if (st->logical == 2) { /* Postponed subexpression: /(??{...})/ */
3330                 regexp *re;
3331                 {
3332                     /* extract RE object from returned value; compiling if
3333                      * necessary */
3334
3335                     MAGIC *mg = NULL;
3336                     SV *sv;
3337                     if(SvROK(ret) && SvSMAGICAL(sv = SvRV(ret)))
3338                         mg = mg_find(sv, PERL_MAGIC_qr);
3339                     else if (SvSMAGICAL(ret)) {
3340                         if (SvGMAGICAL(ret))
3341                             sv_unmagic(ret, PERL_MAGIC_qr);
3342                         else
3343                             mg = mg_find(ret, PERL_MAGIC_qr);
3344                     }
3345
3346                     if (mg) {
3347                         re = (regexp *)mg->mg_obj;
3348                         (void)ReREFCNT_inc(re);
3349                     }
3350                     else {
3351                         STRLEN len;
3352                         const char * const t = SvPV_const(ret, len);
3353                         PMOP pm;
3354                         const I32 osize = PL_regsize;
3355
3356                         Zero(&pm, 1, PMOP);
3357                         if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
3358                         re = CALLREGCOMP(aTHX_ (char*)t, (char*)t + len, &pm);
3359                         if (!(SvFLAGS(ret)
3360                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
3361                                 | SVs_GMG)))
3362                             sv_magic(ret,(SV*)ReREFCNT_inc(re),
3363                                         PERL_MAGIC_qr,0,0);
3364                         PL_regsize = osize;
3365                     }
3366                 }
3367
3368                 /* run the pattern returned from (??{...}) */
3369
3370                 DEBUG_EXECUTE_r(
3371                     PerlIO_printf(Perl_debug_log,
3372                                   "Entering embedded \"%s%.60s%s%s\"\n",
3373                                   PL_colors[0],
3374                                   re->precomp,
3375                                   PL_colors[1],
3376                                   (strlen(re->precomp) > 60 ? "..." : ""))
3377                     );
3378
3379                 st->u.eval.cp = regcppush(0);   /* Save *all* the positions. */
3380                 REGCP_SET(st->u.eval.lastcp);
3381                 *PL_reglastparen = 0;
3382                 *PL_reglastcloseparen = 0;
3383                 PL_reginput = locinput;
3384
3385                 /* XXXX This is too dramatic a measure... */
3386                 PL_reg_maxiter = 0;
3387
3388                 st->logical = 0;
3389                 st->u.eval.toggleutf = ((PL_reg_flags & RF_utf8) != 0) ^
3390                             ((re->reganch & ROPT_UTF8) != 0);
3391                 if (st->u.eval.toggleutf) PL_reg_flags ^= RF_utf8;
3392                 st->u.eval.prev_rex = rex;
3393                 assert(rex == PL_reg_re); /* XXX */
3394                 rex = re;
3395                 PL_reg_re = rex; /* XXX */
3396
3397                 st->u.eval.prev_eval = cur_eval;
3398                 st->u.eval.prev_slab = PL_regmatch_slab;
3399                 st->u.eval.depth = depth;
3400                 cur_eval = st;
3401                 PUSH_STATE(newst, resume_EVAL);
3402                 st = newst;
3403
3404                 /* now continue  from first node in postoned RE */
3405                 next = re->program + 1;
3406                 break;
3407                 /* NOTREACHED */
3408             }
3409             /* /(?(?{...})X|Y)/ */
3410             st->sw = SvTRUE(ret);
3411             st->logical = 0;
3412             break;
3413         }
3414         case OPEN:
3415             n = ARG(scan);  /* which paren pair */
3416             PL_reg_start_tmp[n] = locinput;
3417             if (n > PL_regsize)
3418                 PL_regsize = n;
3419             break;
3420         case CLOSE:
3421             n = ARG(scan);  /* which paren pair */
3422             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
3423             PL_regendp[n] = locinput - PL_bostr;
3424             if (n > (I32)*PL_reglastparen)
3425                 *PL_reglastparen = n;
3426             *PL_reglastcloseparen = n;
3427             break;
3428         case GROUPP:
3429             n = ARG(scan);  /* which paren pair */
3430             st->sw = ((I32)*PL_reglastparen >= n && PL_regendp[n] != -1);
3431             break;
3432         case IFTHEN:
3433             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3434             if (st->sw)
3435                 next = NEXTOPER(NEXTOPER(scan));
3436             else {
3437                 next = scan + ARG(scan);
3438                 if (OP(next) == IFTHEN) /* Fake one. */
3439                     next = NEXTOPER(NEXTOPER(next));
3440             }
3441             break;
3442         case LOGICAL:
3443             st->logical = scan->flags;
3444             break;
3445 /*******************************************************************
3446  cc points to the regmatch_state associated with the most recent CURLYX.
3447  This struct contains info about the innermost (...)* loop (an
3448  "infoblock"), and a pointer to the next outer cc.
3449
3450  Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM):
3451
3452    1) After matching Y, regnode for CURLYX is processed;
3453
3454    2) This regnode populates cc, and calls regmatch() recursively
3455       with the starting point at WHILEM node;
3456
3457    3) Each hit of WHILEM node tries to match A and Z (in the order
3458       depending on the current iteration, min/max of {min,max} and
3459       greediness).  The information about where are nodes for "A"
3460       and "Z" is read from cc, as is info on how many times "A"
3461       was already matched, and greediness.
3462
3463    4) After A matches, the same WHILEM node is hit again.
3464
3465    5) Each time WHILEM is hit, cc is the infoblock created by CURLYX
3466       of the same pair.  Thus when WHILEM tries to match Z, it temporarily
3467       resets cc, since this Y(A)*Z can be a part of some other loop:
3468       as in (Y(A)*Z)*.  If Z matches, the automaton will hit the WHILEM node
3469       of the external loop.
3470
3471  Currently present infoblocks form a tree with a stem formed by st->cc
3472  and whatever it mentions via ->next, and additional attached trees
3473  corresponding to temporarily unset infoblocks as in "5" above.
3474
3475  In the following picture, infoblocks for outer loop of
3476  (Y(A)*?Z)*?T are denoted O, for inner I.  NULL starting block
3477  is denoted by x.  The matched string is YAAZYAZT.  Temporarily postponed
3478  infoblocks are drawn below the "reset" infoblock.
3479
3480  In fact in the picture below we do not show failed matches for Z and T
3481  by WHILEM blocks.  [We illustrate minimal matches, since for them it is
3482  more obvious *why* one needs to *temporary* unset infoblocks.]
3483
3484   Matched       REx position    InfoBlocks      Comment
3485                 (Y(A)*?Z)*?T    x
3486                 Y(A)*?Z)*?T     x <- O
3487   Y             (A)*?Z)*?T      x <- O
3488   Y             A)*?Z)*?T       x <- O <- I
3489   YA            )*?Z)*?T        x <- O <- I
3490   YA            A)*?Z)*?T       x <- O <- I
3491   YAA           )*?Z)*?T        x <- O <- I
3492   YAA           Z)*?T           x <- O          # Temporary unset I
3493                                      I
3494
3495   YAAZ          Y(A)*?Z)*?T     x <- O
3496                                      I
3497
3498   YAAZY         (A)*?Z)*?T      x <- O
3499                                      I
3500
3501   YAAZY         A)*?Z)*?T       x <- O <- I
3502                                      I
3503
3504   YAAZYA        )*?Z)*?T        x <- O <- I
3505                                      I
3506
3507   YAAZYA        Z)*?T           x <- O          # Temporary unset I
3508                                      I,I
3509
3510   YAAZYAZ       )*?T            x <- O
3511                                      I,I
3512
3513   YAAZYAZ       T               x               # Temporary unset O
3514                                 O
3515                                 I,I
3516
3517   YAAZYAZT                      x
3518                                 O
3519                                 I,I
3520  *******************************************************************/
3521
3522         case CURLYX: {
3523                 /* No need to save/restore up to this paren */
3524                 I32 parenfloor = scan->flags;
3525
3526                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
3527                     next += ARG(next);
3528                 /* XXXX Probably it is better to teach regpush to support
3529                    parenfloor > PL_regsize... */
3530                 if (parenfloor > (I32)*PL_reglastparen)
3531                     parenfloor = *PL_reglastparen; /* Pessimization... */
3532
3533                 st->u.curlyx.cp = PL_savestack_ix;
3534                 st->u.curlyx.outercc = st->cc;
3535                 st->cc = st;
3536                 /* these fields contain the state of the current curly.
3537                  * they are accessed by subsequent WHILEMs;
3538                  * cur and lastloc are also updated by WHILEM */
3539                 st->u.curlyx.parenfloor = parenfloor;
3540                 st->u.curlyx.cur = -1; /* this will be updated by WHILEM */
3541                 st->u.curlyx.min = ARG1(scan);
3542                 st->u.curlyx.max  = ARG2(scan);
3543                 st->u.curlyx.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3544                 st->u.curlyx.lastloc = 0;
3545                 /* st->next and st->minmod are also read by WHILEM */
3546
3547                 PL_reginput = locinput;
3548                 REGMATCH(PREVOPER(next), CURLYX); /* start on the WHILEM */
3549                 /*** all unsaved local vars undefined at this point */
3550                 regcpblow(st->u.curlyx.cp);
3551                 st->cc = st->u.curlyx.outercc;
3552                 saySAME(result);
3553             }
3554             /* NOTREACHED */
3555         case WHILEM: {
3556                 /*
3557                  * This is really hard to understand, because after we match
3558                  * what we're trying to match, we must make sure the rest of
3559                  * the REx is going to match for sure, and to do that we have
3560                  * to go back UP the parse tree by recursing ever deeper.  And
3561                  * if it fails, we have to reset our parent's current state
3562                  * that we can try again after backing off.
3563                  */
3564
3565                 st->u.whilem.lastloc = st->cc->u.curlyx.lastloc; /* Detection of 0-len. */
3566                 st->u.whilem.cache_offset = 0;
3567                 st->u.whilem.cache_bit = 0;
3568
3569                 n = st->cc->u.curlyx.cur + 1; /* how many we know we matched */
3570                 PL_reginput = locinput;
3571
3572                 DEBUG_EXECUTE_r(
3573                     PerlIO_printf(Perl_debug_log,
3574                                   "%*s  %ld out of %ld..%ld  cc=%"UVxf"\n",
3575                                   REPORT_CODE_OFF+PL_regindent*2, "",
3576                                   (long)n, (long)st->cc->u.curlyx.min,
3577                                   (long)st->cc->u.curlyx.max, PTR2UV(st->cc))
3578                     );
3579
3580                 /* If degenerate scan matches "", assume scan done. */
3581
3582                 if (locinput == st->cc->u.curlyx.lastloc && n >= st->cc->u.curlyx.min) {
3583                     st->u.whilem.savecc = st->cc;
3584                     st->cc = st->cc->u.curlyx.outercc;
3585                     if (st->cc)
3586                         st->ln = st->cc->u.curlyx.cur;
3587                     DEBUG_EXECUTE_r(
3588                         PerlIO_printf(Perl_debug_log,
3589                            "%*s  empty match detected, try continuation...\n",
3590                            REPORT_CODE_OFF+PL_regindent*2, "")
3591                         );
3592                     REGMATCH(st->u.whilem.savecc->next, WHILEM1);
3593                     /*** all unsaved local vars undefined at this point */
3594                     st->cc = st->u.whilem.savecc;
3595                     if (result)
3596                         sayYES;
3597                     if (st->cc->u.curlyx.outercc)
3598                         st->cc->u.curlyx.outercc->u.curlyx.cur = st->ln;
3599                     sayNO;
3600                 }
3601
3602                 /* First just match a string of min scans. */
3603
3604                 if (n < st->cc->u.curlyx.min) {
3605                     st->cc->u.curlyx.cur = n;
3606                     st->cc->u.curlyx.lastloc = locinput;
3607                     REGMATCH(st->cc->u.curlyx.scan, WHILEM2);
3608                     /*** all unsaved local vars undefined at this point */
3609                     if (result)
3610                         sayYES;
3611                     st->cc->u.curlyx.cur = n - 1;
3612                     st->cc->u.curlyx.lastloc = st->u.whilem.lastloc;
3613                     sayNO;
3614                 }
3615
3616                 if (scan->flags) {
3617                     /* Check whether we already were at this position.
3618                         Postpone detection until we know the match is not
3619                         *that* much linear. */
3620                 if (!PL_reg_maxiter) {
3621                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
3622                     PL_reg_leftiter = PL_reg_maxiter;
3623                 }
3624                 if (PL_reg_leftiter-- == 0) {
3625                     const I32 size = (PL_reg_maxiter + 7 + POSCACHE_START)/8;
3626                     if (PL_reg_poscache) {
3627                         if ((I32)PL_reg_poscache_size < size) {
3628                             Renew(PL_reg_poscache, size, char);
3629                             PL_reg_poscache_size = size;
3630                         }
3631                         Zero(PL_reg_poscache, size, char);
3632                     }
3633                     else {
3634                         PL_reg_poscache_size = size;
3635                         Newxz(PL_reg_poscache, size, char);
3636                     }
3637                     DEBUG_EXECUTE_r(
3638                         PerlIO_printf(Perl_debug_log,
3639               "%sDetected a super-linear match, switching on caching%s...\n",
3640                                       PL_colors[4], PL_colors[5])
3641                         );
3642                 }
3643                 if (PL_reg_leftiter < 0) {
3644                     st->u.whilem.cache_offset = locinput - PL_bostr;
3645
3646                     st->u.whilem.cache_offset = (scan->flags & 0xf) - 1 + POSCACHE_START
3647                             + st->u.whilem.cache_offset * (scan->flags>>4);
3648                     st->u.whilem.cache_bit = st->u.whilem.cache_offset % 8;
3649                     st->u.whilem.cache_offset /= 8;
3650                     if (PL_reg_poscache[st->u.whilem.cache_offset] & (1<<st->u.whilem.cache_bit)) {
3651                     DEBUG_EXECUTE_r(
3652                         PerlIO_printf(Perl_debug_log,
3653                                       "%*s  already tried at this position...\n",
3654                                       REPORT_CODE_OFF+PL_regindent*2, "")
3655                         );
3656                         if (PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))
3657                             /* cache records success */
3658                             sayYES;
3659                         else
3660                             /* cache records failure */
3661                             sayNO_SILENT;
3662                     }
3663                     PL_reg_poscache[st->u.whilem.cache_offset] |= (1<<st->u.whilem.cache_bit);
3664                 }
3665                 }
3666
3667                 /* Prefer next over scan for minimal matching. */
3668
3669                 if (st->cc->minmod) {
3670                     st->u.whilem.savecc = st->cc;
3671                     st->cc = st->cc->u.curlyx.outercc;
3672                     if (st->cc)
3673                         st->ln = st->cc->u.curlyx.cur;
3674                     st->u.whilem.cp = regcppush(st->u.whilem.savecc->u.curlyx.parenfloor);
3675                     REGCP_SET(st->u.whilem.lastcp);
3676                     REGMATCH(st->u.whilem.savecc->next, WHILEM3);
3677                     /*** all unsaved local vars undefined at this point */
3678                     st->cc = st->u.whilem.savecc;
3679                     if (result) {
3680                         regcpblow(st->u.whilem.cp);
3681                         CACHEsayYES;    /* All done. */
3682                     }
3683                     REGCP_UNWIND(st->u.whilem.lastcp);
3684                     regcppop(rex);
3685                     if (st->cc->u.curlyx.outercc)
3686                         st->cc->u.curlyx.outercc->u.curlyx.cur = st->ln;
3687
3688                     if (n >= st->cc->u.curlyx.max) { /* Maximum greed exceeded? */
3689                         if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3690                             && !(PL_reg_flags & RF_warned)) {
3691                             PL_reg_flags |= RF_warned;
3692                             Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
3693                                  "Complex regular subexpression recursion",
3694                                  REG_INFTY - 1);
3695                         }
3696                         CACHEsayNO;
3697                     }
3698
3699                     DEBUG_EXECUTE_r(
3700                         PerlIO_printf(Perl_debug_log,
3701                                       "%*s  trying longer...\n",
3702                                       REPORT_CODE_OFF+PL_regindent*2, "")
3703                         );
3704                     /* Try scanning more and see if it helps. */
3705                     PL_reginput = locinput;
3706                     st->cc->u.curlyx.cur = n;
3707                     st->cc->u.curlyx.lastloc = locinput;
3708                     st->u.whilem.cp = regcppush(st->cc->u.curlyx.parenfloor);
3709                     REGCP_SET(st->u.whilem.lastcp);
3710                     REGMATCH(st->cc->u.curlyx.scan, WHILEM4);
3711                     /*** all unsaved local vars undefined at this point */
3712                     if (result) {
3713                         regcpblow(st->u.whilem.cp);
3714                         CACHEsayYES;
3715                     }
3716                     REGCP_UNWIND(st->u.whilem.lastcp);
3717                     regcppop(rex);
3718                     st->cc->u.curlyx.cur = n - 1;
3719                     st->cc->u.curlyx.lastloc = st->u.whilem.lastloc;
3720                     CACHEsayNO;
3721                 }
3722
3723                 /* Prefer scan over next for maximal matching. */
3724
3725                 if (n < st->cc->u.curlyx.max) { /* More greed allowed? */
3726                     st->u.whilem.cp = regcppush(st->cc->u.curlyx.parenfloor);
3727                     st->cc->u.curlyx.cur = n;
3728                     st->cc->u.curlyx.lastloc = locinput;
3729                     REGCP_SET(st->u.whilem.lastcp);
3730                     REGMATCH(st->cc->u.curlyx.scan, WHILEM5);
3731                     /*** all unsaved local vars undefined at this point */
3732                     if (result) {
3733                         regcpblow(st->u.whilem.cp);
3734                         CACHEsayYES;
3735                     }
3736                     REGCP_UNWIND(st->u.whilem.lastcp);
3737                     regcppop(rex);      /* Restore some previous $<digit>s? */
3738                     PL_reginput = locinput;
3739                     DEBUG_EXECUTE_r(
3740                         PerlIO_printf(Perl_debug_log,
3741                                       "%*s  failed, try continuation...\n",
3742                                       REPORT_CODE_OFF+PL_regindent*2, "")
3743                         );
3744                 }
3745                 if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3746                         && !(PL_reg_flags & RF_warned)) {
3747                     PL_reg_flags |= RF_warned;
3748                     Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
3749                          "Complex regular subexpression recursion",
3750                          REG_INFTY - 1);
3751                 }
3752
3753                 /* Failed deeper matches of scan, so see if this one works. */
3754                 st->u.whilem.savecc = st->cc;
3755                 st->cc = st->cc->u.curlyx.outercc;
3756                 if (st->cc)
3757                     st->ln = st->cc->u.curlyx.cur;
3758                 REGMATCH(st->u.whilem.savecc->next, WHILEM6);
3759                 /*** all unsaved local vars undefined at this point */
3760                 st->cc = st->u.whilem.savecc;
3761                 if (result)
3762                     CACHEsayYES;
3763                 if (st->cc->u.curlyx.outercc)
3764                     st->cc->u.curlyx.outercc->u.curlyx.cur = st->ln;
3765                 st->cc->u.curlyx.cur = n - 1;
3766                 st->cc->u.curlyx.lastloc = st->u.whilem.lastloc;
3767                 CACHEsayNO;
3768             }
3769             /* NOTREACHED */
3770         case BRANCHJ:
3771             next = scan + ARG(scan);
3772             if (next == scan)
3773                 next = NULL;
3774             inner = NEXTOPER(NEXTOPER(scan));
3775             goto do_branch;
3776         case BRANCH:
3777             inner = NEXTOPER(scan);
3778           do_branch:
3779             {
3780                 I32 type;
3781                 type = OP(scan);
3782                 if (OP(next) != type)   /* No choice. */
3783                     next = inner;       /* Avoid recursion. */
3784                 else {
3785                     const I32 lastparen = *PL_reglastparen;
3786                     /* Put unwinding data on stack */
3787                     const I32 unwind1 = SSNEWt(1,re_unwind_branch_t);
3788                     re_unwind_branch_t * const uw = SSPTRt(unwind1,re_unwind_branch_t);
3789
3790                     uw->prev = st->unwind;
3791                     st->unwind = unwind1;
3792                     uw->type = ((type == BRANCH)
3793                                 ? RE_UNWIND_BRANCH
3794                                 : RE_UNWIND_BRANCHJ);
3795                     uw->lastparen = lastparen;
3796                     uw->next = next;
3797                     uw->locinput = locinput;
3798                     uw->nextchr = nextchr;
3799                     uw->minmod = st->minmod;
3800 #ifdef DEBUGGING
3801                     uw->regindent = ++PL_regindent;
3802 #endif
3803
3804                     REGCP_SET(uw->lastcp);
3805
3806                     /* Now go into the first branch */
3807                     next = inner;
3808                 }
3809             }
3810             break;
3811         case MINMOD:
3812             st->minmod = 1;
3813             break;
3814         case CURLYM:
3815         {
3816             st->u.curlym.l = st->u.curlym.matches = 0;
3817
3818             /* We suppose that the next guy does not need
3819                backtracking: in particular, it is of constant non-zero length,
3820                and has no parenths to influence future backrefs. */
3821             st->ln = ARG1(scan);  /* min to match */
3822             n  = ARG2(scan);  /* max to match */
3823             st->u.curlym.paren = scan->flags;
3824             if (st->u.curlym.paren) {
3825                 if (st->u.curlym.paren > PL_regsize)
3826                     PL_regsize = st->u.curlym.paren;
3827                 if (st->u.curlym.paren > (I32)*PL_reglastparen)
3828                     *PL_reglastparen = st->u.curlym.paren;
3829             }
3830             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3831             if (st->u.curlym.paren)
3832                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
3833             PL_reginput = locinput;
3834             st->u.curlym.maxwanted = st->minmod ? st->ln : n;
3835             if (st->u.curlym.maxwanted) {
3836                 while (PL_reginput < PL_regeol && st->u.curlym.matches < st->u.curlym.maxwanted) {
3837                     REGMATCH(scan, CURLYM1);
3838                     /*** all unsaved local vars undefined at this point */
3839                     if (!result)
3840                         break;
3841                     /* on first match, determine length, u.curlym.l */
3842                     if (!st->u.curlym.matches++) {
3843                         if (PL_reg_match_utf8) {
3844                             char *s = locinput;
3845                             while (s < PL_reginput) {
3846                                 st->u.curlym.l++;
3847                                 s += UTF8SKIP(s);
3848                             }
3849                         }
3850                         else {
3851                             st->u.curlym.l = PL_reginput - locinput;
3852                         }
3853                         if (st->u.curlym.l == 0) {
3854                             st->u.curlym.matches = st->u.curlym.maxwanted;
3855                             break;
3856                         }
3857                     }
3858                     locinput = PL_reginput;
3859                 }
3860             }
3861
3862             PL_reginput = locinput;
3863
3864             if (st->minmod) {
3865                 st->minmod = 0;
3866                 if (st->ln && st->u.curlym.matches < st->ln)
3867                     sayNO;
3868                 if (HAS_TEXT(next) || JUMPABLE(next)) {
3869                     regnode *text_node = next;
3870
3871                     if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3872
3873                     if (! HAS_TEXT(text_node)) st->u.curlym.c1 = st->u.curlym.c2 = -1000;
3874                     else {
3875                         if (PL_regkind[(U8)OP(text_node)] == REF) {
3876                             st->u.curlym.c1 = st->u.curlym.c2 = -1000;
3877                             goto assume_ok_MM;
3878                         }
3879                         else { st->u.curlym.c1 = (U8)*STRING(text_node); }
3880                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3881                             st->u.curlym.c2 = PL_fold[st->u.curlym.c1];
3882                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3883                             st->u.curlym.c2 = PL_fold_locale[st->u.curlym.c1];
3884                         else
3885                             st->u.curlym.c2 = st->u.curlym.c1;
3886                     }
3887                 }
3888                 else
3889                     st->u.curlym.c1 = st->u.curlym.c2 = -1000;
3890             assume_ok_MM:
3891                 REGCP_SET(st->u.curlym.lastcp);
3892                 while (n >= st->ln || (n == REG_INFTY && st->ln > 0)) { /* ln overflow ? */
3893                     /* If it could work, try it. */
3894                     if (st->u.curlym.c1 == -1000 ||
3895                         UCHARAT(PL_reginput) == st->u.curlym.c1 ||
3896                         UCHARAT(PL_reginput) == st->u.curlym.c2)
3897                     {
3898                         if (st->u.curlym.paren) {
3899                             if (st->ln) {
3900                                 PL_regstartp[st->u.curlym.paren] =
3901                                     HOPc(PL_reginput, -st->u.curlym.l) - PL_bostr;
3902                                 PL_regendp[st->u.curlym.paren] = PL_reginput - PL_bostr;
3903                             }
3904                             else
3905                                 PL_regendp[st->u.curlym.paren] = -1;
3906                         }
3907                         REGMATCH(next, CURLYM2);
3908                         /*** all unsaved local vars undefined at this point */
3909                         if (result)
3910                             sayYES;
3911                         REGCP_UNWIND(st->u.curlym.lastcp);
3912                     }
3913                     /* Couldn't or didn't -- move forward. */
3914                     PL_reginput = locinput;
3915                     REGMATCH(scan, CURLYM3);
3916                     /*** all unsaved local vars undefined at this point */
3917                     if (result) {
3918                         st->ln++;
3919                         locinput = PL_reginput;
3920                     }
3921                     else
3922                         sayNO;
3923                 }
3924             }
3925             else {
3926                 DEBUG_EXECUTE_r(
3927                     PerlIO_printf(Perl_debug_log,
3928                               "%*s  matched %"IVdf" times, len=%"IVdf"...\n",
3929                               (int)(REPORT_CODE_OFF+PL_regindent*2), "",
3930                               (IV) st->u.curlym.matches, (IV)st->u.curlym.l)
3931                     );
3932                 if (st->u.curlym.matches >= st->ln) {
3933                     if (HAS_TEXT(next) || JUMPABLE(next)) {
3934                         regnode *text_node = next;
3935
3936                         if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3937
3938                         if (! HAS_TEXT(text_node)) st->u.curlym.c1 = st->u.curlym.c2 = -1000;
3939                         else {
3940                             if (PL_regkind[(U8)OP(text_node)] == REF) {
3941                                 st->u.curlym.c1 = st->u.curlym.c2 = -1000;
3942                                 goto assume_ok_REG;
3943                             }
3944                             else { st->u.curlym.c1 = (U8)*STRING(text_node); }
3945
3946                             if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3947                                 st->u.curlym.c2 = PL_fold[st->u.curlym.c1];
3948                             else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3949                                 st->u.curlym.c2 = PL_fold_locale[st->u.curlym.c1];
3950                             else
3951                                 st->u.curlym.c2 = st->u.curlym.c1;
3952                         }
3953                     }
3954                     else
3955                         st->u.curlym.c1 = st->u.curlym.c2 = -1000;
3956                 }
3957             assume_ok_REG:
3958                 REGCP_SET(st->u.curlym.lastcp);
3959                 while (st->u.curlym.matches >= st->ln) {
3960                     /* If it could work, try it. */
3961                     if (st->u.curlym.c1 == -1000 ||
3962                         UCHARAT(PL_reginput) == st->u.curlym.c1 ||
3963                         UCHARAT(PL_reginput) == st->u.curlym.c2)
3964                     {
3965                         DEBUG_EXECUTE_r(
3966                             PerlIO_printf(Perl_debug_log,
3967                                 "%*s  trying tail with matches=%"IVdf"...\n",
3968                                 (int)(REPORT_CODE_OFF+PL_regindent*2),
3969                                 "", (IV)st->u.curlym.matches)
3970                             );
3971                         if (st->u.curlym.paren) {
3972                             if (st->u.curlym.matches) {
3973                                 PL_regstartp[st->u.curlym.paren]
3974                                     = HOPc(PL_reginput, -st->u.curlym.l) - PL_bostr;
3975                                 PL_regendp[st->u.curlym.paren] = PL_reginput - PL_bostr;
3976                             }
3977                             else
3978                                 PL_regendp[st->u.curlym.paren] = -1;
3979                         }
3980                         REGMATCH(next, CURLYM4);
3981                         /*** all unsaved local vars undefined at this point */
3982                         if (result)
3983                             sayYES;
3984                         REGCP_UNWIND(st->u.curlym.lastcp);
3985                     }
3986                     /* Couldn't or didn't -- back up. */
3987                     st->u.curlym.matches--;
3988                     locinput = HOPc(locinput, -st->u.curlym.l);
3989                     PL_reginput = locinput;
3990                 }
3991             }
3992             sayNO;
3993             /* NOTREACHED */
3994             break;
3995         }
3996         case CURLYN:
3997             st->u.plus.paren = scan->flags;     /* Which paren to set */
3998             if (st->u.plus.paren > PL_regsize)
3999                 PL_regsize = st->u.plus.paren;
4000             if (st->u.plus.paren > (I32)*PL_reglastparen)
4001                 *PL_reglastparen = st->u.plus.paren;
4002             st->ln = ARG1(scan);  /* min to match */
4003             n  = ARG2(scan);  /* max to match */
4004             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
4005             goto repeat;
4006         case CURLY:
4007             st->u.plus.paren = 0;
4008             st->ln = ARG1(scan);  /* min to match */
4009             n  = ARG2(scan);  /* max to match */
4010             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
4011             goto repeat;
4012         case STAR:
4013             st->ln = 0;
4014             n = REG_INFTY;
4015             scan = NEXTOPER(scan);
4016             st->u.plus.paren = 0;
4017             goto repeat;
4018         case PLUS:
4019             st->ln = 1;
4020             n = REG_INFTY;
4021             scan = NEXTOPER(scan);
4022             st->u.plus.paren = 0;
4023           repeat:
4024             /*
4025             * Lookahead to avoid useless match attempts
4026             * when we know what character comes next.
4027             */
4028
4029             /*
4030             * Used to only do .*x and .*?x, but now it allows
4031             * for )'s, ('s and (?{ ... })'s to be in the way
4032             * of the quantifier and the EXACT-like node.  -- japhy
4033             */
4034
4035             if (HAS_TEXT(next) || JUMPABLE(next)) {
4036                 U8 *s;
4037                 regnode *text_node = next;
4038
4039                 if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
4040
4041                 if (! HAS_TEXT(text_node)) st->u.plus.c1 = st->u.plus.c2 = -1000;
4042                 else {
4043                     if (PL_regkind[(U8)OP(text_node)] == REF) {
4044                         st->u.plus.c1 = st->u.plus.c2 = -1000;
4045                         goto assume_ok_easy;
4046                     }
4047                     else { s = (U8*)STRING(text_node); }
4048
4049                     if (!UTF) {
4050                         st->u.plus.c2 = st->u.plus.c1 = *s;
4051                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
4052                             st->u.plus.c2 = PL_fold[st->u.plus.c1];
4053                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
4054                             st->u.plus.c2 = PL_fold_locale[st->u.plus.c1];
4055                     }
4056                     else { /* UTF */
4057                         if (OP(text_node) == EXACTF || OP(text_node) == REFF) {
4058                              STRLEN ulen1, ulen2;
4059                              U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
4060                              U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
4061
4062                              to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
4063                              to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
4064
4065                              st->u.plus.c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
4066                                                  uniflags);
4067                              st->u.plus.c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
4068                                                  uniflags);
4069                         }
4070                         else {
4071                             st->u.plus.c2 = st->u.plus.c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
4072                                                      uniflags);
4073                         }
4074                     }
4075                 }
4076             }
4077             else
4078                 st->u.plus.c1 = st->u.plus.c2 = -1000;
4079         assume_ok_easy:
4080             PL_reginput = locinput;
4081             if (st->minmod) {
4082                 st->minmod = 0;
4083                 if (st->ln && regrepeat(scan, st->ln) < st->ln)
4084                     sayNO;
4085                 locinput = PL_reginput;
4086                 REGCP_SET(st->u.plus.lastcp);
4087                 if (st->u.plus.c1 != -1000) {
4088                     st->u.plus.old = locinput;
4089                     st->u.plus.count = 0;
4090
4091                     if  (n == REG_INFTY) {
4092                         st->u.plus.e = PL_regeol - 1;
4093                         if (do_utf8)
4094                             while (UTF8_IS_CONTINUATION(*(U8*)st->u.plus.e))
4095                                 st->u.plus.e--;
4096                     }
4097                     else if (do_utf8) {
4098                         int m = n - st->ln;
4099                         for (st->u.plus.e = locinput;
4100                              m >0 && st->u.plus.e + UTF8SKIP(st->u.plus.e) <= PL_regeol; m--)
4101                             st->u.plus.e += UTF8SKIP(st->u.plus.e);
4102                     }
4103                     else {
4104                         st->u.plus.e = locinput + n - st->ln;
4105                         if (st->u.plus.e >= PL_regeol)
4106                             st->u.plus.e = PL_regeol - 1;
4107                     }
4108                     while (1) {
4109                         /* Find place 'next' could work */
4110                         if (!do_utf8) {
4111                             if (st->u.plus.c1 == st->u.plus.c2) {
4112                                 while (locinput <= st->u.plus.e &&
4113                                        UCHARAT(locinput) != st->u.plus.c1)
4114                                     locinput++;
4115                             } else {
4116                                 while (locinput <= st->u.plus.e
4117                                        && UCHARAT(locinput) != st->u.plus.c1
4118                                        && UCHARAT(locinput) != st->u.plus.c2)
4119                                     locinput++;
4120                             }
4121                             st->u.plus.count = locinput - st->u.plus.old;
4122                         }
4123                         else {
4124                             if (st->u.plus.c1 == st->u.plus.c2) {
4125                                 STRLEN len;
4126                                 /* count initialised to
4127                                  * utf8_distance(old, locinput) */
4128                                 while (locinput <= st->u.plus.e &&
4129                                        utf8n_to_uvchr((U8*)locinput,
4130                                                       UTF8_MAXBYTES, &len,
4131                                                       uniflags) != (UV)st->u.plus.c1) {
4132                                     locinput += len;
4133                                     st->u.plus.count++;
4134                                 }
4135                             } else {
4136                                 STRLEN len;
4137                                 /* count initialised to
4138                                  * utf8_distance(old, locinput) */
4139                                 while (locinput <= st->u.plus.e) {
4140                                     UV c = utf8n_to_uvchr((U8*)locinput,
4141                                                           UTF8_MAXBYTES, &len,
4142                                                           uniflags);
4143                                     if (c == (UV)st->u.plus.c1 || c == (UV)st->u.plus.c2)
4144                                         break;
4145                                     locinput += len;
4146                                     st->u.plus.count++;
4147                                 }
4148                             }
4149                         }
4150                         if (locinput > st->u.plus.e)
4151                             sayNO;
4152                         /* PL_reginput == old now */
4153                         if (locinput != st->u.plus.old) {
4154                             st->ln = 1; /* Did some */
4155                             if (regrepeat(scan, st->u.plus.count) < st->u.plus.count)
4156                                 sayNO;
4157                         }
4158                         /* PL_reginput == locinput now */
4159                         TRYPAREN(st->u.plus.paren, st->ln, locinput, PLUS1);
4160                         /*** all unsaved local vars undefined at this point */
4161                         PL_reginput = locinput; /* Could be reset... */
4162                         REGCP_UNWIND(st->u.plus.lastcp);
4163                         /* Couldn't or didn't -- move forward. */
4164                         st->u.plus.old = locinput;
4165                         if (do_utf8)
4166                             locinput += UTF8SKIP(locinput);
4167                         else
4168                             locinput++;
4169                         st->u.plus.count = 1;
4170                     }
4171                 }
4172                 else
4173                 while (n >= st->ln || (n == REG_INFTY && st->ln > 0)) { /* ln overflow ? */
4174                     UV c;
4175                     if (st->u.plus.c1 != -1000) {
4176                         if (do_utf8)
4177                             c = utf8n_to_uvchr((U8*)PL_reginput,
4178                                                UTF8_MAXBYTES, 0,
4179                                                uniflags);
4180                         else
4181                             c = UCHARAT(PL_reginput);
4182                         /* If it could work, try it. */
4183                         if (c == (UV)st->u.plus.c1 || c == (UV)st->u.plus.c2)
4184                         {
4185                             TRYPAREN(st->u.plus.paren, st->ln, PL_reginput, PLUS2);
4186                             /*** all unsaved local vars undefined at this point */
4187                             REGCP_UNWIND(st->u.plus.lastcp);
4188                         }
4189                     }
4190                     /* If it could work, try it. */
4191                     else if (st->u.plus.c1 == -1000)
4192                     {
4193                         TRYPAREN(st->u.plus.paren, st->ln, PL_reginput, PLUS3);
4194                         /*** all unsaved local vars undefined at this point */
4195                         REGCP_UNWIND(st->u.plus.lastcp);
4196                     }
4197                     /* Couldn't or didn't -- move forward. */
4198                     PL_reginput = locinput;
4199                     if (regrepeat(scan, 1)) {
4200                         st->ln++;
4201                         locinput = PL_reginput;
4202                     }
4203                     else
4204                         sayNO;
4205                 }
4206             }
4207             else {
4208                 n = regrepeat(scan, n);
4209                 locinput = PL_reginput;
4210                 if (st->ln < n && PL_regkind[(U8)OP(next)] == EOL &&
4211                     (OP(next) != MEOL ||
4212                         OP(next) == SEOL || OP(next) == EOS))
4213                 {
4214                     st->ln = n;                 /* why back off? */
4215                     /* ...because $ and \Z can match before *and* after
4216                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
4217                        We should back off by one in this case. */
4218                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(next) != EOS)
4219                         st->ln--;
4220                 }
4221                 REGCP_SET(st->u.plus.lastcp);
4222                 {
4223                     UV c = 0;
4224                     while (n >= st->ln) {
4225                         if (st->u.plus.c1 != -1000) {
4226                             if (do_utf8)
4227                                 c = utf8n_to_uvchr((U8*)PL_reginput,
4228                                                    UTF8_MAXBYTES, 0,
4229                                                    uniflags);
4230                             else
4231                                 c = UCHARAT(PL_reginput);
4232                         }
4233                         /* If it could work, try it. */
4234                         if (st->u.plus.c1 == -1000 || c == (UV)st->u.plus.c1 || c == (UV)st->u.plus.c2)
4235                             {
4236                                 TRYPAREN(st->u.plus.paren, n, PL_reginput, PLUS4);
4237                                 /*** all unsaved local vars undefined at this point */
4238                                 REGCP_UNWIND(st->u.plus.lastcp);
4239                             }
4240                         /* Couldn't or didn't -- back up. */
4241                         n--;
4242                         PL_reginput = locinput = HOPc(locinput, -1);
4243                     }
4244                 }
4245             }
4246             sayNO;
4247             break;
4248         case END:
4249             if (cur_eval) {
4250                 /* we have successfully completed the execution of a
4251                  * postponed re. Pop all states back to the last EVAL
4252                  * then continue with the node following the (??{...})
4253                  */
4254
4255                 /* this simulates a POP_STATE, except that it pops several
4256                  * levels, and doesn't restore locinput */
4257
4258                 st = cur_eval;
4259                 PL_regmatch_slab = st->u.eval.prev_slab;
4260                 cur_eval = st->u.eval.prev_eval;
4261                 depth = st->u.eval.depth;
4262
4263                 PL_regmatch_state = st;
4264                 scan    = st->scan;
4265                 next    = st->next;
4266                 n               = st->n;
4267
4268                 if (st->u.eval.toggleutf)
4269                     PL_reg_flags ^= RF_utf8;
4270                 ReREFCNT_dec(rex);
4271                 rex = st->u.eval.prev_rex;
4272                 PL_reg_re = rex; /* XXX */
4273                 /* XXXX This is too dramatic a measure... */
4274                 PL_reg_maxiter = 0;
4275
4276                 /* Restore parens of the caller without popping the
4277                  * savestack */
4278                 {
4279                     I32 tmp = PL_savestack_ix;
4280                     PL_savestack_ix = st->u.eval.lastcp;
4281                     regcppop(rex);
4282                     PL_savestack_ix = tmp;
4283                 }
4284
4285
4286                 PL_reginput = locinput;
4287                 /* resume at node following the (??{...}) */
4288                 break;
4289
4290             }
4291
4292             if (locinput < PL_regtill) {
4293                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4294                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
4295                                       PL_colors[4],
4296                                       (long)(locinput - PL_reg_starttry),
4297                                       (long)(PL_regtill - PL_reg_starttry),
4298                                       PL_colors[5]));
4299                 sayNO_FINAL;            /* Cannot match: too short. */
4300             }
4301             PL_reginput = locinput;     /* put where regtry can find it */
4302             sayYES_FINAL;               /* Success! */
4303         case SUCCEED:
4304             PL_reginput = locinput;     /* put where regtry can find it */
4305             sayYES_LOUD;                /* Success! */
4306         case SUSPEND:
4307             n = 1;
4308             PL_reginput = locinput;
4309             goto do_ifmatch;
4310         case UNLESSM:
4311             n = 0;
4312             if (scan->flags) {
4313                 char * const s = HOPBACKc(locinput, scan->flags);
4314                 if (!s)
4315                     goto say_yes;
4316                 PL_reginput = s;
4317             }
4318             else
4319                 PL_reginput = locinput;
4320             goto do_ifmatch;
4321         case IFMATCH:
4322             n = 1;
4323             if (scan->flags) {
4324                 char * const s = HOPBACKc(locinput, scan->flags);
4325                 if (!s)
4326                     goto say_no;
4327                 PL_reginput = s;
4328             }
4329             else
4330                 PL_reginput = locinput;
4331
4332           do_ifmatch:
4333             REGMATCH(NEXTOPER(NEXTOPER(scan)), IFMATCH);
4334             /*** all unsaved local vars undefined at this point */
4335             if (result != n) {
4336               say_no:
4337                 if (st->logical) {
4338                     st->logical = 0;
4339                     st->sw = 0;
4340                     goto do_longjump;
4341                 }
4342                 else
4343                     sayNO;
4344             }
4345           say_yes:
4346             if (st->logical) {
4347                 st->logical = 0;
4348                 st->sw = 1;
4349             }
4350             if (OP(scan) == SUSPEND) {
4351                 locinput = PL_reginput;
4352                 nextchr = UCHARAT(locinput);
4353             }
4354             /* FALL THROUGH. */
4355         case LONGJMP:
4356           do_longjump:
4357             next = scan + ARG(scan);
4358             if (next == scan)
4359                 next = NULL;
4360             break;
4361         default:
4362             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
4363                           PTR2UV(scan), OP(scan));
4364             Perl_croak(aTHX_ "regexp memory corruption");
4365         }
4366
4367       reenter:
4368         scan = next;
4369         continue;
4370         /* NOTREACHED */
4371
4372         /* simulate recursively calling regmatch(), but without actually
4373          * recursing - ie save the current state on the heap rather than on
4374          * the stack, then re-enter the loop. This avoids complex regexes
4375          * blowing the processor stack */
4376
4377       start_recurse:
4378         {
4379             /* push new state */
4380             regmatch_state *oldst = st;
4381
4382             depth++;
4383
4384             /* grab the next free state slot */
4385             st++;
4386             if (st >  &(PL_regmatch_slab->states[PERL_REGMATCH_SLAB_SLOTS-1]))
4387                 st = S_push_slab(aTHX);
4388             PL_regmatch_state = st;
4389
4390             oldst->next = next;
4391             oldst->n = n;
4392             oldst->locinput = locinput;
4393
4394             st->cc = oldst->cc;
4395             locinput = PL_reginput;
4396             nextchr = UCHARAT(locinput);
4397             st->minmod = 0;
4398             st->sw = 0;
4399             st->logical = 0;
4400             st->unwind = 0;
4401 #ifdef DEBUGGING
4402             PL_regindent++;
4403 #endif
4404         }
4405     }
4406
4407
4408
4409     /*
4410     * We get here only if there's trouble -- normally "case END" is
4411     * the terminating point.
4412     */
4413     Perl_croak(aTHX_ "corrupted regexp pointers");
4414     /*NOTREACHED*/
4415     sayNO;
4416
4417 yes_loud:
4418     DEBUG_EXECUTE_r(
4419         PerlIO_printf(Perl_debug_log,
4420                       "%*s  %scould match...%s\n",
4421                       REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], PL_colors[5])
4422         );
4423     goto yes;
4424 yes_final:
4425     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
4426                           PL_colors[4], PL_colors[5]));
4427 yes:
4428 #ifdef DEBUGGING
4429     PL_regindent--;
4430 #endif
4431
4432     result = 1;
4433     /* XXX this is duplicate(ish) code to that in the do_no section.
4434      * eventually a yes should just pop the whole stack */
4435     if (depth) {
4436         /* restore previous state and re-enter */
4437         POP_STATE;
4438
4439         switch (st->resume_state) {
4440         case resume_TRIE1:
4441             goto resume_point_TRIE1;
4442         case resume_TRIE2:
4443             goto resume_point_TRIE2;
4444         case resume_EVAL:
4445             break;
4446         case resume_CURLYX:
4447             goto resume_point_CURLYX;
4448         case resume_WHILEM1:
4449             goto resume_point_WHILEM1;
4450         case resume_WHILEM2:
4451             goto resume_point_WHILEM2;
4452         case resume_WHILEM3:
4453             goto resume_point_WHILEM3;
4454         case resume_WHILEM4:
4455             goto resume_point_WHILEM4;
4456         case resume_WHILEM5:
4457             goto resume_point_WHILEM5;
4458         case resume_WHILEM6:
4459             goto resume_point_WHILEM6;
4460         case resume_CURLYM1:
4461             goto resume_point_CURLYM1;
4462         case resume_CURLYM2:
4463             goto resume_point_CURLYM2;
4464         case resume_CURLYM3:
4465             goto resume_point_CURLYM3;
4466         case resume_CURLYM4:
4467             goto resume_point_CURLYM4;
4468         case resume_IFMATCH:
4469             goto resume_point_IFMATCH;
4470         case resume_PLUS1:
4471             goto resume_point_PLUS1;
4472         case resume_PLUS2:
4473             goto resume_point_PLUS2;
4474         case resume_PLUS3:
4475             goto resume_point_PLUS3;
4476         case resume_PLUS4:
4477             goto resume_point_PLUS4;
4478         default:
4479             Perl_croak(aTHX_ "regexp resume memory corruption");
4480         }
4481     }
4482     goto final_exit;
4483
4484 no:
4485     DEBUG_EXECUTE_r(
4486         PerlIO_printf(Perl_debug_log,
4487                       "%*s  %sfailed...%s\n",
4488                       REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], PL_colors[5])
4489         );
4490     goto do_no;
4491 no_final:
4492 do_no:
4493     if (st->unwind) {
4494         re_unwind_t * const uw = SSPTRt(st->unwind,re_unwind_t);
4495
4496         switch (uw->type) {
4497         case RE_UNWIND_BRANCH:
4498         case RE_UNWIND_BRANCHJ:
4499         {
4500             re_unwind_branch_t * const uwb = &(uw->branch);
4501             const I32 lastparen = uwb->lastparen;
4502
4503             REGCP_UNWIND(uwb->lastcp);
4504             for (n = *PL_reglastparen; n > lastparen; n--)
4505                 PL_regendp[n] = -1;
4506             *PL_reglastparen = n;
4507             scan = next = uwb->next;
4508             st->minmod = uwb->minmod;
4509             if ( !scan ||
4510                  OP(scan) != (uwb->type == RE_UNWIND_BRANCH
4511                               ? BRANCH : BRANCHJ) ) {           /* Failure */
4512                 st->unwind = uwb->prev;
4513 #ifdef DEBUGGING
4514                 PL_regindent--;
4515 #endif
4516                 goto do_no;
4517             }
4518             /* Have more choice yet.  Reuse the same uwb.  */
4519             if ((n = (uwb->type == RE_UNWIND_BRANCH
4520                       ? NEXT_OFF(next) : ARG(next))))
4521                 next += n;
4522             else
4523                 next = NULL;    /* XXXX Needn't unwinding in this case... */
4524             uwb->next = next;
4525             next = NEXTOPER(scan);
4526             if (uwb->type == RE_UNWIND_BRANCHJ)
4527                 next = NEXTOPER(next);
4528             locinput = uwb->locinput;
4529             nextchr = uwb->nextchr;
4530 #ifdef DEBUGGING
4531             PL_regindent = uwb->regindent;
4532 #endif
4533
4534             goto reenter;
4535         }
4536         /* NOTREACHED */
4537         default:
4538             Perl_croak(aTHX_ "regexp unwind memory corruption");
4539         }
4540         /* NOTREACHED */
4541     }
4542
4543 #ifdef DEBUGGING
4544     PL_regindent--;
4545 #endif
4546     result = 0;
4547
4548     if (depth) {
4549         /* there's a previous state to backtrack to */
4550         POP_STATE;
4551         switch (st->resume_state) {
4552         case resume_TRIE1:
4553             goto resume_point_TRIE1;
4554         case resume_TRIE2:
4555             goto resume_point_TRIE2;
4556         case resume_EVAL:
4557             /* we have failed an (??{...}). Restore state to the outer re
4558              * then re-throw the failure */
4559             if (st->u.eval.toggleutf)
4560                 PL_reg_flags ^= RF_utf8;
4561             ReREFCNT_dec(rex);
4562             rex = st->u.eval.prev_rex;
4563             PL_reg_re = rex; /* XXX */
4564             cur_eval = st->u.eval.prev_eval;
4565
4566             /* XXXX This is too dramatic a measure... */
4567             PL_reg_maxiter = 0;
4568
4569             PL_reginput = locinput;
4570             REGCP_UNWIND(st->u.eval.lastcp);
4571             regcppop(rex);
4572             goto do_no;
4573
4574         case resume_CURLYX:
4575             goto resume_point_CURLYX;
4576         case resume_WHILEM1:
4577             goto resume_point_WHILEM1;
4578         case resume_WHILEM2:
4579             goto resume_point_WHILEM2;
4580         case resume_WHILEM3:
4581             goto resume_point_WHILEM3;
4582         case resume_WHILEM4:
4583             goto resume_point_WHILEM4;
4584         case resume_WHILEM5:
4585             goto resume_point_WHILEM5;
4586         case resume_WHILEM6:
4587             goto resume_point_WHILEM6;
4588         case resume_CURLYM1:
4589             goto resume_point_CURLYM1;
4590         case resume_CURLYM2:
4591             goto resume_point_CURLYM2;
4592         case resume_CURLYM3:
4593             goto resume_point_CURLYM3;
4594         case resume_CURLYM4:
4595             goto resume_point_CURLYM4;
4596         case resume_IFMATCH:
4597             goto resume_point_IFMATCH;
4598         case resume_PLUS1:
4599             goto resume_point_PLUS1;
4600         case resume_PLUS2:
4601             goto resume_point_PLUS2;
4602         case resume_PLUS3:
4603             goto resume_point_PLUS3;
4604         case resume_PLUS4:
4605             goto resume_point_PLUS4;
4606         default:
4607             Perl_croak(aTHX_ "regexp resume memory corruption");
4608         }
4609     }
4610
4611 final_exit:
4612
4613     /* restore original high-water mark */
4614     PL_regmatch_slab  = orig_slab;
4615     PL_regmatch_state = orig_state;
4616
4617     /* free all slabs above current one */
4618     if (orig_slab->next) {
4619         regmatch_slab *osl, *sl = orig_slab->next;
4620         orig_slab->next = NULL;
4621         while (sl) {
4622             osl = sl;
4623             sl = sl->next;
4624             Safefree(osl);
4625         }
4626     }
4627
4628     return result;
4629
4630 }
4631
4632 /*
4633  - regrepeat - repeatedly match something simple, report how many
4634  */
4635 /*
4636  * [This routine now assumes that it will only match on things of length 1.
4637  * That was true before, but now we assume scan - reginput is the count,
4638  * rather than incrementing count on every character.  [Er, except utf8.]]
4639  */
4640 STATIC I32
4641 S_regrepeat(pTHX_ const regnode *p, I32 max)
4642 {
4643     dVAR;
4644     register char *scan;
4645     register I32 c;
4646     register char *loceol = PL_regeol;
4647     register I32 hardcount = 0;
4648     register bool do_utf8 = PL_reg_match_utf8;
4649
4650     scan = PL_reginput;
4651     if (max == REG_INFTY)
4652         max = I32_MAX;
4653     else if (max < loceol - scan)
4654         loceol = scan + max;
4655     switch (OP(p)) {
4656     case REG_ANY:
4657         if (do_utf8) {
4658             loceol = PL_regeol;
4659             while (scan < loceol && hardcount < max && *scan != '\n') {
4660                 scan += UTF8SKIP(scan);
4661                 hardcount++;
4662             }
4663         } else {
4664             while (scan < loceol && *scan != '\n')
4665                 scan++;
4666         }
4667         break;
4668     case SANY:
4669         if (do_utf8) {
4670             loceol = PL_regeol;
4671             while (scan < loceol && hardcount < max) {
4672                 scan += UTF8SKIP(scan);
4673                 hardcount++;
4674             }
4675         }
4676         else
4677             scan = loceol;
4678         break;
4679     case CANY:
4680         scan = loceol;
4681         break;
4682     case EXACT:         /* length of string is 1 */
4683         c = (U8)*STRING(p);
4684         while (scan < loceol && UCHARAT(scan) == c)
4685             scan++;
4686         break;
4687     case EXACTF:        /* length of string is 1 */
4688         c = (U8)*STRING(p);
4689         while (scan < loceol &&
4690                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
4691             scan++;
4692         break;
4693     case EXACTFL:       /* length of string is 1 */
4694         PL_reg_flags |= RF_tainted;
4695         c = (U8)*STRING(p);
4696         while (scan < loceol &&
4697                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
4698             scan++;
4699         break;
4700     case ANYOF:
4701         if (do_utf8) {
4702             loceol = PL_regeol;
4703             while (hardcount < max && scan < loceol &&
4704                    reginclass(p, (U8*)scan, 0, do_utf8)) {
4705                 scan += UTF8SKIP(scan);
4706                 hardcount++;
4707             }
4708         } else {
4709             while (scan < loceol && REGINCLASS(p, (U8*)scan))
4710                 scan++;
4711         }
4712         break;
4713     case ALNUM:
4714         if (do_utf8) {
4715             loceol = PL_regeol;
4716             LOAD_UTF8_CHARCLASS_ALNUM();
4717             while (hardcount < max && scan < loceol &&
4718                    swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
4719                 scan += UTF8SKIP(scan);
4720                 hardcount++;
4721             }
4722         } else {
4723             while (scan < loceol && isALNUM(*scan))
4724                 scan++;
4725         }
4726         break;
4727     case ALNUML:
4728         PL_reg_flags |= RF_tainted;
4729         if (do_utf8) {
4730             loceol = PL_regeol;
4731             while (hardcount < max && scan < loceol &&
4732                    isALNUM_LC_utf8((U8*)scan)) {
4733                 scan += UTF8SKIP(scan);
4734                 hardcount++;
4735             }
4736         } else {
4737             while (scan < loceol && isALNUM_LC(*scan))
4738                 scan++;
4739         }
4740         break;
4741     case NALNUM:
4742         if (do_utf8) {
4743             loceol = PL_regeol;
4744             LOAD_UTF8_CHARCLASS_ALNUM();
4745             while (hardcount < max && scan < loceol &&
4746                    !swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
4747                 scan += UTF8SKIP(scan);
4748                 hardcount++;
4749             }
4750         } else {
4751             while (scan < loceol && !isALNUM(*scan))
4752                 scan++;
4753         }
4754         break;
4755     case NALNUML:
4756         PL_reg_flags |= RF_tainted;
4757         if (do_utf8) {
4758             loceol = PL_regeol;
4759             while (hardcount < max && scan < loceol &&
4760                    !isALNUM_LC_utf8((U8*)scan)) {
4761                 scan += UTF8SKIP(scan);
4762                 hardcount++;
4763             }
4764         } else {
4765             while (scan < loceol && !isALNUM_LC(*scan))
4766                 scan++;
4767         }
4768         break;
4769     case SPACE:
4770         if (do_utf8) {
4771             loceol = PL_regeol;
4772             LOAD_UTF8_CHARCLASS_SPACE();
4773             while (hardcount < max && scan < loceol &&
4774                    (*scan == ' ' ||
4775                     swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
4776                 scan += UTF8SKIP(scan);
4777                 hardcount++;
4778             }
4779         } else {
4780             while (scan < loceol && isSPACE(*scan))
4781                 scan++;
4782         }
4783         break;
4784     case SPACEL:
4785         PL_reg_flags |= RF_tainted;
4786         if (do_utf8) {
4787             loceol = PL_regeol;
4788             while (hardcount < max && scan < loceol &&
4789                    (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
4790                 scan += UTF8SKIP(scan);
4791                 hardcount++;
4792             }
4793         } else {
4794             while (scan < loceol && isSPACE_LC(*scan))
4795                 scan++;
4796         }
4797         break;
4798     case NSPACE:
4799         if (do_utf8) {
4800             loceol = PL_regeol;
4801             LOAD_UTF8_CHARCLASS_SPACE();
4802             while (hardcount < max && scan < loceol &&
4803                    !(*scan == ' ' ||
4804                      swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
4805                 scan += UTF8SKIP(scan);
4806                 hardcount++;
4807             }
4808         } else {
4809             while (scan < loceol && !isSPACE(*scan))
4810                 scan++;
4811             break;
4812         }
4813     case NSPACEL:
4814         PL_reg_flags |= RF_tainted;
4815         if (do_utf8) {
4816             loceol = PL_regeol;
4817             while (hardcount < max && scan < loceol &&
4818                    !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
4819                 scan += UTF8SKIP(scan);
4820                 hardcount++;
4821             }
4822         } else {
4823             while (scan < loceol && !isSPACE_LC(*scan))
4824                 scan++;
4825         }
4826         break;
4827     case DIGIT:
4828         if (do_utf8) {
4829             loceol = PL_regeol;
4830             LOAD_UTF8_CHARCLASS_DIGIT();
4831             while (hardcount < max && scan < loceol &&
4832                    swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4833                 scan += UTF8SKIP(scan);
4834                 hardcount++;
4835             }
4836         } else {
4837             while (scan < loceol && isDIGIT(*scan))
4838                 scan++;
4839         }
4840         break;
4841     case NDIGIT:
4842         if (do_utf8) {
4843             loceol = PL_regeol;
4844             LOAD_UTF8_CHARCLASS_DIGIT();
4845             while (hardcount < max && scan < loceol &&
4846                    !swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4847                 scan += UTF8SKIP(scan);
4848                 hardcount++;
4849             }
4850         } else {
4851             while (scan < loceol && !isDIGIT(*scan))
4852                 scan++;
4853         }
4854         break;
4855     default:            /* Called on something of 0 width. */
4856         break;          /* So match right here or not at all. */
4857     }
4858
4859     if (hardcount)
4860         c = hardcount;
4861     else
4862         c = scan - PL_reginput;
4863     PL_reginput = scan;
4864
4865     DEBUG_r({
4866                 SV *re_debug_flags = NULL;
4867                 SV * const prop = sv_newmortal();
4868                 GET_RE_DEBUG_FLAGS;
4869                 DEBUG_EXECUTE_r({
4870                 regprop(prop, p);
4871                 PerlIO_printf(Perl_debug_log,
4872                               "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
4873                               REPORT_CODE_OFF+1, "", SvPVX_const(prop),(IV)c,(IV)max);
4874         });
4875         });
4876
4877     return(c);
4878 }
4879
4880
4881 /*
4882 - regclass_swash - prepare the utf8 swash
4883 */
4884
4885 SV *
4886 Perl_regclass_swash(pTHX_ register const regnode* node, bool doinit, SV** listsvp, SV **altsvp)
4887 {
4888     dVAR;
4889     SV *sw  = NULL;
4890     SV *si  = NULL;
4891     SV *alt = NULL;
4892     const struct reg_data *data = PL_reg_re ? PL_reg_re->data : NULL;
4893
4894     if (data && data->count) {
4895         const U32 n = ARG(node);
4896
4897         if (data->what[n] == 's') {
4898             SV * const rv = (SV*)data->data[n];
4899             AV * const av = (AV*)SvRV((SV*)rv);
4900             SV **const ary = AvARRAY(av);
4901             SV **a, **b;
4902
4903             /* See the end of regcomp.c:S_regclass() for
4904              * documentation of these array elements. */
4905
4906             si = *ary;
4907             a  = SvROK(ary[1]) ? &ary[1] : 0;
4908             b  = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : 0;
4909
4910             if (a)
4911                 sw = *a;
4912             else if (si && doinit) {
4913                 sw = swash_init("utf8", "", si, 1, 0);
4914                 (void)av_store(av, 1, sw);
4915             }
4916             if (b)
4917                 alt = *b;
4918         }
4919     }
4920
4921     if (listsvp)
4922         *listsvp = si;
4923     if (altsvp)
4924         *altsvp  = alt;
4925
4926     return sw;
4927 }
4928
4929 /*
4930  - reginclass - determine if a character falls into a character class
4931
4932   The n is the ANYOF regnode, the p is the target string, lenp
4933   is pointer to the maximum length of how far to go in the p
4934   (if the lenp is zero, UTF8SKIP(p) is used),
4935   do_utf8 tells whether the target string is in UTF-8.
4936
4937  */
4938
4939 STATIC bool
4940 S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp, register bool do_utf8)
4941 {
4942     dVAR;
4943     const char flags = ANYOF_FLAGS(n);
4944     bool match = FALSE;
4945     UV c = *p;
4946     STRLEN len = 0;
4947     STRLEN plen;
4948
4949     if (do_utf8 && !UTF8_IS_INVARIANT(c)) {
4950         c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &len,
4951                 (UTF8_ALLOW_DEFAULT & UTF8_ALLOW_ANYUV) | UTF8_CHECK_ONLY);
4952                 /* see [perl #37836] for UTF8_ALLOW_ANYUV */
4953         if (len == (STRLEN)-1)
4954             Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
4955     }
4956
4957     plen = lenp ? *lenp : UNISKIP(NATIVE_TO_UNI(c));
4958     if (do_utf8 || (flags & ANYOF_UNICODE)) {
4959         if (lenp)
4960             *lenp = 0;
4961         if (do_utf8 && !ANYOF_RUNTIME(n)) {
4962             if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
4963                 match = TRUE;
4964         }
4965         if (!match && do_utf8 && (flags & ANYOF_UNICODE_ALL) && c >= 256)
4966             match = TRUE;
4967         if (!match) {
4968             AV *av;
4969             SV * const sw = regclass_swash(n, TRUE, 0, (SV**)&av);
4970
4971             if (sw) {
4972                 if (swash_fetch(sw, p, do_utf8))
4973                     match = TRUE;
4974                 else if (flags & ANYOF_FOLD) {
4975                     if (!match && lenp && av) {
4976                         I32 i;
4977                         for (i = 0; i <= av_len(av); i++) {
4978                             SV* const sv = *av_fetch(av, i, FALSE);
4979                             STRLEN len;
4980                             const char * const s = SvPV_const(sv, len);
4981
4982                             if (len <= plen && memEQ(s, (char*)p, len)) {
4983                                 *lenp = len;
4984                                 match = TRUE;
4985                                 break;
4986                             }
4987                         }
4988                     }
4989                     if (!match) {
4990                         U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
4991                         STRLEN tmplen;
4992
4993                         to_utf8_fold(p, tmpbuf, &tmplen);
4994                         if (swash_fetch(sw, tmpbuf, do_utf8))
4995                             match = TRUE;
4996                     }
4997                 }
4998             }
4999         }
5000         if (match && lenp && *lenp == 0)
5001             *lenp = UNISKIP(NATIVE_TO_UNI(c));
5002     }
5003     if (!match && c < 256) {
5004         if (ANYOF_BITMAP_TEST(n, c))
5005             match = TRUE;
5006         else if (flags & ANYOF_FOLD) {
5007             U8 f;
5008
5009             if (flags & ANYOF_LOCALE) {
5010                 PL_reg_flags |= RF_tainted;
5011                 f = PL_fold_locale[c];
5012             }
5013             else
5014                 f = PL_fold[c];
5015             if (f != c && ANYOF_BITMAP_TEST(n, f))
5016                 match = TRUE;
5017         }
5018
5019         if (!match && (flags & ANYOF_CLASS)) {
5020             PL_reg_flags |= RF_tainted;
5021             if (
5022                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
5023                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
5024                 (ANYOF_CLASS_TEST(n, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
5025                 (ANYOF_CLASS_TEST(n, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
5026                 (ANYOF_CLASS_TEST(n, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
5027                 (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
5028                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
5029                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
5030                 (ANYOF_CLASS_TEST(n, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
5031                 (ANYOF_CLASS_TEST(n, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
5032                 (ANYOF_CLASS_TEST(n, ANYOF_ASCII)   &&  isASCII(c))     ||
5033                 (ANYOF_CLASS_TEST(n, ANYOF_NASCII)  && !isASCII(c))     ||
5034                 (ANYOF_CLASS_TEST(n, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
5035                 (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
5036                 (ANYOF_CLASS_TEST(n, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
5037                 (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
5038                 (ANYOF_CLASS_TEST(n, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
5039                 (ANYOF_CLASS_TEST(n, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
5040                 (ANYOF_CLASS_TEST(n, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
5041                 (ANYOF_CLASS_TEST(n, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
5042                 (ANYOF_CLASS_TEST(n, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
5043                 (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
5044                 (ANYOF_CLASS_TEST(n, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
5045                 (ANYOF_CLASS_TEST(n, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
5046                 (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
5047                 (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c))    ||
5048                 (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC)  &&  isPSXSPC(c))    ||
5049                 (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c))    ||
5050                 (ANYOF_CLASS_TEST(n, ANYOF_BLANK)   &&  isBLANK(c))     ||
5051                 (ANYOF_CLASS_TEST(n, ANYOF_NBLANK)  && !isBLANK(c))
5052                 ) /* How's that for a conditional? */
5053             {
5054                 match = TRUE;
5055             }
5056         }
5057     }
5058
5059     return (flags & ANYOF_INVERT) ? !match : match;
5060 }
5061
5062 STATIC U8 *
5063 S_reghop3(U8 *s, I32 off, U8* lim)
5064 {
5065     dVAR;
5066     if (off >= 0) {
5067         while (off-- && s < lim) {
5068             /* XXX could check well-formedness here */
5069             s += UTF8SKIP(s);
5070         }
5071     }
5072     else {
5073         while (off++) {
5074             if (s > lim) {
5075                 s--;
5076                 if (UTF8_IS_CONTINUED(*s)) {
5077                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
5078                         s--;
5079                 }
5080                 /* XXX could check well-formedness here */
5081             }
5082         }
5083     }
5084     return s;
5085 }
5086
5087 STATIC U8 *
5088 S_reghopmaybe3(U8* s, I32 off, U8* lim)
5089 {
5090     dVAR;
5091     if (off >= 0) {
5092         while (off-- && s < lim) {
5093             /* XXX could check well-formedness here */
5094             s += UTF8SKIP(s);
5095         }
5096         if (off >= 0)
5097             return 0;
5098     }
5099     else {
5100         while (off++) {
5101             if (s > lim) {
5102                 s--;
5103                 if (UTF8_IS_CONTINUED(*s)) {
5104                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
5105                         s--;
5106                 }
5107                 /* XXX could check well-formedness here */
5108             }
5109             else
5110                 break;
5111         }
5112         if (off <= 0)
5113             return 0;
5114     }
5115     return s;
5116 }
5117
5118 static void
5119 restore_pos(pTHX_ void *arg)
5120 {
5121     dVAR;
5122     regexp * const rex = (regexp *)arg;
5123     if (PL_reg_eval_set) {
5124         if (PL_reg_oldsaved) {
5125             rex->subbeg = PL_reg_oldsaved;
5126             rex->sublen = PL_reg_oldsavedlen;
5127 #ifdef PERL_OLD_COPY_ON_WRITE
5128             rex->saved_copy = PL_nrs;
5129 #endif
5130             RX_MATCH_COPIED_on(rex);
5131         }
5132         PL_reg_magic->mg_len = PL_reg_oldpos;
5133         PL_reg_eval_set = 0;
5134         PL_curpm = PL_reg_oldcurpm;
5135     }
5136 }
5137
5138 STATIC void
5139 S_to_utf8_substr(pTHX_ register regexp *prog)
5140 {
5141     if (prog->float_substr && !prog->float_utf8) {
5142         SV* const sv = newSVsv(prog->float_substr);
5143         prog->float_utf8 = sv;
5144         sv_utf8_upgrade(sv);
5145         if (SvTAIL(prog->float_substr))
5146             SvTAIL_on(sv);
5147         if (prog->float_substr == prog->check_substr)
5148             prog->check_utf8 = sv;
5149     }
5150     if (prog->anchored_substr && !prog->anchored_utf8) {
5151         SV* const sv = newSVsv(prog->anchored_substr);
5152         prog->anchored_utf8 = sv;
5153         sv_utf8_upgrade(sv);
5154         if (SvTAIL(prog->anchored_substr))
5155             SvTAIL_on(sv);
5156         if (prog->anchored_substr == prog->check_substr)
5157             prog->check_utf8 = sv;
5158     }
5159 }
5160
5161 STATIC void
5162 S_to_byte_substr(pTHX_ register regexp *prog)
5163 {
5164     dVAR;
5165     if (prog->float_utf8 && !prog->float_substr) {
5166         SV* sv = newSVsv(prog->float_utf8);
5167         prog->float_substr = sv;
5168         if (sv_utf8_downgrade(sv, TRUE)) {
5169             if (SvTAIL(prog->float_utf8))
5170                 SvTAIL_on(sv);
5171         } else {
5172             SvREFCNT_dec(sv);
5173             prog->float_substr = sv = &PL_sv_undef;
5174         }
5175         if (prog->float_utf8 == prog->check_utf8)
5176             prog->check_substr = sv;
5177     }
5178     if (prog->anchored_utf8 && !prog->anchored_substr) {
5179         SV* sv = newSVsv(prog->anchored_utf8);
5180         prog->anchored_substr = sv;
5181         if (sv_utf8_downgrade(sv, TRUE)) {
5182             if (SvTAIL(prog->anchored_utf8))
5183                 SvTAIL_on(sv);
5184         } else {
5185             SvREFCNT_dec(sv);
5186             prog->anchored_substr = sv = &PL_sv_undef;
5187         }
5188         if (prog->anchored_utf8 == prog->check_utf8)
5189             prog->check_substr = sv;
5190     }
5191 }
5192
5193 /*
5194  * Local variables:
5195  * c-indentation-style: bsd
5196  * c-basic-offset: 4
5197  * indent-tabs-mode: t
5198  * End:
5199  *
5200  * ex: set ts=8 sts=4 sw=4 noet:
5201  */