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