regexec.c

   1 /*    regexec.c
   2  */
   3
   4 /*
   5  * "One Ring to rule them all, One Ring to find them..."
   6  */
   7
   8 /* This file contains functions for executing a regular expression.  See
   9  * also regcomp.c which funnily enough, contains functions for compiling
  10  * a regular expression.
  11  *
  12  * This file is also copied at build time to ext/re/re_exec.c, where
  13  * it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
  14  * This causes the main functions to be compiled under new names and with
  15  * debugging support added, which makes "use re 'debug'" work.
  16
  17  */
  18
  19 /* NOTE: this is derived from Henry Spencer's regexp code, and should not
  20  * confused with the original package (see point 3 below).  Thanks, Henry!
  21  */
  22
  23 /* Additional note: this code is very heavily munged from Henry's version
  24  * in places.  In some spots I've traded clarity for efficiency, so don't
  25  * blame Henry for some of the lack of readability.
  26  */
  27
  28 /* The names of the functions have been changed from regcomp and
  29  * regexec to  pregcomp and pregexec in order to avoid conflicts
  30  * with the POSIX routines of the same names.
  31 */
  32
  33 #ifdef PERL_EXT_RE_BUILD
  34 /* need to replace pregcomp et al, so enable that */
  35 #  ifndef PERL_IN_XSUB_RE
  36 #    define PERL_IN_XSUB_RE
  37 #  endif
  38 /* need access to debugger hooks */
  39 #  if defined(PERL_EXT_RE_DEBUG) && !defined(DEBUGGING)
  40 #    define DEBUGGING
  41 #  endif
  42 #endif
  43
  44 #ifdef PERL_IN_XSUB_RE
  45 /* We *really* need to overwrite these symbols: */
  46 #  define Perl_regexec_flags my_regexec
  47 #  define Perl_regdump my_regdump
  48 #  define Perl_regprop my_regprop
  49 #  define Perl_re_intuit_start my_re_intuit_start
  50 /* *These* symbols are masked to allow static link. */
  51 #  define Perl_pregexec my_pregexec
  52 #  define Perl_reginitcolors my_reginitcolors
  53 #  define Perl_regclass_swash my_regclass_swash
  54
  55 #  define PERL_NO_GET_CONTEXT
  56 #endif
  57
  58 /*
  59  * pregcomp and pregexec -- regsub and regerror are not used in perl
  60  *
  61  *      Copyright (c) 1986 by University of Toronto.
  62  *      Written by Henry Spencer.  Not derived from licensed software.
  63  *
  64  *      Permission is granted to anyone to use this software for any
  65  *      purpose on any computer system, and to redistribute it freely,
  66  *      subject to the following restrictions:
  67  *
  68  *      1. The author is not responsible for the consequences of use of
  69  *              this software, no matter how awful, even if they arise
  70  *              from defects in it.
  71  *
  72  *      2. The origin of this software must not be misrepresented, either
  73  *              by explicit claim or by omission.
  74  *
  75  *      3. Altered versions must be plainly marked as such, and must not
  76  *              be misrepresented as being the original software.
  77  *
  78  ****    Alterations to Henry's code are...
  79  ****
  80  ****    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
  81  ****    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
  82  ****
  83  ****    You may distribute under the terms of either the GNU General Public
  84  ****    License or the Artistic License, as specified in the README file.
  85  *
  86  * Beware that some of this code is subtly aware of the way operator
  87  * precedence is structured in regular expressions.  Serious changes in
  88  * regular-expression syntax might require a total rethink.
  89  */
  90 #include "EXTERN.h"
  91 #define PERL_IN_REGEXEC_C
  92 #include "perl.h"
  93
  94 #include "regcomp.h"
  95
  96 #define RF_tainted      1               /* tainted information used? */
  97 #define RF_warned       2               /* warned about big count? */
  98 #define RF_evaled       4               /* Did an EVAL with setting? */
  99 #define RF_utf8         8               /* String contains multibyte chars? */
 100
 101 #define UTF ((PL_reg_flags & RF_utf8) != 0)
 102
 103 #define RS_init         1               /* eval environment created */
 104 #define RS_set          2               /* replsv value is set */
 105
 106 #ifndef STATIC
 107 #define STATIC  static
 108 #endif
 109
 110 #define REGINCLASS(p,c)  (ANYOF_FLAGS(p) ? reginclass(p,c,0,0) : ANYOF_BITMAP_TEST(p,*(c)))
 111
 112 /*
 113  * Forwards.
 114  */
 115
 116 #define CHR_SVLEN(sv) (do_utf8 ? sv_len_utf8(sv) : SvCUR(sv))
 117 #define CHR_DIST(a,b) (PL_reg_match_utf8 ? utf8_distance(a,b) : a - b)
 118
 119 #define reghop_c(pos,off) ((char*)reghop((U8*)pos, off))
 120 #define reghopmaybe_c(pos,off) ((char*)reghopmaybe((U8*)pos, off))
 121 #define HOP(pos,off) (PL_reg_match_utf8 ? reghop((U8*)pos, off) : (U8*)(pos + off))
 122 #define HOPMAYBE(pos,off) (PL_reg_match_utf8 ? reghopmaybe((U8*)pos, off) : (U8*)(pos + off))
 123 #define HOPc(pos,off) ((char*)HOP(pos,off))
 124 #define HOPMAYBEc(pos,off) ((char*)HOPMAYBE(pos,off))
 125
 126 #define HOPBACK(pos, off) (             \
 127     (PL_reg_match_utf8)                 \
 128         ? reghopmaybe((U8*)pos, -off)   \
 129     : (pos - off >= PL_bostr)           \
 130         ? (U8*)(pos - off)              \
 131     : (U8*)NULL                         \
 132 )
 133 #define HOPBACKc(pos, off) (char*)HOPBACK(pos, off)
 134
 135 #define reghop3_c(pos,off,lim) ((char*)reghop3((U8*)pos, off, (U8*)lim))
 136 #define reghopmaybe3_c(pos,off,lim) ((char*)reghopmaybe3((U8*)pos, off, (U8*)lim))
 137 #define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
 138 #define HOPMAYBE3(pos,off,lim) (PL_reg_match_utf8 ? reghopmaybe3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
 139 #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
 140 #define HOPMAYBE3c(pos,off,lim) ((char*)HOPMAYBE3(pos,off,lim))
 141
 142 #define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \
 143     if (!CAT2(PL_utf8_,class)) { bool ok; ENTER; save_re_context(); ok=CAT2(is_utf8_,class)((const U8*)str); assert(ok); LEAVE; } } STMT_END
 144 #define LOAD_UTF8_CHARCLASS_ALNUM() LOAD_UTF8_CHARCLASS(alnum,"a")
 145 #define LOAD_UTF8_CHARCLASS_DIGIT() LOAD_UTF8_CHARCLASS(digit,"0")
 146 #define LOAD_UTF8_CHARCLASS_SPACE() LOAD_UTF8_CHARCLASS(space," ")
 147 #define LOAD_UTF8_CHARCLASS_MARK()  LOAD_UTF8_CHARCLASS(mark, "\xcd\x86")
 148
 149 /* for use after a quantifier and before an EXACT-like node -- japhy */
 150 #define JUMPABLE(rn) ( \
 151     OP(rn) == OPEN || OP(rn) == CLOSE || OP(rn) == EVAL || \
 152     OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
 153     OP(rn) == PLUS || OP(rn) == MINMOD || \
 154     (PL_regkind[(U8)OP(rn)] == CURLY && ARG1(rn) > 0) \
 155 )
 156
 157 #define HAS_TEXT(rn) ( \
 158     PL_regkind[(U8)OP(rn)] == EXACT || PL_regkind[(U8)OP(rn)] == REF \
 159 )
 160
 161 /*
 162   Search for mandatory following text node; for lookahead, the text must
 163   follow but for lookbehind (rn->flags != 0) we skip to the next step.
 164 */
 165 #define FIND_NEXT_IMPT(rn) STMT_START { \
 166     while (JUMPABLE(rn)) \
 167         if (OP(rn) == SUSPEND || PL_regkind[(U8)OP(rn)] == CURLY) \
 168             rn = NEXTOPER(NEXTOPER(rn)); \
 169         else if (OP(rn) == PLUS) \
 170             rn = NEXTOPER(rn); \
 171         else if (OP(rn) == IFMATCH) \
 172             rn = (rn->flags == 0) ? NEXTOPER(NEXTOPER(rn)) : rn + ARG(rn); \
 173         else rn += NEXT_OFF(rn); \
 174 } STMT_END
 175
 176 static void restore_pos(pTHX_ void *arg);
 177
 178 STATIC CHECKPOINT
 179 S_regcppush(pTHX_ I32 parenfloor)
 180 {
 181     dVAR;
 182     const int retval = PL_savestack_ix;
 183 #define REGCP_PAREN_ELEMS 4
 184     const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS;
 185     int p;
 186
 187     if (paren_elems_to_push < 0)
 188         Perl_croak(aTHX_ "panic: paren_elems_to_push < 0");
 189
 190 #define REGCP_OTHER_ELEMS 6
 191     SSGROW(paren_elems_to_push + REGCP_OTHER_ELEMS);
 192     for (p = PL_regsize; p > parenfloor; p--) {
 193 /* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
 194         SSPUSHINT(PL_regendp[p]);
 195         SSPUSHINT(PL_regstartp[p]);
 196         SSPUSHPTR(PL_reg_start_tmp[p]);
 197         SSPUSHINT(p);
 198     }
 199 /* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
 200     SSPUSHINT(PL_regsize);
 201     SSPUSHINT(*PL_reglastparen);
 202     SSPUSHINT(*PL_reglastcloseparen);
 203     SSPUSHPTR(PL_reginput);
 204 #define REGCP_FRAME_ELEMS 2
 205 /* REGCP_FRAME_ELEMS are part of the REGCP_OTHER_ELEMS and
 206  * are needed for the regexp context stack bookkeeping. */
 207     SSPUSHINT(paren_elems_to_push + REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
 208     SSPUSHINT(SAVEt_REGCONTEXT); /* Magic cookie. */
 209
 210     return retval;
 211 }
 212
 213 /* These are needed since we do not localize EVAL nodes: */
 214 #  define REGCP_SET(cp)  DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,          \
 215                              "  Setting an EVAL scope, savestack=%"IVdf"\n",    \
 216                              (IV)PL_savestack_ix)); cp = PL_savestack_ix
 217
 218 #  define REGCP_UNWIND(cp)  DEBUG_EXECUTE_r(cp != PL_savestack_ix ?             \
 219                                 PerlIO_printf(Perl_debug_log,           \
 220                                 "  Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
 221                                 (IV)(cp), (IV)PL_savestack_ix) : 0); regcpblow(cp)
 222
 223 STATIC char *
 224 S_regcppop(pTHX)
 225 {
 226     dVAR;
 227     I32 i;
 228     U32 paren = 0;
 229     char *input;
 230
 231     GET_RE_DEBUG_FLAGS_DECL;
 232
 233     /* Pop REGCP_OTHER_ELEMS before the parentheses loop starts. */
 234     i = SSPOPINT;
 235     assert(i == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
 236     i = SSPOPINT; /* Parentheses elements to pop. */
 237     input = (char *) SSPOPPTR;
 238     *PL_reglastcloseparen = SSPOPINT;
 239     *PL_reglastparen = SSPOPINT;
 240     PL_regsize = SSPOPINT;
 241
 242     /* Now restore the parentheses context. */
 243     for (i -= (REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
 244          i > 0; i -= REGCP_PAREN_ELEMS) {
 245         I32 tmps;
 246         paren = (U32)SSPOPINT;
 247         PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
 248         PL_regstartp[paren] = SSPOPINT;
 249         tmps = SSPOPINT;
 250         if (paren <= *PL_reglastparen)
 251             PL_regendp[paren] = tmps;
 252         DEBUG_EXECUTE_r(
 253             PerlIO_printf(Perl_debug_log,
 254                           "     restoring \\%"UVuf" to %"IVdf"(%"IVdf")..%"IVdf"%s\n",
 255                           (UV)paren, (IV)PL_regstartp[paren],
 256                           (IV)(PL_reg_start_tmp[paren] - PL_bostr),
 257                           (IV)PL_regendp[paren],
 258                           (paren > *PL_reglastparen ? "(no)" : ""));
 259         );
 260     }
 261     DEBUG_EXECUTE_r(
 262         if ((I32)(*PL_reglastparen + 1) <= PL_regnpar) {
 263             PerlIO_printf(Perl_debug_log,
 264                           "     restoring \\%"IVdf"..\\%"IVdf" to undef\n",
 265                           (IV)(*PL_reglastparen + 1), (IV)PL_regnpar);
 266         }
 267     );
 268 #if 1
 269     /* It would seem that the similar code in regtry()
 270      * already takes care of this, and in fact it is in
 271      * a better location to since this code can #if 0-ed out
 272      * but the code in regtry() is needed or otherwise tests
 273      * requiring null fields (pat.t#187 and split.t#{13,14}
 274      * (as of patchlevel 7877)  will fail.  Then again,
 275      * this code seems to be necessary or otherwise
 276      * building DynaLoader will fail:
 277      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
 278      * --jhi */
 279     for (paren = *PL_reglastparen + 1; (I32)paren <= PL_regnpar; paren++) {
 280         if ((I32)paren > PL_regsize)
 281             PL_regstartp[paren] = -1;
 282         PL_regendp[paren] = -1;
 283     }
 284 #endif
 285     return input;
 286 }
 287
 288 typedef struct re_cc_state
 289 {
 290     I32 ss;
 291     regnode *node;
 292     struct re_cc_state *prev;
 293     CURCUR *cc;
 294     regexp *re;
 295 } re_cc_state;
 296
 297 #define regcpblow(cp) LEAVE_SCOPE(cp)   /* Ignores regcppush()ed data. */
 298
 299 #define TRYPAREN(paren, n, input) {                             \
 300     if (paren) {                                                \
 301         if (n) {                                                \
 302             PL_regstartp[paren] = HOPc(input, -1) - PL_bostr;   \
 303             PL_regendp[paren] = input - PL_bostr;               \
 304         }                                                       \
 305         else                                                    \
 306             PL_regendp[paren] = -1;                             \
 307     }                                                           \
 308     if (regmatch(next))                                         \
 309         sayYES;                                                 \
 310     if (paren && n)                                             \
 311         PL_regendp[paren] = -1;                                 \
 312 }
 313
 314
 315 /*
 316  * pregexec and friends
 317  */
 318
 319 /*
 320  - pregexec - match a regexp against a string
 321  */
 322 I32
 323 Perl_pregexec(pTHX_ register regexp *prog, char *stringarg, register char *strend,
 324          char *strbeg, I32 minend, SV *screamer, U32 nosave)
 325 /* strend: pointer to null at end of string */
 326 /* strbeg: real beginning of string */
 327 /* minend: end of match must be >=minend after stringarg. */
 328 /* nosave: For optimizations. */
 329 {
 330     return
 331         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
 332                       nosave ? 0 : REXEC_COPY_STR);
 333 }
 334
 335 STATIC void
 336 S_cache_re(pTHX_ regexp *prog)
 337 {
 338     dVAR;
 339     PL_regprecomp = prog->precomp;              /* Needed for FAIL. */
 340 #ifdef DEBUGGING
 341     PL_regprogram = prog->program;
 342 #endif
 343     PL_regnpar = prog->nparens;
 344     PL_regdata = prog->data;
 345     PL_reg_re = prog;
 346 }
 347
 348 /*
 349  * Need to implement the following flags for reg_anch:
 350  *
 351  * USE_INTUIT_NOML              - Useful to call re_intuit_start() first
 352  * USE_INTUIT_ML
 353  * INTUIT_AUTORITATIVE_NOML     - Can trust a positive answer
 354  * INTUIT_AUTORITATIVE_ML
 355  * INTUIT_ONCE_NOML             - Intuit can match in one location only.
 356  * INTUIT_ONCE_ML
 357  *
 358  * Another flag for this function: SECOND_TIME (so that float substrs
 359  * with giant delta may be not rechecked).
 360  */
 361
 362 /* Assumptions: if ANCH_GPOS, then strpos is anchored. XXXX Check GPOS logic */
 363
 364 /* If SCREAM, then SvPVX_const(sv) should be compatible with strpos and strend.
 365    Otherwise, only SvCUR(sv) is used to get strbeg. */
 366
 367 /* XXXX We assume that strpos is strbeg unless sv. */
 368
 369 /* XXXX Some places assume that there is a fixed substring.
 370         An update may be needed if optimizer marks as "INTUITable"
 371         RExen without fixed substrings.  Similarly, it is assumed that
 372         lengths of all the strings are no more than minlen, thus they
 373         cannot come from lookahead.
 374         (Or minlen should take into account lookahead.) */
 375
 376 /* A failure to find a constant substring means that there is no need to make
 377    an expensive call to REx engine, thus we celebrate a failure.  Similarly,
 378    finding a substring too deep into the string means that less calls to
 379    regtry() should be needed.
 380
 381    REx compiler's optimizer found 4 possible hints:
 382         a) Anchored substring;
 383         b) Fixed substring;
 384         c) Whether we are anchored (beginning-of-line or \G);
 385         d) First node (of those at offset 0) which may distingush positions;
 386    We use a)b)d) and multiline-part of c), and try to find a position in the
 387    string which does not contradict any of them.
 388  */
 389
 390 /* Most of decisions we do here should have been done at compile time.
 391    The nodes of the REx which we used for the search should have been
 392    deleted from the finite automaton. */
 393
 394 char *
 395 Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 396                      char *strend, U32 flags, re_scream_pos_data *data)
 397 {
 398     dVAR;
 399     register I32 start_shift = 0;
 400     /* Should be nonnegative! */
 401     register I32 end_shift   = 0;
 402     register char *s;
 403     register SV *check;
 404     char *strbeg;
 405     char *t;
 406     const int do_utf8 = sv ? SvUTF8(sv) : 0;    /* if no sv we have to assume bytes */
 407     I32 ml_anch;
 408     register char *other_last = NULL;   /* other substr checked before this */
 409     char *check_at = NULL;              /* check substr found at this pos */
 410     const I32 multiline = prog->reganch & PMf_MULTILINE;
 411 #ifdef DEBUGGING
 412     const char * const i_strpos = strpos;
 413     SV * const dsv = PERL_DEBUG_PAD_ZERO(0);
 414 #endif
 415
 416     GET_RE_DEBUG_FLAGS_DECL;
 417
 418     RX_MATCH_UTF8_set(prog,do_utf8);
 419
 420     if (prog->reganch & ROPT_UTF8) {
 421         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 422                               "UTF-8 regex...\n"));
 423         PL_reg_flags |= RF_utf8;
 424     }
 425
 426     DEBUG_EXECUTE_r({
 427          const char *s   = PL_reg_match_utf8 ?
 428                          sv_uni_display(dsv, sv, 60, UNI_DISPLAY_REGEX) :
 429                          strpos;
 430          const int   len = PL_reg_match_utf8 ?
 431                          strlen(s) : strend - strpos;
 432          if (!PL_colorset)
 433               reginitcolors();
 434          if (PL_reg_match_utf8)
 435              DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 436                                    "UTF-8 target...\n"));
 437          PerlIO_printf(Perl_debug_log,
 438                        "%sGuessing start of match, REx%s \"%s%.60s%s%s\" against \"%s%.*s%s%s\"...\n",
 439                        PL_colors[4], PL_colors[5], PL_colors[0],
 440                        prog->precomp,
 441                        PL_colors[1],
 442                        (strlen(prog->precomp) > 60 ? "..." : ""),
 443                        PL_colors[0],
 444                        (int)(len > 60 ? 60 : len),
 445                        s, PL_colors[1],
 446                        (len > 60 ? "..." : "")
 447               );
 448     });
 449
 450     /* CHR_DIST() would be more correct here but it makes things slow. */
 451     if (prog->minlen > strend - strpos) {
 452         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 453                               "String too short... [re_intuit_start]\n"));
 454         goto fail;
 455     }
 456     strbeg = (sv && SvPOK(sv)) ? strend - SvCUR(sv) : strpos;
 457     PL_regeol = strend;
 458     if (do_utf8) {
 459         if (!prog->check_utf8 && prog->check_substr)
 460             to_utf8_substr(prog);
 461         check = prog->check_utf8;
 462     } else {
 463         if (!prog->check_substr && prog->check_utf8)
 464             to_byte_substr(prog);
 465         check = prog->check_substr;
 466     }
 467    if (check == &PL_sv_undef) {
 468         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 469                 "Non-utf string cannot match utf check string\n"));
 470         goto fail;
 471     }
 472     if (prog->reganch & ROPT_ANCH) {    /* Match at beg-of-str or after \n */
 473         ml_anch = !( (prog->reganch & ROPT_ANCH_SINGLE)
 474                      || ( (prog->reganch & ROPT_ANCH_BOL)
 475                           && !multiline ) );    /* Check after \n? */
 476
 477         if (!ml_anch) {
 478           if ( !(prog->reganch & (ROPT_ANCH_GPOS /* Checked by the caller */
 479                                   | ROPT_IMPLICIT)) /* not a real BOL */
 480                /* SvCUR is not set on references: SvRV and SvPVX_const overlap */
 481                && sv && !SvROK(sv)
 482                && (strpos != strbeg)) {
 483               DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
 484               goto fail;
 485           }
 486           if (prog->check_offset_min == prog->check_offset_max &&
 487               !(prog->reganch & ROPT_CANY_SEEN)) {
 488             /* Substring at constant offset from beg-of-str... */
 489             I32 slen;
 490
 491             s = HOP3c(strpos, prog->check_offset_min, strend);
 492             if (SvTAIL(check)) {
 493                 slen = SvCUR(check);    /* >= 1 */
 494
 495                 if ( strend - s > slen || strend - s < slen - 1
 496                      || (strend - s == slen && strend[-1] != '\n')) {
 497                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String too long...\n"));
 498                     goto fail_finish;
 499                 }
 500                 /* Now should match s[0..slen-2] */
 501                 slen--;
 502                 if (slen && (*SvPVX_const(check) != *s
 503                              || (slen > 1
 504                                  && memNE(SvPVX_const(check), s, slen)))) {
 505                   report_neq:
 506                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String not equal...\n"));
 507                     goto fail_finish;
 508                 }
 509             }
 510             else if (*SvPVX_const(check) != *s
 511                      || ((slen = SvCUR(check)) > 1
 512                          && memNE(SvPVX_const(check), s, slen)))
 513                 goto report_neq;
 514             check_at = s;
 515             goto success_at_start;
 516           }
 517         }
 518         /* Match is anchored, but substr is not anchored wrt beg-of-str. */
 519         s = strpos;
 520         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
 521         end_shift = prog->minlen - start_shift -
 522             CHR_SVLEN(check) + (SvTAIL(check) != 0);
 523         if (!ml_anch) {
 524             const I32 end = prog->check_offset_max + CHR_SVLEN(check)
 525                                          - (SvTAIL(check) != 0);
 526             const I32 eshift = CHR_DIST((U8*)strend, (U8*)s) - end;
 527
 528             if (end_shift < eshift)
 529                 end_shift = eshift;
 530         }
 531     }
 532     else {                              /* Can match at random position */
 533         ml_anch = 0;
 534         s = strpos;
 535         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
 536         /* Should be nonnegative! */
 537         end_shift = prog->minlen - start_shift -
 538             CHR_SVLEN(check) + (SvTAIL(check) != 0);
 539     }
 540
 541 #ifdef DEBUGGING        /* 7/99: reports of failure (with the older version) */
 542     if (end_shift < 0)
 543         Perl_croak(aTHX_ "panic: end_shift");
 544 #endif
 545
 546   restart:
 547     /* Find a possible match in the region s..strend by looking for
 548        the "check" substring in the region corrected by start/end_shift. */
 549     if (flags & REXEC_SCREAM) {
 550         I32 p = -1;                     /* Internal iterator of scream. */
 551         I32 * const pp = data ? data->scream_pos : &p;
 552
 553         if (PL_screamfirst[BmRARE(check)] >= 0
 554             || ( BmRARE(check) == '\n'
 555                  && (BmPREVIOUS(check) == SvCUR(check) - 1)
 556                  && SvTAIL(check) ))
 557             s = screaminstr(sv, check,
 558                             start_shift + (s - strbeg), end_shift, pp, 0);
 559         else
 560             goto fail_finish;
 561         /* we may be pointing at the wrong string */
 562         if (s && RX_MATCH_COPIED(prog))
 563             s = strbeg + (s - SvPVX_const(sv));
 564         if (data)
 565             *data->scream_olds = s;
 566     }
 567     else if (prog->reganch & ROPT_CANY_SEEN)
 568         s = fbm_instr((U8*)(s + start_shift),
 569                       (U8*)(strend - end_shift),
 570                       check, multiline ? FBMrf_MULTILINE : 0);
 571     else
 572         s = fbm_instr(HOP3(s, start_shift, strend),
 573                       HOP3(strend, -end_shift, strbeg),
 574                       check, multiline ? FBMrf_MULTILINE : 0);
 575
 576     /* Update the count-of-usability, remove useless subpatterns,
 577         unshift s.  */
 578
 579     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s %s substr \"%s%.*s%s\"%s%s",
 580                           (s ? "Found" : "Did not find"),
 581                           (check == (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) ? "anchored" : "floating"),
 582                           PL_colors[0],
 583                           (int)(SvCUR(check) - (SvTAIL(check)!=0)),
 584                           SvPVX_const(check),
 585                           PL_colors[1], (SvTAIL(check) ? "$" : ""),
 586                           (s ? " at offset " : "...\n") ) );
 587
 588     if (!s)
 589         goto fail_finish;
 590
 591     check_at = s;
 592
 593     /* Finish the diagnostic message */
 594     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - i_strpos)) );
 595
 596     /* Got a candidate.  Check MBOL anchoring, and the *other* substr.
 597        Start with the other substr.
 598        XXXX no SCREAM optimization yet - and a very coarse implementation
 599        XXXX /ttx+/ results in anchored="ttx", floating="x".  floating will
 600                 *always* match.  Probably should be marked during compile...
 601        Probably it is right to do no SCREAM here...
 602      */
 603
 604     if (do_utf8 ? (prog->float_utf8 && prog->anchored_utf8) : (prog->float_substr && prog->anchored_substr)) {
 605         /* Take into account the "other" substring. */
 606         /* XXXX May be hopelessly wrong for UTF... */
 607         if (!other_last)
 608             other_last = strpos;
 609         if (check == (do_utf8 ? prog->float_utf8 : prog->float_substr)) {
 610           do_other_anchored:
 611             {
 612                 char * const last = HOP3c(s, -start_shift, strbeg);
 613                 char *last1, *last2;
 614                 char *s1 = s;
 615                 SV* must;
 616
 617                 t = s - prog->check_offset_max;
 618                 if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
 619                     && (!do_utf8
 620                         || ((t = reghopmaybe3_c(s, -(prog->check_offset_max), strpos))
 621                             && t > strpos)))
 622                     /* EMPTY */;
 623                 else
 624                     t = strpos;
 625                 t = HOP3c(t, prog->anchored_offset, strend);
 626                 if (t < other_last)     /* These positions already checked */
 627                     t = other_last;
 628                 last2 = last1 = HOP3c(strend, -prog->minlen, strbeg);
 629                 if (last < last1)
 630                     last1 = last;
 631  /* XXXX It is not documented what units *_offsets are in.  Assume bytes.  */
 632                 /* On end-of-str: see comment below. */
 633                 must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
 634                 if (must == &PL_sv_undef) {
 635                     s = (char*)NULL;
 636                     DEBUG_EXECUTE_r(must = prog->anchored_utf8);        /* for debug */
 637                 }
 638                 else
 639                     s = fbm_instr(
 640                         (unsigned char*)t,
 641                         HOP3(HOP3(last1, prog->anchored_offset, strend)
 642                                 + SvCUR(must), -(SvTAIL(must)!=0), strbeg),
 643                         must,
 644                         multiline ? FBMrf_MULTILINE : 0
 645                     );
 646                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 647                         "%s anchored substr \"%s%.*s%s\"%s",
 648                         (s ? "Found" : "Contradicts"),
 649                         PL_colors[0],
 650                           (int)(SvCUR(must)
 651                           - (SvTAIL(must)!=0)),
 652                           SvPVX_const(must),
 653                           PL_colors[1], (SvTAIL(must) ? "$" : "")));
 654                 if (!s) {
 655                     if (last1 >= last2) {
 656                         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 657                                                 ", giving up...\n"));
 658                         goto fail_finish;
 659                     }
 660                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 661                         ", trying floating at offset %ld...\n",
 662                         (long)(HOP3c(s1, 1, strend) - i_strpos)));
 663                     other_last = HOP3c(last1, prog->anchored_offset+1, strend);
 664                     s = HOP3c(last, 1, strend);
 665                     goto restart;
 666                 }
 667                 else {
 668                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
 669                           (long)(s - i_strpos)));
 670                     t = HOP3c(s, -prog->anchored_offset, strbeg);
 671                     other_last = HOP3c(s, 1, strend);
 672                     s = s1;
 673                     if (t == strpos)
 674                         goto try_at_start;
 675                     goto try_at_offset;
 676                 }
 677             }
 678         }
 679         else {          /* Take into account the floating substring. */
 680             char *last, *last1;
 681             char *s1 = s;
 682             SV* must;
 683
 684             t = HOP3c(s, -start_shift, strbeg);
 685             last1 = last =
 686                 HOP3c(strend, -prog->minlen + prog->float_min_offset, strbeg);
 687             if (CHR_DIST((U8*)last, (U8*)t) > prog->float_max_offset)
 688                 last = HOP3c(t, prog->float_max_offset, strend);
 689             s = HOP3c(t, prog->float_min_offset, strend);
 690             if (s < other_last)
 691                 s = other_last;
 692  /* XXXX It is not documented what units *_offsets are in.  Assume bytes.  */
 693             must = do_utf8 ? prog->float_utf8 : prog->float_substr;
 694             /* fbm_instr() takes into account exact value of end-of-str
 695                if the check is SvTAIL(ed).  Since false positives are OK,
 696                and end-of-str is not later than strend we are OK. */
 697             if (must == &PL_sv_undef) {
 698                 s = (char*)NULL;
 699                 DEBUG_EXECUTE_r(must = prog->float_utf8);       /* for debug message */
 700             }
 701             else
 702                 s = fbm_instr((unsigned char*)s,
 703                               (unsigned char*)last + SvCUR(must)
 704                                   - (SvTAIL(must)!=0),
 705                               must, multiline ? FBMrf_MULTILINE : 0);
 706             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s floating substr \"%s%.*s%s\"%s",
 707                     (s ? "Found" : "Contradicts"),
 708                     PL_colors[0],
 709                       (int)(SvCUR(must) - (SvTAIL(must)!=0)),
 710                       SvPVX_const(must),
 711                       PL_colors[1], (SvTAIL(must) ? "$" : "")));
 712             if (!s) {
 713                 if (last1 == last) {
 714                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 715                                             ", giving up...\n"));
 716                     goto fail_finish;
 717                 }
 718                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 719                     ", trying anchored starting at offset %ld...\n",
 720                     (long)(s1 + 1 - i_strpos)));
 721                 other_last = last;
 722                 s = HOP3c(t, 1, strend);
 723                 goto restart;
 724             }
 725             else {
 726                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
 727                       (long)(s - i_strpos)));
 728                 other_last = s; /* Fix this later. --Hugo */
 729                 s = s1;
 730                 if (t == strpos)
 731                     goto try_at_start;
 732                 goto try_at_offset;
 733             }
 734         }
 735     }
 736
 737     t = s - prog->check_offset_max;
 738     if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
 739         && (!do_utf8
 740             || ((t = reghopmaybe3_c(s, -prog->check_offset_max, strpos))
 741                  && t > strpos))) {
 742         /* Fixed substring is found far enough so that the match
 743            cannot start at strpos. */
 744       try_at_offset:
 745         if (ml_anch && t[-1] != '\n') {
 746             /* Eventually fbm_*() should handle this, but often
 747                anchored_offset is not 0, so this check will not be wasted. */
 748             /* XXXX In the code below we prefer to look for "^" even in
 749                presence of anchored substrings.  And we search even
 750                beyond the found float position.  These pessimizations
 751                are historical artefacts only.  */
 752           find_anchor:
 753             while (t < strend - prog->minlen) {
 754                 if (*t == '\n') {
 755                     if (t < check_at - prog->check_offset_min) {
 756                         if (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) {
 757                             /* Since we moved from the found position,
 758                                we definitely contradict the found anchored
 759                                substr.  Due to the above check we do not
 760                                contradict "check" substr.
 761                                Thus we can arrive here only if check substr
 762                                is float.  Redo checking for "other"=="fixed".
 763                              */
 764                             strpos = t + 1;
 765                             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld, rescanning for anchored from offset %ld...\n",
 766                                 PL_colors[0], PL_colors[1], (long)(strpos - i_strpos), (long)(strpos - i_strpos + prog->anchored_offset)));
 767                             goto do_other_anchored;
 768                         }
 769                         /* We don't contradict the found floating substring. */
 770                         /* XXXX Why not check for STCLASS? */
 771                         s = t + 1;
 772                         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld...\n",
 773                             PL_colors[0], PL_colors[1], (long)(s - i_strpos)));
 774                         goto set_useful;
 775                     }
 776                     /* Position contradicts check-string */
 777                     /* XXXX probably better to look for check-string
 778                        than for "\n", so one should lower the limit for t? */
 779                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting lookup for check-string at offset %ld...\n",
 780                         PL_colors[0], PL_colors[1], (long)(t + 1 - i_strpos)));
 781                     other_last = strpos = s = t + 1;
 782                     goto restart;
 783                 }
 784                 t++;
 785             }
 786             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Did not find /%s^%s/m...\n",
 787                         PL_colors[0], PL_colors[1]));
 788             goto fail_finish;
 789         }
 790         else {
 791             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Starting position does not contradict /%s^%s/m...\n",
 792                         PL_colors[0], PL_colors[1]));
 793         }
 794         s = t;
 795       set_useful:
 796         ++BmUSEFUL(do_utf8 ? prog->check_utf8 : prog->check_substr);    /* hooray/5 */
 797     }
 798     else {
 799         /* The found string does not prohibit matching at strpos,
 800            - no optimization of calling REx engine can be performed,
 801            unless it was an MBOL and we are not after MBOL,
 802            or a future STCLASS check will fail this. */
 803       try_at_start:
 804         /* Even in this situation we may use MBOL flag if strpos is offset
 805            wrt the start of the string. */
 806         if (ml_anch && sv && !SvROK(sv) /* See prev comment on SvROK */
 807             && (strpos != strbeg) && strpos[-1] != '\n'
 808             /* May be due to an implicit anchor of m{.*foo}  */
 809             && !(prog->reganch & ROPT_IMPLICIT))
 810         {
 811             t = strpos;
 812             goto find_anchor;
 813         }
 814         DEBUG_EXECUTE_r( if (ml_anch)
 815             PerlIO_printf(Perl_debug_log, "Position at offset %ld does not contradict /%s^%s/m...\n",
 816                         (long)(strpos - i_strpos), PL_colors[0], PL_colors[1]);
 817         );
 818       success_at_start:
 819         if (!(prog->reganch & ROPT_NAUGHTY)     /* XXXX If strpos moved? */
 820             && (do_utf8 ? (
 821                 prog->check_utf8                /* Could be deleted already */
 822                 && --BmUSEFUL(prog->check_utf8) < 0
 823                 && (prog->check_utf8 == prog->float_utf8)
 824             ) : (
 825                 prog->check_substr              /* Could be deleted already */
 826                 && --BmUSEFUL(prog->check_substr) < 0
 827                 && (prog->check_substr == prog->float_substr)
 828             )))
 829         {
 830             /* If flags & SOMETHING - do not do it many times on the same match */
 831             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "... Disabling check substring...\n"));
 832             SvREFCNT_dec(do_utf8 ? prog->check_utf8 : prog->check_substr);
 833             if (do_utf8 ? prog->check_substr : prog->check_utf8)
 834                 SvREFCNT_dec(do_utf8 ? prog->check_substr : prog->check_utf8);
 835             prog->check_substr = prog->check_utf8 = NULL;       /* disable */
 836             prog->float_substr = prog->float_utf8 = NULL;       /* clear */
 837             check = NULL;                       /* abort */
 838             s = strpos;
 839             /* XXXX This is a remnant of the old implementation.  It
 840                     looks wasteful, since now INTUIT can use many
 841                     other heuristics. */
 842             prog->reganch &= ~RE_USE_INTUIT;
 843         }
 844         else
 845             s = strpos;
 846     }
 847
 848     /* Last resort... */
 849     /* XXXX BmUSEFUL already changed, maybe multiple change is meaningful... */
 850     if (prog->regstclass) {
 851         /* minlen == 0 is possible if regstclass is \b or \B,
 852            and the fixed substr is ''$.
 853            Since minlen is already taken into account, s+1 is before strend;
 854            accidentally, minlen >= 1 guaranties no false positives at s + 1
 855            even for \b or \B.  But (minlen? 1 : 0) below assumes that
 856            regstclass does not come from lookahead...  */
 857         /* If regstclass takes bytelength more than 1: If charlength==1, OK.
 858            This leaves EXACTF only, which is dealt with in find_byclass().  */
 859         const U8* const str = (U8*)STRING(prog->regstclass);
 860         const int cl_l = (PL_regkind[(U8)OP(prog->regstclass)] == EXACT
 861                     ? CHR_DIST(str+STR_LEN(prog->regstclass), str)
 862                     : 1);
 863         const char * const endpos = (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
 864                 ? HOP3c(s, (prog->minlen ? cl_l : 0), strend)
 865                 : (prog->float_substr || prog->float_utf8
 866                    ? HOP3c(HOP3c(check_at, -start_shift, strbeg),
 867                            cl_l, strend)
 868                    : strend);
 869
 870         t = s;
 871         cache_re(prog);
 872         s = find_byclass(prog, prog->regstclass, s, endpos, 1);
 873         if (!s) {
 874 #ifdef DEBUGGING
 875             const char *what = NULL;
 876 #endif
 877             if (endpos == strend) {
 878                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 879                                 "Could not match STCLASS...\n") );
 880                 goto fail;
 881             }
 882             DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 883                                    "This position contradicts STCLASS...\n") );
 884             if ((prog->reganch & ROPT_ANCH) && !ml_anch)
 885                 goto fail;
 886             /* Contradict one of substrings */
 887             if (prog->anchored_substr || prog->anchored_utf8) {
 888                 if ((do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) == check) {
 889                     DEBUG_EXECUTE_r( what = "anchored" );
 890                   hop_and_restart:
 891                     s = HOP3c(t, 1, strend);
 892                     if (s + start_shift + end_shift > strend) {
 893                         /* XXXX Should be taken into account earlier? */
 894                         DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 895                                                "Could not match STCLASS...\n") );
 896                         goto fail;
 897                     }
 898                     if (!check)
 899                         goto giveup;
 900                     DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 901                                 "Looking for %s substr starting at offset %ld...\n",
 902                                  what, (long)(s + start_shift - i_strpos)) );
 903                     goto restart;
 904                 }
 905                 /* Have both, check_string is floating */
 906                 if (t + start_shift >= check_at) /* Contradicts floating=check */
 907                     goto retry_floating_check;
 908                 /* Recheck anchored substring, but not floating... */
 909                 s = check_at;
 910                 if (!check)
 911                     goto giveup;
 912                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 913                           "Looking for anchored substr starting at offset %ld...\n",
 914                           (long)(other_last - i_strpos)) );
 915                 goto do_other_anchored;
 916             }
 917             /* Another way we could have checked stclass at the
 918                current position only: */
 919             if (ml_anch) {
 920                 s = t = t + 1;
 921                 if (!check)
 922                     goto giveup;
 923                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
 924                           "Looking for /%s^%s/m starting at offset %ld...\n",
 925                           PL_colors[0], PL_colors[1], (long)(t - i_strpos)) );
 926                 goto try_at_offset;
 927             }
 928             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))     /* Could have been deleted */
 929                 goto fail;
 930             /* Check is floating subtring. */
 931           retry_floating_check:
 932             t = check_at - start_shift;
 933             DEBUG_EXECUTE_r( what = "floating" );
 934             goto hop_and_restart;
 935         }
 936         if (t != s) {
 937             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 938                         "By STCLASS: moving %ld --> %ld\n",
 939                                   (long)(t - i_strpos), (long)(s - i_strpos))
 940                    );
 941         }
 942         else {
 943             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
 944                                   "Does not contradict STCLASS...\n");
 945                    );
 946         }
 947     }
 948   giveup:
 949     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s%s:%s match at offset %ld\n",
 950                           PL_colors[4], (check ? "Guessed" : "Giving up"),
 951                           PL_colors[5], (long)(s - i_strpos)) );
 952     return s;
 953
 954   fail_finish:                          /* Substring not found */
 955     if (prog->check_substr || prog->check_utf8)         /* could be removed already */
 956         BmUSEFUL(do_utf8 ? prog->check_utf8 : prog->check_substr) += 5; /* hooray */
 957   fail:
 958     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n",
 959                           PL_colors[4], PL_colors[5]));
 960     return NULL;
 961 }
 962
 963 /* We know what class REx starts with.  Try to find this position... */
 964 STATIC char *
 965 S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 norun)
 966 {
 967         dVAR;
 968         const I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
 969         char *m;
 970         STRLEN ln;
 971         STRLEN lnc;
 972         register STRLEN uskip;
 973         unsigned int c1;
 974         unsigned int c2;
 975         char *e;
 976         register I32 tmp = 1;   /* Scratch variable? */
 977         register const bool do_utf8 = PL_reg_match_utf8;
 978
 979         /* We know what class it must start with. */
 980         switch (OP(c)) {
 981         case ANYOF:
 982             if (do_utf8) {
 983                  while (s + (uskip = UTF8SKIP(s)) <= strend) {
 984                       if ((ANYOF_FLAGS(c) & ANYOF_UNICODE) ||
 985                           !UTF8_IS_INVARIANT((U8)s[0]) ?
 986                           reginclass(c, (U8*)s, 0, do_utf8) :
 987                           REGINCLASS(c, (U8*)s)) {
 988                            if (tmp && (norun || regtry(prog, s)))
 989                                 goto got_it;
 990                            else
 991                                 tmp = doevery;
 992                       }
 993                       else
 994                            tmp = 1;
 995                       s += uskip;
 996                  }
 997             }
 998             else {
 999                  while (s < strend) {
1000                       STRLEN skip = 1;
1001
1002                       if (REGINCLASS(c, (U8*)s) ||
1003                           (ANYOF_FOLD_SHARP_S(c, s, strend) &&
1004                            /* The assignment of 2 is intentional:
1005                             * for the folded sharp s, the skip is 2. */
1006                            (skip = SHARP_S_SKIP))) {
1007                            if (tmp && (norun || regtry(prog, s)))
1008                                 goto got_it;
1009                            else
1010                                 tmp = doevery;
1011                       }
1012                       else
1013                            tmp = 1;
1014                       s += skip;
1015                  }
1016             }
1017             break;
1018         case CANY:
1019             while (s < strend) {
1020                 if (tmp && (norun || regtry(prog, s)))
1021                     goto got_it;
1022                 else
1023                     tmp = doevery;
1024                 s++;
1025             }
1026             break;
1027         case EXACTF:
1028             m   = STRING(c);
1029             ln  = STR_LEN(c);   /* length to match in octets/bytes */
1030             lnc = (I32) ln;     /* length to match in characters */
1031             if (UTF) {
1032                 STRLEN ulen1, ulen2;
1033                 U8 *sm = (U8 *) m;
1034                 U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
1035                 U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
1036                 const U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
1037
1038                 to_utf8_lower((U8*)m, tmpbuf1, &ulen1);
1039                 to_utf8_upper((U8*)m, tmpbuf2, &ulen2);
1040
1041                 c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXBYTES_CASE,
1042                                     0, uniflags);
1043                 c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXBYTES_CASE,
1044                                     0, uniflags);
1045                 lnc = 0;
1046                 while (sm < ((U8 *) m + ln)) {
1047                     lnc++;
1048                     sm += UTF8SKIP(sm);
1049                 }
1050             }
1051             else {
1052                 c1 = *(U8*)m;
1053                 c2 = PL_fold[c1];
1054             }
1055             goto do_exactf;
1056         case EXACTFL:
1057             m   = STRING(c);
1058             ln  = STR_LEN(c);
1059             lnc = (I32) ln;
1060             c1 = *(U8*)m;
1061             c2 = PL_fold_locale[c1];
1062           do_exactf:
1063             e = HOP3c(strend, -((I32)lnc), s);
1064
1065             if (norun && e < s)
1066                 e = s;                  /* Due to minlen logic of intuit() */
1067
1068             /* The idea in the EXACTF* cases is to first find the
1069              * first character of the EXACTF* node and then, if
1070              * necessary, case-insensitively compare the full
1071              * text of the node.  The c1 and c2 are the first
1072              * characters (though in Unicode it gets a bit
1073              * more complicated because there are more cases
1074              * than just upper and lower: one needs to use
1075              * the so-called folding case for case-insensitive
1076              * matching (called "loose matching" in Unicode).
1077              * ibcmp_utf8() will do just that. */
1078
1079             if (do_utf8) {
1080                 UV c, f;
1081                 U8 tmpbuf [UTF8_MAXBYTES+1];
1082                 STRLEN len, foldlen;
1083                 const U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
1084                 if (c1 == c2) {
1085                     /* Upper and lower of 1st char are equal -
1086                      * probably not a "letter". */
1087                     while (s <= e) {
1088                         c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
1089                                            uniflags);
1090                         if ( c == c1
1091                              && (ln == len ||
1092                                  ibcmp_utf8(s, (char **)0, 0,  do_utf8,
1093                                             m, (char **)0, ln, (bool)UTF))
1094                              && (norun || regtry(prog, s)) )
1095                             goto got_it;
1096                         else {
1097                              U8 foldbuf[UTF8_MAXBYTES_CASE+1];
1098                              uvchr_to_utf8(tmpbuf, c);
1099                              f = to_utf8_fold(tmpbuf, foldbuf, &foldlen);
1100                              if ( f != c
1101                                   && (f == c1 || f == c2)
1102                                   && (ln == foldlen ||
1103                                       !ibcmp_utf8((char *) foldbuf,
1104                                                   (char **)0, foldlen, do_utf8,
1105                                                   m,
1106                                                   (char **)0, ln, (bool)UTF))
1107                                   && (norun || regtry(prog, s)) )
1108                                   goto got_it;
1109                         }
1110                         s += len;
1111                     }
1112                 }
1113                 else {
1114                     while (s <= e) {
1115                       c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
1116                                            uniflags);
1117
1118                         /* Handle some of the three Greek sigmas cases.
1119                          * Note that not all the possible combinations
1120                          * are handled here: some of them are handled
1121                          * by the standard folding rules, and some of
1122                          * them (the character class or ANYOF cases)
1123                          * are handled during compiletime in
1124                          * regexec.c:S_regclass(). */
1125                         if (c == (UV)UNICODE_GREEK_CAPITAL_LETTER_SIGMA ||
1126                             c == (UV)UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA)
1127                             c = (UV)UNICODE_GREEK_SMALL_LETTER_SIGMA;
1128
1129                         if ( (c == c1 || c == c2)
1130                              && (ln == len ||
1131                                  ibcmp_utf8(s, (char **)0, 0,  do_utf8,
1132                                             m, (char **)0, ln, (bool)UTF))
1133                              && (norun || regtry(prog, s)) )
1134                             goto got_it;
1135                         else {
1136                              U8 foldbuf[UTF8_MAXBYTES_CASE+1];
1137                              uvchr_to_utf8(tmpbuf, c);
1138                              f = to_utf8_fold(tmpbuf, foldbuf, &foldlen);
1139                              if ( f != c
1140                                   && (f == c1 || f == c2)
1141                                   && (ln == foldlen ||
1142                                       !ibcmp_utf8((char *) foldbuf,
1143                                                   (char **)0, foldlen, do_utf8,
1144                                                   m,
1145                                                   (char **)0, ln, (bool)UTF))
1146                                   && (norun || regtry(prog, s)) )
1147                                   goto got_it;
1148                         }
1149                         s += len;
1150                     }
1151                 }
1152             }
1153             else {
1154                 if (c1 == c2)
1155                     while (s <= e) {
1156                         if ( *(U8*)s == c1
1157                              && (ln == 1 || !(OP(c) == EXACTF
1158                                               ? ibcmp(s, m, ln)
1159                                               : ibcmp_locale(s, m, ln)))
1160                              && (norun || regtry(prog, s)) )
1161                             goto got_it;
1162                         s++;
1163                     }
1164                 else
1165                     while (s <= e) {
1166                         if ( (*(U8*)s == c1 || *(U8*)s == c2)
1167                              && (ln == 1 || !(OP(c) == EXACTF
1168                                               ? ibcmp(s, m, ln)
1169                                               : ibcmp_locale(s, m, ln)))
1170                              && (norun || regtry(prog, s)) )
1171                             goto got_it;
1172                         s++;
1173                     }
1174             }
1175             break;
1176         case BOUNDL:
1177             PL_reg_flags |= RF_tainted;
1178             /* FALL THROUGH */
1179         case BOUND:
1180             if (do_utf8) {
1181                 if (s == PL_bostr)
1182                     tmp = '\n';
1183                 else {
1184                     U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);
1185                     tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, 0);
1186                 }
1187                 tmp = ((OP(c) == BOUND ?
1188                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1189                 LOAD_UTF8_CHARCLASS_ALNUM();
1190                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1191                     if (tmp == !(OP(c) == BOUND ?
1192                                  swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1193                                  isALNUM_LC_utf8((U8*)s)))
1194                     {
1195                         tmp = !tmp;
1196                         if ((norun || regtry(prog, s)))
1197                             goto got_it;
1198                     }
1199                     s += uskip;
1200                 }
1201             }
1202             else {
1203                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1204                 tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1205                 while (s < strend) {
1206                     if (tmp ==
1207                         !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
1208                         tmp = !tmp;
1209                         if ((norun || regtry(prog, s)))
1210                             goto got_it;
1211                     }
1212                     s++;
1213                 }
1214             }
1215             if ((!prog->minlen && tmp) && (norun || regtry(prog, s)))
1216                 goto got_it;
1217             break;
1218         case NBOUNDL:
1219             PL_reg_flags |= RF_tainted;
1220             /* FALL THROUGH */
1221         case NBOUND:
1222             if (do_utf8) {
1223                 if (s == PL_bostr)
1224                     tmp = '\n';
1225                 else {
1226                     U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);
1227                     tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, 0);
1228                 }
1229                 tmp = ((OP(c) == NBOUND ?
1230                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1231                 LOAD_UTF8_CHARCLASS_ALNUM();
1232                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1233                     if (tmp == !(OP(c) == NBOUND ?
1234                                  swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1235                                  isALNUM_LC_utf8((U8*)s)))
1236                         tmp = !tmp;
1237                     else if ((norun || regtry(prog, s)))
1238                         goto got_it;
1239                     s += uskip;
1240                 }
1241             }
1242             else {
1243                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1244                 tmp = ((OP(c) == NBOUND ?
1245                         isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1246                 while (s < strend) {
1247                     if (tmp ==
1248                         !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
1249                         tmp = !tmp;
1250                     else if ((norun || regtry(prog, s)))
1251                         goto got_it;
1252                     s++;
1253                 }
1254             }
1255             if ((!prog->minlen && !tmp) && (norun || regtry(prog, s)))
1256                 goto got_it;
1257             break;
1258         case ALNUM:
1259             if (do_utf8) {
1260                 LOAD_UTF8_CHARCLASS_ALNUM();
1261                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1262                     if (swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) {
1263                         if (tmp && (norun || regtry(prog, s)))
1264                             goto got_it;
1265                         else
1266                             tmp = doevery;
1267                     }
1268                     else
1269                         tmp = 1;
1270                     s += uskip;
1271                 }
1272             }
1273             else {
1274                 while (s < strend) {
1275                     if (isALNUM(*s)) {
1276                         if (tmp && (norun || regtry(prog, s)))
1277                             goto got_it;
1278                         else
1279                             tmp = doevery;
1280                     }
1281                     else
1282                         tmp = 1;
1283                     s++;
1284                 }
1285             }
1286             break;
1287         case ALNUML:
1288             PL_reg_flags |= RF_tainted;
1289             if (do_utf8) {
1290                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1291                     if (isALNUM_LC_utf8((U8*)s)) {
1292                         if (tmp && (norun || regtry(prog, s)))
1293                             goto got_it;
1294                         else
1295                             tmp = doevery;
1296                     }
1297                     else
1298                         tmp = 1;
1299                     s += uskip;
1300                 }
1301             }
1302             else {
1303                 while (s < strend) {
1304                     if (isALNUM_LC(*s)) {
1305                         if (tmp && (norun || regtry(prog, s)))
1306                             goto got_it;
1307                         else
1308                             tmp = doevery;
1309                     }
1310                     else
1311                         tmp = 1;
1312                     s++;
1313                 }
1314             }
1315             break;
1316         case NALNUM:
1317             if (do_utf8) {
1318                 LOAD_UTF8_CHARCLASS_ALNUM();
1319                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1320                     if (!swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) {
1321                         if (tmp && (norun || regtry(prog, s)))
1322                             goto got_it;
1323                         else
1324                             tmp = doevery;
1325                     }
1326                     else
1327                         tmp = 1;
1328                     s += uskip;
1329                 }
1330             }
1331             else {
1332                 while (s < strend) {
1333                     if (!isALNUM(*s)) {
1334                         if (tmp && (norun || regtry(prog, s)))
1335                             goto got_it;
1336                         else
1337                             tmp = doevery;
1338                     }
1339                     else
1340                         tmp = 1;
1341                     s++;
1342                 }
1343             }
1344             break;
1345         case NALNUML:
1346             PL_reg_flags |= RF_tainted;
1347             if (do_utf8) {
1348                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1349                     if (!isALNUM_LC_utf8((U8*)s)) {
1350                         if (tmp && (norun || regtry(prog, s)))
1351                             goto got_it;
1352                         else
1353                             tmp = doevery;
1354                     }
1355                     else
1356                         tmp = 1;
1357                     s += uskip;
1358                 }
1359             }
1360             else {
1361                 while (s < strend) {
1362                     if (!isALNUM_LC(*s)) {
1363                         if (tmp && (norun || regtry(prog, s)))
1364                             goto got_it;
1365                         else
1366                             tmp = doevery;
1367                     }
1368                     else
1369                         tmp = 1;
1370                     s++;
1371                 }
1372             }
1373             break;
1374         case SPACE:
1375             if (do_utf8) {
1376                 LOAD_UTF8_CHARCLASS_SPACE();
1377                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1378                     if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8)) {
1379                         if (tmp && (norun || regtry(prog, s)))
1380                             goto got_it;
1381                         else
1382                             tmp = doevery;
1383                     }
1384                     else
1385                         tmp = 1;
1386                     s += uskip;
1387                 }
1388             }
1389             else {
1390                 while (s < strend) {
1391                     if (isSPACE(*s)) {
1392                         if (tmp && (norun || regtry(prog, s)))
1393                             goto got_it;
1394                         else
1395                             tmp = doevery;
1396                     }
1397                     else
1398                         tmp = 1;
1399                     s++;
1400                 }
1401             }
1402             break;
1403         case SPACEL:
1404             PL_reg_flags |= RF_tainted;
1405             if (do_utf8) {
1406                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1407                     if (*s == ' ' || isSPACE_LC_utf8((U8*)s)) {
1408                         if (tmp && (norun || regtry(prog, s)))
1409                             goto got_it;
1410                         else
1411                             tmp = doevery;
1412                     }
1413                     else
1414                         tmp = 1;
1415                     s += uskip;
1416                 }
1417             }
1418             else {
1419                 while (s < strend) {
1420                     if (isSPACE_LC(*s)) {
1421                         if (tmp && (norun || regtry(prog, s)))
1422                             goto got_it;
1423                         else
1424                             tmp = doevery;
1425                     }
1426                     else
1427                         tmp = 1;
1428                     s++;
1429                 }
1430             }
1431             break;
1432         case NSPACE:
1433             if (do_utf8) {
1434                 LOAD_UTF8_CHARCLASS_SPACE();
1435                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1436                     if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8))) {
1437                         if (tmp && (norun || regtry(prog, s)))
1438                             goto got_it;
1439                         else
1440                             tmp = doevery;
1441                     }
1442                     else
1443                         tmp = 1;
1444                     s += uskip;
1445                 }
1446             }
1447             else {
1448                 while (s < strend) {
1449                     if (!isSPACE(*s)) {
1450                         if (tmp && (norun || regtry(prog, s)))
1451                             goto got_it;
1452                         else
1453                             tmp = doevery;
1454                     }
1455                     else
1456                         tmp = 1;
1457                     s++;
1458                 }
1459             }
1460             break;
1461         case NSPACEL:
1462             PL_reg_flags |= RF_tainted;
1463             if (do_utf8) {
1464                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1465                     if (!(*s == ' ' || isSPACE_LC_utf8((U8*)s))) {
1466                         if (tmp && (norun || regtry(prog, s)))
1467                             goto got_it;
1468                         else
1469                             tmp = doevery;
1470                     }
1471                     else
1472                         tmp = 1;
1473                     s += uskip;
1474                 }
1475             }
1476             else {
1477                 while (s < strend) {
1478                     if (!isSPACE_LC(*s)) {
1479                         if (tmp && (norun || regtry(prog, s)))
1480                             goto got_it;
1481                         else
1482                             tmp = doevery;
1483                     }
1484                     else
1485                         tmp = 1;
1486                     s++;
1487                 }
1488             }
1489             break;
1490         case DIGIT:
1491             if (do_utf8) {
1492                 LOAD_UTF8_CHARCLASS_DIGIT();
1493                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1494                     if (swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) {
1495                         if (tmp && (norun || regtry(prog, s)))
1496                             goto got_it;
1497                         else
1498                             tmp = doevery;
1499                     }
1500                     else
1501                         tmp = 1;
1502                     s += uskip;
1503                 }
1504             }
1505             else {
1506                 while (s < strend) {
1507                     if (isDIGIT(*s)) {
1508                         if (tmp && (norun || regtry(prog, s)))
1509                             goto got_it;
1510                         else
1511                             tmp = doevery;
1512                     }
1513                     else
1514                         tmp = 1;
1515                     s++;
1516                 }
1517             }
1518             break;
1519         case DIGITL:
1520             PL_reg_flags |= RF_tainted;
1521             if (do_utf8) {
1522                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1523                     if (isDIGIT_LC_utf8((U8*)s)) {
1524                         if (tmp && (norun || regtry(prog, s)))
1525                             goto got_it;
1526                         else
1527                             tmp = doevery;
1528                     }
1529                     else
1530                         tmp = 1;
1531                     s += uskip;
1532                 }
1533             }
1534             else {
1535                 while (s < strend) {
1536                     if (isDIGIT_LC(*s)) {
1537                         if (tmp && (norun || regtry(prog, s)))
1538                             goto got_it;
1539                         else
1540                             tmp = doevery;
1541                     }
1542                     else
1543                         tmp = 1;
1544                     s++;
1545                 }
1546             }
1547             break;
1548         case NDIGIT:
1549             if (do_utf8) {
1550                 LOAD_UTF8_CHARCLASS_DIGIT();
1551                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1552                     if (!swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) {
1553                         if (tmp && (norun || regtry(prog, s)))
1554                             goto got_it;
1555                         else
1556                             tmp = doevery;
1557                     }
1558                     else
1559                         tmp = 1;
1560                     s += uskip;
1561                 }
1562             }
1563             else {
1564                 while (s < strend) {
1565                     if (!isDIGIT(*s)) {
1566                         if (tmp && (norun || regtry(prog, s)))
1567                             goto got_it;
1568                         else
1569                             tmp = doevery;
1570                     }
1571                     else
1572                         tmp = 1;
1573                     s++;
1574                 }
1575             }
1576             break;
1577         case NDIGITL:
1578             PL_reg_flags |= RF_tainted;
1579             if (do_utf8) {
1580                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1581                     if (!isDIGIT_LC_utf8((U8*)s)) {
1582                         if (tmp && (norun || regtry(prog, s)))
1583                             goto got_it;
1584                         else
1585                             tmp = doevery;
1586                     }
1587                     else
1588                         tmp = 1;
1589                     s += uskip;
1590                 }
1591             }
1592             else {
1593                 while (s < strend) {
1594                     if (!isDIGIT_LC(*s)) {
1595                         if (tmp && (norun || regtry(prog, s)))
1596                             goto got_it;
1597                         else
1598                             tmp = doevery;
1599                     }
1600                     else
1601                         tmp = 1;
1602                     s++;
1603                 }
1604             }
1605             break;
1606         default:
1607             Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
1608             break;
1609         }
1610         return 0;
1611       got_it:
1612         return s;
1613 }
1614
1615 /*
1616  - regexec_flags - match a regexp against a string
1617  */
1618 I32
1619 Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *strend,
1620               char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
1621 /* strend: pointer to null at end of string */
1622 /* strbeg: real beginning of string */
1623 /* minend: end of match must be >=minend after stringarg. */
1624 /* data: May be used for some additional optimizations. */
1625 /* nosave: For optimizations. */
1626 {
1627     dVAR;
1628     register char *s;
1629     register regnode *c;
1630     register char *startpos = stringarg;
1631     I32 minlen;         /* must match at least this many chars */
1632     I32 dontbother = 0; /* how many characters not to try at end */
1633     I32 end_shift = 0;                  /* Same for the end. */         /* CC */
1634     I32 scream_pos = -1;                /* Internal iterator of scream. */
1635     char *scream_olds = NULL;
1636     SV* oreplsv = GvSV(PL_replgv);
1637     const bool do_utf8 = DO_UTF8(sv);
1638     const I32 multiline = prog->reganch & PMf_MULTILINE;
1639 #ifdef DEBUGGING
1640     SV * const dsv0 = PERL_DEBUG_PAD_ZERO(0);
1641     SV * const dsv1 = PERL_DEBUG_PAD_ZERO(1);
1642 #endif
1643
1644     GET_RE_DEBUG_FLAGS_DECL;
1645
1646     PERL_UNUSED_ARG(data);
1647     RX_MATCH_UTF8_set(prog,do_utf8);
1648
1649     PL_regcc = 0;
1650
1651     cache_re(prog);
1652 #ifdef DEBUGGING
1653     PL_regnarrate = DEBUG_r_TEST;
1654 #endif
1655
1656     /* Be paranoid... */
1657     if (prog == NULL || startpos == NULL) {
1658         Perl_croak(aTHX_ "NULL regexp parameter");
1659         return 0;
1660     }
1661
1662     minlen = prog->minlen;
1663     if (strend - startpos < minlen) {
1664         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
1665                               "String too short [regexec_flags]...\n"));
1666         goto phooey;
1667     }
1668
1669     /* Check validity of program. */
1670     if (UCHARAT(prog->program) != REG_MAGIC) {
1671         Perl_croak(aTHX_ "corrupted regexp program");
1672     }
1673
1674     PL_reg_flags = 0;
1675     PL_reg_eval_set = 0;
1676     PL_reg_maxiter = 0;
1677
1678     if (prog->reganch & ROPT_UTF8)
1679         PL_reg_flags |= RF_utf8;
1680
1681     /* Mark beginning of line for ^ and lookbehind. */
1682     PL_regbol = startpos;
1683     PL_bostr  = strbeg;
1684     PL_reg_sv = sv;
1685
1686     /* Mark end of line for $ (and such) */
1687     PL_regeol = strend;
1688
1689     /* see how far we have to get to not match where we matched before */
1690     PL_regtill = startpos+minend;
1691
1692     /* We start without call_cc context.  */
1693     PL_reg_call_cc = 0;
1694
1695     /* If there is a "must appear" string, look for it. */
1696     s = startpos;
1697
1698     if (prog->reganch & ROPT_GPOS_SEEN) { /* Need to have PL_reg_ganch */
1699         MAGIC *mg;
1700
1701         if (flags & REXEC_IGNOREPOS)    /* Means: check only at start */
1702             PL_reg_ganch = startpos;
1703         else if (sv && SvTYPE(sv) >= SVt_PVMG
1704                   && SvMAGIC(sv)
1705                   && (mg = mg_find(sv, PERL_MAGIC_regex_global))
1706                   && mg->mg_len >= 0) {
1707             PL_reg_ganch = strbeg + mg->mg_len; /* Defined pos() */
1708             if (prog->reganch & ROPT_ANCH_GPOS) {
1709                 if (s > PL_reg_ganch)
1710                     goto phooey;
1711                 s = PL_reg_ganch;
1712             }
1713         }
1714         else                            /* pos() not defined */
1715             PL_reg_ganch = strbeg;
1716     }
1717
1718     if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) {
1719         re_scream_pos_data d;
1720
1721         d.scream_olds = &scream_olds;
1722         d.scream_pos = &scream_pos;
1723         s = re_intuit_start(prog, sv, s, strend, flags, &d);
1724         if (!s) {
1725             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
1726             goto phooey;        /* not present */
1727         }
1728     }
1729
1730     DEBUG_EXECUTE_r({
1731         const char * const s0   = UTF
1732             ? pv_uni_display(dsv0, (U8*)prog->precomp, prog->prelen, 60,
1733                           UNI_DISPLAY_REGEX)
1734             : prog->precomp;
1735         const int len0 = UTF ? SvCUR(dsv0) : prog->prelen;
1736         const char * const s1 = do_utf8 ? sv_uni_display(dsv1, sv, 60,
1737                                                UNI_DISPLAY_REGEX) : startpos;
1738         const int len1 = do_utf8 ? SvCUR(dsv1) : strend - startpos;
1739          if (!PL_colorset)
1740              reginitcolors();
1741          PerlIO_printf(Perl_debug_log,
1742                        "%sMatching REx%s \"%s%*.*s%s%s\" against \"%s%.*s%s%s\"\n",
1743                        PL_colors[4], PL_colors[5], PL_colors[0],
1744                        len0, len0, s0,
1745                        PL_colors[1],
1746                        len0 > 60 ? "..." : "",
1747                        PL_colors[0],
1748                        (int)(len1 > 60 ? 60 : len1),
1749                        s1, PL_colors[1],
1750                        (len1 > 60 ? "..." : "")
1751               );
1752     });
1753
1754     /* Simplest case:  anchored match need be tried only once. */
1755     /*  [unless only anchor is BOL and multiline is set] */
1756     if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
1757         if (s == startpos && regtry(prog, startpos))
1758             goto got_it;
1759         else if (multiline || (prog->reganch & ROPT_IMPLICIT)
1760                  || (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
1761         {
1762             char *end;
1763
1764             if (minlen)
1765                 dontbother = minlen - 1;
1766             end = HOP3c(strend, -dontbother, strbeg) - 1;
1767             /* for multiline we only have to try after newlines */
1768             if (prog->check_substr || prog->check_utf8) {
1769                 if (s == startpos)
1770                     goto after_try;
1771                 while (1) {
1772                     if (regtry(prog, s))
1773                         goto got_it;
1774                   after_try:
1775                     if (s >= end)
1776                         goto phooey;
1777                     if (prog->reganch & RE_USE_INTUIT) {
1778                         s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
1779                         if (!s)
1780                             goto phooey;
1781                     }
1782                     else
1783                         s++;
1784                 }
1785             } else {
1786                 if (s > startpos)
1787                     s--;
1788                 while (s < end) {
1789                     if (*s++ == '\n') { /* don't need PL_utf8skip here */
1790                         if (regtry(prog, s))
1791                             goto got_it;
1792                     }
1793                 }
1794             }
1795         }
1796         goto phooey;
1797     } else if (prog->reganch & ROPT_ANCH_GPOS) {
1798         if (regtry(prog, PL_reg_ganch))
1799             goto got_it;
1800         goto phooey;
1801     }
1802
1803     /* Messy cases:  unanchored match. */
1804     if ((prog->anchored_substr || prog->anchored_utf8) && prog->reganch & ROPT_SKIP) {
1805         /* we have /x+whatever/ */
1806         /* it must be a one character string (XXXX Except UTF?) */
1807         char ch;
1808 #ifdef DEBUGGING
1809         int did_match = 0;
1810 #endif
1811         if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1812             do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1813         ch = SvPVX_const(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr)[0];
1814
1815         if (do_utf8) {
1816             while (s < strend) {
1817                 if (*s == ch) {
1818                     DEBUG_EXECUTE_r( did_match = 1 );
1819                     if (regtry(prog, s)) goto got_it;
1820                     s += UTF8SKIP(s);
1821                     while (s < strend && *s == ch)
1822                         s += UTF8SKIP(s);
1823                 }
1824                 s += UTF8SKIP(s);
1825             }
1826         }
1827         else {
1828             while (s < strend) {
1829                 if (*s == ch) {
1830                     DEBUG_EXECUTE_r( did_match = 1 );
1831                     if (regtry(prog, s)) goto got_it;
1832                     s++;
1833                     while (s < strend && *s == ch)
1834                         s++;
1835                 }
1836                 s++;
1837             }
1838         }
1839         DEBUG_EXECUTE_r(if (!did_match)
1840                 PerlIO_printf(Perl_debug_log,
1841                                   "Did not find anchored character...\n")
1842                );
1843     }
1844     else if (prog->anchored_substr != NULL
1845               || prog->anchored_utf8 != NULL
1846               || ((prog->float_substr != NULL || prog->float_utf8 != NULL)
1847                   && prog->float_max_offset < strend - s)) {
1848         SV *must;
1849         I32 back_max;
1850         I32 back_min;
1851         char *last;
1852         char *last1;            /* Last position checked before */
1853 #ifdef DEBUGGING
1854         int did_match = 0;
1855 #endif
1856         if (prog->anchored_substr || prog->anchored_utf8) {
1857             if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1858                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1859             must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
1860             back_max = back_min = prog->anchored_offset;
1861         } else {
1862             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
1863                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1864             must = do_utf8 ? prog->float_utf8 : prog->float_substr;
1865             back_max = prog->float_max_offset;
1866             back_min = prog->float_min_offset;
1867         }
1868         if (must == &PL_sv_undef)
1869             /* could not downgrade utf8 check substring, so must fail */
1870             goto phooey;
1871
1872         last = HOP3c(strend,    /* Cannot start after this */
1873                           -(I32)(CHR_SVLEN(must)
1874                                  - (SvTAIL(must) != 0) + back_min), strbeg);
1875
1876         if (s > PL_bostr)
1877             last1 = HOPc(s, -1);
1878         else
1879             last1 = s - 1;      /* bogus */
1880
1881         /* XXXX check_substr already used to find "s", can optimize if
1882            check_substr==must. */
1883         scream_pos = -1;
1884         dontbother = end_shift;
1885         strend = HOPc(strend, -dontbother);
1886         while ( (s <= last) &&
1887                 ((flags & REXEC_SCREAM)
1888                  ? (s = screaminstr(sv, must, HOP3c(s, back_min, strend) - strbeg,
1889                                     end_shift, &scream_pos, 0))
1890                  : (s = fbm_instr((unsigned char*)HOP3(s, back_min, strend),
1891                                   (unsigned char*)strend, must,
1892                                   multiline ? FBMrf_MULTILINE : 0))) ) {
1893             /* we may be pointing at the wrong string */
1894             if ((flags & REXEC_SCREAM) && RX_MATCH_COPIED(prog))
1895                 s = strbeg + (s - SvPVX_const(sv));
1896             DEBUG_EXECUTE_r( did_match = 1 );
1897             if (HOPc(s, -back_max) > last1) {
1898                 last1 = HOPc(s, -back_min);
1899                 s = HOPc(s, -back_max);
1900             }
1901             else {
1902                 char *t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
1903
1904                 last1 = HOPc(s, -back_min);
1905                 s = t;
1906             }
1907             if (do_utf8) {
1908                 while (s <= last1) {
1909                     if (regtry(prog, s))
1910                         goto got_it;
1911                     s += UTF8SKIP(s);
1912                 }
1913             }
1914             else {
1915                 while (s <= last1) {
1916                     if (regtry(prog, s))
1917                         goto got_it;
1918                     s++;
1919                 }
1920             }
1921         }
1922         DEBUG_EXECUTE_r(if (!did_match)
1923                     PerlIO_printf(Perl_debug_log,
1924                                   "Did not find %s substr \"%s%.*s%s\"%s...\n",
1925                               ((must == prog->anchored_substr || must == prog->anchored_utf8)
1926                                ? "anchored" : "floating"),
1927                               PL_colors[0],
1928                               (int)(SvCUR(must) - (SvTAIL(must)!=0)),
1929                               SvPVX_const(must),
1930                                   PL_colors[1], (SvTAIL(must) ? "$" : ""))
1931                );
1932         goto phooey;
1933     }
1934     else if ((c = prog->regstclass)) {
1935         if (minlen) {
1936             I32 op = (U8)OP(prog->regstclass);
1937             /* don't bother with what can't match */
1938             if (PL_regkind[op] != EXACT && op != CANY)
1939                 strend = HOPc(strend, -(minlen - 1));
1940         }
1941         DEBUG_EXECUTE_r({
1942             SV *prop = sv_newmortal();
1943             const char *s0;
1944             const char *s1;
1945             int len0;
1946             int len1;
1947
1948             regprop(prop, c);
1949             s0 = UTF ?
1950               pv_uni_display(dsv0, (U8*)SvPVX_const(prop), SvCUR(prop), 60,
1951                              UNI_DISPLAY_REGEX) :
1952               SvPVX_const(prop);
1953             len0 = UTF ? SvCUR(dsv0) : SvCUR(prop);
1954             s1 = UTF ?
1955               sv_uni_display(dsv1, sv, 60, UNI_DISPLAY_REGEX) : s;
1956             len1 = UTF ? SvCUR(dsv1) : strend - s;
1957             PerlIO_printf(Perl_debug_log,
1958                           "Matching stclass \"%*.*s\" against \"%*.*s\"\n",
1959                           len0, len0, s0,
1960                           len1, len1, s1);
1961         });
1962         if (find_byclass(prog, c, s, strend, 0))
1963             goto got_it;
1964         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass...\n"));
1965     }
1966     else {
1967         dontbother = 0;
1968         if (prog->float_substr != NULL || prog->float_utf8 != NULL) {
1969             /* Trim the end. */
1970             char *last;
1971             SV* float_real;
1972
1973             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
1974                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1975             float_real = do_utf8 ? prog->float_utf8 : prog->float_substr;
1976
1977             if (flags & REXEC_SCREAM) {
1978                 last = screaminstr(sv, float_real, s - strbeg,
1979                                    end_shift, &scream_pos, 1); /* last one */
1980                 if (!last)
1981                     last = scream_olds; /* Only one occurrence. */
1982                 /* we may be pointing at the wrong string */
1983                 else if (RX_MATCH_COPIED(prog))
1984                     s = strbeg + (s - SvPVX_const(sv));
1985             }
1986             else {
1987                 STRLEN len;
1988                 const char * const little = SvPV_const(float_real, len);
1989
1990                 if (SvTAIL(float_real)) {
1991                     if (memEQ(strend - len + 1, little, len - 1))
1992                         last = strend - len + 1;
1993                     else if (!multiline)
1994                         last = memEQ(strend - len, little, len)
1995                             ? strend - len : NULL;
1996                     else
1997                         goto find_last;
1998                 } else {
1999                   find_last:
2000                     if (len)
2001                         last = rninstr(s, strend, little, little + len);
2002                     else
2003                         last = strend;  /* matching "$" */
2004                 }
2005             }
2006             if (last == NULL) {
2007                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
2008                                       "%sCan't trim the tail, match fails (should not happen)%s\n",
2009                                       PL_colors[4], PL_colors[5]));
2010                 goto phooey; /* Should not happen! */
2011             }
2012             dontbother = strend - last + prog->float_min_offset;
2013         }
2014         if (minlen && (dontbother < minlen))
2015             dontbother = minlen - 1;
2016         strend -= dontbother;              /* this one's always in bytes! */
2017         /* We don't know much -- general case. */
2018         if (do_utf8) {
2019             for (;;) {
2020                 if (regtry(prog, s))
2021                     goto got_it;
2022                 if (s >= strend)
2023                     break;
2024                 s += UTF8SKIP(s);
2025             };
2026         }
2027         else {
2028             do {
2029                 if (regtry(prog, s))
2030                     goto got_it;
2031             } while (s++ < strend);
2032         }
2033     }
2034
2035     /* Failure. */
2036     goto phooey;
2037
2038 got_it:
2039     RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
2040
2041     if (PL_reg_eval_set) {
2042         /* Preserve the current value of $^R */
2043         if (oreplsv != GvSV(PL_replgv))
2044             sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
2045                                                   restored, the value remains
2046                                                   the same. */
2047         restore_pos(aTHX_ 0);
2048     }
2049
2050     /* make sure $`, $&, $', and $digit will work later */
2051     if ( !(flags & REXEC_NOT_FIRST) ) {
2052         RX_MATCH_COPY_FREE(prog);
2053         if (flags & REXEC_COPY_STR) {
2054             I32 i = PL_regeol - startpos + (stringarg - strbeg);
2055 #ifdef PERL_OLD_COPY_ON_WRITE
2056             if ((SvIsCOW(sv)
2057                  || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) {
2058                 if (DEBUG_C_TEST) {
2059                     PerlIO_printf(Perl_debug_log,
2060                                   "Copy on write: regexp capture, type %d\n",
2061                                   (int) SvTYPE(sv));
2062                 }
2063                 prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
2064                 prog->subbeg = (char *)SvPVX_const(prog->saved_copy);
2065                 assert (SvPOKp(prog->saved_copy));
2066             } else
2067 #endif
2068             {
2069                 RX_MATCH_COPIED_on(prog);
2070                 s = savepvn(strbeg, i);
2071                 prog->subbeg = s;
2072             }
2073             prog->sublen = i;
2074         }
2075         else {
2076             prog->subbeg = strbeg;
2077             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
2078         }
2079     }
2080
2081     return 1;
2082
2083 phooey:
2084     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
2085                           PL_colors[4], PL_colors[5]));
2086     if (PL_reg_eval_set)
2087         restore_pos(aTHX_ 0);
2088     return 0;
2089 }
2090
2091 /*
2092  - regtry - try match at specific point
2093  */
2094 STATIC I32                      /* 0 failure, 1 success */
2095 S_regtry(pTHX_ regexp *prog, char *startpos)
2096 {
2097     dVAR;
2098     register I32 i;
2099     register I32 *sp;
2100     register I32 *ep;
2101     CHECKPOINT lastcp;
2102     GET_RE_DEBUG_FLAGS_DECL;
2103
2104 #ifdef DEBUGGING
2105     PL_regindent = 0;   /* XXXX Not good when matches are reenterable... */
2106 #endif
2107     if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
2108         MAGIC *mg;
2109
2110         PL_reg_eval_set = RS_init;
2111         DEBUG_EXECUTE_r(DEBUG_s(
2112             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %"IVdf"\n",
2113                           (IV)(PL_stack_sp - PL_stack_base));
2114             ));
2115         SAVEI32(cxstack[cxstack_ix].blk_oldsp);
2116         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
2117         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
2118         SAVETMPS;
2119         /* Apparently this is not needed, judging by wantarray. */
2120         /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
2121            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
2122
2123         if (PL_reg_sv) {
2124             /* Make $_ available to executed code. */
2125             if (PL_reg_sv != DEFSV) {
2126                 SAVE_DEFSV;
2127                 DEFSV = PL_reg_sv;
2128             }
2129
2130             if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv)
2131                   && (mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global)))) {
2132                 /* prepare for quick setting of pos */
2133                 sv_magic(PL_reg_sv, (SV*)0,
2134                         PERL_MAGIC_regex_global, NULL, 0);
2135                 mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global);
2136                 mg->mg_len = -1;
2137             }
2138             PL_reg_magic    = mg;
2139             PL_reg_oldpos   = mg->mg_len;
2140             SAVEDESTRUCTOR_X(restore_pos, 0);
2141         }
2142         if (!PL_reg_curpm) {
2143             Newxz(PL_reg_curpm, 1, PMOP);
2144 #ifdef USE_ITHREADS
2145             {
2146                 SV* repointer = newSViv(0);
2147                 /* so we know which PL_regex_padav element is PL_reg_curpm */
2148                 SvFLAGS(repointer) |= SVf_BREAK;
2149                 av_push(PL_regex_padav,repointer);
2150                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
2151                 PL_regex_pad = AvARRAY(PL_regex_padav);
2152             }
2153 #endif
2154         }
2155         PM_SETRE(PL_reg_curpm, prog);
2156         PL_reg_oldcurpm = PL_curpm;
2157         PL_curpm = PL_reg_curpm;
2158         if (RX_MATCH_COPIED(prog)) {
2159             /*  Here is a serious problem: we cannot rewrite subbeg,
2160                 since it may be needed if this match fails.  Thus
2161                 $` inside (?{}) could fail... */
2162             PL_reg_oldsaved = prog->subbeg;
2163             PL_reg_oldsavedlen = prog->sublen;
2164 #ifdef PERL_OLD_COPY_ON_WRITE
2165             PL_nrs = prog->saved_copy;
2166 #endif
2167             RX_MATCH_COPIED_off(prog);
2168         }
2169         else
2170             PL_reg_oldsaved = NULL;
2171         prog->subbeg = PL_bostr;
2172         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
2173     }
2174     prog->startp[0] = startpos - PL_bostr;
2175     PL_reginput = startpos;
2176     PL_regstartp = prog->startp;
2177     PL_regendp = prog->endp;
2178     PL_reglastparen = &prog->lastparen;
2179     PL_reglastcloseparen = &prog->lastcloseparen;
2180     prog->lastparen = 0;
2181     prog->lastcloseparen = 0;
2182     PL_regsize = 0;
2183     DEBUG_EXECUTE_r(PL_reg_starttry = startpos);
2184     if (PL_reg_start_tmpl <= prog->nparens) {
2185         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
2186         if(PL_reg_start_tmp)
2187             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2188         else
2189             Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2190     }
2191
2192     /* XXXX What this code is doing here?!!!  There should be no need
2193        to do this again and again, PL_reglastparen should take care of
2194        this!  --ilya*/
2195
2196     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
2197      * Actually, the code in regcppop() (which Ilya may be meaning by
2198      * PL_reglastparen), is not needed at all by the test suite
2199      * (op/regexp, op/pat, op/split), but that code is needed, oddly
2200      * enough, for building DynaLoader, or otherwise this
2201      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
2202      * will happen.  Meanwhile, this code *is* needed for the
2203      * above-mentioned test suite tests to succeed.  The common theme
2204      * on those tests seems to be returning null fields from matches.
2205      * --jhi */
2206 #if 1
2207     sp = prog->startp;
2208     ep = prog->endp;
2209     if (prog->nparens) {
2210         for (i = prog->nparens; i > (I32)*PL_reglastparen; i--) {
2211             *++sp = -1;
2212             *++ep = -1;
2213         }
2214     }
2215 #endif
2216     REGCP_SET(lastcp);
2217     if (regmatch(prog->program + 1)) {
2218         prog->endp[0] = PL_reginput - PL_bostr;
2219         return 1;
2220     }
2221     REGCP_UNWIND(lastcp);
2222     return 0;
2223 }
2224
2225 #define RE_UNWIND_BRANCH        1
2226 #define RE_UNWIND_BRANCHJ       2
2227
2228 union re_unwind_t;
2229
2230 typedef struct {                /* XX: makes sense to enlarge it... */
2231     I32 type;
2232     I32 prev;
2233     CHECKPOINT lastcp;
2234 } re_unwind_generic_t;
2235
2236 typedef struct {
2237     I32 type;
2238     I32 prev;
2239     CHECKPOINT lastcp;
2240     I32 lastparen;
2241     regnode *next;
2242     char *locinput;
2243     I32 nextchr;
2244 #ifdef DEBUGGING
2245     int regindent;
2246 #endif
2247 } re_unwind_branch_t;
2248
2249 typedef union re_unwind_t {
2250     I32 type;
2251     re_unwind_generic_t generic;
2252     re_unwind_branch_t branch;
2253 } re_unwind_t;
2254
2255 #define sayYES goto yes
2256 #define sayNO goto no
2257 #define sayNO_ANYOF goto no_anyof
2258 #define sayYES_FINAL goto yes_final
2259 #define sayYES_LOUD  goto yes_loud
2260 #define sayNO_FINAL  goto no_final
2261 #define sayNO_SILENT goto do_no
2262 #define saySAME(x) if (x) goto yes; else goto no
2263
2264 #define POSCACHE_SUCCESS 0      /* caching success rather than failure */
2265 #define POSCACHE_SEEN 1         /* we know what we're caching */
2266 #define POSCACHE_START 2        /* the real cache: this bit maps to pos 0 */
2267 #define CACHEsayYES STMT_START { \
2268     if (cache_offset | cache_bit) { \
2269         if (!(PL_reg_poscache[0] & (1<<POSCACHE_SEEN))) \
2270             PL_reg_poscache[0] |= (1<<POSCACHE_SUCCESS) || (1<<POSCACHE_SEEN); \
2271         else if (!(PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))) { \
2272             /* cache records failure, but this is success */ \
2273             DEBUG_r( \
2274                 PerlIO_printf(Perl_debug_log, \
2275                     "%*s  (remove success from failure cache)\n", \
2276                     REPORT_CODE_OFF+PL_regindent*2, "") \
2277             ); \
2278             PL_reg_poscache[cache_offset] &= ~(1<<cache_bit); \
2279         } \
2280     } \
2281     sayYES; \
2282 } STMT_END
2283 #define CACHEsayNO STMT_START { \
2284     if (cache_offset | cache_bit) { \
2285         if (!(PL_reg_poscache[0] & (1<<POSCACHE_SEEN))) \
2286             PL_reg_poscache[0] |= (1<<POSCACHE_SEEN); \
2287         else if ((PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))) { \
2288             /* cache records success, but this is failure */ \
2289             DEBUG_r( \
2290                 PerlIO_printf(Perl_debug_log, \
2291                     "%*s  (remove failure from success cache)\n", \
2292                     REPORT_CODE_OFF+PL_regindent*2, "") \
2293             ); \
2294             PL_reg_poscache[cache_offset] &= ~(1<<cache_bit); \
2295         } \
2296     } \
2297     sayNO; \
2298 } STMT_END
2299
2300 /* this is used to determine how far from the left messages like
2301    'failed...' are printed. Currently 29 makes these messages line
2302    up with the opcode they refer to. Earlier perls used 25 which
2303    left these messages outdented making reviewing a debug output
2304    quite difficult.
2305 */
2306 #define REPORT_CODE_OFF 29
2307
2308
2309 /* Make sure there is a test for this +1 options in re_tests */
2310 #define TRIE_INITAL_ACCEPT_BUFFLEN 4;
2311
2312 #define TRIE_CHECK_STATE_IS_ACCEPTING STMT_START {                       \
2313     if ( trie->states[ state ].wordnum ) {                               \
2314         if ( !accepted ) {                                               \
2315             ENTER;                                                       \
2316             SAVETMPS;                                                    \
2317             bufflen = TRIE_INITAL_ACCEPT_BUFFLEN ;                       \
2318             sv_accept_buff=newSV(bufflen * sizeof(reg_trie_accepted) - 1 );\
2319             SvCUR_set( sv_accept_buff, sizeof(reg_trie_accepted) );      \
2320             SvPOK_on( sv_accept_buff );                                  \
2321             sv_2mortal( sv_accept_buff );                                \
2322             accept_buff = (reg_trie_accepted*)SvPV_nolen( sv_accept_buff );\
2323         } else {                                                         \
2324             if ( accepted >= bufflen ) {                                 \
2325                 bufflen *= 2;                                            \
2326                 accept_buff =(reg_trie_accepted*)SvGROW( sv_accept_buff, \
2327                     bufflen * sizeof(reg_trie_accepted) );               \
2328             }                                                            \
2329             SvCUR_set( sv_accept_buff,SvCUR( sv_accept_buff )            \
2330                 + sizeof( reg_trie_accepted ) );                         \
2331         }                                                                \
2332         accept_buff[ accepted ].wordnum = trie->states[ state ].wordnum; \
2333         accept_buff[ accepted ].endpos = uc;                             \
2334         ++accepted;                                                      \
2335     } } STMT_END
2336
2337 #define TRIE_HANDLE_CHAR STMT_START {                                   \
2338         if ( uvc < 256 ) {                                              \
2339             charid = trie->charmap[ uvc ];                              \
2340         } else {                                                        \
2341             charid = 0;                                                 \
2342             if( trie->widecharmap ) {                                   \
2343             SV** svpp = (SV**)NULL;                                     \
2344             svpp = hv_fetch( trie->widecharmap, (char*)&uvc,            \
2345                           sizeof( UV ), 0 );                            \
2346             if ( svpp ) {                                               \
2347                 charid = (U16)SvIV( *svpp );                            \
2348                 }                                                       \
2349             }                                                           \
2350         }                                                               \
2351         if ( charid &&                                                  \
2352              ( base + charid > trie->uniquecharcount ) &&               \
2353              ( base + charid - 1 - trie->uniquecharcount < trie->lasttrans) && \
2354              trie->trans[ base + charid - 1 - trie->uniquecharcount ].check == state ) \
2355         {                                                               \
2356             state = trie->trans[ base + charid - 1 - trie->uniquecharcount ].next;     \
2357         } else {                                                        \
2358             state = 0;                                                  \
2359         }                                                               \
2360         uc += len;                                                      \
2361     } STMT_END
2362
2363 /*
2364  - regmatch - main matching routine
2365  *
2366  * Conceptually the strategy is simple:  check to see whether the current
2367  * node matches, call self recursively to see whether the rest matches,
2368  * and then act accordingly.  In practice we make some effort to avoid
2369  * recursion, in particular by going through "ordinary" nodes (that don't
2370  * need to know whether the rest of the match failed) by a loop instead of
2371  * by recursion.
2372  */
2373 /* [lwall] I've hoisted the register declarations to the outer block in order to
2374  * maybe save a little bit of pushing and popping on the stack.  It also takes
2375  * advantage of machines that use a register save mask on subroutine entry.
2376  */
2377 STATIC I32                      /* 0 failure, 1 success */
2378 S_regmatch(pTHX_ regnode *prog)
2379 {
2380     dVAR;
2381     register regnode *scan;     /* Current node. */
2382     regnode *next;              /* Next node. */
2383     regnode *inner;             /* Next node in internal branch. */
2384     register I32 nextchr;       /* renamed nextchr - nextchar colides with
2385                                    function of same name */
2386     register I32 n;             /* no or next */
2387     register I32 ln = 0;        /* len or last */
2388     register char *s = NULL;    /* operand or save */
2389     register char *locinput = PL_reginput;
2390     register I32 c1 = 0, c2 = 0, paren; /* case fold search, parenth */
2391     int minmod = 0, sw = 0, logical = 0;
2392     I32 unwind = 0;
2393
2394     /* used by the trie code */
2395     SV                 *sv_accept_buff = NULL; /* accepting states we have traversed */
2396     reg_trie_accepted  *accept_buff = NULL;  /* "" */
2397     reg_trie_data      *trie;                /* what trie are we using right now */
2398     U32 accepted = 0;                        /* how many accepting states we have seen*/
2399
2400 #if 0
2401     I32 firstcp = PL_savestack_ix;
2402 #endif
2403     register const bool do_utf8 = PL_reg_match_utf8;
2404 #ifdef DEBUGGING
2405     SV * const dsv0 = PERL_DEBUG_PAD_ZERO(0);
2406     SV * const dsv1 = PERL_DEBUG_PAD_ZERO(1);
2407     SV * const dsv2 = PERL_DEBUG_PAD_ZERO(2);
2408
2409     SV *re_debug_flags = NULL;
2410 #endif
2411     U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
2412
2413     GET_RE_DEBUG_FLAGS;
2414
2415 #ifdef DEBUGGING
2416     PL_regindent++;
2417 #endif
2418
2419
2420     /* Note that nextchr is a byte even in UTF */
2421     nextchr = UCHARAT(locinput);
2422     scan = prog;
2423     while (scan != NULL) {
2424
2425         DEBUG_EXECUTE_r( {
2426             SV * const prop = sv_newmortal();
2427             const int docolor = *PL_colors[0];
2428             const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
2429             int l = (PL_regeol - locinput) > taill ? taill : (PL_regeol - locinput);
2430             /* The part of the string before starttry has one color
2431                (pref0_len chars), between starttry and current
2432                position another one (pref_len - pref0_len chars),
2433                after the current position the third one.
2434                We assume that pref0_len <= pref_len, otherwise we
2435                decrease pref0_len.  */
2436             int pref_len = (locinput - PL_bostr) > (5 + taill) - l
2437                 ? (5 + taill) - l : locinput - PL_bostr;
2438             int pref0_len;
2439
2440             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
2441                 pref_len++;
2442             pref0_len = pref_len  - (locinput - PL_reg_starttry);
2443             if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
2444                 l = ( PL_regeol - locinput > (5 + taill) - pref_len
2445                       ? (5 + taill) - pref_len : PL_regeol - locinput);
2446             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
2447                 l--;
2448             if (pref0_len < 0)
2449                 pref0_len = 0;
2450             if (pref0_len > pref_len)
2451                 pref0_len = pref_len;
2452             regprop(prop, scan);
2453             {
2454               const char * const s0 =
2455                 do_utf8 && OP(scan) != CANY ?
2456                 pv_uni_display(dsv0, (U8*)(locinput - pref_len),
2457                                pref0_len, 60, UNI_DISPLAY_REGEX) :
2458                 locinput - pref_len;
2459               const int len0 = do_utf8 ? strlen(s0) : pref0_len;
2460               const char * const s1 = do_utf8 && OP(scan) != CANY ?
2461                 pv_uni_display(dsv1, (U8*)(locinput - pref_len + pref0_len),
2462                                pref_len - pref0_len, 60, UNI_DISPLAY_REGEX) :
2463                 locinput - pref_len + pref0_len;
2464               const int len1 = do_utf8 ? strlen(s1) : pref_len - pref0_len;
2465               const char * const s2 = do_utf8 && OP(scan) != CANY ?
2466                 pv_uni_display(dsv2, (U8*)locinput,
2467                                PL_regeol - locinput, 60, UNI_DISPLAY_REGEX) :
2468                 locinput;
2469               const int len2 = do_utf8 ? strlen(s2) : l;
2470               PerlIO_printf(Perl_debug_log,
2471                             "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n",
2472                             (IV)(locinput - PL_bostr),
2473                             PL_colors[4],
2474                             len0, s0,
2475                             PL_colors[5],
2476                             PL_colors[2],
2477                             len1, s1,
2478                             PL_colors[3],
2479                             (docolor ? "" : "> <"),
2480                             PL_colors[0],
2481                             len2, s2,
2482                             PL_colors[1],
2483                             15 - l - pref_len + 1,
2484                             "",
2485                             (IV)(scan - PL_regprogram), PL_regindent*2, "",
2486                             SvPVX_const(prop));
2487             }
2488         });
2489
2490         next = scan + NEXT_OFF(scan);
2491         if (next == scan)
2492             next = NULL;
2493
2494         switch (OP(scan)) {
2495         case BOL:
2496             if (locinput == PL_bostr)
2497             {
2498                 /* regtill = regbol; */
2499                 break;
2500             }
2501             sayNO;
2502         case MBOL:
2503             if (locinput == PL_bostr ||
2504                 ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n'))
2505             {
2506                 break;
2507             }
2508             sayNO;
2509         case SBOL:
2510             if (locinput == PL_bostr)
2511                 break;
2512             sayNO;
2513         case GPOS:
2514             if (locinput == PL_reg_ganch)
2515                 break;
2516             sayNO;
2517         case EOL:
2518                 goto seol;
2519         case MEOL:
2520             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2521                 sayNO;
2522             break;
2523         case SEOL:
2524           seol:
2525             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2526                 sayNO;
2527             if (PL_regeol - locinput > 1)
2528                 sayNO;
2529             break;
2530         case EOS:
2531             if (PL_regeol != locinput)
2532                 sayNO;
2533             break;
2534         case SANY:
2535             if (!nextchr && locinput >= PL_regeol)
2536                 sayNO;
2537             if (do_utf8) {
2538                 locinput += PL_utf8skip[nextchr];
2539                 if (locinput > PL_regeol)
2540                     sayNO;
2541                 nextchr = UCHARAT(locinput);
2542             }
2543             else
2544                 nextchr = UCHARAT(++locinput);
2545             break;
2546         case CANY:
2547             if (!nextchr && locinput >= PL_regeol)
2548                 sayNO;
2549             nextchr = UCHARAT(++locinput);
2550             break;
2551         case REG_ANY:
2552             if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
2553                 sayNO;
2554             if (do_utf8) {
2555                 locinput += PL_utf8skip[nextchr];
2556                 if (locinput > PL_regeol)
2557                     sayNO;
2558                 nextchr = UCHARAT(locinput);
2559             }
2560             else
2561                 nextchr = UCHARAT(++locinput);
2562             break;
2563
2564
2565
2566         /*
2567            traverse the TRIE keeping track of all accepting states
2568            we transition through until we get to a failing node.
2569
2570            we use two slightly different pieces of code to handle
2571            the traversal depending on whether its case sensitive or
2572            not. we reuse the accept code however. (this should probably
2573            be turned into a macro.)
2574
2575         */
2576         case TRIEF:
2577         case TRIEFL:
2578             {
2579                 U8 *uc = ( U8* )locinput;
2580                 U32 state = 1;
2581                 U16 charid = 0;
2582                 U32 base = 0;
2583                 UV uvc = 0;
2584                 STRLEN len = 0;
2585                 STRLEN foldlen = 0;
2586                 U8 *uscan = (U8*)NULL;
2587                 STRLEN bufflen=0;
2588                 accepted = 0;
2589
2590                 trie = (reg_trie_data*)PL_regdata->data[ ARG( scan ) ];
2591
2592                 while ( state && uc <= (U8*)PL_regeol ) {
2593
2594                     TRIE_CHECK_STATE_IS_ACCEPTING;
2595
2596                     base = trie->states[ state ].trans.base;
2597
2598                     DEBUG_TRIE_EXECUTE_r(
2599                                 PerlIO_printf( Perl_debug_log,
2600                                     "%*s  %sState: %4"UVxf", Base: %4"UVxf", Accepted: %4"UVxf" ",
2601                                     REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
2602                                     (UV)state, (UV)base, (UV)accepted );
2603                     );
2604
2605                     if ( base ) {
2606
2607                         if ( do_utf8 ) {
2608                             if ( foldlen>0 ) {
2609                                 uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags );
2610                                 foldlen -= len;
2611                                 uscan += len;
2612                                 len=0;
2613                             } else {
2614                                 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
2615                                 uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );
2616                                 uvc = to_uni_fold( uvc, foldbuf, &foldlen );
2617                                 foldlen -= UNISKIP( uvc );
2618                                 uscan = foldbuf + UNISKIP( uvc );
2619                             }
2620                         } else {
2621                             uvc = (UV)*uc;
2622                             len = 1;
2623                         }
2624
2625                         TRIE_HANDLE_CHAR;
2626
2627                     } else {
2628                         state = 0;
2629                     }
2630                     DEBUG_TRIE_EXECUTE_r(
2631                         PerlIO_printf( Perl_debug_log,
2632                             "Charid:%3x CV:%4"UVxf" After State: %4"UVxf"%s\n",
2633                             charid, uvc, (UV)state, PL_colors[5] );
2634                     );
2635                 }
2636                 if ( !accepted ) {
2637                    sayNO;
2638                 } else {
2639                     goto TrieAccept;
2640                 }
2641             }
2642             /* unreached codepoint: we jump into the middle of the next case
2643                from previous if blocks */
2644         case TRIE:
2645             {
2646                 U8 *uc = (U8*)locinput;
2647                 U32 state = 1;
2648                 U16 charid = 0;
2649                 U32 base = 0;
2650                 UV uvc = 0;
2651                 STRLEN len = 0;
2652                 STRLEN bufflen = 0;
2653                 accepted = 0;
2654
2655                 trie = (reg_trie_data*)PL_regdata->data[ ARG( scan ) ];
2656
2657                 while ( state && uc <= (U8*)PL_regeol ) {
2658
2659                     TRIE_CHECK_STATE_IS_ACCEPTING;
2660
2661                     base = trie->states[ state ].trans.base;
2662
2663                     DEBUG_TRIE_EXECUTE_r(
2664                             PerlIO_printf( Perl_debug_log,
2665                                 "%*s  %sState: %4"UVxf", Base: %4"UVxf", Accepted: %4"UVxf" ",
2666                                 REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
2667                                 (UV)state, (UV)base, (UV)accepted );
2668                     );
2669
2670                     if ( base ) {
2671
2672                         if ( do_utf8 ) {
2673                             uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );
2674                         } else {
2675                             uvc = (U32)*uc;
2676                             len = 1;
2677                         }
2678
2679                         TRIE_HANDLE_CHAR;
2680
2681                     } else {
2682                         state = 0;
2683                     }
2684                     DEBUG_TRIE_EXECUTE_r(
2685                             PerlIO_printf( Perl_debug_log,
2686                                 "Charid:%3x CV:%4"UVxf" After State: %4"UVxf"%s\n",
2687                                 charid, uvc, (UV)state, PL_colors[5] );
2688                     );
2689                 }
2690                 if ( !accepted ) {
2691                    sayNO;
2692                 }
2693             }
2694
2695
2696             /*
2697                There was at least one accepting state that we
2698                transitioned through. Presumably the number of accepting
2699                states is going to be low, typically one or two. So we
2700                simply scan through to find the one with lowest wordnum.
2701                Once we find it, we swap the last state into its place
2702                and decrement the size. We then try to match the rest of
2703                the pattern at the point where the word ends, if we
2704                succeed then we end the loop, otherwise the loop
2705                eventually terminates once all of the accepting states
2706                have been tried.
2707             */
2708         TrieAccept:
2709             {
2710                 int gotit = 0;
2711
2712                 if ( accepted == 1 ) {
2713                     DEBUG_EXECUTE_r({
2714                         SV **tmp = av_fetch( trie->words, accept_buff[ 0 ].wordnum-1, 0 );
2715                         PerlIO_printf( Perl_debug_log,
2716                             "%*s  %sonly one match : #%d <%s>%s\n",
2717                             REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
2718                             accept_buff[ 0 ].wordnum,
2719                             tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",
2720                             PL_colors[5] );
2721                     });
2722                     PL_reginput = (char *)accept_buff[ 0 ].endpos;
2723                     /* in this case we free tmps/leave before we call regmatch
2724                        as we wont be using accept_buff again. */
2725                     FREETMPS;
2726                     LEAVE;
2727                     gotit = regmatch( scan + NEXT_OFF( scan ) );
2728                 } else {
2729                     DEBUG_EXECUTE_r(
2730                         PerlIO_printf( Perl_debug_log,"%*s  %sgot %"IVdf" possible matches%s\n",
2731                             REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4], (IV)accepted,
2732                             PL_colors[5] );
2733                     );
2734                     while ( !gotit && accepted-- ) {
2735                         U32 best = 0;
2736                         U32 cur;
2737                         for( cur = 1 ; cur <= accepted ; cur++ ) {
2738                             DEBUG_TRIE_EXECUTE_r(
2739                                 PerlIO_printf( Perl_debug_log,
2740                                     "%*s  %sgot %"IVdf" (%d) as best, looking at %"IVdf" (%d)%s\n",
2741                                     REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
2742                                     (IV)best, accept_buff[ best ].wordnum, (IV)cur,
2743                                     accept_buff[ cur ].wordnum, PL_colors[5] );
2744                             );
2745
2746                             if ( accept_buff[ cur ].wordnum < accept_buff[ best ].wordnum )
2747                                     best = cur;
2748                         }
2749                         DEBUG_EXECUTE_r({
2750                             SV ** const tmp = av_fetch( trie->words, accept_buff[ best ].wordnum - 1, 0 );
2751                             PerlIO_printf( Perl_debug_log, "%*s  %strying alternation #%d <%s> at 0x%p%s\n",
2752                                 REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
2753                                 accept_buff[best].wordnum,
2754                                 tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",scan,
2755                                 PL_colors[5] );
2756                         });
2757                         if ( best<accepted ) {
2758                             reg_trie_accepted tmp = accept_buff[ best ];
2759                             accept_buff[ best ] = accept_buff[ accepted ];
2760                             accept_buff[ accepted ] = tmp;
2761                             best = accepted;
2762                         }
2763                         PL_reginput = (char *)accept_buff[ best ].endpos;
2764
2765                         /*
2766                            as far as I can tell we only need the SAVETMPS/FREETMPS
2767                            for re's with EVAL in them but I'm leaving them in for
2768                            all until I can be sure.
2769                          */
2770                         SAVETMPS;
2771                         gotit = regmatch( scan + NEXT_OFF( scan ) ) ;
2772                         FREETMPS;
2773                     }
2774                     FREETMPS;
2775                     LEAVE;
2776                 }
2777
2778                 if ( gotit ) {
2779                     sayYES;
2780                 } else {
2781                     sayNO;
2782                 }
2783             }
2784             /* unreached codepoint */
2785         case EXACT:
2786             s = STRING(scan);
2787             ln = STR_LEN(scan);
2788             if (do_utf8 != UTF) {
2789                 /* The target and the pattern have differing utf8ness. */
2790                 char *l = locinput;
2791                 const char *e = s + ln;
2792
2793                 if (do_utf8) {
2794                     /* The target is utf8, the pattern is not utf8. */
2795                     while (s < e) {
2796                         STRLEN ulen;
2797                         if (l >= PL_regeol)
2798                              sayNO;
2799                         if (NATIVE_TO_UNI(*(U8*)s) !=
2800                             utf8n_to_uvuni((U8*)l, UTF8_MAXBYTES, &ulen,
2801                                             uniflags))
2802                              sayNO;
2803                         l += ulen;
2804                         s ++;
2805                     }
2806                 }
2807                 else {
2808                     /* The target is not utf8, the pattern is utf8. */
2809                     while (s < e) {
2810                         STRLEN ulen;
2811                         if (l >= PL_regeol)
2812                             sayNO;
2813                         if (NATIVE_TO_UNI(*((U8*)l)) !=
2814                             utf8n_to_uvuni((U8*)s, UTF8_MAXBYTES, &ulen,
2815                                            uniflags))
2816                             sayNO;
2817                         s += ulen;
2818                         l ++;
2819                     }
2820                 }
2821                 locinput = l;
2822                 nextchr = UCHARAT(locinput);
2823                 break;
2824             }
2825             /* The target and the pattern have the same utf8ness. */
2826             /* Inline the first character, for speed. */
2827             if (UCHARAT(s) != nextchr)
2828                 sayNO;
2829             if (PL_regeol - locinput < ln)
2830                 sayNO;
2831             if (ln > 1 && memNE(s, locinput, ln))
2832                 sayNO;
2833             locinput += ln;
2834             nextchr = UCHARAT(locinput);
2835             break;
2836         case EXACTFL:
2837             PL_reg_flags |= RF_tainted;
2838             /* FALL THROUGH */
2839         case EXACTF:
2840             s = STRING(scan);
2841             ln = STR_LEN(scan);
2842
2843             if (do_utf8 || UTF) {
2844               /* Either target or the pattern are utf8. */
2845                 char *l = locinput;
2846                 char *e = PL_regeol;
2847
2848                 if (ibcmp_utf8(s, 0,  ln, (bool)UTF,
2849                                l, &e, 0,  do_utf8)) {
2850                      /* One more case for the sharp s:
2851                       * pack("U0U*", 0xDF) =~ /ss/i,
2852                       * the 0xC3 0x9F are the UTF-8
2853                       * byte sequence for the U+00DF. */
2854                      if (!(do_utf8 &&
2855                            toLOWER(s[0]) == 's' &&
2856                            ln >= 2 &&
2857                            toLOWER(s[1]) == 's' &&
2858                            (U8)l[0] == 0xC3 &&
2859                            e - l >= 2 &&
2860                            (U8)l[1] == 0x9F))
2861                           sayNO;
2862                 }
2863                 locinput = e;
2864                 nextchr = UCHARAT(locinput);
2865                 break;
2866             }
2867
2868             /* Neither the target and the pattern are utf8. */
2869
2870             /* Inline the first character, for speed. */
2871             if (UCHARAT(s) != nextchr &&
2872                 UCHARAT(s) != ((OP(scan) == EXACTF)
2873                                ? PL_fold : PL_fold_locale)[nextchr])
2874                 sayNO;
2875             if (PL_regeol - locinput < ln)
2876                 sayNO;
2877             if (ln > 1 && (OP(scan) == EXACTF
2878                            ? ibcmp(s, locinput, ln)
2879                            : ibcmp_locale(s, locinput, ln)))
2880                 sayNO;
2881             locinput += ln;
2882             nextchr = UCHARAT(locinput);
2883             break;
2884         case ANYOF:
2885             if (do_utf8) {
2886                 STRLEN inclasslen = PL_regeol - locinput;
2887
2888                 if (!reginclass(scan, (U8*)locinput, &inclasslen, do_utf8))
2889                     sayNO_ANYOF;
2890                 if (locinput >= PL_regeol)
2891                     sayNO;
2892                 locinput += inclasslen ? inclasslen : UTF8SKIP(locinput);
2893                 nextchr = UCHARAT(locinput);
2894                 break;
2895             }
2896             else {
2897                 if (nextchr < 0)
2898                     nextchr = UCHARAT(locinput);
2899                 if (!REGINCLASS(scan, (U8*)locinput))
2900                     sayNO_ANYOF;
2901                 if (!nextchr && locinput >= PL_regeol)
2902                     sayNO;
2903                 nextchr = UCHARAT(++locinput);
2904                 break;
2905             }
2906         no_anyof:
2907             /* If we might have the case of the German sharp s
2908              * in a casefolding Unicode character class. */
2909
2910             if (ANYOF_FOLD_SHARP_S(scan, locinput, PL_regeol)) {
2911                  locinput += SHARP_S_SKIP;
2912                  nextchr = UCHARAT(locinput);
2913             }
2914             else
2915                  sayNO;
2916             break;
2917         case ALNUML:
2918             PL_reg_flags |= RF_tainted;
2919             /* FALL THROUGH */
2920         case ALNUM:
2921             if (!nextchr)
2922                 sayNO;
2923             if (do_utf8) {
2924                 LOAD_UTF8_CHARCLASS_ALNUM();
2925                 if (!(OP(scan) == ALNUM
2926                       ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2927                       : isALNUM_LC_utf8((U8*)locinput)))
2928                 {
2929                     sayNO;
2930                 }
2931                 locinput += PL_utf8skip[nextchr];
2932                 nextchr = UCHARAT(locinput);
2933                 break;
2934             }
2935             if (!(OP(scan) == ALNUM
2936                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
2937                 sayNO;
2938             nextchr = UCHARAT(++locinput);
2939             break;
2940         case NALNUML:
2941             PL_reg_flags |= RF_tainted;
2942             /* FALL THROUGH */
2943         case NALNUM:
2944             if (!nextchr && locinput >= PL_regeol)
2945                 sayNO;
2946             if (do_utf8) {
2947                 LOAD_UTF8_CHARCLASS_ALNUM();
2948                 if (OP(scan) == NALNUM
2949                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2950                     : isALNUM_LC_utf8((U8*)locinput))
2951                 {
2952                     sayNO;
2953                 }
2954                 locinput += PL_utf8skip[nextchr];
2955                 nextchr = UCHARAT(locinput);
2956                 break;
2957             }
2958             if (OP(scan) == NALNUM
2959                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
2960                 sayNO;
2961             nextchr = UCHARAT(++locinput);
2962             break;
2963         case BOUNDL:
2964         case NBOUNDL:
2965             PL_reg_flags |= RF_tainted;
2966             /* FALL THROUGH */
2967         case BOUND:
2968         case NBOUND:
2969             /* was last char in word? */
2970             if (do_utf8) {
2971                 if (locinput == PL_bostr)
2972                     ln = '\n';
2973                 else {
2974                     const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
2975
2976                     ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, 0);
2977                 }
2978                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2979                     ln = isALNUM_uni(ln);
2980                     LOAD_UTF8_CHARCLASS_ALNUM();
2981                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
2982                 }
2983                 else {
2984                     ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
2985                     n = isALNUM_LC_utf8((U8*)locinput);
2986                 }
2987             }
2988             else {
2989                 ln = (locinput != PL_bostr) ?
2990                     UCHARAT(locinput - 1) : '\n';
2991                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2992                     ln = isALNUM(ln);
2993                     n = isALNUM(nextchr);
2994                 }
2995                 else {
2996                     ln = isALNUM_LC(ln);
2997                     n = isALNUM_LC(nextchr);
2998                 }
2999             }
3000             if (((!ln) == (!n)) == (OP(scan) == BOUND ||
3001                                     OP(scan) == BOUNDL))
3002                     sayNO;
3003             break;
3004         case SPACEL:
3005             PL_reg_flags |= RF_tainted;
3006             /* FALL THROUGH */
3007         case SPACE:
3008             if (!nextchr)
3009                 sayNO;
3010             if (do_utf8) {
3011                 if (UTF8_IS_CONTINUED(nextchr)) {
3012                     LOAD_UTF8_CHARCLASS_SPACE();
3013                     if (!(OP(scan) == SPACE
3014                           ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3015                           : isSPACE_LC_utf8((U8*)locinput)))
3016                     {
3017                         sayNO;
3018                     }
3019                     locinput += PL_utf8skip[nextchr];
3020                     nextchr = UCHARAT(locinput);
3021                     break;
3022                 }
3023                 if (!(OP(scan) == SPACE
3024                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3025                     sayNO;
3026                 nextchr = UCHARAT(++locinput);
3027             }
3028             else {
3029                 if (!(OP(scan) == SPACE
3030                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3031                     sayNO;
3032                 nextchr = UCHARAT(++locinput);
3033             }
3034             break;
3035         case NSPACEL:
3036             PL_reg_flags |= RF_tainted;
3037             /* FALL THROUGH */
3038         case NSPACE:
3039             if (!nextchr && locinput >= PL_regeol)
3040                 sayNO;
3041             if (do_utf8) {
3042                 LOAD_UTF8_CHARCLASS_SPACE();
3043                 if (OP(scan) == NSPACE
3044                     ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3045                     : isSPACE_LC_utf8((U8*)locinput))
3046                 {
3047                     sayNO;
3048                 }
3049                 locinput += PL_utf8skip[nextchr];
3050                 nextchr = UCHARAT(locinput);
3051                 break;
3052             }
3053             if (OP(scan) == NSPACE
3054                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
3055                 sayNO;
3056             nextchr = UCHARAT(++locinput);
3057             break;
3058         case DIGITL:
3059             PL_reg_flags |= RF_tainted;
3060             /* FALL THROUGH */
3061         case DIGIT:
3062             if (!nextchr)
3063                 sayNO;
3064             if (do_utf8) {
3065                 LOAD_UTF8_CHARCLASS_DIGIT();
3066                 if (!(OP(scan) == DIGIT
3067                       ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3068                       : isDIGIT_LC_utf8((U8*)locinput)))
3069                 {
3070                     sayNO;
3071                 }
3072                 locinput += PL_utf8skip[nextchr];
3073                 nextchr = UCHARAT(locinput);
3074                 break;
3075             }
3076             if (!(OP(scan) == DIGIT
3077                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
3078                 sayNO;
3079             nextchr = UCHARAT(++locinput);
3080             break;
3081         case NDIGITL:
3082             PL_reg_flags |= RF_tainted;
3083             /* FALL THROUGH */
3084         case NDIGIT:
3085             if (!nextchr && locinput >= PL_regeol)
3086                 sayNO;
3087             if (do_utf8) {
3088                 LOAD_UTF8_CHARCLASS_DIGIT();
3089                 if (OP(scan) == NDIGIT
3090                     ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3091                     : isDIGIT_LC_utf8((U8*)locinput))
3092                 {
3093                     sayNO;
3094                 }
3095                 locinput += PL_utf8skip[nextchr];
3096                 nextchr = UCHARAT(locinput);
3097                 break;
3098             }
3099             if (OP(scan) == NDIGIT
3100                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
3101                 sayNO;
3102             nextchr = UCHARAT(++locinput);
3103             break;
3104         case CLUMP:
3105             if (locinput >= PL_regeol)
3106                 sayNO;
3107             if  (do_utf8) {
3108                 LOAD_UTF8_CHARCLASS_MARK();
3109                 if (swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3110                     sayNO;
3111                 locinput += PL_utf8skip[nextchr];
3112                 while (locinput < PL_regeol &&
3113                        swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3114                     locinput += UTF8SKIP(locinput);
3115                 if (locinput > PL_regeol)
3116                     sayNO;
3117             }
3118             else
3119                locinput++;
3120             nextchr = UCHARAT(locinput);
3121             break;
3122         case REFFL:
3123             PL_reg_flags |= RF_tainted;
3124             /* FALL THROUGH */
3125         case REF:
3126         case REFF:
3127             n = ARG(scan);  /* which paren pair */
3128             ln = PL_regstartp[n];
3129             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3130             if ((I32)*PL_reglastparen < n || ln == -1)
3131                 sayNO;                  /* Do not match unless seen CLOSEn. */
3132             if (ln == PL_regendp[n])
3133                 break;
3134
3135             s = PL_bostr + ln;
3136             if (do_utf8 && OP(scan) != REF) {   /* REF can do byte comparison */
3137                 char *l = locinput;
3138                 const char *e = PL_bostr + PL_regendp[n];
3139                 /*
3140                  * Note that we can't do the "other character" lookup trick as
3141                  * in the 8-bit case (no pun intended) because in Unicode we
3142                  * have to map both upper and title case to lower case.
3143                  */
3144                 if (OP(scan) == REFF) {
3145                     while (s < e) {
3146                         STRLEN ulen1, ulen2;
3147                         U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
3148                         U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
3149
3150                         if (l >= PL_regeol)
3151                             sayNO;
3152                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
3153                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
3154                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
3155                             sayNO;
3156                         s += ulen1;
3157                         l += ulen2;
3158                     }
3159                 }
3160                 locinput = l;
3161                 nextchr = UCHARAT(locinput);
3162                 break;
3163             }
3164
3165             /* Inline the first character, for speed. */
3166             if (UCHARAT(s) != nextchr &&
3167                 (OP(scan) == REF ||
3168                  (UCHARAT(s) != ((OP(scan) == REFF
3169                                   ? PL_fold : PL_fold_locale)[nextchr]))))
3170                 sayNO;
3171             ln = PL_regendp[n] - ln;
3172             if (locinput + ln > PL_regeol)
3173                 sayNO;
3174             if (ln > 1 && (OP(scan) == REF
3175                            ? memNE(s, locinput, ln)
3176                            : (OP(scan) == REFF
3177                               ? ibcmp(s, locinput, ln)
3178                               : ibcmp_locale(s, locinput, ln))))
3179                 sayNO;
3180             locinput += ln;
3181             nextchr = UCHARAT(locinput);
3182             break;
3183
3184         case NOTHING:
3185         case TAIL:
3186             break;
3187         case BACK:
3188             break;
3189         case EVAL:
3190         {
3191             dSP;
3192             OP_4tree * const oop = PL_op;
3193             COP * const ocurcop = PL_curcop;
3194             PAD *old_comppad;
3195             SV *ret;
3196             struct regexp * const oreg = PL_reg_re;
3197
3198             n = ARG(scan);
3199             PL_op = (OP_4tree*)PL_regdata->data[n];
3200             DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
3201             PAD_SAVE_LOCAL(old_comppad, (PAD*)PL_regdata->data[n + 2]);
3202             PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
3203
3204             {
3205                 SV ** const before = SP;
3206                 CALLRUNOPS(aTHX);                       /* Scalar context. */
3207                 SPAGAIN;
3208                 if (SP == before)
3209                     ret = &PL_sv_undef;   /* protect against empty (?{}) blocks. */
3210                 else {
3211                     ret = POPs;
3212                     PUTBACK;
3213                 }
3214             }
3215
3216             PL_op = oop;
3217             PAD_RESTORE_LOCAL(old_comppad);
3218             PL_curcop = ocurcop;
3219             if (logical) {
3220                 if (logical == 2) {     /* Postponed subexpression. */
3221                     regexp *re;
3222                     MAGIC *mg = NULL;
3223                     re_cc_state state;
3224                     CHECKPOINT cp, lastcp;
3225                     int toggleutf;
3226                     register SV *sv;
3227
3228                     if(SvROK(ret) && SvSMAGICAL(sv = SvRV(ret)))
3229                         mg = mg_find(sv, PERL_MAGIC_qr);
3230                     else if (SvSMAGICAL(ret)) {
3231                         if (SvGMAGICAL(ret))
3232                             sv_unmagic(ret, PERL_MAGIC_qr);
3233                         else
3234                             mg = mg_find(ret, PERL_MAGIC_qr);
3235                     }
3236
3237                     if (mg) {
3238                         re = (regexp *)mg->mg_obj;
3239                         (void)ReREFCNT_inc(re);
3240                     }
3241                     else {
3242                         STRLEN len;
3243                         const char * const t = SvPV_const(ret, len);
3244                         PMOP pm;
3245                         char * const oprecomp = PL_regprecomp;
3246                         const I32 osize = PL_regsize;
3247                         const I32 onpar = PL_regnpar;
3248
3249                         Zero(&pm, 1, PMOP);
3250                         if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
3251                         re = CALLREGCOMP(aTHX_ (char*)t, (char*)t + len, &pm);
3252                         if (!(SvFLAGS(ret)
3253                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
3254                                 | SVs_GMG)))
3255                             sv_magic(ret,(SV*)ReREFCNT_inc(re),
3256                                         PERL_MAGIC_qr,0,0);
3257                         PL_regprecomp = oprecomp;
3258                         PL_regsize = osize;
3259                         PL_regnpar = onpar;
3260                     }
3261                     DEBUG_EXECUTE_r(
3262                         PerlIO_printf(Perl_debug_log,
3263                                       "Entering embedded \"%s%.60s%s%s\"\n",
3264                                       PL_colors[0],
3265                                       re->precomp,
3266                                       PL_colors[1],
3267                                       (strlen(re->precomp) > 60 ? "..." : ""))
3268                         );
3269                     state.node = next;
3270                     state.prev = PL_reg_call_cc;
3271                     state.cc = PL_regcc;
3272                     state.re = PL_reg_re;
3273
3274                     PL_regcc = 0;
3275
3276                     cp = regcppush(0);  /* Save *all* the positions. */
3277                     REGCP_SET(lastcp);
3278                     cache_re(re);
3279                     state.ss = PL_savestack_ix;
3280                     *PL_reglastparen = 0;
3281                     *PL_reglastcloseparen = 0;
3282                     PL_reg_call_cc = &state;
3283                     PL_reginput = locinput;
3284                     toggleutf = ((PL_reg_flags & RF_utf8) != 0) ^
3285                                 ((re->reganch & ROPT_UTF8) != 0);
3286                     if (toggleutf) PL_reg_flags ^= RF_utf8;
3287
3288                     /* XXXX This is too dramatic a measure... */
3289                     PL_reg_maxiter = 0;
3290
3291                     if (regmatch(re->program + 1)) {
3292                         /* Even though we succeeded, we need to restore
3293                            global variables, since we may be wrapped inside
3294                            SUSPEND, thus the match may be not finished yet. */
3295
3296                         /* XXXX Do this only if SUSPENDed? */
3297                         PL_reg_call_cc = state.prev;
3298                         PL_regcc = state.cc;
3299                         PL_reg_re = state.re;
3300                         cache_re(PL_reg_re);
3301                         if (toggleutf) PL_reg_flags ^= RF_utf8;
3302
3303                         /* XXXX This is too dramatic a measure... */
3304                         PL_reg_maxiter = 0;
3305
3306                         /* These are needed even if not SUSPEND. */
3307                         ReREFCNT_dec(re);
3308                         regcpblow(cp);
3309                         sayYES;
3310                     }
3311                     ReREFCNT_dec(re);
3312                     REGCP_UNWIND(lastcp);
3313                     regcppop();
3314                     PL_reg_call_cc = state.prev;
3315                     PL_regcc = state.cc;
3316                     PL_reg_re = state.re;
3317                     cache_re(PL_reg_re);
3318                     if (toggleutf) PL_reg_flags ^= RF_utf8;
3319
3320                     /* XXXX This is too dramatic a measure... */
3321                     PL_reg_maxiter = 0;
3322
3323                     logical = 0;
3324                     sayNO;
3325                 }
3326                 sw = SvTRUE(ret);
3327                 logical = 0;
3328             }
3329             else {
3330                 sv_setsv(save_scalar(PL_replgv), ret);
3331                 cache_re(oreg);
3332             }
3333             break;
3334         }
3335         case OPEN:
3336             n = ARG(scan);  /* which paren pair */
3337             PL_reg_start_tmp[n] = locinput;
3338             if (n > PL_regsize)
3339                 PL_regsize = n;
3340             break;
3341         case CLOSE:
3342             n = ARG(scan);  /* which paren pair */
3343             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
3344             PL_regendp[n] = locinput - PL_bostr;
3345             if (n > (I32)*PL_reglastparen)
3346                 *PL_reglastparen = n;
3347             *PL_reglastcloseparen = n;
3348             break;
3349         case GROUPP:
3350             n = ARG(scan);  /* which paren pair */
3351             sw = ((I32)*PL_reglastparen >= n && PL_regendp[n] != -1);
3352             break;
3353         case IFTHEN:
3354             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3355             if (sw)
3356                 next = NEXTOPER(NEXTOPER(scan));
3357             else {
3358                 next = scan + ARG(scan);
3359                 if (OP(next) == IFTHEN) /* Fake one. */
3360                     next = NEXTOPER(NEXTOPER(next));
3361             }
3362             break;
3363         case LOGICAL:
3364             logical = scan->flags;
3365             break;
3366 /*******************************************************************
3367  PL_regcc contains infoblock about the innermost (...)* loop, and
3368  a pointer to the next outer infoblock.
3369
3370  Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM):
3371
3372    1) After matching X, regnode for CURLYX is processed;
3373
3374    2) This regnode creates infoblock on the stack, and calls
3375       regmatch() recursively with the starting point at WHILEM node;
3376
3377    3) Each hit of WHILEM node tries to match A and Z (in the order
3378       depending on the current iteration, min/max of {min,max} and
3379       greediness).  The information about where are nodes for "A"
3380       and "Z" is read from the infoblock, as is info on how many times "A"
3381       was already matched, and greediness.
3382
3383    4) After A matches, the same WHILEM node is hit again.
3384
3385    5) Each time WHILEM is hit, PL_regcc is the infoblock created by CURLYX
3386       of the same pair.  Thus when WHILEM tries to match Z, it temporarily
3387       resets PL_regcc, since this Y(A)*Z can be a part of some other loop:
3388       as in (Y(A)*Z)*.  If Z matches, the automaton will hit the WHILEM node
3389       of the external loop.
3390
3391  Currently present infoblocks form a tree with a stem formed by PL_curcc
3392  and whatever it mentions via ->next, and additional attached trees
3393  corresponding to temporarily unset infoblocks as in "5" above.
3394
3395  In the following picture infoblocks for outer loop of
3396  (Y(A)*?Z)*?T are denoted O, for inner I.  NULL starting block
3397  is denoted by x.  The matched string is YAAZYAZT.  Temporarily postponed
3398  infoblocks are drawn below the "reset" infoblock.
3399
3400  In fact in the picture below we do not show failed matches for Z and T
3401  by WHILEM blocks.  [We illustrate minimal matches, since for them it is
3402  more obvious *why* one needs to *temporary* unset infoblocks.]
3403
3404   Matched       REx position    InfoBlocks      Comment
3405                 (Y(A)*?Z)*?T    x
3406                 Y(A)*?Z)*?T     x <- O
3407   Y             (A)*?Z)*?T      x <- O
3408   Y             A)*?Z)*?T       x <- O <- I
3409   YA            )*?Z)*?T        x <- O <- I
3410   YA            A)*?Z)*?T       x <- O <- I
3411   YAA           )*?Z)*?T        x <- O <- I
3412   YAA           Z)*?T           x <- O          # Temporary unset I
3413                                      I
3414
3415   YAAZ          Y(A)*?Z)*?T     x <- O
3416                                      I
3417
3418   YAAZY         (A)*?Z)*?T      x <- O
3419                                      I
3420
3421   YAAZY         A)*?Z)*?T       x <- O <- I
3422                                      I
3423
3424   YAAZYA        )*?Z)*?T        x <- O <- I
3425                                      I
3426
3427   YAAZYA        Z)*?T           x <- O          # Temporary unset I
3428                                      I,I
3429
3430   YAAZYAZ       )*?T            x <- O
3431                                      I,I
3432
3433   YAAZYAZ       T               x               # Temporary unset O
3434                                 O
3435                                 I,I
3436
3437   YAAZYAZT                      x
3438                                 O
3439                                 I,I
3440  *******************************************************************/
3441         case CURLYX: {
3442                 CURCUR cc;
3443                 CHECKPOINT cp = PL_savestack_ix;
3444                 /* No need to save/restore up to this paren */
3445                 I32 parenfloor = scan->flags;
3446
3447                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
3448                     next += ARG(next);
3449                 cc.oldcc = PL_regcc;
3450                 PL_regcc = &cc;
3451                 /* XXXX Probably it is better to teach regpush to support
3452                    parenfloor > PL_regsize... */
3453                 if (parenfloor > (I32)*PL_reglastparen)
3454                     parenfloor = *PL_reglastparen; /* Pessimization... */
3455                 cc.parenfloor = parenfloor;
3456                 cc.cur = -1;
3457                 cc.min = ARG1(scan);
3458                 cc.max  = ARG2(scan);
3459                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3460                 cc.next = next;
3461                 cc.minmod = minmod;
3462                 cc.lastloc = 0;
3463                 PL_reginput = locinput;
3464                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
3465                 regcpblow(cp);
3466                 PL_regcc = cc.oldcc;
3467                 saySAME(n);
3468             }
3469             /* NOTREACHED */
3470         case WHILEM: {
3471                 /*
3472                  * This is really hard to understand, because after we match
3473                  * what we're trying to match, we must make sure the rest of
3474                  * the REx is going to match for sure, and to do that we have
3475                  * to go back UP the parse tree by recursing ever deeper.  And
3476                  * if it fails, we have to reset our parent's current state
3477                  * that we can try again after backing off.
3478                  */
3479
3480                 CHECKPOINT cp, lastcp;
3481                 CURCUR* cc = PL_regcc;
3482                 char * const lastloc = cc->lastloc; /* Detection of 0-len. */
3483                 I32 cache_offset = 0, cache_bit = 0;
3484
3485                 n = cc->cur + 1;        /* how many we know we matched */
3486                 PL_reginput = locinput;
3487
3488                 DEBUG_EXECUTE_r(
3489                     PerlIO_printf(Perl_debug_log,
3490                                   "%*s  %ld out of %ld..%ld  cc=%"UVxf"\n",
3491                                   REPORT_CODE_OFF+PL_regindent*2, "",
3492                                   (long)n, (long)cc->min,
3493                                   (long)cc->max, PTR2UV(cc))
3494                     );
3495
3496                 /* If degenerate scan matches "", assume scan done. */
3497
3498                 if (locinput == cc->lastloc && n >= cc->min) {
3499                     PL_regcc = cc->oldcc;
3500                     if (PL_regcc)
3501                         ln = PL_regcc->cur;
3502                     DEBUG_EXECUTE_r(
3503                         PerlIO_printf(Perl_debug_log,
3504                            "%*s  empty match detected, try continuation...\n",
3505                            REPORT_CODE_OFF+PL_regindent*2, "")
3506                         );
3507                     if (regmatch(cc->next))
3508                         sayYES;
3509                     if (PL_regcc)
3510                         PL_regcc->cur = ln;
3511                     PL_regcc = cc;
3512                     sayNO;
3513                 }
3514
3515                 /* First just match a string of min scans. */
3516
3517                 if (n < cc->min) {
3518                     cc->cur = n;
3519                     cc->lastloc = locinput;
3520                     if (regmatch(cc->scan))
3521                         sayYES;
3522                     cc->cur = n - 1;
3523                     cc->lastloc = lastloc;
3524                     sayNO;
3525                 }
3526
3527                 if (scan->flags) {
3528                     /* Check whether we already were at this position.
3529                         Postpone detection until we know the match is not
3530                         *that* much linear. */
3531                 if (!PL_reg_maxiter) {
3532                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
3533                     PL_reg_leftiter = PL_reg_maxiter;
3534                 }
3535                 if (PL_reg_leftiter-- == 0) {
3536                     const I32 size = (PL_reg_maxiter + 7 + POSCACHE_START)/8;
3537                     if (PL_reg_poscache) {
3538                         if ((I32)PL_reg_poscache_size < size) {
3539                             Renew(PL_reg_poscache, size, char);
3540                             PL_reg_poscache_size = size;
3541                         }
3542                         Zero(PL_reg_poscache, size, char);
3543                     }
3544                     else {
3545                         PL_reg_poscache_size = size;
3546                         Newxz(PL_reg_poscache, size, char);
3547                     }
3548                     DEBUG_EXECUTE_r(
3549                         PerlIO_printf(Perl_debug_log,
3550               "%sDetected a super-linear match, switching on caching%s...\n",
3551                                       PL_colors[4], PL_colors[5])
3552                         );
3553                 }
3554                 if (PL_reg_leftiter < 0) {
3555                     cache_offset = locinput - PL_bostr;
3556
3557                     cache_offset = (scan->flags & 0xf) - 1 + POSCACHE_START
3558                             + cache_offset * (scan->flags>>4);
3559                     cache_bit = cache_offset % 8;
3560                     cache_offset /= 8;
3561                     if (PL_reg_poscache[cache_offset] & (1<<cache_bit)) {
3562                     DEBUG_EXECUTE_r(
3563                         PerlIO_printf(Perl_debug_log,
3564                                       "%*s  already tried at this position...\n",
3565                                       REPORT_CODE_OFF+PL_regindent*2, "")
3566                         );
3567                         if (PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))
3568                             /* cache records success */
3569                             sayYES;
3570                         else
3571                             /* cache records failure */
3572                             sayNO_SILENT;
3573                     }
3574                     PL_reg_poscache[cache_offset] |= (1<<cache_bit);
3575                 }
3576                 }
3577
3578                 /* Prefer next over scan for minimal matching. */
3579
3580                 if (cc->minmod) {
3581                     PL_regcc = cc->oldcc;
3582                     if (PL_regcc)
3583                         ln = PL_regcc->cur;
3584                     cp = regcppush(cc->parenfloor);
3585                     REGCP_SET(lastcp);
3586                     if (regmatch(cc->next)) {
3587                         regcpblow(cp);
3588                         CACHEsayYES;    /* All done. */
3589                     }
3590                     REGCP_UNWIND(lastcp);
3591                     regcppop();
3592                     if (PL_regcc)
3593                         PL_regcc->cur = ln;
3594                     PL_regcc = cc;
3595
3596                     if (n >= cc->max) { /* Maximum greed exceeded? */
3597                         if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3598                             && !(PL_reg_flags & RF_warned)) {
3599                             PL_reg_flags |= RF_warned;
3600                             Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
3601                                  "Complex regular subexpression recursion",
3602                                  REG_INFTY - 1);
3603                         }
3604                         CACHEsayNO;
3605                     }
3606
3607                     DEBUG_EXECUTE_r(
3608                         PerlIO_printf(Perl_debug_log,
3609                                       "%*s  trying longer...\n",
3610                                       REPORT_CODE_OFF+PL_regindent*2, "")
3611                         );
3612                     /* Try scanning more and see if it helps. */
3613                     PL_reginput = locinput;
3614                     cc->cur = n;
3615                     cc->lastloc = locinput;
3616                     cp = regcppush(cc->parenfloor);
3617                     REGCP_SET(lastcp);
3618                     if (regmatch(cc->scan)) {
3619                         regcpblow(cp);
3620                         CACHEsayYES;
3621                     }
3622                     REGCP_UNWIND(lastcp);
3623                     regcppop();
3624                     cc->cur = n - 1;
3625                     cc->lastloc = lastloc;
3626                     CACHEsayNO;
3627                 }
3628
3629                 /* Prefer scan over next for maximal matching. */
3630
3631                 if (n < cc->max) {      /* More greed allowed? */
3632                     cp = regcppush(cc->parenfloor);
3633                     cc->cur = n;
3634                     cc->lastloc = locinput;
3635                     REGCP_SET(lastcp);
3636                     if (regmatch(cc->scan)) {
3637                         regcpblow(cp);
3638                         CACHEsayYES;
3639                     }
3640                     REGCP_UNWIND(lastcp);
3641                     regcppop();         /* Restore some previous $<digit>s? */
3642                     PL_reginput = locinput;
3643                     DEBUG_EXECUTE_r(
3644                         PerlIO_printf(Perl_debug_log,
3645                                       "%*s  failed, try continuation...\n",
3646                                       REPORT_CODE_OFF+PL_regindent*2, "")
3647                         );
3648                 }
3649                 if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3650                         && !(PL_reg_flags & RF_warned)) {
3651                     PL_reg_flags |= RF_warned;
3652                     Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
3653                          "Complex regular subexpression recursion",
3654                          REG_INFTY - 1);
3655                 }
3656
3657                 /* Failed deeper matches of scan, so see if this one works. */
3658                 PL_regcc = cc->oldcc;
3659                 if (PL_regcc)
3660                     ln = PL_regcc->cur;
3661                 if (regmatch(cc->next))
3662                     CACHEsayYES;
3663                 if (PL_regcc)
3664                     PL_regcc->cur = ln;
3665                 PL_regcc = cc;
3666                 cc->cur = n - 1;
3667                 cc->lastloc = lastloc;
3668                 CACHEsayNO;
3669             }
3670             /* NOTREACHED */
3671         case BRANCHJ:
3672             next = scan + ARG(scan);
3673             if (next == scan)
3674                 next = NULL;
3675             inner = NEXTOPER(NEXTOPER(scan));
3676             goto do_branch;
3677         case BRANCH:
3678             inner = NEXTOPER(scan);
3679           do_branch:
3680             {
3681                 c1 = OP(scan);
3682                 if (OP(next) != c1)     /* No choice. */
3683                     next = inner;       /* Avoid recursion. */
3684                 else {
3685                     const I32 lastparen = *PL_reglastparen;
3686                     /* Put unwinding data on stack */
3687                     const I32 unwind1 = SSNEWt(1,re_unwind_branch_t);
3688                     re_unwind_branch_t * const uw = SSPTRt(unwind1,re_unwind_branch_t);
3689
3690                     uw->prev = unwind;
3691                     unwind = unwind1;
3692                     uw->type = ((c1 == BRANCH)
3693                                 ? RE_UNWIND_BRANCH
3694                                 : RE_UNWIND_BRANCHJ);
3695                     uw->lastparen = lastparen;
3696                     uw->next = next;
3697                     uw->locinput = locinput;
3698                     uw->nextchr = nextchr;
3699 #ifdef DEBUGGING
3700                     uw->regindent = ++PL_regindent;
3701 #endif
3702
3703                     REGCP_SET(uw->lastcp);
3704
3705                     /* Now go into the first branch */
3706                     next = inner;
3707                 }
3708             }
3709             break;
3710         case MINMOD:
3711             minmod = 1;
3712             break;
3713         case CURLYM:
3714         {
3715             I32 l = 0;
3716             I32 matches = 0;
3717             CHECKPOINT lastcp;
3718             I32 maxwanted;
3719
3720             /* We suppose that the next guy does not need
3721                backtracking: in particular, it is of constant non-zero length,
3722                and has no parenths to influence future backrefs. */
3723             ln = ARG1(scan);  /* min to match */
3724             n  = ARG2(scan);  /* max to match */
3725             paren = scan->flags;
3726             if (paren) {
3727                 if (paren > PL_regsize)
3728                     PL_regsize = paren;
3729                 if (paren > (I32)*PL_reglastparen)
3730                     *PL_reglastparen = paren;
3731             }
3732             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3733             if (paren)
3734                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
3735             PL_reginput = locinput;
3736             maxwanted = minmod ? ln : n;
3737             if (maxwanted) {
3738                 while (PL_reginput < PL_regeol && matches < maxwanted) {
3739                     if (!regmatch(scan))
3740                         break;
3741                     /* on first match, determine length, l */
3742                     if (!matches++) {
3743                         if (PL_reg_match_utf8) {
3744                             char *s = locinput;
3745                             while (s < PL_reginput) {
3746                                 l++;
3747                                 s += UTF8SKIP(s);
3748                             }
3749                         }
3750                         else {
3751                             l = PL_reginput - locinput;
3752                         }
3753                         if (l == 0) {
3754                             matches = maxwanted;
3755                             break;
3756                         }
3757                     }
3758                     locinput = PL_reginput;
3759                 }
3760             }
3761
3762             PL_reginput = locinput;
3763
3764             if (minmod) {
3765                 minmod = 0;
3766                 if (ln && matches < ln)
3767                     sayNO;
3768                 if (HAS_TEXT(next) || JUMPABLE(next)) {
3769                     regnode *text_node = next;
3770
3771                     if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3772
3773                     if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3774                     else {
3775                         if (PL_regkind[(U8)OP(text_node)] == REF) {
3776                             c1 = c2 = -1000;
3777                             goto assume_ok_MM;
3778                         }
3779                         else { c1 = (U8)*STRING(text_node); }
3780                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3781                             c2 = PL_fold[c1];
3782                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3783                             c2 = PL_fold_locale[c1];
3784                         else
3785                             c2 = c1;
3786                     }
3787                 }
3788                 else
3789                     c1 = c2 = -1000;
3790             assume_ok_MM:
3791                 REGCP_SET(lastcp);
3792                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
3793                     /* If it could work, try it. */
3794                     if (c1 == -1000 ||
3795                         UCHARAT(PL_reginput) == c1 ||
3796                         UCHARAT(PL_reginput) == c2)
3797                     {
3798                         if (paren) {
3799                             if (ln) {
3800                                 PL_regstartp[paren] =
3801                                     HOPc(PL_reginput, -l) - PL_bostr;
3802                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3803                             }
3804                             else
3805                                 PL_regendp[paren] = -1;
3806                         }
3807                         if (regmatch(next))
3808                             sayYES;
3809                         REGCP_UNWIND(lastcp);
3810                     }
3811                     /* Couldn't or didn't -- move forward. */
3812                     PL_reginput = locinput;
3813                     if (regmatch(scan)) {
3814                         ln++;
3815                         locinput = PL_reginput;
3816                     }
3817                     else
3818                         sayNO;
3819                 }
3820             }
3821             else {
3822                 DEBUG_EXECUTE_r(
3823                     PerlIO_printf(Perl_debug_log,
3824                                   "%*s  matched %"IVdf" times, len=%"IVdf"...\n",
3825                                   (int)(REPORT_CODE_OFF+PL_regindent*2), "",
3826                                   (IV) matches, (IV)l)
3827                     );
3828                 if (matches >= ln) {
3829                     if (HAS_TEXT(next) || JUMPABLE(next)) {
3830                         regnode *text_node = next;
3831
3832                         if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3833
3834                         if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3835                         else {
3836                             if (PL_regkind[(U8)OP(text_node)] == REF) {
3837                                 c1 = c2 = -1000;
3838                                 goto assume_ok_REG;
3839                             }
3840                             else { c1 = (U8)*STRING(text_node); }
3841
3842                             if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3843                                 c2 = PL_fold[c1];
3844                             else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3845                                 c2 = PL_fold_locale[c1];
3846                             else
3847                                 c2 = c1;
3848                         }
3849                     }
3850                     else
3851                         c1 = c2 = -1000;
3852                 }
3853             assume_ok_REG:
3854                 REGCP_SET(lastcp);
3855                 while (matches >= ln) {
3856                     /* If it could work, try it. */
3857                     if (c1 == -1000 ||
3858                         UCHARAT(PL_reginput) == c1 ||
3859                         UCHARAT(PL_reginput) == c2)
3860                     {
3861                         DEBUG_EXECUTE_r(
3862                   &nbs