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