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