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                             reg_trie_data * const trie = (reg_trie_data*)
2809                                             PL_reg_re->data->data[ARG(scan)];
2810                             SV ** const tmp = av_fetch( trie->words, st->u.trie.accept_buff[ best ].wordnum - 1, 0 );
2811                             PerlIO_printf( Perl_debug_log, "%*s  %strying alternation #%d <%s> at 0x%p%s\n",
2812                                 REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
2813                                 st->u.trie.accept_buff[best].wordnum,
2814                                 tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",scan,
2815                                 PL_colors[5] );
2816                         });
2817                         if ( best<st->u.trie.accepted ) {
2818                             reg_trie_accepted tmp = st->u.trie.accept_buff[ best ];
2819                             st->u.trie.accept_buff[ best ] = st->u.trie.accept_buff[ st->u.trie.accepted ];
2820                             st->u.trie.accept_buff[ st->u.trie.accepted ] = tmp;
2821                             best = st->u.trie.accepted;
2822                         }
2823                         PL_reginput = (char *)st->u.trie.accept_buff[ best ].endpos;
2824
2825                         /*
2826                            as far as I can tell we only need the SAVETMPS/FREETMPS
2827                            for re's with EVAL in them but I'm leaving them in for
2828                            all until I can be sure.
2829                          */
2830                         SAVETMPS;
2831                         REGMATCH(scan + NEXT_OFF(scan), TRIE2);
2832                         /*** all unsaved local vars undefined at this point */
2833                         FREETMPS;
2834                     }
2835                     FREETMPS;
2836                     LEAVE;
2837                 }
2838
2839                 if (result) {
2840                     sayYES;
2841                 } else {
2842                     sayNO;
2843                 }
2844             }
2845             /* unreached codepoint */
2846         case EXACT: {
2847             char *s = STRING(scan);
2848             st->ln = STR_LEN(scan);
2849             if (do_utf8 != UTF) {
2850                 /* The target and the pattern have differing utf8ness. */
2851                 char *l = locinput;
2852                 const char *e = s + st->ln;
2853
2854                 if (do_utf8) {
2855                     /* The target is utf8, the pattern is not utf8. */
2856                     while (s < e) {
2857                         STRLEN ulen;
2858                         if (l >= PL_regeol)
2859                              sayNO;
2860                         if (NATIVE_TO_UNI(*(U8*)s) !=
2861                             utf8n_to_uvuni((U8*)l, UTF8_MAXBYTES, &ulen,
2862                                             uniflags))
2863                              sayNO;
2864                         l += ulen;
2865                         s ++;
2866                     }
2867                 }
2868                 else {
2869                     /* The target is not utf8, the pattern is utf8. */
2870                     while (s < e) {
2871                         STRLEN ulen;
2872                         if (l >= PL_regeol)
2873                             sayNO;
2874                         if (NATIVE_TO_UNI(*((U8*)l)) !=
2875                             utf8n_to_uvuni((U8*)s, UTF8_MAXBYTES, &ulen,
2876                                            uniflags))
2877                             sayNO;
2878                         s += ulen;
2879                         l ++;
2880                     }
2881                 }
2882                 locinput = l;
2883                 nextchr = UCHARAT(locinput);
2884                 break;
2885             }
2886             /* The target and the pattern have the same utf8ness. */
2887             /* Inline the first character, for speed. */
2888             if (UCHARAT(s) != nextchr)
2889                 sayNO;
2890             if (PL_regeol - locinput < st->ln)
2891                 sayNO;
2892             if (st->ln > 1 && memNE(s, locinput, st->ln))
2893                 sayNO;
2894             locinput += st->ln;
2895             nextchr = UCHARAT(locinput);
2896             break;
2897             }
2898         case EXACTFL:
2899             PL_reg_flags |= RF_tainted;
2900             /* FALL THROUGH */
2901         case EXACTF: {
2902             char *s = STRING(scan);
2903             st->ln = STR_LEN(scan);
2904
2905             if (do_utf8 || UTF) {
2906               /* Either target or the pattern are utf8. */
2907                 char *l = locinput;
2908                 char *e = PL_regeol;
2909
2910                 if (ibcmp_utf8(s, 0,  st->ln, (bool)UTF,
2911                                l, &e, 0,  do_utf8)) {
2912                      /* One more case for the sharp s:
2913                       * pack("U0U*", 0xDF) =~ /ss/i,
2914                       * the 0xC3 0x9F are the UTF-8
2915                       * byte sequence for the U+00DF. */
2916                      if (!(do_utf8 &&
2917                            toLOWER(s[0]) == 's' &&
2918                            st->ln >= 2 &&
2919                            toLOWER(s[1]) == 's' &&
2920                            (U8)l[0] == 0xC3 &&
2921                            e - l >= 2 &&
2922                            (U8)l[1] == 0x9F))
2923                           sayNO;
2924                 }
2925                 locinput = e;
2926                 nextchr = UCHARAT(locinput);
2927                 break;
2928             }
2929
2930             /* Neither the target and the pattern are utf8. */
2931
2932             /* Inline the first character, for speed. */
2933             if (UCHARAT(s) != nextchr &&
2934                 UCHARAT(s) != ((OP(scan) == EXACTF)
2935                                ? PL_fold : PL_fold_locale)[nextchr])
2936                 sayNO;
2937             if (PL_regeol - locinput < st->ln)
2938                 sayNO;
2939             if (st->ln > 1 && (OP(scan) == EXACTF
2940                            ? ibcmp(s, locinput, st->ln)
2941                            : ibcmp_locale(s, locinput, st->ln)))
2942                 sayNO;
2943             locinput += st->ln;
2944             nextchr = UCHARAT(locinput);
2945             break;
2946             }
2947         case ANYOF:
2948             if (do_utf8) {
2949                 STRLEN inclasslen = PL_regeol - locinput;
2950
2951                 if (!reginclass(scan, (U8*)locinput, &inclasslen, do_utf8))
2952                     sayNO_ANYOF;
2953                 if (locinput >= PL_regeol)
2954                     sayNO;
2955                 locinput += inclasslen ? inclasslen : UTF8SKIP(locinput);
2956                 nextchr = UCHARAT(locinput);
2957                 break;
2958             }
2959             else {
2960                 if (nextchr < 0)
2961                     nextchr = UCHARAT(locinput);
2962                 if (!REGINCLASS(scan, (U8*)locinput))
2963                     sayNO_ANYOF;
2964                 if (!nextchr && locinput >= PL_regeol)
2965                     sayNO;
2966                 nextchr = UCHARAT(++locinput);
2967                 break;
2968             }
2969         no_anyof:
2970             /* If we might have the case of the German sharp s
2971              * in a casefolding Unicode character class. */
2972
2973             if (ANYOF_FOLD_SHARP_S(scan, locinput, PL_regeol)) {
2974                  locinput += SHARP_S_SKIP;
2975                  nextchr = UCHARAT(locinput);
2976             }
2977             else
2978                  sayNO;
2979             break;
2980         case ALNUML:
2981             PL_reg_flags |= RF_tainted;
2982             /* FALL THROUGH */
2983         case ALNUM:
2984             if (!nextchr)
2985                 sayNO;
2986             if (do_utf8) {
2987                 LOAD_UTF8_CHARCLASS_ALNUM();
2988                 if (!(OP(scan) == ALNUM
2989                       ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2990                       : isALNUM_LC_utf8((U8*)locinput)))
2991                 {
2992                     sayNO;
2993                 }
2994                 locinput += PL_utf8skip[nextchr];
2995                 nextchr = UCHARAT(locinput);
2996                 break;
2997             }
2998             if (!(OP(scan) == ALNUM
2999                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
3000                 sayNO;
3001             nextchr = UCHARAT(++locinput);
3002             break;
3003         case NALNUML:
3004             PL_reg_flags |= RF_tainted;
3005             /* FALL THROUGH */
3006         case NALNUM:
3007             if (!nextchr && locinput >= PL_regeol)
3008                 sayNO;
3009             if (do_utf8) {
3010                 LOAD_UTF8_CHARCLASS_ALNUM();
3011                 if (OP(scan) == NALNUM
3012                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
3013                     : isALNUM_LC_utf8((U8*)locinput))
3014                 {
3015                     sayNO;
3016                 }
3017                 locinput += PL_utf8skip[nextchr];
3018                 nextchr = UCHARAT(locinput);
3019                 break;
3020             }
3021             if (OP(scan) == NALNUM
3022                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
3023                 sayNO;
3024             nextchr = UCHARAT(++locinput);
3025             break;
3026         case BOUNDL:
3027         case NBOUNDL:
3028             PL_reg_flags |= RF_tainted;
3029             /* FALL THROUGH */
3030         case BOUND:
3031         case NBOUND:
3032             /* was last char in word? */
3033             if (do_utf8) {
3034                 if (locinput == PL_bostr)
3035                     st->ln = '\n';
3036                 else {
3037                     const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
3038
3039                     st->ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, uniflags);
3040                 }
3041                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
3042                     st->ln = isALNUM_uni(st->ln);
3043                     LOAD_UTF8_CHARCLASS_ALNUM();
3044                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
3045                 }
3046                 else {
3047                     st->ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(st->ln));
3048                     n = isALNUM_LC_utf8((U8*)locinput);
3049                 }
3050             }
3051             else {
3052                 st->ln = (locinput != PL_bostr) ?
3053                     UCHARAT(locinput - 1) : '\n';
3054                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
3055                     st->ln = isALNUM(st->ln);
3056                     n = isALNUM(nextchr);
3057                 }
3058                 else {
3059                     st->ln = isALNUM_LC(st->ln);
3060                     n = isALNUM_LC(nextchr);
3061                 }
3062             }
3063             if (((!st->ln) == (!n)) == (OP(scan) == BOUND ||
3064                                     OP(scan) == BOUNDL))
3065                     sayNO;
3066             break;
3067         case SPACEL:
3068             PL_reg_flags |= RF_tainted;
3069             /* FALL THROUGH */
3070         case SPACE:
3071             if (!nextchr)
3072                 sayNO;
3073             if (do_utf8) {
3074                 if (UTF8_IS_CONTINUED(nextchr)) {
3075                     LOAD_UTF8_CHARCLASS_SPACE();
3076                     if (!(OP(scan) == SPACE
3077                           ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3078                           : isSPACE_LC_utf8((U8*)locinput)))
3079                     {
3080                         sayNO;
3081                     }
3082                     locinput += PL_utf8skip[nextchr];
3083                     nextchr = UCHARAT(locinput);
3084                     break;
3085                 }
3086                 if (!(OP(scan) == SPACE
3087                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3088                     sayNO;
3089                 nextchr = UCHARAT(++locinput);
3090             }
3091             else {
3092                 if (!(OP(scan) == SPACE
3093                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3094                     sayNO;
3095                 nextchr = UCHARAT(++locinput);
3096             }
3097             break;
3098         case NSPACEL:
3099             PL_reg_flags |= RF_tainted;
3100             /* FALL THROUGH */
3101         case NSPACE:
3102             if (!nextchr && locinput >= PL_regeol)
3103                 sayNO;
3104             if (do_utf8) {
3105                 LOAD_UTF8_CHARCLASS_SPACE();
3106                 if (OP(scan) == NSPACE
3107                     ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3108                     : isSPACE_LC_utf8((U8*)locinput))
3109                 {
3110                     sayNO;
3111                 }
3112                 locinput += PL_utf8skip[nextchr];
3113                 nextchr = UCHARAT(locinput);
3114                 break;
3115             }
3116             if (OP(scan) == NSPACE
3117                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
3118                 sayNO;
3119             nextchr = UCHARAT(++locinput);
3120             break;
3121         case DIGITL:
3122             PL_reg_flags |= RF_tainted;
3123             /* FALL THROUGH */
3124         case DIGIT:
3125             if (!nextchr)
3126                 sayNO;
3127             if (do_utf8) {
3128                 LOAD_UTF8_CHARCLASS_DIGIT();
3129                 if (!(OP(scan) == DIGIT
3130                       ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3131                       : isDIGIT_LC_utf8((U8*)locinput)))
3132                 {
3133                     sayNO;
3134                 }
3135                 locinput += PL_utf8skip[nextchr];
3136                 nextchr = UCHARAT(locinput);
3137                 break;
3138             }
3139             if (!(OP(scan) == DIGIT
3140                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
3141                 sayNO;
3142             nextchr = UCHARAT(++locinput);
3143             break;
3144         case NDIGITL:
3145             PL_reg_flags |= RF_tainted;
3146             /* FALL THROUGH */
3147         case NDIGIT:
3148             if (!nextchr && locinput >= PL_regeol)
3149                 sayNO;
3150             if (do_utf8) {
3151                 LOAD_UTF8_CHARCLASS_DIGIT();
3152                 if (OP(scan) == NDIGIT
3153                     ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3154                     : isDIGIT_LC_utf8((U8*)locinput))
3155                 {
3156                     sayNO;
3157                 }
3158                 locinput += PL_utf8skip[nextchr];
3159                 nextchr = UCHARAT(locinput);
3160                 break;
3161             }
3162             if (OP(scan) == NDIGIT
3163                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
3164                 sayNO;
3165             nextchr = UCHARAT(++locinput);
3166             break;
3167         case CLUMP:
3168             if (locinput >= PL_regeol)
3169                 sayNO;
3170             if  (do_utf8) {
3171                 LOAD_UTF8_CHARCLASS_MARK();
3172                 if (swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3173                     sayNO;
3174                 locinput += PL_utf8skip[nextchr];
3175                 while (locinput < PL_regeol &&
3176                        swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3177                     locinput += UTF8SKIP(locinput);
3178                 if (locinput > PL_regeol)
3179                     sayNO;
3180             }
3181             else
3182                locinput++;
3183             nextchr = UCHARAT(locinput);
3184             break;
3185         case REFFL:
3186             PL_reg_flags |= RF_tainted;
3187             /* FALL THROUGH */
3188         case REF:
3189         case REFF: {
3190             char *s;
3191             n = ARG(scan);  /* which paren pair */
3192             st->ln = PL_regstartp[n];
3193             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3194             if ((I32)*PL_reglastparen < n || st->ln == -1)
3195                 sayNO;                  /* Do not match unless seen CLOSEn. */
3196             if (st->ln == PL_regendp[n])
3197                 break;
3198
3199             s = PL_bostr + st->ln;
3200             if (do_utf8 && OP(scan) != REF) {   /* REF can do byte comparison */
3201                 char *l = locinput;
3202                 const char *e = PL_bostr + PL_regendp[n];
3203                 /*
3204                  * Note that we can't do the "other character" lookup trick as
3205                  * in the 8-bit case (no pun intended) because in Unicode we
3206                  * have to map both upper and title case to lower case.
3207                  */
3208                 if (OP(scan) == REFF) {
3209                     while (s < e) {
3210                         STRLEN ulen1, ulen2;
3211                         U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
3212                         U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
3213
3214                         if (l >= PL_regeol)
3215                             sayNO;
3216                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
3217                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
3218                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
3219                             sayNO;
3220                         s += ulen1;
3221                         l += ulen2;
3222                     }
3223                 }
3224                 locinput = l;
3225                 nextchr = UCHARAT(locinput);
3226                 break;
3227             }
3228
3229             /* Inline the first character, for speed. */
3230             if (UCHARAT(s) != nextchr &&
3231                 (OP(scan) == REF ||
3232                  (UCHARAT(s) != ((OP(scan) == REFF
3233                                   ? PL_fold : PL_fold_locale)[nextchr]))))
3234                 sayNO;
3235             st->ln = PL_regendp[n] - st->ln;
3236             if (locinput + st->ln > PL_regeol)
3237                 sayNO;
3238             if (st->ln > 1 && (OP(scan) == REF
3239                            ? memNE(s, locinput, st->ln)
3240                            : (OP(scan) == REFF
3241                               ? ibcmp(s, locinput, st->ln)
3242                               : ibcmp_locale(s, locinput, st->ln))))
3243                 sayNO;
3244             locinput += st->ln;
3245             nextchr = UCHARAT(locinput);
3246             break;
3247             }
3248
3249         case NOTHING:
3250         case TAIL:
3251             break;
3252         case BACK:
3253             break;
3254         case EVAL:
3255         {
3256             SV *ret;
3257             {
3258                 /* execute the code in the {...} */
3259                 dSP;
3260                 SV ** const before = SP;
3261                 OP_4tree * const oop = PL_op;
3262                 COP * const ocurcop = PL_curcop;
3263                 PAD *old_comppad;
3264                 struct regexp * const oreg = PL_reg_re;
3265
3266                 n = ARG(scan);
3267                 PL_op = (OP_4tree*)PL_reg_re->data->data[n];
3268                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
3269                 PAD_SAVE_LOCAL(old_comppad, (PAD*)PL_reg_re->data->data[n + 2]);
3270                 PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
3271
3272                 CALLRUNOPS(aTHX);                       /* Scalar context. */
3273                 SPAGAIN;
3274                 if (SP == before)
3275                     ret = &PL_sv_undef;   /* protect against empty (?{}) blocks. */
3276                 else {
3277                     ret = POPs;
3278                     PUTBACK;
3279                 }
3280
3281                 PL_op = oop;
3282                 PAD_RESTORE_LOCAL(old_comppad);
3283                 PL_curcop = ocurcop;
3284                 PL_reg_re = oreg;
3285                 if (!st->logical) {
3286                     /* /(?{...})/ */
3287                     sv_setsv(save_scalar(PL_replgv), ret);
3288                     break;
3289                 }
3290             }
3291             if (st->logical == 2) { /* Postponed subexpression: /(??{...})/ */
3292                 regexp *re;
3293                 re_cc_state state;
3294                 int toggleutf;
3295
3296                 {
3297                     /* extract RE object from returned value; compiling if
3298                      * necessary */
3299
3300                     MAGIC *mg = NULL;
3301                     SV *sv;
3302                     if(SvROK(ret) && SvSMAGICAL(sv = SvRV(ret)))
3303                         mg = mg_find(sv, PERL_MAGIC_qr);
3304                     else if (SvSMAGICAL(ret)) {
3305                         if (SvGMAGICAL(ret))
3306                             sv_unmagic(ret, PERL_MAGIC_qr);
3307                         else
3308                             mg = mg_find(ret, PERL_MAGIC_qr);
3309                     }
3310
3311                     if (mg) {
3312                         re = (regexp *)mg->mg_obj;
3313                         (void)ReREFCNT_inc(re);
3314                     }
3315                     else {
3316                         STRLEN len;
3317                         const char * const t = SvPV_const(ret, len);
3318                         PMOP pm;
3319                         const I32 osize = PL_regsize;
3320
3321                         Zero(&pm, 1, PMOP);
3322                         if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
3323                         re = CALLREGCOMP(aTHX_ (char*)t, (char*)t + len, &pm);
3324                         if (!(SvFLAGS(ret)
3325                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
3326                                 | SVs_GMG)))
3327                             sv_magic(ret,(SV*)ReREFCNT_inc(re),
3328                                         PERL_MAGIC_qr,0,0);
3329                         PL_regsize = osize;
3330                     }
3331                 }
3332                 DEBUG_EXECUTE_r(
3333                     PerlIO_printf(Perl_debug_log,
3334                                   "Entering embedded \"%s%.60s%s%s\"\n",
3335                                   PL_colors[0],
3336                                   re->precomp,
3337                                   PL_colors[1],
3338                                   (strlen(re->precomp) > 60 ? "..." : ""))
3339                     );
3340                 state.node = next;
3341                 state.prev = PL_reg_call_cc;
3342                 state.cc = st->cc;
3343                 state.re = PL_reg_re;
3344
3345                 st->cc = 0;
3346
3347                 st->u.eval.cp = regcppush(0);   /* Save *all* the positions. */
3348                 REGCP_SET(st->u.eval.lastcp);
3349                 PL_reg_re = re;
3350                 state.ss = PL_savestack_ix;
3351                 *PL_reglastparen = 0;
3352                 *PL_reglastcloseparen = 0;
3353                 PL_reg_call_cc = &state;
3354                 PL_reginput = locinput;
3355                 toggleutf = ((PL_reg_flags & RF_utf8) != 0) ^
3356                             ((re->reganch & ROPT_UTF8) != 0);
3357                 if (toggleutf) PL_reg_flags ^= RF_utf8;
3358
3359                 /* XXXX This is too dramatic a measure... */
3360                 PL_reg_maxiter = 0;
3361
3362                 /* XXX the only recursion left in regmatch() */
3363                 if (regmatch(re, re->program + 1)) {
3364                     /* Even though we succeeded, we need to restore
3365                        global variables, since we may be wrapped inside
3366                        SUSPEND, thus the match may be not finished yet. */
3367
3368                     /* XXXX Do this only if SUSPENDed? */
3369                     PL_reg_call_cc = state.prev;
3370                     st->cc = state.cc;
3371                     PL_reg_re = state.re;
3372
3373                     if (toggleutf) PL_reg_flags ^= RF_utf8;
3374
3375                     /* XXXX This is too dramatic a measure... */
3376                     PL_reg_maxiter = 0;
3377
3378                     /* These are needed even if not SUSPEND. */
3379                     ReREFCNT_dec(re);
3380                     regcpblow(st->u.eval.cp);
3381                     sayYES;
3382                 }
3383                 ReREFCNT_dec(re);
3384                 REGCP_UNWIND(st->u.eval.lastcp);
3385                 regcppop(rex);
3386                 PL_reg_call_cc = state.prev;
3387                 st->cc = state.cc;
3388                 PL_reg_re = state.re;
3389                 if (toggleutf) PL_reg_flags ^= RF_utf8;
3390
3391                 /* XXXX This is too dramatic a measure... */
3392                 PL_reg_maxiter = 0;
3393
3394                 st->logical = 0;
3395                 sayNO;
3396                 /* NOTREACHED */
3397             }
3398             /* /(?(?{...})X|Y)/ */
3399             st->sw = SvTRUE(ret);
3400             st->logical = 0;
3401             break;
3402         }
3403         case OPEN:
3404             n = ARG(scan);  /* which paren pair */
3405             PL_reg_start_tmp[n] = locinput;
3406             if (n > PL_regsize)
3407                 PL_regsize = n;
3408             break;
3409         case CLOSE:
3410             n = ARG(scan);  /* which paren pair */
3411             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
3412             PL_regendp[n] = locinput - PL_bostr;
3413             if (n > (I32)*PL_reglastparen)
3414                 *PL_reglastparen = n;
3415             *PL_reglastcloseparen = n;
3416             break;
3417         case GROUPP:
3418             n = ARG(scan);  /* which paren pair */
3419             st->sw = ((I32)*PL_reglastparen >= n && PL_regendp[n] != -1);
3420             break;
3421         case IFTHEN:
3422             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3423             if (st->sw)
3424                 next = NEXTOPER(NEXTOPER(scan));
3425             else {
3426                 next = scan + ARG(scan);
3427                 if (OP(next) == IFTHEN) /* Fake one. */
3428                     next = NEXTOPER(NEXTOPER(next));
3429             }
3430             break;
3431         case LOGICAL:
3432             st->logical = scan->flags;
3433             break;
3434 /*******************************************************************
3435  cc points to the regmatch_state associated with the most recent CURLYX.
3436  This struct contains info about the innermost (...)* loop (an
3437  "infoblock"), and a pointer to the next outer cc.
3438
3439  Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM):
3440
3441    1) After matching Y, regnode for CURLYX is processed;
3442
3443    2) This regnode populates cc, and calls regmatch() recursively
3444       with the starting point at WHILEM node;
3445
3446    3) Each hit of WHILEM node tries to match A and Z (in the order
3447       depending on the current iteration, min/max of {min,max} and
3448       greediness).  The information about where are nodes for "A"
3449       and "Z" is read from cc, as is info on how many times "A"
3450       was already matched, and greediness.
3451
3452    4) After A matches, the same WHILEM node is hit again.
3453
3454    5) Each time WHILEM is hit, cc is the infoblock created by CURLYX
3455       of the same pair.  Thus when WHILEM tries to match Z, it temporarily
3456       resets cc, since this Y(A)*Z can be a part of some other loop:
3457       as in (Y(A)*Z)*.  If Z matches, the automaton will hit the WHILEM node
3458       of the external loop.
3459
3460  Currently present infoblocks form a tree with a stem formed by st->cc
3461  and whatever it mentions via ->next, and additional attached trees
3462  corresponding to temporarily unset infoblocks as in "5" above.
3463
3464  In the following picture, infoblocks for outer loop of
3465  (Y(A)*?Z)*?T are denoted O, for inner I.  NULL starting block
3466  is denoted by x.  The matched string is YAAZYAZT.  Temporarily postponed
3467  infoblocks are drawn below the "reset" infoblock.
3468
3469  In fact in the picture below we do not show failed matches for Z and T
3470  by WHILEM blocks.  [We illustrate minimal matches, since for them it is
3471  more obvious *why* one needs to *temporary* unset infoblocks.]
3472
3473   Matched       REx position    InfoBlocks      Comment
3474                 (Y(A)*?Z)*?T    x
3475                 Y(A)*?Z)*?T     x <- O
3476   Y             (A)*?Z)*?T      x <- O
3477   Y             A)*?Z)*?T       x <- O <- I
3478   YA            )*?Z)*?T        x <- O <- I
3479   YA            A)*?Z)*?T       x <- O <- I
3480   YAA           )*?Z)*?T        x <- O <- I
3481   YAA           Z)*?T           x <- O          # Temporary unset I
3482                                      I
3483
3484   YAAZ          Y(A)*?Z)*?T     x <- O
3485                                      I
3486
3487   YAAZY         (A)*?Z)*?T      x <- O
3488                                      I
3489
3490   YAAZY         A)*?Z)*?T       x <- O <- I
3491                                      I
3492
3493   YAAZYA        )*?Z)*?T        x <- O <- I
3494                                      I
3495
3496   YAAZYA        Z)*?T           x <- O          # Temporary unset I
3497                                      I,I
3498
3499   YAAZYAZ       )*?T            x <- O
3500                                      I,I
3501
3502   YAAZYAZ       T               x               # Temporary unset O
3503                                 O
3504                                 I,I
3505
3506   YAAZYAZT                      x
3507                                 O
3508                                 I,I
3509  *******************************************************************/
3510
3511         case CURLYX: {
3512                 /* No need to save/restore up to this paren */
3513                 I32 parenfloor = scan->flags;
3514
3515                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
3516                     next += ARG(next);
3517                 /* XXXX Probably it is better to teach regpush to support
3518                    parenfloor > PL_regsize... */
3519                 if (parenfloor > (I32)*PL_reglastparen)
3520                     parenfloor = *PL_reglastparen; /* Pessimization... */
3521
3522                 st->u.curlyx.cp = PL_savestack_ix;
3523                 st->u.curlyx.outercc = st->cc;
3524                 st->cc = st;
3525                 /* these fields contain the state of the current curly.
3526                  * they are accessed by subsequent WHILEMs;
3527                  * cur and lastloc are also updated by WHILEM */
3528                 st->u.curlyx.parenfloor = parenfloor;
3529                 st->u.curlyx.cur = -1; /* this will be updated by WHILEM */
3530                 st->u.curlyx.min = ARG1(scan);
3531                 st->u.curlyx.max  = ARG2(scan);
3532                 st->u.curlyx.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3533                 st->u.curlyx.lastloc = 0;
3534                 /* st->next and st->minmod are also read by WHILEM */
3535
3536                 PL_reginput = locinput;
3537                 REGMATCH(PREVOPER(next), CURLYX); /* start on the WHILEM */
3538                 /*** all unsaved local vars undefined at this point */
3539                 regcpblow(st->u.curlyx.cp);
3540                 st->cc = st->u.curlyx.outercc;
3541                 saySAME(result);
3542             }
3543             /* NOTREACHED */
3544         case WHILEM: {
3545                 /*
3546                  * This is really hard to understand, because after we match
3547                  * what we're trying to match, we must make sure the rest of
3548                  * the REx is going to match for sure, and to do that we have
3549                  * to go back UP the parse tree by recursing ever deeper.  And
3550                  * if it fails, we have to reset our parent's current state
3551                  * that we can try again after backing off.
3552                  */
3553
3554                 st->u.whilem.lastloc = st->cc->u.curlyx.lastloc; /* Detection of 0-len. */
3555                 st->u.whilem.cache_offset = 0;
3556                 st->u.whilem.cache_bit = 0;
3557
3558                 n = st->cc->u.curlyx.cur + 1; /* how many we know we matched */
3559                 PL_reginput = locinput;
3560
3561                 DEBUG_EXECUTE_r(
3562                     PerlIO_printf(Perl_debug_log,
3563                                   "%*s  %ld out of %ld..%ld  cc=%"UVxf"\n",
3564                                   REPORT_CODE_OFF+PL_regindent*2, "",
3565                                   (long)n, (long)st->cc->u.curlyx.min,
3566                                   (long)st->cc->u.curlyx.max, PTR2UV(st->cc))
3567                     );
3568
3569                 /* If degenerate scan matches "", assume scan done. */
3570
3571                 if (locinput == st->cc->u.curlyx.lastloc && n >= st->cc->u.curlyx.min) {
3572                     st->u.whilem.savecc = st->cc;
3573                     st->cc = st->cc->u.curlyx.outercc;
3574                     if (st->cc)
3575                         st->ln = st->cc->u.curlyx.cur;
3576                     DEBUG_EXECUTE_r(
3577                         PerlIO_printf(Perl_debug_log,
3578                            "%*s  empty match detected, try continuation...\n",
3579                            REPORT_CODE_OFF+PL_regindent*2, "")
3580                         );
3581                     REGMATCH(st->u.whilem.savecc->next, WHILEM1);
3582                     /*** all unsaved local vars undefined at this point */
3583                     st->cc = st->u.whilem.savecc;
3584                     if (result)
3585                         sayYES;
3586                     if (st->cc->u.curlyx.outercc)
3587                         st->cc->u.curlyx.outercc->u.curlyx.cur = st->ln;
3588                     sayNO;
3589                 }
3590
3591                 /* First just match a string of min scans. */
3592
3593                 if (n < st->cc->u.curlyx.min) {
3594                     st->cc->u.curlyx.cur = n;
3595                     st->cc->u.curlyx.lastloc = locinput;
3596                     REGMATCH(st->cc->u.curlyx.scan, WHILEM2);
3597                     /*** all unsaved local vars undefined at this point */
3598                     if (result)
3599                         sayYES;
3600                     st->cc->u.curlyx.cur = n - 1;
3601                     st->cc->u.curlyx.lastloc = st->u.whilem.lastloc;
3602                     sayNO;
3603                 }
3604
3605                 if (scan->flags) {
3606                     /* Check whether we already were at this position.
3607                         Postpone detection until we know the match is not
3608                         *that* much linear. */
3609                 if (!PL_reg_maxiter) {
3610                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
3611                     PL_reg_leftiter = PL_reg_maxiter;
3612                 }
3613                 if (PL_reg_leftiter-- == 0) {
3614                     const I32 size = (PL_reg_maxiter + 7 + POSCACHE_START)/8;
3615                     if (PL_reg_poscache) {
3616                         if ((I32)PL_reg_poscache_size < size) {
3617                             Renew(PL_reg_poscache, size, char);
3618                             PL_reg_poscache_size = size;
3619                         }
3620                         Zero(PL_reg_poscache, size, char);
3621                     }
3622                     else {
3623                         PL_reg_poscache_size = size;
3624                         Newxz(PL_reg_poscache, size, char);
3625                     }
3626                     DEBUG_EXECUTE_r(
3627                         PerlIO_printf(Perl_debug_log,
3628               "%sDetected a super-linear match, switching on caching%s...\n",
3629                                       PL_colors[4], PL_colors[5])
3630                         );
3631                 }
3632                 if (PL_reg_leftiter < 0) {
3633                     st->u.whilem.cache_offset = locinput - PL_bostr;
3634
3635                     st->u.whilem.cache_offset = (scan->flags & 0xf) - 1 + POSCACHE_START
3636                             + st->u.whilem.cache_offset * (scan->flags>>4);
3637                     st->u.whilem.cache_bit = st->u.whilem.cache_offset % 8;
3638                     st->u.whilem.cache_offset /= 8;
3639                     if (PL_reg_poscache[st->u.whilem.cache_offset] & (1<<st->u.whilem.cache_bit)) {
3640                     DEBUG_EXECUTE_r(
3641                         PerlIO_printf(Perl_debug_log,
3642                                       "%*s  already tried at this position...\n",
3643                                       REPORT_CODE_OFF+PL_regindent*2, "")
3644                         );
3645                         if (PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))
3646                             /* cache records success */
3647                             sayYES;
3648                         else
3649                             /* cache records failure */
3650                             sayNO_SILENT;
3651                     }
3652                     PL_reg_poscache[st->u.whilem.cache_offset] |= (1<<st->u.whilem.cache_bit);
3653                 }
3654                 }
3655
3656                 /* Prefer next over scan for minimal matching. */
3657
3658                 if (st->cc->minmod) {
3659                     st->u.whilem.savecc = st->cc;
3660                     st->cc = st->cc->u.curlyx.outercc;
3661                     if (st->cc)
3662                         st->ln = st->cc->u.curlyx.cur;
3663                     st->u.whilem.cp = regcppush(st->u.whilem.savecc->u.curlyx.parenfloor);
3664                     REGCP_SET(st->u.whilem.lastcp);
3665                     REGMATCH(st->u.whilem.savecc->next, WHILEM3);
3666                     /*** all unsaved local vars undefined at this point */
3667                     st->cc = st->u.whilem.savecc;
3668                     if (result) {
3669                         regcpblow(st->u.whilem.cp);
3670                         CACHEsayYES;    /* All done. */
3671                     }
3672                     REGCP_UNWIND(st->u.whilem.lastcp);
3673                     regcppop(rex);
3674                     if (st->cc->u.curlyx.outercc)
3675                         st->cc->u.curlyx.outercc->u.curlyx.cur = st->ln;
3676
3677                     if (n >= st->cc->u.curlyx.max) { /* Maximum greed exceeded? */
3678                         if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3679                             && !(PL_reg_flags & RF_warned)) {
3680                             PL_reg_flags |= RF_warned;
3681                             Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
3682                                  "Complex regular subexpression recursion",
3683                                  REG_INFTY - 1);
3684                         }
3685                         CACHEsayNO;
3686                     }
3687
3688                     DEBUG_EXECUTE_r(
3689                         PerlIO_printf(Perl_debug_log,
3690                                       "%*s  trying longer...\n",
3691                                       REPORT_CODE_OFF+PL_regindent*2, "")
3692                         );
3693                     /* Try scanning more and see if it helps. */
3694                     PL_reginput = locinput;
3695                     st->cc->u.curlyx.cur = n;
3696                     st->cc->u.curlyx.lastloc = locinput;
3697                     st->u.whilem.cp = regcppush(st->cc->u.curlyx.parenfloor);
3698                     REGCP_SET(st->u.whilem.lastcp);
3699                     REGMATCH(st->cc->u.curlyx.scan, WHILEM4);
3700                     /*** all unsaved local vars undefined at this point */
3701                     if (result) {
3702                         regcpblow(st->u.whilem.cp);
3703                         CACHEsayYES;
3704                     }
3705                     REGCP_UNWIND(st->u.whilem.lastcp);
3706                     regcppop(rex);
3707                     st->cc->u.curlyx.cur = n - 1;
3708                     st->cc->u.curlyx.lastloc = st->u.whilem.lastloc;
3709                     CACHEsayNO;
3710                 }
3711
3712                 /* Prefer scan over next for maximal matching. */
3713
3714                 if (n < st->cc->u.curlyx.max) { /* More greed allowed? */
3715                     st->u.whilem.cp = regcppush(st->cc->u.curlyx.parenfloor);
3716                     st->cc->u.curlyx.cur = n;
3717                     st->cc->u.curlyx.lastloc = locinput;
3718                     REGCP_SET(st->u.whilem.lastcp);
3719                     REGMATCH(st->cc->u.curlyx.scan, WHILEM5);
3720                     /*** all unsaved local vars undefined at this point */
3721                     if (result) {
3722                         regcpblow(st->u.whilem.cp);
3723                         CACHEsayYES;
3724                     }
3725                     REGCP_UNWIND(st->u.whilem.lastcp);
3726                     regcppop(rex);      /* Restore some previous $<digit>s? */
3727                     PL_reginput = locinput;
3728                     DEBUG_EXECUTE_r(
3729                         PerlIO_printf(Perl_debug_log,
3730                                       "%*s  failed, try continuation...\n",
3731                                       REPORT_CODE_OFF+PL_regindent*2, "")
3732                         );
3733                 }
3734                 if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3735                         && !(PL_reg_flags & RF_warned)) {
3736                     PL_reg_flags |= RF_warned;
3737                     Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
3738                          "Complex regular subexpression recursion",
3739                          REG_INFTY - 1);
3740                 }
3741
3742                 /* Failed deeper matches of scan, so see if this one works. */
3743                 st->u.whilem.savecc = st->cc;
3744                 st->cc = st->cc->u.curlyx.outercc;
3745                 if (st->cc)
3746                     st->ln = st->cc->u.curlyx.cur;
3747                 REGMATCH(st->u.whilem.savecc->next, WHILEM6);
3748                 /*** all unsaved local vars undefined at this point */
3749                 st->cc = st->u.whilem.savecc;
3750                 if (result)
3751                     CACHEsayYES;
3752                 if (st->cc->u.curlyx.outercc)
3753                     st->cc->u.curlyx.outercc->u.curlyx.cur = st->ln;
3754                 st->cc->u.curlyx.cur = n - 1;
3755                 st->cc->u.curlyx.lastloc = st->u.whilem.lastloc;
3756                 CACHEsayNO;
3757             }
3758             /* NOTREACHED */
3759         case BRANCHJ:
3760             next = scan + ARG(scan);
3761             if (next == scan)
3762                 next = NULL;
3763             inner = NEXTOPER(NEXTOPER(scan));
3764             goto do_branch;
3765         case BRANCH:
3766             inner = NEXTOPER(scan);
3767           do_branch:
3768             {
3769                 I32 type;
3770                 type = OP(scan);
3771                 if (OP(next) != type)   /* No choice. */
3772                     next = inner;       /* Avoid recursion. */
3773                 else {
3774                     const I32 lastparen = *PL_reglastparen;
3775                     /* Put unwinding data on stack */
3776                     const I32 unwind1 = SSNEWt(1,re_unwind_branch_t);
3777                     re_unwind_branch_t * const uw = SSPTRt(unwind1,re_unwind_branch_t);
3778
3779                     uw->prev = st->unwind;
3780                     st->unwind = unwind1;
3781                     uw->type = ((type == BRANCH)
3782                                 ? RE_UNWIND_BRANCH
3783                                 : RE_UNWIND_BRANCHJ);
3784                     uw->lastparen = lastparen;
3785                     uw->next = next;
3786                     uw->locinput = locinput;
3787                     uw->nextchr = nextchr;
3788 #ifdef DEBUGGING
3789                     uw->regindent = ++PL_regindent;
3790 #endif
3791
3792                     REGCP_SET(uw->lastcp);
3793
3794                     /* Now go into the first branch */
3795                     next = inner;
3796                 }
3797             }
3798             break;
3799         case MINMOD:
3800             st->minmod = 1;
3801             break;
3802         case CURLYM:
3803         {
3804             st->u.curlym.l = st->u.curlym.matches = 0;
3805
3806             /* We suppose that the next guy does not need
3807                backtracking: in particular, it is of constant non-zero length,
3808                and has no parenths to influence future backrefs. */
3809             st->ln = ARG1(scan);  /* min to match */
3810             n  = ARG2(scan);  /* max to match */
3811             st->u.curlym.paren = scan->flags;
3812             if (st->u.curlym.paren) {
3813                 if (st->u.curlym.paren > PL_regsize)
3814                     PL_regsize = st->u.curlym.paren;
3815                 if (st->u.curlym.paren > (I32)*PL_reglastparen)
3816                     *PL_reglastparen = st->u.curlym.paren;
3817             }
3818             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3819             if (st->u.curlym.paren)
3820                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
3821             PL_reginput = locinput;
3822             st->u.curlym.maxwanted = st->minmod ? st->ln : n;
3823             if (st->u.curlym.maxwanted) {
3824                 while (PL_reginput < PL_regeol && st->u.curlym.matches < st->u.curlym.maxwanted) {
3825                     REGMATCH(scan, CURLYM1);
3826                     /*** all unsaved local vars undefined at this point */
3827                     if (!result)
3828                         break;
3829                     /* on first match, determine length, u.curlym.l */
3830                     if (!st->u.curlym.matches++) {
3831                         if (PL_reg_match_utf8) {
3832                             char *s = locinput;
3833                             while (s < PL_reginput) {
3834                                 st->u.curlym.l++;
3835                                 s += UTF8SKIP(s);
3836                             }
3837                         }
3838                         else {
3839                             st->u.curlym.l = PL_reginput - locinput;
3840                         }
3841                         if (st->u.curlym.l == 0) {
3842                             st->u.curlym.matches = st->u.curlym.maxwanted;
3843                             break;
3844                         }
3845                     }
3846                     locinput = PL_reginput;
3847                 }
3848             }
3849
3850             PL_reginput = locinput;
3851
3852             if (st->minmod) {
3853                 st->minmod = 0;
3854                 if (st->ln && st->u.curlym.matches < st->ln)
3855                     sayNO;
3856                 if (HAS_TEXT(next) || JUMPABLE(next)) {
3857                     regnode *text_node = next;
3858
3859                     if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3860
3861                     if (! HAS_TEXT(text_node)) st->u.curlym.c1 = st->u.curlym.c2 = -1000;
3862                     else {
3863                         if (PL_regkind[(U8)OP(text_node)] == REF) {
3864                             st->u.curlym.c1 = st->u.curlym.c2 = -1000;
3865                             goto assume_ok_MM;
3866                         }
3867                         else { st->u.curlym.c1 = (U8)*STRING(text_node); }
3868                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3869                             st->u.curlym.c2 = PL_fold[st->u.curlym.c1];
3870                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3871                             st->u.curlym.c2 = PL_fold_locale[st->u.curlym.c1];
3872                         else
3873                             st->u.curlym.c2 = st->u.curlym.c1;
3874                     }
3875                 }
3876                 else
3877                     st->u.curlym.c1 = st->u.curlym.c2 = -1000;
3878             assume_ok_MM:
3879                 REGCP_SET(st->u.curlym.lastcp);
3880                 while (n >= st->ln || (n == REG_INFTY && st->ln > 0)) { /* ln overflow ? */
3881                     /* If it could work, try it. */
3882                     if (st->u.curlym.c1 == -1000 ||
3883                         UCHARAT(PL_reginput) == st->u.curlym.c1 ||
3884                         UCHARAT(PL_reginput) == st->u.curlym.c2)
3885                     {
3886                         if (st->u.curlym.paren) {
3887                             if (st->ln) {
3888                                 PL_regstartp[st->u.curlym.paren] =
3889                                     HOPc(PL_reginput, -st->u.curlym.l) - PL_bostr;
3890                                 PL_regendp[st->u.curlym.paren] = PL_reginput - PL_bostr;
3891                             }
3892                             else
3893                                 PL_regendp[st->u.curlym.paren] = -1;
3894                         }
3895                         REGMATCH(next, CURLYM2);
3896                         /*** all unsaved local vars undefined at this point */
3897                         if (result)
3898                             sayYES;
3899                         REGCP_UNWIND(st->u.curlym.lastcp);
3900                     }
3901                     /* Couldn't or didn't -- move forward. */
3902                     PL_reginput = locinput;
3903                     REGMATCH(scan, CURLYM3);
3904                     /*** all unsaved local vars undefined at this point */
3905                     if (result) {
3906                         st->ln++;
3907                         locinput = PL_reginput;
3908                     }
3909                     else
3910                         sayNO;
3911                 }
3912             }
3913             else {
3914                 DEBUG_EXECUTE_r(
3915                     PerlIO_printf(Perl_debug_log,
3916                               "%*s  matched %"IVdf" times, len=%"IVdf"...\n",
3917                               (int)(REPORT_CODE_OFF+PL_regindent*2), "",
3918                               (IV) st->u.curlym.matches, (IV)st->u.curlym.l)
3919                     );
3920                 if (st->u.curlym.matches >= st->ln) {
3921                     if (HAS_TEXT(next) || JUMPABLE(next)) {
3922                         regnode *text_node = next;
3923
3924                         if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3925
3926                         if (! HAS_TEXT(text_node)) st->u.curlym.c1 = st->u.curlym.c2 = -1000;
3927                         else {
3928                             if (PL_regkind[(U8)OP(text_node)] == REF) {
3929                                 st->u.curlym.c1 = st->u.curlym.c2 = -1000;
3930                                 goto assume_ok_REG;
3931                             }
3932                             else { st->u.curlym.c1 = (U8)*STRING(text_node); }
3933
3934                             if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3935                                 st->u.curlym.c2 = PL_fold[st->u.curlym.c1];
3936                             else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3937                                 st->u.curlym.c2 = PL_fold_locale[st->u.curlym.c1];
3938                             else
3939                                 st->u.curlym.c2 = st->u.curlym.c1;
3940                         }
3941                     }
3942                     else
3943                         st->u.curlym.c1 = st->u.curlym.c2 = -1000;
3944                 }
3945             assume_ok_REG:
3946                 REGCP_SET(st->u.curlym.lastcp);
3947                 while (st->u.curlym.matches >= st->ln) {
3948                     /* If it could work, try it. */
3949                     if (st->u.curlym.c1 == -1000 ||
3950                         UCHARAT(PL_reginput) == st->u.curlym.c1 ||
3951                         UCHARAT(PL_reginput) == st->u.curlym.c2)
3952                     {
3953                         DEBUG_EXECUTE_r(
3954                             PerlIO_printf(Perl_debug_log,
3955                                 "%*s  trying tail with matches=%"IVdf"...\n",
3956                                 (int)(REPORT_CODE_OFF+PL_regindent*2),
3957                                 "", (IV)st->u.curlym.matches)
3958                             );
3959                         if (st->u.curlym.paren) {
3960                             if (st->u.curlym.matches) {
3961                                 PL_regstartp[st->u.curlym.paren]
3962                                     = HOPc(PL_reginput, -st->u.curlym.l) - PL_bostr;
3963                                 PL_regendp[st->u.curlym.paren] = PL_reginput - PL_bostr;
3964                             }
3965                             else
3966                                 PL_regendp[st->u.curlym.paren] = -1;
3967                         }
3968                         REGMATCH(next, CURLYM4);
3969                         /*** all unsaved local vars undefined at this point */
3970                         if (result)
3971                             sayYES;
3972                         REGCP_UNWIND(st->u.curlym.lastcp);
3973                     }
3974                     /* Couldn't or didn't -- back up. */
3975                     st->u.curlym.matches--;
3976                     locinput = HOPc(locinput, -st->u.curlym.l);
3977                     PL_reginput = locinput;
3978                 }
3979             }
3980             sayNO;
3981             /* NOTREACHED */
3982             break;
3983         }
3984         case CURLYN:
3985             st->u.plus.paren = scan->flags;     /* Which paren to set */
3986             if (st->u.plus.paren > PL_regsize)
3987                 PL_regsize = st->u.plus.paren;
3988             if (st->u.plus.paren > (I32)*PL_reglastparen)
3989                 *PL_reglastparen = st->u.plus.paren;
3990             st->ln = ARG1(scan);  /* min to match */
3991             n  = ARG2(scan);  /* max to match */
3992             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
3993             goto repeat;
3994         case CURLY:
3995             st->u.plus.paren = 0;
3996             st->ln = ARG1(scan);  /* min to match */
3997             n  = ARG2(scan);  /* max to match */
3998             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3999             goto repeat;
4000         case STAR:
4001             st->ln = 0;
4002             n = REG_INFTY;
4003             scan = NEXTOPER(scan);
4004             st->u.plus.paren = 0;
4005             goto repeat;
4006         case PLUS:
4007             st->ln = 1;
4008             n = REG_INFTY;
4009             scan = NEXTOPER(scan);
4010             st->u.plus.paren = 0;
4011           repeat:
4012             /*
4013             * Lookahead to avoid useless match attempts
4014             * when we know what character comes next.
4015             */
4016
4017             /*
4018             * Used to only do .*x and .*?x, but now it allows
4019             * for )'s, ('s and (?{ ... })'s to be in the way
4020             * of the quantifier and the EXACT-like node.  -- japhy
4021             */
4022
4023             if (HAS_TEXT(next) || JUMPABLE(next)) {
4024                 U8 *s;
4025                 regnode *text_node = next;
4026
4027                 if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
4028
4029                 if (! HAS_TEXT(text_node)) st->u.plus.c1 = st->u.plus.c2 = -1000;
4030                 else {
4031                     if (PL_regkind[(U8)OP(text_node)] == REF) {
4032                         st->u.plus.c1 = st->u.plus.c2 = -1000;
4033                         goto assume_ok_easy;
4034                     }
4035                     else { s = (U8*)STRING(text_node); }
4036
4037                     if (!UTF) {
4038                         st->u.plus.c2 = st->u.plus.c1 = *s;
4039                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
4040                             st->u.plus.c2 = PL_fold[st->u.plus.c1];
4041                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
4042                             st->u.plus.c2 = PL_fold_locale[st->u.plus.c1];
4043                     }
4044                     else { /* UTF */
4045                         if (OP(text_node) == EXACTF || OP(text_node) == REFF) {
4046                              STRLEN ulen1, ulen2;
4047                              U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
4048                              U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
4049
4050                              to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
4051                              to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
4052
4053                              st->u.plus.c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
4054                                                  uniflags);
4055                              st->u.plus.c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
4056                                                  uniflags);
4057                         }
4058                         else {
4059                             st->u.plus.c2 = st->u.plus.c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
4060                                                      uniflags);
4061                         }
4062                     }
4063                 }
4064             }
4065             else
4066                 st->u.plus.c1 = st->u.plus.c2 = -1000;
4067         assume_ok_easy:
4068             PL_reginput = locinput;
4069             if (st->minmod) {
4070                 st->minmod = 0;
4071                 if (st->ln && regrepeat(scan, st->ln) < st->ln)
4072                     sayNO;
4073                 locinput = PL_reginput;
4074                 REGCP_SET(st->u.plus.lastcp);
4075                 if (st->u.plus.c1 != -1000) {
4076                     st->u.plus.old = locinput;
4077                     st->u.plus.count = 0;
4078
4079                     if  (n == REG_INFTY) {
4080                         st->u.plus.e = PL_regeol - 1;
4081                         if (do_utf8)
4082                             while (UTF8_IS_CONTINUATION(*(U8*)st->u.plus.e))
4083                                 st->u.plus.e--;
4084                     }
4085                     else if (do_utf8) {
4086                         int m = n - st->ln;
4087                         for (st->u.plus.e = locinput;
4088                              m >0 && st->u.plus.e + UTF8SKIP(st->u.plus.e) <= PL_regeol; m--)
4089                             st->u.plus.e += UTF8SKIP(st->u.plus.e);
4090                     }
4091                     else {
4092                         st->u.plus.e = locinput + n - st->ln;
4093                         if (st->u.plus.e >= PL_regeol)
4094                             st->u.plus.e = PL_regeol - 1;
4095                     }
4096                     while (1) {
4097                         /* Find place 'next' could work */
4098                         if (!do_utf8) {
4099                             if (st->u.plus.c1 == st->u.plus.c2) {
4100                                 while (locinput <= st->u.plus.e &&
4101                                        UCHARAT(locinput) != st->u.plus.c1)
4102                                     locinput++;
4103                             } else {
4104                                 while (locinput <= st->u.plus.e
4105                                        && UCHARAT(locinput) != st->u.plus.c1
4106                                        && UCHARAT(locinput) != st->u.plus.c2)
4107                                     locinput++;
4108                             }
4109                             st->u.plus.count = locinput - st->u.plus.old;
4110                         }
4111                         else {
4112                             if (st->u.plus.c1 == st->u.plus.c2) {
4113                                 STRLEN len;
4114                                 /* count initialised to
4115                                  * utf8_distance(old, locinput) */
4116                                 while (locinput <= st->u.plus.e &&
4117                                        utf8n_to_uvchr((U8*)locinput,
4118                                                       UTF8_MAXBYTES, &len,
4119                                                       uniflags) != (UV)st->u.plus.c1) {
4120                                     locinput += len;
4121                                     st->u.plus.count++;
4122                                 }
4123                             } else {
4124                                 STRLEN len;
4125                                 /* count initialised to
4126                                  * utf8_distance(old, locinput) */
4127                                 while (locinput <= st->u.plus.e) {
4128                                     UV c = utf8n_to_uvchr((U8*)locinput,
4129                                                           UTF8_MAXBYTES, &len,
4130                                                           uniflags);
4131                                     if (c == (UV)st->u.plus.c1 || c == (UV)st->u.plus.c2)
4132                                         break;
4133                                     locinput += len;
4134                                     st->u.plus.count++;
4135                                 }
4136                             }
4137                         }
4138                         if (locinput > st->u.plus.e)
4139                             sayNO;
4140                         /* PL_reginput == old now */
4141                         if (locinput != st->u.plus.old) {
4142                             st->ln = 1; /* Did some */
4143                             if (regrepeat(scan, st->u.plus.count) < st->u.plus.count)
4144                                 sayNO;
4145                         }
4146                         /* PL_reginput == locinput now */
4147                         TRYPAREN(st->u.plus.paren, st->ln, locinput, PLUS1);
4148                         /*** all unsaved local vars undefined at this point */
4149                         PL_reginput = locinput; /* Could be reset... */
4150                         REGCP_UNWIND(st->u.plus.lastcp);
4151                         /* Couldn't or didn't -- move forward. */
4152                         st->u.plus.old = locinput;
4153                         if (do_utf8)
4154                             locinput += UTF8SKIP(locinput);
4155                         else
4156                             locinput++;
4157                         st->u.plus.count = 1;
4158                     }
4159                 }
4160                 else
4161                 while (n >= st->ln || (n == REG_INFTY && st->ln > 0)) { /* ln overflow ? */
4162                     UV c;
4163                     if (st->u.plus.c1 != -1000) {
4164                         if (do_utf8)
4165                             c = utf8n_to_uvchr((U8*)PL_reginput,
4166                                                UTF8_MAXBYTES, 0,
4167                                                uniflags);
4168                         else
4169                             c = UCHARAT(PL_reginput);
4170                         /* If it could work, try it. */
4171                         if (c == (UV)st->u.plus.c1 || c == (UV)st->u.plus.c2)
4172                         {
4173                             TRYPAREN(st->u.plus.paren, st->ln, PL_reginput, PLUS2);
4174                             /*** all unsaved local vars undefined at this point */
4175                             REGCP_UNWIND(st->u.plus.lastcp);
4176                         }
4177                     }
4178                     /* If it could work, try it. */
4179                     else if (st->u.plus.c1 == -1000)
4180                     {
4181                         TRYPAREN(st->u.plus.paren, st->ln, PL_reginput, PLUS3);
4182                         /*** all unsaved local vars undefined at this point */
4183                         REGCP_UNWIND(st->u.plus.lastcp);
4184                     }
4185                     /* Couldn't or didn't -- move forward. */
4186                     PL_reginput = locinput;
4187                     if (regrepeat(scan, 1)) {
4188                         st->ln++;
4189                         locinput = PL_reginput;
4190                     }
4191                     else
4192                         sayNO;
4193                 }
4194             }
4195             else {
4196                 n = regrepeat(scan, n);
4197                 locinput = PL_reginput;
4198                 if (st->ln < n && PL_regkind[(U8)OP(next)] == EOL &&
4199                     (OP(next) != MEOL ||
4200                         OP(next) == SEOL || OP(next) == EOS))
4201                 {
4202                     st->ln = n;                 /* why back off? */
4203                     /* ...because $ and \Z can match before *and* after
4204                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
4205                        We should back off by one in this case. */
4206                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(next) != EOS)
4207                         st->ln--;
4208                 }
4209                 REGCP_SET(st->u.plus.lastcp);
4210                 {
4211                     UV c = 0;
4212                     while (n >= st->ln) {
4213                         if (st->u.plus.c1 != -1000) {
4214                             if (do_utf8)
4215                                 c = utf8n_to_uvchr((U8*)PL_reginput,
4216                                                    UTF8_MAXBYTES, 0,
4217                                                    uniflags);
4218                             else
4219                                 c = UCHARAT(PL_reginput);
4220                         }
4221                         /* If it could work, try it. */
4222                         if (st->u.plus.c1 == -1000 || c == (UV)st->u.plus.c1 || c == (UV)st->u.plus.c2)
4223                             {
4224                                 TRYPAREN(st->u.plus.paren, n, PL_reginput, PLUS4);
4225                                 /*** all unsaved local vars undefined at this point */
4226                                 REGCP_UNWIND(st->u.plus.lastcp);
4227                             }
4228                         /* Couldn't or didn't -- back up. */
4229                         n--;
4230                         PL_reginput = locinput = HOPc(locinput, -1);
4231                     }
4232                 }
4233             }
4234             sayNO;
4235             break;
4236         case END:
4237             if (PL_reg_call_cc) {
4238                 st->u.end.cur_call_cc = PL_reg_call_cc;
4239                 st->u.end.end_re = PL_reg_re;
4240
4241                 /* Save *all* the positions. */
4242                 st->u.end.cp = regcppush(0);
4243                 REGCP_SET(st->u.end.lastcp);
4244
4245                 /* Restore parens of the caller. */
4246                 {
4247                     I32 tmp = PL_savestack_ix;
4248                     PL_savestack_ix = PL_reg_call_cc->ss;
4249                     regcppop(rex);
4250                     PL_savestack_ix = tmp;
4251                 }
4252
4253                 /* Make position available to the callcc. */
4254                 PL_reginput = locinput;
4255
4256                 PL_reg_re = PL_reg_call_cc->re;
4257                 st->u.end.savecc = st->cc;
4258                 st->cc = PL_reg_call_cc->cc;
4259                 PL_reg_call_cc = PL_reg_call_cc->prev;
4260                 REGMATCH(st->u.end.cur_call_cc->node, END);
4261                 /*** all unsaved local vars undefined at this point */
4262                 if (result) {
4263                     PL_reg_call_cc = st->u.end.cur_call_cc;
4264                     regcpblow(st->u.end.cp);
4265                     sayYES;
4266                 }
4267                 REGCP_UNWIND(st->u.end.lastcp);
4268                 regcppop(rex);
4269                 PL_reg_call_cc = st->u.end.cur_call_cc;
4270                 st->cc = st->u.end.savecc;
4271                 PL_reg_re = st->u.end.end_re;
4272
4273                 DEBUG_EXECUTE_r(
4274                     PerlIO_printf(Perl_debug_log,
4275                                   "%*s  continuation failed...\n",
4276                                   REPORT_CODE_OFF+PL_regindent*2, "")
4277                     );
4278                 sayNO_SILENT;
4279             }
4280             if (locinput < PL_regtill) {
4281                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4282                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
4283                                       PL_colors[4],
4284                                       (long)(locinput - PL_reg_starttry),
4285                                       (long)(PL_regtill - PL_reg_starttry),
4286                                       PL_colors[5]));
4287                 sayNO_FINAL;            /* Cannot match: too short. */
4288             }
4289             PL_reginput = locinput;     /* put where regtry can find it */
4290             sayYES_FINAL;               /* Success! */
4291         case SUCCEED:
4292             PL_reginput = locinput;     /* put where regtry can find it */
4293             sayYES_LOUD;                /* Success! */
4294         case SUSPEND:
4295             n = 1;
4296             PL_reginput = locinput;
4297             goto do_ifmatch;
4298         case UNLESSM:
4299             n = 0;
4300             if (scan->flags) {
4301                 char * const s = HOPBACKc(locinput, scan->flags);
4302                 if (!s)
4303                     goto say_yes;
4304                 PL_reginput = s;
4305             }
4306             else
4307                 PL_reginput = locinput;
4308             goto do_ifmatch;
4309         case IFMATCH:
4310             n = 1;
4311             if (scan->flags) {
4312                 char * const s = HOPBACKc(locinput, scan->flags);
4313                 if (!s)
4314                     goto say_no;
4315                 PL_reginput = s;
4316             }
4317             else
4318                 PL_reginput = locinput;
4319
4320           do_ifmatch:
4321             REGMATCH(NEXTOPER(NEXTOPER(scan)), IFMATCH);
4322             /*** all unsaved local vars undefined at this point */
4323             if (result != n) {
4324               say_no:
4325                 if (st->logical) {
4326                     st->logical = 0;
4327                     st->sw = 0;
4328                     goto do_longjump;
4329                 }
4330                 else
4331                     sayNO;
4332             }
4333           say_yes:
4334             if (st->logical) {
4335                 st->logical = 0;
4336                 st->sw = 1;
4337             }
4338             if (OP(scan) == SUSPEND) {
4339                 locinput = PL_reginput;
4340                 nextchr = UCHARAT(locinput);
4341             }
4342             /* FALL THROUGH. */
4343         case LONGJMP:
4344           do_longjump:
4345             next = scan + ARG(scan);
4346             if (next == scan)
4347                 next = NULL;
4348             break;
4349         default:
4350             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
4351                           PTR2UV(scan), OP(scan));
4352             Perl_croak(aTHX_ "regexp memory corruption");
4353         }
4354
4355       reenter:
4356         scan = next;
4357         continue;
4358         /* NOTREACHED */
4359
4360         /* simulate recursively calling regmatch(), but without actually
4361          * recursing - ie save the current state on the heap rather than on
4362          * the stack, then re-enter the loop. This avoids complex regexes
4363          * blowing the processor stack */
4364
4365       start_recurse:
4366         {
4367             /* push new state */
4368             regmatch_state *oldst = st;
4369
4370             depth++;
4371
4372             /* grab the next free state slot */
4373             st++;
4374             if (st >  &(PL_regmatch_slab->states[PERL_REGMATCH_SLAB_SLOTS-1]))
4375                 st = S_push_slab(aTHX);
4376             PL_regmatch_state = st;
4377
4378             oldst->next = next;
4379             oldst->n = n;
4380             oldst->locinput = locinput;
4381             oldst->reg_call_cc = PL_reg_call_cc;
4382
4383             st->cc = oldst->cc;
4384             locinput = PL_reginput;
4385             nextchr = UCHARAT(locinput);
4386             st->minmod = 0;
4387             st->sw = 0;
4388             st->logical = 0;
4389             st->unwind = 0;
4390 #ifdef DEBUGGING
4391             PL_regindent++;
4392 #endif
4393         }
4394     }
4395
4396     /*
4397     * We get here only if there's trouble -- normally "case END" is
4398     * the terminating point.
4399     */
4400     Perl_croak(aTHX_ "corrupted regexp pointers");
4401     /*NOTREACHED*/
4402     sayNO;
4403
4404 yes_loud:
4405     DEBUG_EXECUTE_r(
4406         PerlIO_printf(Perl_debug_log,
4407                       "%*s  %scould match...%s\n",
4408                       REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], PL_colors[5])
4409         );
4410     goto yes;
4411 yes_final:
4412     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
4413                           PL_colors[4], PL_colors[5]));
4414 yes:
4415 #ifdef DEBUGGING
4416     PL_regindent--;
4417 #endif
4418
4419     result = 1;
4420     goto exit_level;
4421
4422 no:
4423     DEBUG_EXECUTE_r(
4424         PerlIO_printf(Perl_debug_log,
4425                       "%*s  %sfailed...%s\n",
4426                       REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], PL_colors[5])
4427         );
4428     goto do_no;
4429 no_final:
4430 do_no:
4431     if (st->unwind) {
4432         re_unwind_t * const uw = SSPTRt(st->unwind,re_unwind_t);
4433
4434         switch (uw->type) {
4435         case RE_UNWIND_BRANCH:
4436         case RE_UNWIND_BRANCHJ:
4437         {
4438             re_unwind_branch_t * const uwb = &(uw->branch);
4439             const I32 lastparen = uwb->lastparen;
4440
4441             REGCP_UNWIND(uwb->lastcp);
4442             for (n = *PL_reglastparen; n > lastparen; n--)
4443                 PL_regendp[n] = -1;
4444             *PL_reglastparen = n;
4445             scan = next = uwb->next;
4446             if ( !scan ||
4447                  OP(scan) != (uwb->type == RE_UNWIND_BRANCH
4448                               ? BRANCH : BRANCHJ) ) {           /* Failure */
4449                 st->unwind = uwb->prev;
4450 #ifdef DEBUGGING
4451                 PL_regindent--;
4452 #endif
4453                 goto do_no;
4454             }
4455             /* Have more choice yet.  Reuse the same uwb.  */
4456             if ((n = (uwb->type == RE_UNWIND_BRANCH
4457                       ? NEXT_OFF(next) : ARG(next))))
4458                 next += n;
4459             else
4460                 next = NULL;    /* XXXX Needn't unwinding in this case... */
4461             uwb->next = next;
4462             next = NEXTOPER(scan);
4463             if (uwb->type == RE_UNWIND_BRANCHJ)
4464                 next = NEXTOPER(next);
4465             locinput = uwb->locinput;
4466             nextchr = uwb->nextchr;
4467 #ifdef DEBUGGING
4468             PL_regindent = uwb->regindent;
4469 #endif
4470
4471             goto reenter;
4472         }
4473         /* NOTREACHED */
4474         default:
4475             Perl_croak(aTHX_ "regexp unwind memory corruption");
4476         }
4477         /* NOTREACHED */
4478     }
4479 #ifdef DEBUGGING
4480     PL_regindent--;
4481 #endif
4482     result = 0;
4483 exit_level:
4484
4485     if (depth--) {
4486         /* restore previous state and re-enter */
4487         st--;
4488         if (st < &PL_regmatch_slab->states[0]) {
4489             PL_regmatch_slab = PL_regmatch_slab->prev;
4490             st = &PL_regmatch_slab->states[PERL_REGMATCH_SLAB_SLOTS-1];
4491         }
4492         PL_regmatch_state = st;
4493
4494         PL_reg_call_cc  = st->reg_call_cc;
4495         scan            = st->scan;
4496         next            = st->next;
4497         n               = st->n;
4498         locinput        = st->locinput;
4499         nextchr = UCHARAT(locinput);
4500
4501         switch (st->resume_state) {
4502         case resume_TRIE1:
4503             goto resume_point_TRIE1;
4504         case resume_TRIE2:
4505             goto resume_point_TRIE2;
4506         case resume_CURLYX:
4507             goto resume_point_CURLYX;
4508         case resume_WHILEM1:
4509             goto resume_point_WHILEM1;
4510         case resume_WHILEM2:
4511             goto resume_point_WHILEM2;
4512         case resume_WHILEM3:
4513             goto resume_point_WHILEM3;
4514         case resume_WHILEM4:
4515             goto resume_point_WHILEM4;
4516         case resume_WHILEM5:
4517             goto resume_point_WHILEM5;
4518         case resume_WHILEM6:
4519             goto resume_point_WHILEM6;
4520         case resume_CURLYM1:
4521             goto resume_point_CURLYM1;
4522         case resume_CURLYM2:
4523             goto resume_point_CURLYM2;
4524         case resume_CURLYM3:
4525             goto resume_point_CURLYM3;
4526         case resume_CURLYM4:
4527             goto resume_point_CURLYM4;
4528         case resume_IFMATCH:
4529             goto resume_point_IFMATCH;
4530         case resume_PLUS1:
4531             goto resume_point_PLUS1;
4532         case resume_PLUS2:
4533             goto resume_point_PLUS2;
4534         case resume_PLUS3:
4535             goto resume_point_PLUS3;
4536         case resume_PLUS4:
4537             goto resume_point_PLUS4;
4538         case resume_END:
4539             goto resume_point_END;
4540         default:
4541             Perl_croak(aTHX_ "regexp resume memory corruption");
4542         }
4543         /* NOTREACHED */
4544     }
4545     /* restore original high-water mark */
4546     PL_regmatch_slab  = orig_slab;
4547     PL_regmatch_state = orig_state;
4548
4549     /* free all slabs above current one */
4550     if (orig_slab->next) {
4551         regmatch_slab *osl, *sl = orig_slab->next;
4552         orig_slab->next = NULL;
4553         while (sl) {
4554             osl = sl;
4555             sl = sl->next;
4556             Safefree(osl);
4557         }
4558     }
4559
4560     return result;
4561
4562 }
4563
4564 /*
4565  - regrepeat - repeatedly match something simple, report how many
4566  */
4567 /*
4568  * [This routine now assumes that it will only match on things of length 1.
4569  * That was true before, but now we assume scan - reginput is the count,
4570  * rather than incrementing count on every character.  [Er, except utf8.]]
4571  */
4572 STATIC I32
4573 S_regrepeat(pTHX_ const regnode *p, I32 max)
4574 {
4575     dVAR;
4576     register char *scan;
4577     register I32 c;
4578     register char *loceol = PL_regeol;
4579     register I32 hardcount = 0;
4580     register bool do_utf8 = PL_reg_match_utf8;
4581
4582     scan = PL_reginput;
4583     if (max == REG_INFTY)
4584         max = I32_MAX;
4585     else if (max < loceol - scan)
4586         loceol = scan + max;
4587     switch (OP(p)) {
4588     case REG_ANY:
4589         if (do_utf8) {
4590             loceol = PL_regeol;
4591             while (scan < loceol && hardcount < max && *scan != '\n') {
4592                 scan += UTF8SKIP(scan);
4593                 hardcount++;
4594             }
4595         } else {
4596             while (scan < loceol && *scan != '\n')
4597                 scan++;
4598         }
4599         break;
4600     case SANY:
4601         if (do_utf8) {
4602             loceol = PL_regeol;
4603             while (scan < loceol && hardcount < max) {
4604                 scan += UTF8SKIP(scan);
4605                 hardcount++;
4606             }
4607         }
4608         else
4609             scan = loceol;
4610         break;
4611     case CANY:
4612         scan = loceol;
4613         break;
4614     case EXACT:         /* length of string is 1 */
4615         c = (U8)*STRING(p);
4616         while (scan < loceol && UCHARAT(scan) == c)
4617             scan++;
4618         break;
4619     case EXACTF:        /* length of string is 1 */
4620         c = (U8)*STRING(p);
4621         while (scan < loceol &&
4622                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
4623             scan++;
4624         break;
4625     case EXACTFL:       /* length of string is 1 */
4626         PL_reg_flags |= RF_tainted;
4627         c = (U8)*STRING(p);
4628         while (scan < loceol &&
4629                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
4630             scan++;
4631         break;
4632     case ANYOF:
4633         if (do_utf8) {
4634             loceol = PL_regeol;
4635             while (hardcount < max && scan < loceol &&
4636                    reginclass(p, (U8*)scan, 0, do_utf8)) {
4637                 scan += UTF8SKIP(scan);
4638                 hardcount++;
4639             }
4640         } else {
4641             while (scan < loceol && REGINCLASS(p, (U8*)scan))
4642                 scan++;
4643         }
4644         break;
4645     case ALNUM:
4646         if (do_utf8) {
4647             loceol = PL_regeol;
4648             LOAD_UTF8_CHARCLASS_ALNUM();
4649             while (hardcount < max && scan < loceol &&
4650                    swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
4651                 scan += UTF8SKIP(scan);
4652                 hardcount++;
4653             }
4654         } else {
4655             while (scan < loceol && isALNUM(*scan))
4656                 scan++;
4657         }
4658         break;
4659     case ALNUML:
4660         PL_reg_flags |= RF_tainted;
4661         if (do_utf8) {
4662             loceol = PL_regeol;
4663             while (hardcount < max && scan < loceol &&
4664                    isALNUM_LC_utf8((U8*)scan)) {
4665                 scan += UTF8SKIP(scan);
4666                 hardcount++;
4667             }
4668         } else {
4669             while (scan < loceol && isALNUM_LC(*scan))
4670                 scan++;
4671         }
4672         break;
4673     case NALNUM:
4674         if (do_utf8) {
4675             loceol = PL_regeol;
4676             LOAD_UTF8_CHARCLASS_ALNUM();
4677             while (hardcount < max && scan < loceol &&
4678                    !swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
4679                 scan += UTF8SKIP(scan);
4680                 hardcount++;
4681             }
4682         } else {
4683             while (scan < loceol && !isALNUM(*scan))
4684                 scan++;
4685         }
4686         break;
4687     case NALNUML:
4688         PL_reg_flags |= RF_tainted;
4689         if (do_utf8) {
4690             loceol = PL_regeol;
4691             while (hardcount < max && scan < loceol &&
4692                    !isALNUM_LC_utf8((U8*)scan)) {
4693                 scan += UTF8SKIP(scan);
4694                 hardcount++;
4695             }
4696         } else {
4697             while (scan < loceol && !isALNUM_LC(*scan))
4698                 scan++;
4699         }
4700         break;
4701     case SPACE:
4702         if (do_utf8) {
4703             loceol = PL_regeol;
4704             LOAD_UTF8_CHARCLASS_SPACE();
4705             while (hardcount < max && scan < loceol &&
4706                    (*scan == ' ' ||
4707                     swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
4708                 scan += UTF8SKIP(scan);
4709                 hardcount++;
4710             }
4711         } else {
4712             while (scan < loceol && isSPACE(*scan))
4713                 scan++;
4714         }
4715         break;
4716     case SPACEL:
4717         PL_reg_flags |= RF_tainted;
4718         if (do_utf8) {
4719             loceol = PL_regeol;
4720             while (hardcount < max && scan < loceol &&
4721                    (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
4722                 scan += UTF8SKIP(scan);
4723                 hardcount++;
4724             }
4725         } else {
4726             while (scan < loceol && isSPACE_LC(*scan))
4727                 scan++;
4728         }
4729         break;
4730     case NSPACE:
4731         if (do_utf8) {
4732             loceol = PL_regeol;
4733             LOAD_UTF8_CHARCLASS_SPACE();
4734             while (hardcount < max && scan < loceol &&
4735                    !(*scan == ' ' ||
4736                      swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
4737                 scan += UTF8SKIP(scan);
4738                 hardcount++;
4739             }
4740         } else {
4741             while (scan < loceol && !isSPACE(*scan))
4742                 scan++;
4743             break;
4744         }
4745     case NSPACEL:
4746         PL_reg_flags |= RF_tainted;
4747         if (do_utf8) {
4748             loceol = PL_regeol;
4749             while (hardcount < max && scan < loceol &&
4750                    !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
4751                 scan += UTF8SKIP(scan);
4752                 hardcount++;
4753             }
4754         } else {
4755             while (scan < loceol && !isSPACE_LC(*scan))
4756                 scan++;
4757         }
4758         break;
4759     case DIGIT:
4760         if (do_utf8) {
4761             loceol = PL_regeol;
4762             LOAD_UTF8_CHARCLASS_DIGIT();
4763             while (hardcount < max && scan < loceol &&
4764                    swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4765                 scan += UTF8SKIP(scan);
4766                 hardcount++;
4767             }
4768         } else {
4769             while (scan < loceol && isDIGIT(*scan))
4770                 scan++;
4771         }
4772         break;
4773     case NDIGIT:
4774         if (do_utf8) {
4775             loceol = PL_regeol;
4776             LOAD_UTF8_CHARCLASS_DIGIT();
4777             while (hardcount < max && scan < loceol &&
4778                    !swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4779                 scan += UTF8SKIP(scan);
4780                 hardcount++;
4781             }
4782         } else {
4783             while (scan < loceol && !isDIGIT(*scan))
4784                 scan++;
4785         }
4786         break;
4787     default:            /* Called on something of 0 width. */
4788         break;          /* So match right here or not at all. */
4789     }
4790
4791     if (hardcount)
4792         c = hardcount;
4793     else
4794         c = scan - PL_reginput;
4795     PL_reginput = scan;
4796
4797     DEBUG_r({
4798                 SV *re_debug_flags = NULL;
4799                 SV * const prop = sv_newmortal();
4800                 GET_RE_DEBUG_FLAGS;
4801                 DEBUG_EXECUTE_r({
4802                 regprop(prop, p);
4803                 PerlIO_printf(Perl_debug_log,
4804                               "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
4805                               REPORT_CODE_OFF+1, "", SvPVX_const(prop),(IV)c,(IV)max);
4806         });
4807         });
4808
4809     return(c);
4810 }
4811
4812
4813 /*
4814 - regclass_swash - prepare the utf8 swash
4815 */
4816
4817 SV *
4818 Perl_regclass_swash(pTHX_ register const regnode* node, bool doinit, SV** listsvp, SV **altsvp)
4819 {
4820     dVAR;
4821     SV *sw  = NULL;
4822     SV *si  = NULL;
4823     SV *alt = NULL;
4824     const struct reg_data *data = PL_reg_re ? PL_reg_re->data : NULL;
4825
4826     if (data && data->count) {
4827         const U32 n = ARG(node);
4828
4829         if (data->what[n] == 's') {
4830             SV * const rv = (SV*)data->data[n];
4831             AV * const av = (AV*)SvRV((SV*)rv);
4832             SV **const ary = AvARRAY(av);
4833             SV **a, **b;
4834
4835             /* See the end of regcomp.c:S_regclass() for
4836              * documentation of these array elements. */
4837
4838             si = *ary;
4839             a  = SvROK(ary[1]) ? &ary[1] : 0;
4840             b  = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : 0;
4841
4842             if (a)
4843                 sw = *a;
4844             else if (si && doinit) {
4845                 sw = swash_init("utf8", "", si, 1, 0);
4846                 (void)av_store(av, 1, sw);
4847             }
4848             if (b)
4849                 alt = *b;
4850         }
4851     }
4852
4853     if (listsvp)
4854         *listsvp = si;
4855     if (altsvp)
4856         *altsvp  = alt;
4857
4858     return sw;
4859 }
4860
4861 /*
4862  - reginclass - determine if a character falls into a character class
4863
4864   The n is the ANYOF regnode, the p is the target string, lenp
4865   is pointer to the maximum length of how far to go in the p
4866   (if the lenp is zero, UTF8SKIP(p) is used),
4867   do_utf8 tells whether the target string is in UTF-8.
4868
4869  */
4870
4871 STATIC bool
4872 S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp, register bool do_utf8)
4873 {
4874     dVAR;
4875     const char flags = ANYOF_FLAGS(n);
4876     bool match = FALSE;
4877     UV c = *p;
4878     STRLEN len = 0;
4879     STRLEN plen;
4880
4881     if (do_utf8 && !UTF8_IS_INVARIANT(c)) {
4882         c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &len,
4883                 (UTF8_ALLOW_DEFAULT & UTF8_ALLOW_ANYUV) | UTF8_CHECK_ONLY);
4884                 /* see [perl #37836] for UTF8_ALLOW_ANYUV */
4885         if (len == (STRLEN)-1)
4886             Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
4887     }
4888
4889     plen = lenp ? *lenp : UNISKIP(NATIVE_TO_UNI(c));
4890     if (do_utf8 || (flags & ANYOF_UNICODE)) {
4891         if (lenp)
4892             *lenp = 0;
4893         if (do_utf8 && !ANYOF_RUNTIME(n)) {
4894             if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
4895                 match = TRUE;
4896         }
4897         if (!match && do_utf8 && (flags & ANYOF_UNICODE_ALL) && c >= 256)
4898             match = TRUE;
4899         if (!match) {
4900             AV *av;
4901             SV * const sw = regclass_swash(n, TRUE, 0, (SV**)&av);
4902
4903             if (sw) {
4904                 if (swash_fetch(sw, p, do_utf8))
4905                     match = TRUE;
4906                 else if (flags & ANYOF_FOLD) {
4907                     if (!match && lenp && av) {
4908                         I32 i;
4909                         for (i = 0; i <= av_len(av); i++) {
4910                             SV* const sv = *av_fetch(av, i, FALSE);
4911                             STRLEN len;
4912                             const char * const s = SvPV_const(sv, len);
4913
4914                             if (len <= plen && memEQ(s, (char*)p, len)) {
4915                                 *lenp = len;
4916                                 match = TRUE;
4917                                 break;
4918                             }
4919                         }
4920                     }
4921                     if (!match) {
4922                         U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
4923                         STRLEN tmplen;
4924
4925                         to_utf8_fold(p, tmpbuf, &tmplen);
4926                         if (swash_fetch(sw, tmpbuf, do_utf8))
4927                             match = TRUE;
4928                     }
4929                 }
4930             }
4931         }
4932         if (match && lenp && *lenp == 0)
4933             *lenp = UNISKIP(NATIVE_TO_UNI(c));
4934     }
4935     if (!match && c < 256) {
4936         if (ANYOF_BITMAP_TEST(n, c))
4937             match = TRUE;
4938         else if (flags & ANYOF_FOLD) {
4939             U8 f;
4940
4941             if (flags & ANYOF_LOCALE) {
4942                 PL_reg_flags |= RF_tainted;
4943                 f = PL_fold_locale[c];
4944             }
4945             else
4946                 f = PL_fold[c];
4947             if (f != c && ANYOF_BITMAP_TEST(n, f))
4948                 match = TRUE;
4949         }
4950
4951         if (!match && (flags & ANYOF_CLASS)) {
4952             PL_reg_flags |= RF_tainted;
4953             if (
4954                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
4955                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
4956                 (ANYOF_CLASS_TEST(n, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
4957                 (ANYOF_CLASS_TEST(n, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
4958                 (ANYOF_CLASS_TEST(n, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
4959                 (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
4960                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
4961                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
4962                 (ANYOF_CLASS_TEST(n, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
4963                 (ANYOF_CLASS_TEST(n, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
4964                 (ANYOF_CLASS_TEST(n, ANYOF_ASCII)   &&  isASCII(c))     ||
4965                 (ANYOF_CLASS_TEST(n, ANYOF_NASCII)  && !isASCII(c))     ||
4966                 (ANYOF_CLASS_TEST(n, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
4967                 (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
4968                 (ANYOF_CLASS_TEST(n, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
4969                 (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
4970                 (ANYOF_CLASS_TEST(n, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
4971                 (ANYOF_CLASS_TEST(n, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
4972                 (ANYOF_CLASS_TEST(n, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
4973                 (ANYOF_CLASS_TEST(n, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
4974                 (ANYOF_CLASS_TEST(n, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
4975                 (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
4976                 (ANYOF_CLASS_TEST(n, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
4977                 (ANYOF_CLASS_TEST(n, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
4978                 (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
4979                 (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c))    ||
4980                 (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC)  &&  isPSXSPC(c))    ||
4981                 (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c))    ||
4982                 (ANYOF_CLASS_TEST(n, ANYOF_BLANK)   &&  isBLANK(c))     ||
4983                 (ANYOF_CLASS_TEST(n, ANYOF_NBLANK)  && !isBLANK(c))
4984                 ) /* How's that for a conditional? */
4985             {
4986                 match = TRUE;
4987             }
4988         }
4989     }
4990
4991     return (flags & ANYOF_INVERT) ? !match : match;
4992 }
4993
4994 STATIC U8 *
4995 S_reghop3(U8 *s, I32 off, U8* lim)
4996 {
4997     dVAR;
4998     if (off >= 0) {
4999         while (off-- && s < lim) {
5000             /* XXX could check well-formedness here */
5001             s += UTF8SKIP(s);
5002         }
5003     }
5004     else {
5005         while (off++) {
5006             if (s > lim) {
5007                 s--;
5008                 if (UTF8_IS_CONTINUED(*s)) {
5009                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
5010                         s--;
5011                 }
5012                 /* XXX could check well-formedness here */
5013             }
5014         }
5015     }
5016     return s;
5017 }
5018
5019 STATIC U8 *
5020 S_reghopmaybe3(U8* s, I32 off, U8* lim)
5021 {
5022     dVAR;
5023     if (off >= 0) {
5024         while (off-- && s < lim) {
5025             /* XXX could check well-formedness here */
5026             s += UTF8SKIP(s);
5027         }
5028         if (off >= 0)
5029             return 0;
5030     }
5031     else {
5032         while (off++) {
5033             if (s > lim) {
5034                 s--;
5035                 if (UTF8_IS_CONTINUED(*s)) {
5036                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
5037                         s--;
5038                 }
5039                 /* XXX could check well-formedness here */
5040             }
5041             else
5042                 break;
5043         }
5044         if (off <= 0)
5045             return 0;
5046     }
5047     return s;
5048 }
5049
5050 static void
5051 restore_pos(pTHX_ void *arg)
5052 {
5053     dVAR;
5054     regexp *rex = (regexp *)arg;
5055     if (PL_reg_eval_set) {
5056         if (PL_reg_oldsaved) {
5057             rex->subbeg = PL_reg_oldsaved;
5058             rex->sublen = PL_reg_oldsavedlen;
5059 #ifdef PERL_OLD_COPY_ON_WRITE
5060             rex->saved_copy = PL_nrs;
5061 #endif
5062             RX_MATCH_COPIED_on(rex);
5063         }
5064         PL_reg_magic->mg_len = PL_reg_oldpos;
5065         PL_reg_eval_set = 0;
5066         PL_curpm = PL_reg_oldcurpm;
5067     }
5068 }
5069
5070 STATIC void
5071 S_to_utf8_substr(pTHX_ register regexp *prog)
5072 {
5073     if (prog->float_substr && !prog->float_utf8) {
5074         SV* sv;
5075         prog->float_utf8 = sv = newSVsv(prog->float_substr);
5076         sv_utf8_upgrade(sv);
5077         if (SvTAIL(prog->float_substr))
5078             SvTAIL_on(sv);
5079         if (prog->float_substr == prog->check_substr)
5080             prog->check_utf8 = sv;
5081     }
5082     if (prog->anchored_substr && !prog->anchored_utf8) {
5083         SV* sv;
5084         prog->anchored_utf8 = sv = newSVsv(prog->anchored_substr);
5085         sv_utf8_upgrade(sv);
5086         if (SvTAIL(prog->anchored_substr))
5087             SvTAIL_on(sv);
5088         if (prog->anchored_substr == prog->check_substr)
5089             prog->check_utf8 = sv;
5090     }
5091 }
5092
5093 STATIC void
5094 S_to_byte_substr(pTHX_ register regexp *prog)
5095 {
5096     dVAR;
5097     if (prog->float_utf8 && !prog->float_substr) {
5098         SV* sv;
5099         prog->float_substr = sv = newSVsv(prog->float_utf8);
5100         if (sv_utf8_downgrade(sv, TRUE)) {
5101             if (SvTAIL(prog->float_utf8))
5102                 SvTAIL_on(sv);
5103         } else {
5104             SvREFCNT_dec(sv);
5105             prog->float_substr = sv = &PL_sv_undef;
5106         }
5107         if (prog->float_utf8 == prog->check_utf8)
5108             prog->check_substr = sv;
5109     }
5110     if (prog->anchored_utf8 && !prog->anchored_substr) {
5111         SV* sv;
5112         prog->anchored_substr = sv = newSVsv(prog->anchored_utf8);
5113         if (sv_utf8_downgrade(sv, TRUE)) {
5114             if (SvTAIL(prog->anchored_utf8))
5115                 SvTAIL_on(sv);
5116         } else {
5117             SvREFCNT_dec(sv);
5118             prog->anchored_substr = sv = &PL_sv_undef;
5119         }
5120         if (prog->anchored_utf8 == prog->check_utf8)
5121             prog->check_substr = sv;
5122     }
5123 }
5124
5125 /*
5126  * Local variables:
5127  * c-indentation-style: bsd
5128  * c-basic-offset: 4
5129  * indent-tabs-mode: t
5130  * End:
5131  *
5132  * ex: set ts=8 sts=4 sw=4 noet:
5133  */