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