regexec.c

   1 /*    regexec.c
   2  */
   3
   4 /*
   5  * "One Ring to rule them all, One Ring to find them..."
   6  */
   7
   8 /* This file contains functions for executing a regular expression.  See
   9  * also regcomp.c which funnily enough, contains functions for compiling
  10  * a regular expression.
  11  *
  12  * This file is also copied at build time to ext/re/re_exec.c, where
  13  * it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
  14  * This causes the main functions to be compiled under new names and with
  15  * debugging support added, which makes "use re 'debug'" work.
  16
  17  */
  18
  19 /* NOTE: this is derived from Henry Spencer's regexp code, and should not
  20  * confused with the original package (see point 3 below).  Thanks, Henry!
  21  */
  22
  23 /* Additional note: this code is very heavily munged from Henry's version
  24  * in places.  In some spots I've traded clarity for efficiency, so don't
  25  * blame Henry for some of the lack of readability.
  26  */
  27
  28 /* The names of the functions have been changed from regcomp and
  29  * regexec to  pregcomp and pregexec in order to avoid conflicts
  30  * with the POSIX routines of the same names.
  31 */
  32
  33 #ifdef PERL_EXT_RE_BUILD
  34 /* need to replace pregcomp et al, so enable that */
  35 #  ifndef PERL_IN_XSUB_RE
  36 #    define PERL_IN_XSUB_RE
  37 #  endif
  38 /* need access to debugger hooks */
  39 #  if defined(PERL_EXT_RE_DEBUG) && !defined(DEBUGGING)
  40 #    define DEBUGGING
  41 #  endif
  42 #endif
  43
  44 #ifdef PERL_IN_XSUB_RE
  45 /* We *really* need to overwrite these symbols: */
  46 #  define Perl_regexec_flags my_regexec
  47 #  define Perl_regdump my_regdump
  48 #  define Perl_regprop my_regprop
  49 #  define Perl_re_intuit_start my_re_intuit_start
  50 /* *These* symbols are masked to allow static link. */
  51 #  define Perl_pregexec my_pregexec
  52 #  define Perl_reginitcolors my_reginitcolors
  53 #  define Perl_regclass_swash my_regclass_swash
  54
  55 #  define PERL_NO_GET_CONTEXT
  56 #endif
  57
  58 /*
  59  * pregcomp and pregexec -- regsub and regerror are not used in perl
  60  *
  61  *      Copyright (c) 1986 by University of Toronto.
  62  *      Written by Henry Spencer.  Not derived from licensed software.
  63  *
  64  *      Permission is granted to anyone to use this software for any
  65  *      purpose on any computer system, and to redistribute it freely,
  66  *      subject to the following restrictions:
  67  *
  68  *      1. The author is not responsible for the consequences of use of
  69  *              this software, no matter how awful, even if they arise
  70  *              from defects in it.
  71  *
  72  *      2. The origin of this software must not be misrepresented, either
  73  *              by explicit claim or by omission.
  74  *
  75  *      3. Altered versions must be plainly marked as such, and must not
  76  *              be misrepresented as being the original software.
  77  *
  78  ****    Alterations to Henry's code are...
  79  ****
  80  ****    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
  81  ****    2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
  82  ****
  83  ****    You may distribute under the terms of either the GNU General Public
  84  ****    License or the Artistic License, as specified in the README file.
  85  *
  86  * Beware that some of this code is subtly aware of the way operator
  87  * precedence is structured in regular expressions.  Serious changes in
  88  * regular-expression syntax might require a total rethink.
  89  */
  90 #include "EXTERN.h"
  91 #define PERL_IN_REGEXEC_C
  92 #include "perl.h"
  93
  94 #include "regcomp.h"
  95
  96 #define RF_tainted      1               /* tainted information used? */
  97 #define RF_warned       2               /* warned about big count? */
  98 #define RF_evaled       4               /* Did an EVAL with setting? */
  99 #define RF_utf8         8               /* String contains multibyte chars? */
 100
 101 #define UTF ((PL_reg_flags & RF_utf8) != 0)
 102
 103 #define RS_init         1               /* eval environment created */
 104 #define RS_set          2               /* replsv value is set */
 105
 106 #ifndef STATIC
 107 #define STATIC  static
 108 #endif
 109
 110 #define REGINCLASS(p,c)  (ANYOF_FLAGS(p) ? reginclass(p,c,0,0) : ANYOF_BITMAP_TEST(p,*(c)))
 111
 112 /*
 113  * Forwards.
 114  */
 115
 116 #define CHR_SVLEN(sv) (do_utf8 ? sv_len_utf8(sv) : SvCUR(sv))
 117 #define CHR_DIST(a,b) (PL_reg_match_utf8 ? utf8_distance(a,b) : a - b)
 118
 119 #define reghop_c(pos,off) ((char*)reghop((U8*)pos, off))
 120 #define reghopmaybe_c(pos,off) ((char*)reghopmaybe((U8*)pos, off))
 121 #define HOP(pos,off) (PL_reg_match_utf8 ? reghop((U8*)pos, off) : (U8*)(pos + off))
 122 #define HOPMAYBE(pos,off) (PL_reg_match_utf8 ? reghopmaybe((U8*)pos, off) : (U8*)(pos + off))
 123 #define HOPc(pos,off) ((char*)HOP(pos,off))
 124 #define HOPMAYBEc(pos,off) ((char*)HOPMAYBE(pos,off))
 125
 126 #define HOPBACK(pos, off) (             \
 127     (PL_reg_match_utf8)                 \
 128         ? reghopmaybe((U8*)pos, -off)   \
 129     : (pos - off >= PL_bostr)           \
 130         ? (U8*)(pos - off)              \
 131     : (U8*)NULL                         \
 132 )
 133 #define HOPBACKc(pos, off) (char*)HOPBACK(pos, off)
 134
 135 #define reghop3_c(pos,off,lim) ((char*)reghop3((U8*)pos, off, (U8*)lim))
 136 #define reghopmaybe3_c(pos,off,lim) ((char*)reghopmaybe3((U8*)pos, off, (U8*)lim))
 137 #define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
 138 #define HOPMAYBE3(pos,off,lim) (PL_reg_match_utf8 ? reghopmaybe3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
 139 #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
 140 #define HOPMAYBE3c(pos,off,lim) ((char*)HOPMAYBE3(pos,off,lim))
 141
 142 #define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \
 143     if (!CAT2(PL_utf8_,class)) { bool ok; ENTER; save_re_context(); ok=CAT2(is_utf8_,class)((U8*)str); assert(ok); LEAVE; } } STMT_END
 144 #define LOAD_UTF8_CHARCLASS_ALNUM() LOAD_UTF8_CHARCLASS(alnum,"a")
 145 #define LOAD_UTF8_CHARCLASS_DIGIT() LOAD_UTF8_CHARCLASS(digit,"0")
 146 #define LOAD_UTF8_CHARCLASS_SPACE() LOAD_UTF8_CHARCLASS(space," ")
 147 #define LOAD_UTF8_CHARCLASS_MARK()  LOAD_UTF8_CHARCLASS(mark, "\xcd\x86")
 148
 149 /* for use after a quantifier and before an EXACT-like node -- japhy */
 150 #define JUMPABLE(rn) ( \
 151     OP(rn) == OPEN || OP(rn) == CLOSE || OP(rn) == EVAL || \
 152     OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
 153     OP(rn) == PLUS || OP(rn) == MINMOD || \
 154     (PL_regkind[(U8)OP(rn)] == CURLY && ARG1(rn) > 0) \
 155 )
 156
 157 #define HAS_TEXT(rn) ( \
 158     PL_regkind[(U8)OP(rn)] == EXACT || PL_regkind[(U8)OP(rn)] == REF \
 159 )
 160
 161 /*
 162   Search for mandatory following text node; for lookahead, the text must
 163   follow but for lookbehind (rn->flags != 0) we skip to the next step.
 164 */
 165 #define FIND_NEXT_IMPT(rn) STMT_START { \
 166     while (JUMPABLE(rn)) \
 167         if (OP(rn) == SUSPEND || PL_regkind[(U8)OP(rn)] == CURLY) \
 168             rn = NEXTOPER(NEXTOPER(rn)); \
 169         else if (OP(rn) == PLUS) \
 170             rn = NEXTOPER(rn); \
 171         else if (OP(rn) == IFMATCH) \
 172             rn = (rn->flags == 0) ? NEXTOPER(NEXTOPER(rn)) : rn + ARG(rn); \
 173         else rn += NEXT_OFF(rn); \
 174 } STMT_END
 175
 176 static void restore_pos(pTHX_ void *arg);
 177
 178 STATIC CHECKPOINT
 179 S_regcppush(pTHX_ I32 parenfloor)
 180 {
 181     const int retval = PL_savestack_ix;
 182 #define REGCP_PAREN_ELEMS 4
 183     const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS;
 184     int p;
 185
 186     if (paren_elems_to_push < 0)
 187         Perl_croak(aTHX_ "panic: paren_elems_to_push < 0");
 188
 189 #define REGCP_OTHER_ELEMS 6
 190     SSGROW(paren_elems_to_push + REGCP_OTHER_ELEMS);
 191     for (p = PL_regsize; p > parenfloor; p--) {
 192 /* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
 193         SSPUSHINT(PL_regendp[p]);
 194         SSPUSHINT(PL_regstartp[p]);
 195         SSPUSHPTR(PL_reg_start_tmp[p]);
 196         SSPUSHINT(p);
 197     }
 198 /* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
 199     SSPUSHINT(PL_regsize);
 200     SSPUSHINT(*PL_reglastparen);
 201     SSPUSHINT(*PL_reglastcloseparen);
 202     SSPUSHPTR(PL_reginput);
 203 #define REGCP_FRAME_ELEMS 2
 204 /* REGCP_FRAME_ELEMS are part of the REGCP_OTHER_ELEMS and
 205  * are needed for the regexp context stack bookkeeping. */
 206     SSPUSHINT(paren_elems_to_push + REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
 207     SSPUSHINT(SAVEt_REGCONTEXT); /* Magic cookie. */
 208
 209     return retval;
 210 }
 211
 212 /* These are needed since we do not localize EVAL nodes: */
 213 #  define REGCP_SET(cp)  DEBUG_r(PerlIO_printf(Perl_debug_log,          \
 214                              "  Setting an EVAL scope, savestack=%"IVdf"\n",    \
 215                              (IV)PL_savestack_ix)); cp = PL_savestack_ix
 216
 217 #  define REGCP_UNWIND(cp)  DEBUG_r(cp != PL_savestack_ix ?             \
 218                                 PerlIO_printf(Perl_debug_log,           \
 219                                 "  Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
 220                                 (IV)(cp), (IV)PL_savestack_ix) : 0); regcpblow(cp)
 221
 222 STATIC char *
 223 S_regcppop(pTHX)
 224 {
 225     I32 i;
 226     U32 paren = 0;
 227     char *input;
 228
 229     /* Pop REGCP_OTHER_ELEMS before the parentheses loop starts. */
 230     i = SSPOPINT;
 231     assert(i == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
 232     i = SSPOPINT; /* Parentheses elements to pop. */
 233     input = (char *) SSPOPPTR;
 234     *PL_reglastcloseparen = SSPOPINT;
 235     *PL_reglastparen = SSPOPINT;
 236     PL_regsize = SSPOPINT;
 237
 238     /* Now restore the parentheses context. */
 239     for (i -= (REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
 240          i > 0; i -= REGCP_PAREN_ELEMS) {
 241         I32 tmps;
 242         paren = (U32)SSPOPINT;
 243         PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
 244         PL_regstartp[paren] = SSPOPINT;
 245         tmps = SSPOPINT;
 246         if (paren <= *PL_reglastparen)
 247             PL_regendp[paren] = tmps;
 248         DEBUG_r(
 249             PerlIO_printf(Perl_debug_log,
 250                           "     restoring \\%"UVuf" to %"IVdf"(%"IVdf")..%"IVdf"%s\n",
 251                           (UV)paren, (IV)PL_regstartp[paren],
 252                           (IV)(PL_reg_start_tmp[paren] - PL_bostr),
 253                           (IV)PL_regendp[paren],
 254                           (paren > *PL_reglastparen ? "(no)" : ""));
 255         );
 256     }
 257     DEBUG_r(
 258         if ((I32)(*PL_reglastparen + 1) <= PL_regnpar) {
 259             PerlIO_printf(Perl_debug_log,
 260                           "     restoring \\%"IVdf"..\\%"IVdf" to undef\n",
 261                           (IV)(*PL_reglastparen + 1), (IV)PL_regnpar);
 262         }
 263     );
 264 #if 1
 265     /* It would seem that the similar code in regtry()
 266      * already takes care of this, and in fact it is in
 267      * a better location to since this code can #if 0-ed out
 268      * but the code in regtry() is needed or otherwise tests
 269      * requiring null fields (pat.t#187 and split.t#{13,14}
 270      * (as of patchlevel 7877)  will fail.  Then again,
 271      * this code seems to be necessary or otherwise
 272      * building DynaLoader will fail:
 273      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
 274      * --jhi */
 275     for (paren = *PL_reglastparen + 1; (I32)paren <= PL_regnpar; paren++) {
 276         if ((I32)paren > PL_regsize)
 277             PL_regstartp[paren] = -1;
 278         PL_regendp[paren] = -1;
 279     }
 280 #endif
 281     return input;
 282 }
 283
 284 STATIC char *
 285 S_regcp_set_to(pTHX_ I32 ss)
 286 {
 287     const I32 tmp = PL_savestack_ix;
 288
 289     PL_savestack_ix = ss;
 290     regcppop();
 291     PL_savestack_ix = tmp;
 292     return Nullch;
 293 }
 294
 295 typedef struct re_cc_state
 296 {
 297     I32 ss;
 298     regnode *node;
 299     struct re_cc_state *prev;
 300     CURCUR *cc;
 301     regexp *re;
 302 } re_cc_state;
 303
 304 #define regcpblow(cp) LEAVE_SCOPE(cp)   /* Ignores regcppush()ed data. */
 305
 306 #define TRYPAREN(paren, n, input) {                             \
 307     if (paren) {                                                \
 308         if (n) {                                                \
 309             PL_regstartp[paren] = HOPc(input, -1) - PL_bostr;   \
 310             PL_regendp[paren] = input - PL_bostr;               \
 311         }                                                       \
 312         else                                                    \
 313             PL_regendp[paren] = -1;                             \
 314     }                                                           \
 315     if (regmatch(next))                                         \
 316         sayYES;                                                 \
 317     if (paren && n)                                             \
 318         PL_regendp[paren] = -1;                                 \
 319 }
 320
 321
 322 /*
 323  * pregexec and friends
 324  */
 325
 326 /*
 327  - pregexec - match a regexp against a string
 328  */
 329 I32
 330 Perl_pregexec(pTHX_ register regexp *prog, char *stringarg, register char *strend,
 331          char *strbeg, I32 minend, SV *screamer, U32 nosave)
 332 /* strend: pointer to null at end of string */
 333 /* strbeg: real beginning of string */
 334 /* minend: end of match must be >=minend after stringarg. */
 335 /* nosave: For optimizations. */
 336 {
 337     return
 338         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
 339                       nosave ? 0 : REXEC_COPY_STR);
 340 }
 341
 342 STATIC void
 343 S_cache_re(pTHX_ regexp *prog)
 344 {
 345     PL_regprecomp = prog->precomp;              /* Needed for FAIL. */
 346 #ifdef DEBUGGING
 347     PL_regprogram = prog->program;
 348 #endif
 349     PL_regnpar = prog->nparens;
 350     PL_regdata = prog->data;
 351     PL_reg_re = prog;
 352 }
 353
 354 /*
 355  * Need to implement the following flags for reg_anch:
 356  *
 357  * USE_INTUIT_NOML              - Useful to call re_intuit_start() first
 358  * USE_INTUIT_ML
 359  * INTUIT_AUTORITATIVE_NOML     - Can trust a positive answer
 360  * INTUIT_AUTORITATIVE_ML
 361  * INTUIT_ONCE_NOML             - Intuit can match in one location only.
 362  * INTUIT_ONCE_ML
 363  *
 364  * Another flag for this function: SECOND_TIME (so that float substrs
 365  * with giant delta may be not rechecked).
 366  */
 367
 368 /* Assumptions: if ANCH_GPOS, then strpos is anchored. XXXX Check GPOS logic */
 369
 370 /* If SCREAM, then SvPVX_const(sv) should be compatible with strpos and strend.
 371    Otherwise, only SvCUR(sv) is used to get strbeg. */
 372
 373 /* XXXX We assume that strpos is strbeg unless sv. */
 374
 375 /* XXXX Some places assume that there is a fixed substring.
 376         An update may be needed if optimizer marks as "INTUITable"
 377         RExen without fixed substrings.  Similarly, it is assumed that
 378         lengths of all the strings are no more than minlen, thus they
 379         cannot come from lookahead.
 380         (Or minlen should take into account lookahead.) */
 381
 382 /* A failure to find a constant substring means that there is no need to make
 383    an expensive call to REx engine, thus we celebrate a failure.  Similarly,
 384    finding a substring too deep into the string means that less calls to
 385    regtry() should be needed.
 386
 387    REx compiler's optimizer found 4 possible hints:
 388         a) Anchored substring;
 389         b) Fixed substring;
 390         c) Whether we are anchored (beginning-of-line or \G);
 391         d) First node (of those at offset 0) which may distingush positions;
 392    We use a)b)d) and multiline-part of c), and try to find a position in the
 393    string which does not contradict any of them.
 394  */
 395
 396 /* Most of decisions we do here should have been done at compile time.
 397    The nodes of the REx which we used for the search should have been
 398    deleted from the finite automaton. */
 399
 400 char *
 401 Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 402                      char *strend, U32 flags, re_scream_pos_data *data)
 403 {
 404     register I32 start_shift = 0;
 405     /* Should be nonnegative! */
 406     register I32 end_shift   = 0;
 407     register char *s;
 408     register SV *check;
 409     char *strbeg;
 410     char *t;
 411     const int do_utf8 = sv ? SvUTF8(sv) : 0;    /* if no sv we have to assume bytes */
 412     I32 ml_anch;
 413     register char *other_last = Nullch; /* other substr checked before this */
 414     char *check_at = Nullch;            /* check substr found at this pos */
 415 #ifdef DEBUGGING
 416     const char * const i_strpos = strpos;
 417     SV * const dsv = PERL_DEBUG_PAD_ZERO(0);
 418 #endif
 419     RX_MATCH_UTF8_set(prog,do_utf8);
 420
 421     if (prog->reganch & ROPT_UTF8) {
 422         DEBUG_r(PerlIO_printf(Perl_debug_log,
 423                               "UTF-8 regex...\n"));
 424         PL_reg_flags |= RF_utf8;
 425     }
 426
 427     DEBUG_r({
 428          const char *s   = PL_reg_match_utf8 ?
 429                          sv_uni_display(dsv, sv, 60, UNI_DISPLAY_REGEX) :
 430                          strpos;
 431          const int   len = PL_reg_match_utf8 ?
 432                          strlen(s) : strend - strpos;
 433          if (!PL_colorset)
 434               reginitcolors();
 435          if (PL_reg_match_utf8)
 436              DEBUG_r(PerlIO_printf(Perl_debug_log,
 437                                    "UTF-8 target...\n"));
 438          PerlIO_printf(Perl_debug_log,
 439                        "%sGuessing start of match, REx%s \"%s%.60s%s%s\" against \"%s%.*s%s%s\"...\n",
 440                        PL_colors[4],PL_colors[5],PL_colors[0],
 441                        prog->precomp,
 442                        PL_colors[1],
 443                        (strlen(prog->precomp) > 60 ? "..." : ""),
 444                        PL_colors[0],
 445                        (int)(len > 60 ? 60 : len),
 446                        s, PL_colors[1],
 447                        (len > 60 ? "..." : "")
 448               );
 449     });
 450
 451     /* CHR_DIST() would be more correct here but it makes things slow. */
 452     if (prog->minlen > strend - strpos) {
 453         DEBUG_r(PerlIO_printf(Perl_debug_log,
 454                               "String too short... [re_intuit_start]\n"));
 455         goto fail;
 456     }
 457     strbeg = (sv && SvPOK(sv)) ? strend - SvCUR(sv) : strpos;
 458     PL_regeol = strend;
 459     if (do_utf8) {
 460         if (!prog->check_utf8 && prog->check_substr)
 461             to_utf8_substr(prog);
 462         check = prog->check_utf8;
 463     } else {
 464         if (!prog->check_substr && prog->check_utf8)
 465             to_byte_substr(prog);
 466         check = prog->check_substr;
 467     }
 468    if (check == &PL_sv_undef) {
 469         DEBUG_r(PerlIO_printf(Perl_debug_log,
 470                 "Non-utf string cannot match utf check string\n"));
 471         goto fail;
 472     }
 473     if (prog->reganch & ROPT_ANCH) {    /* Match at beg-of-str or after \n */
 474         ml_anch = !( (prog->reganch & ROPT_ANCH_SINGLE)
 475                      || ( (prog->reganch & ROPT_ANCH_BOL)
 476                           && !PL_multiline ) ); /* Check after \n? */
 477
 478         if (!ml_anch) {
 479           if ( !(prog->reganch & (ROPT_ANCH_GPOS /* Checked by the caller */
 480                                   | ROPT_IMPLICIT)) /* not a real BOL */
 481                /* SvCUR is not set on references: SvRV and SvPVX_const overlap */
 482                && sv && !SvROK(sv)
 483                && (strpos != strbeg)) {
 484               DEBUG_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
 485               goto fail;
 486           }
 487           if (prog->check_offset_min == prog->check_offset_max &&
 488               !(prog->reganch & ROPT_CANY_SEEN)) {
 489             /* Substring at constant offset from beg-of-str... */
 490             I32 slen;
 491
 492             s = HOP3c(strpos, prog->check_offset_min, strend);
 493             if (SvTAIL(check)) {
 494                 slen = SvCUR(check);    /* >= 1 */
 495
 496                 if ( strend - s > slen || strend - s < slen - 1
 497                      || (strend - s == slen && strend[-1] != '\n')) {
 498                     DEBUG_r(PerlIO_printf(Perl_debug_log, "String too long...\n"));
 499                     goto fail_finish;
 500                 }
 501                 /* Now should match s[0..slen-2] */
 502                 slen--;
 503                 if (slen && (*SvPVX_const(check) != *s
 504                              || (slen > 1
 505                                  && memNE(SvPVX_const(check), s, slen)))) {
 506                   report_neq:
 507                     DEBUG_r(PerlIO_printf(Perl_debug_log, "String not equal...\n"));
 508                     goto fail_finish;
 509                 }
 510             }
 511             else if (*SvPVX_const(check) != *s
 512                      || ((slen = SvCUR(check)) > 1
 513                          && memNE(SvPVX_const(check), s, slen)))
 514                 goto report_neq;
 515             goto success_at_start;
 516           }
 517         }
 518         /* Match is anchored, but substr is not anchored wrt beg-of-str. */
 519         s = strpos;
 520         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
 521         end_shift = prog->minlen - start_shift -
 522             CHR_SVLEN(check) + (SvTAIL(check) != 0);
 523         if (!ml_anch) {
 524             const I32 end = prog->check_offset_max + CHR_SVLEN(check)
 525                                          - (SvTAIL(check) != 0);
 526             const I32 eshift = CHR_DIST((U8*)strend, (U8*)s) - end;
 527
 528             if (end_shift < eshift)
 529                 end_shift = eshift;
 530         }
 531     }
 532     else {                              /* Can match at random position */
 533         ml_anch = 0;
 534         s = strpos;
 535         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
 536         /* Should be nonnegative! */
 537         end_shift = prog->minlen - start_shift -
 538             CHR_SVLEN(check) + (SvTAIL(check) != 0);
 539     }
 540
 541 #ifdef DEBUGGING        /* 7/99: reports of failure (with the older version) */
 542     if (end_shift < 0)
 543         Perl_croak(aTHX_ "panic: end_shift");
 544 #endif
 545
 546   restart:
 547     /* Find a possible match in the region s..strend by looking for
 548        the "check" substring in the region corrected by start/end_shift. */
 549     if (flags & REXEC_SCREAM) {
 550         I32 p = -1;                     /* Internal iterator of scream. */
 551         I32 * const pp = data ? data->scream_pos : &p;
 552
 553         if (PL_screamfirst[BmRARE(check)] >= 0
 554             || ( BmRARE(check) == '\n'
 555                  && (BmPREVIOUS(check) == SvCUR(check) - 1)
 556                  && SvTAIL(check) ))
 557             s = screaminstr(sv, check,
 558                             start_shift + (s - strbeg), end_shift, pp, 0);
 559         else
 560             goto fail_finish;
 561         /* we may be pointing at the wrong string */
 562         if (s && RX_MATCH_COPIED(prog))
 563             s = strbeg + (s - SvPVX_const(sv));
 564         if (data)
 565             *data->scream_olds = s;
 566     }
 567     else if (prog->reganch & ROPT_CANY_SEEN)
 568         s = fbm_instr((U8*)(s + start_shift),
 569                       (U8*)(strend - end_shift),
 570                       check, PL_multiline ? FBMrf_MULTILINE : 0);
 571     else
 572         s = fbm_instr(HOP3(s, start_shift, strend),
 573                       HOP3(strend, -end_shift, strbeg),
 574                       check, PL_multiline ? FBMrf_MULTILINE : 0);
 575
 576     /* Update the count-of-usability, remove useless subpatterns,
 577         unshift s.  */
 578
 579         /* FIXME - DEBUG_EXECUTE_r if that is merged to maint.  */
 580     DEBUG_r(PerlIO_printf(Perl_debug_log, "%s %s substr \"%s%.*s%s\"%s%s",
 581                           (s ? "Found" : "Did not find"),
 582                           (check == (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) ? "anchored" : "floating"),
 583                           PL_colors[0],
 584                           (int)(SvCUR(check) - (SvTAIL(check)!=0)),
 585                           SvPVX_const(check),
 586                           PL_colors[1], (SvTAIL(check) ? "$" : ""),
 587                           (s ? " at offset " : "...\n") ) );
 588
 589     if (!s)
 590         goto fail_finish;
 591
 592     check_at = s;
 593
 594     /* Finish the diagnostic message */
 595     DEBUG_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - i_strpos)) );
 596
 597     /* Got a candidate.  Check MBOL anchoring, and the *other* substr.
 598        Start with the other substr.
 599        XXXX no SCREAM optimization yet - and a very coarse implementation
 600        XXXX /ttx+/ results in anchored="ttx", floating="x".  floating will
 601                 *always* match.  Probably should be marked during compile...
 602        Probably it is right to do no SCREAM here...
 603      */
 604
 605     if (do_utf8 ? (prog->float_utf8 && prog->anchored_utf8) : (prog->float_substr && prog->anchored_substr)) {
 606         /* Take into account the "other" substring. */
 607         /* XXXX May be hopelessly wrong for UTF... */
 608         if (!other_last)
 609             other_last = strpos;
 610         if (check == (do_utf8 ? prog->float_utf8 : prog->float_substr)) {
 611           do_other_anchored:
 612             {
 613                 char * const last = HOP3c(s, -start_shift, strbeg);
 614                 char *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_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                         PL_multiline ? FBMrf_MULTILINE : 0
 646                     );
 647                 DEBUG_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_r(PerlIO_printf(Perl_debug_log,
 658                                                 ", giving up...\n"));
 659                         goto fail_finish;
 660                     }
 661                     DEBUG_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_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_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, PL_multiline ? FBMrf_MULTILINE : 0);
 707             /* FIXME - DEBUG_EXECUTE_r if that is merged to maint  */
 708             DEBUG_r(PerlIO_printf(Perl_debug_log, "%s floating substr \"%s%.*s%s\"%s",
 709                     (s ? "Found" : "Contradicts"),
 710                     PL_colors[0],
 711                       (int)(SvCUR(must) - (SvTAIL(must)!=0)),
 712                       SvPVX_const(must),
 713                       PL_colors[1], (SvTAIL(must) ? "$" : "")));
 714             if (!s) {
 715                 if (last1 == last) {
 716                     DEBUG_r(PerlIO_printf(Perl_debug_log,
 717                                             ", giving up...\n"));
 718                     goto fail_finish;
 719                 }
 720                 DEBUG_r(PerlIO_printf(Perl_debug_log,
 721                     ", trying anchored starting at offset %ld...\n",
 722                     (long)(s1 + 1 - i_strpos)));
 723                 other_last = last;
 724                 s = HOP3c(t, 1, strend);
 725                 goto restart;
 726             }
 727             else {
 728                 DEBUG_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
 729                       (long)(s - i_strpos)));
 730                 other_last = s; /* Fix this later. --Hugo */
 731                 s = s1;
 732                 if (t == strpos)
 733                     goto try_at_start;
 734                 goto try_at_offset;
 735             }
 736         }
 737     }
 738
 739     t = s - prog->check_offset_max;
 740     if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
 741         && (!do_utf8
 742             || ((t = reghopmaybe3_c(s, -prog->check_offset_max, strpos))
 743                  && t > strpos))) {
 744         /* Fixed substring is found far enough so that the match
 745            cannot start at strpos. */
 746       try_at_offset:
 747         if (ml_anch && t[-1] != '\n') {
 748             /* Eventually fbm_*() should handle this, but often
 749                anchored_offset is not 0, so this check will not be wasted. */
 750             /* XXXX In the code below we prefer to look for "^" even in
 751                presence of anchored substrings.  And we search even
 752                beyond the found float position.  These pessimizations
 753                are historical artefacts only.  */
 754           find_anchor:
 755             while (t < strend - prog->minlen) {
 756                 if (*t == '\n') {
 757                     if (t < check_at - prog->check_offset_min) {
 758                         if (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) {
 759                             /* Since we moved from the found position,
 760                                we definitely contradict the found anchored
 761                                substr.  Due to the above check we do not
 762                                contradict "check" substr.
 763                                Thus we can arrive here only if check substr
 764                                is float.  Redo checking for "other"=="fixed".
 765                              */
 766                             strpos = t + 1;
 767                             DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld, rescanning for anchored from offset %ld...\n",
 768                                 PL_colors[0],PL_colors[1], (long)(strpos - i_strpos), (long)(strpos - i_strpos + prog->anchored_offset)));
 769                             goto do_other_anchored;
 770                         }
 771                         /* We don't contradict the found floating substring. */
 772                         /* XXXX Why not check for STCLASS? */
 773                         s = t + 1;
 774                         DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld...\n",
 775                             PL_colors[0],PL_colors[1], (long)(s - i_strpos)));
 776                         goto set_useful;
 777                     }
 778                     /* Position contradicts check-string */
 779                     /* XXXX probably better to look for check-string
 780                        than for "\n", so one should lower the limit for t? */
 781                     DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting lookup for check-string at offset %ld...\n",
 782                         PL_colors[0],PL_colors[1], (long)(t + 1 - i_strpos)));
 783                     other_last = strpos = s = t + 1;
 784                     goto restart;
 785                 }
 786                 t++;
 787             }
 788             DEBUG_r(PerlIO_printf(Perl_debug_log, "Did not find /%s^%s/m...\n",
 789                         PL_colors[0],PL_colors[1]));
 790             goto fail_finish;
 791         }
 792         else {
 793             DEBUG_r(PerlIO_printf(Perl_debug_log, "Starting position does not contradict /%s^%s/m...\n",
 794                         PL_colors[0],PL_colors[1]));
 795         }
 796         s = t;
 797       set_useful:
 798         ++BmUSEFUL(do_utf8 ? prog->check_utf8 : prog->check_substr);    /* hooray/5 */
 799     }
 800     else {
 801         /* The found string does not prohibit matching at strpos,
 802            - no optimization of calling REx engine can be performed,
 803            unless it was an MBOL and we are not after MBOL,
 804            or a future STCLASS check will fail this. */
 805       try_at_start:
 806         /* Even in this situation we may use MBOL flag if strpos is offset
 807            wrt the start of the string. */
 808         if (ml_anch && sv && !SvROK(sv) /* See prev comment on SvROK */
 809             && (strpos != strbeg) && strpos[-1] != '\n'
 810             /* May be due to an implicit anchor of m{.*foo}  */
 811             && !(prog->reganch & ROPT_IMPLICIT))
 812         {
 813             t = strpos;
 814             goto find_anchor;
 815         }
 816         DEBUG_r( if (ml_anch)
 817             PerlIO_printf(Perl_debug_log, "Position at offset %ld does not contradict /%s^%s/m...\n",
 818                         (long)(strpos - i_strpos), PL_colors[0],PL_colors[1]);
 819         );
 820       success_at_start:
 821         if (!(prog->reganch & ROPT_NAUGHTY)     /* XXXX If strpos moved? */
 822             && (do_utf8 ? (
 823                 prog->check_utf8                /* Could be deleted already */
 824                 && --BmUSEFUL(prog->check_utf8) < 0
 825                 && (prog->check_utf8 == prog->float_utf8)
 826             ) : (
 827                 prog->check_substr              /* Could be deleted already */
 828                 && --BmUSEFUL(prog->check_substr) < 0
 829                 && (prog->check_substr == prog->float_substr)
 830             )))
 831         {
 832             /* If flags & SOMETHING - do not do it many times on the same match */
 833             DEBUG_r(PerlIO_printf(Perl_debug_log, "... Disabling check substring...\n"));
 834             SvREFCNT_dec(do_utf8 ? prog->check_utf8 : prog->check_substr);
 835             if (do_utf8 ? prog->check_substr : prog->check_utf8)
 836                 SvREFCNT_dec(do_utf8 ? prog->check_substr : prog->check_utf8);
 837             prog->check_substr = prog->check_utf8 = Nullsv;     /* disable */
 838             prog->float_substr = prog->float_utf8 = Nullsv;     /* clear */
 839             check = Nullsv;                     /* abort */
 840             s = strpos;
 841             /* XXXX This is a remnant of the old implementation.  It
 842                     looks wasteful, since now INTUIT can use many
 843                     other heuristics. */
 844             prog->reganch &= ~RE_USE_INTUIT;
 845         }
 846         else
 847             s = strpos;
 848     }
 849
 850     /* Last resort... */
 851     /* XXXX BmUSEFUL already changed, maybe multiple change is meaningful... */
 852     if (prog->regstclass) {
 853         /* minlen == 0 is possible if regstclass is \b or \B,
 854            and the fixed substr is ''$.
 855            Since minlen is already taken into account, s+1 is before strend;
 856            accidentally, minlen >= 1 guaranties no false positives at s + 1
 857            even for \b or \B.  But (minlen? 1 : 0) below assumes that
 858            regstclass does not come from lookahead...  */
 859         /* If regstclass takes bytelength more than 1: If charlength==1, OK.
 860            This leaves EXACTF only, which is dealt with in find_byclass().  */
 861         const U8* const str = (U8*)STRING(prog->regstclass);
 862         const int cl_l = (PL_regkind[(U8)OP(prog->regstclass)] == EXACT
 863                           ? CHR_DIST((U8 *)str+STR_LEN(prog->regstclass),
 864                                      (U8 *)str)
 865                     : 1);
 866         const char * const endpos = (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
 867                 ? HOP3c(s, (prog->minlen ? cl_l : 0), strend)
 868                 : (prog->float_substr || prog->float_utf8
 869                    ? HOP3c(HOP3c(check_at, -start_shift, strbeg),
 870                            cl_l, strend)
 871                    : strend);
 872
 873         t = s;
 874         cache_re(prog);
 875         s = find_byclass(prog, prog->regstclass, s, endpos, 1);
 876         if (!s) {
 877 #ifdef DEBUGGING
 878             const char *what = 0;
 879 #endif
 880             if (endpos == strend) {
 881                 DEBUG_r( PerlIO_printf(Perl_debug_log,
 882                                 "Could not match STCLASS...\n") );
 883                 goto fail;
 884             }
 885             DEBUG_r( PerlIO_printf(Perl_debug_log,
 886                                    "This position contradicts STCLASS...\n") );
 887             if ((prog->reganch & ROPT_ANCH) && !ml_anch)
 888                 goto fail;
 889             /* Contradict one of substrings */
 890             if (prog->anchored_substr || prog->anchored_utf8) {
 891                 if ((do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) == check) {
 892                     DEBUG_r( what = "anchored" );
 893                   hop_and_restart:
 894                     s = HOP3c(t, 1, strend);
 895                     if (s + start_shift + end_shift > strend) {
 896                         /* XXXX Should be taken into account earlier? */
 897                         DEBUG_r( PerlIO_printf(Perl_debug_log,
 898                                                "Could not match STCLASS...\n") );
 899                         goto fail;
 900                     }
 901                     if (!check)
 902                         goto giveup;
 903                     DEBUG_r( PerlIO_printf(Perl_debug_log,
 904                                 "Looking for %s substr starting at offset %ld...\n",
 905                                  what, (long)(s + start_shift - i_strpos)) );
 906                     goto restart;
 907                 }
 908                 /* Have both, check_string is floating */
 909                 if (t + start_shift >= check_at) /* Contradicts floating=check */
 910                     goto retry_floating_check;
 911                 /* Recheck anchored substring, but not floating... */
 912                 s = check_at;
 913                 if (!check)
 914                     goto giveup;
 915                 DEBUG_r( PerlIO_printf(Perl_debug_log,
 916                           "Looking for anchored substr starting at offset %ld...\n",
 917                           (long)(other_last - i_strpos)) );
 918                 goto do_other_anchored;
 919             }
 920             /* Another way we could have checked stclass at the
 921                current position only: */
 922             if (ml_anch) {
 923                 s = t = t + 1;
 924                 if (!check)
 925                     goto giveup;
 926                 DEBUG_r( PerlIO_printf(Perl_debug_log,
 927                           "Looking for /%s^%s/m starting at offset %ld...\n",
 928                           PL_colors[0],PL_colors[1], (long)(t - i_strpos)) );
 929                 goto try_at_offset;
 930             }
 931             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))     /* Could have been deleted */
 932                 goto fail;
 933             /* Check is floating subtring. */
 934           retry_floating_check:
 935             t = check_at - start_shift;
 936             DEBUG_r( what = "floating" );
 937             goto hop_and_restart;
 938         }
 939         if (t != s) {
 940             DEBUG_r(PerlIO_printf(Perl_debug_log,
 941                         "By STCLASS: moving %ld --> %ld\n",
 942                                   (long)(t - i_strpos), (long)(s - i_strpos))
 943                    );
 944         }
 945         else {
 946             DEBUG_r(PerlIO_printf(Perl_debug_log,
 947                                   "Does not contradict STCLASS...\n");
 948                    );
 949         }
 950     }
 951   giveup:
 952     DEBUG_r(PerlIO_printf(Perl_debug_log, "%s%s:%s match at offset %ld\n",
 953                           PL_colors[4], (check ? "Guessed" : "Giving up"),
 954                           PL_colors[5], (long)(s - i_strpos)) );
 955     return s;
 956
 957   fail_finish:                          /* Substring not found */
 958     if (prog->check_substr || prog->check_utf8)         /* could be removed already */
 959         BmUSEFUL(do_utf8 ? prog->check_utf8 : prog->check_substr) += 5; /* hooray */
 960   fail:
 961     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n",
 962                           PL_colors[4],PL_colors[5]));
 963     return Nullch;
 964 }
 965
 966 /* We know what class REx starts with.  Try to find this position... */
 967 STATIC char *
 968 S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 norun)
 969 {
 970         const I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
 971         char *m;
 972         STRLEN ln;
 973         STRLEN lnc;
 974         register STRLEN uskip;
 975         unsigned int c1;
 976         unsigned int c2;
 977         char *e;
 978         register I32 tmp = 1;   /* Scratch variable? */
 979         register const bool do_utf8 = PL_reg_match_utf8;
 980
 981         /* We know what class it must start with. */
 982         switch (OP(c)) {
 983         case ANYOF:
 984             if (do_utf8) {
 985                  while (s + (uskip = UTF8SKIP(s)) <= strend) {
 986                       if ((ANYOF_FLAGS(c) & ANYOF_UNICODE) ||
 987                           !UTF8_IS_INVARIANT((U8)s[0]) ?
 988                           reginclass(c, (U8*)s, 0, do_utf8) :
 989                           REGINCLASS(c, (U8*)s)) {
 990                            if (tmp && (norun || regtry(prog, s)))
 991                                 goto got_it;
 992                            else
 993                                 tmp = doevery;
 994                       }
 995                       else
 996                            tmp = 1;
 997                       s += uskip;
 998                  }
 999             }
1000             else {
1001                  while (s < strend) {
1002                       STRLEN skip = 1;
1003
1004                       if (REGINCLASS(c, (U8*)s) ||
1005                           (ANYOF_FOLD_SHARP_S(c, s, strend) &&
1006                            /* The assignment of 2 is intentional:
1007                             * for the folded sharp s, the skip is 2. */
1008                            (skip = SHARP_S_SKIP))) {
1009                            if (tmp && (norun || regtry(prog, s)))
1010                                 goto got_it;
1011                            else
1012                                 tmp = doevery;
1013                       }
1014                       else
1015                            tmp = 1;
1016                       s += skip;
1017                  }
1018             }
1019             break;
1020         case CANY:
1021             while (s < strend) {
1022                 if (tmp && (norun || regtry(prog, s)))
1023                     goto got_it;
1024                 else
1025                     tmp = doevery;
1026                 s++;
1027             }
1028             break;
1029         case EXACTF:
1030             m   = STRING(c);
1031             ln  = STR_LEN(c);   /* length to match in octets/bytes */
1032             lnc = (I32) ln;     /* length to match in characters */
1033             if (UTF) {
1034                 STRLEN ulen1, ulen2;
1035                 U8 *sm = (U8 *) m;
1036                 U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
1037                 U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
1038                 const U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
1039
1040                 to_utf8_lower((U8*)m, tmpbuf1, &ulen1);
1041                 to_utf8_upper((U8*)m, tmpbuf2, &ulen2);
1042
1043                 c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXBYTES_CASE,
1044                                     0, uniflags);
1045                 c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXBYTES_CASE,
1046                                     0, uniflags);
1047                 lnc = 0;
1048                 while (sm < ((U8 *) m + ln)) {
1049                     lnc++;
1050                     sm += UTF8SKIP(sm);
1051                 }
1052             }
1053             else {
1054                 c1 = *(U8*)m;
1055                 c2 = PL_fold[c1];
1056             }
1057             goto do_exactf;
1058         case EXACTFL:
1059             m   = STRING(c);
1060             ln  = STR_LEN(c);
1061             lnc = (I32) ln;
1062             c1 = *(U8*)m;
1063             c2 = PL_fold_locale[c1];
1064           do_exactf:
1065             e = HOP3c(strend, -((I32)lnc), s);
1066
1067             if (norun && e < s)
1068                 e = s;                  /* Due to minlen logic of intuit() */
1069
1070             /* The idea in the EXACTF* cases is to first find the
1071              * first character of the EXACTF* node and then, if
1072              * necessary, case-insensitively compare the full
1073              * text of the node.  The c1 and c2 are the first
1074              * characters (though in Unicode it gets a bit
1075              * more complicated because there are more cases
1076              * than just upper and lower: one needs to use
1077              * the so-called folding case for case-insensitive
1078              * matching (called "loose matching" in Unicode).
1079              * ibcmp_utf8() will do just that. */
1080
1081             if (do_utf8) {
1082                 UV c, f;
1083                 U8 tmpbuf [UTF8_MAXBYTES+1];
1084                 STRLEN len, foldlen;
1085                 const U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
1086                 if (c1 == c2) {
1087                     /* Upper and lower of 1st char are equal -
1088                      * probably not a "letter". */
1089                     while (s <= e) {
1090                         c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
1091                                            uniflags);
1092                         if ( c == c1
1093                              && (ln == len ||
1094                                  ibcmp_utf8(s, (char **)0, 0,  do_utf8,
1095                                             m, (char **)0, ln, (bool)UTF))
1096                              && (norun || regtry(prog, s)) )
1097                             goto got_it;
1098                         else {
1099                              U8 foldbuf[UTF8_MAXBYTES_CASE+1];
1100                              uvchr_to_utf8(tmpbuf, c);
1101                              f = to_utf8_fold(tmpbuf, foldbuf, &foldlen);
1102                              if ( f != c
1103                                   && (f == c1 || f == c2)
1104                                   && (ln == foldlen ||
1105                                       !ibcmp_utf8((char *) foldbuf,
1106                                                   (char **)0, foldlen, do_utf8,
1107                                                   m,
1108                                                   (char **)0, ln, (bool)UTF))
1109                                   && (norun || regtry(prog, s)) )
1110                                   goto got_it;
1111                         }
1112                         s += len;
1113                     }
1114                 }
1115                 else {
1116                     while (s <= e) {
1117                       c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
1118                                            uniflags);
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();
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();
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();
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();
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();
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();
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 #ifdef DEBUGGING
1642     SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
1643     SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
1644 #endif
1645     PERL_UNUSED_ARG(data);
1646     RX_MATCH_UTF8_set(prog,do_utf8);
1647
1648     PL_regcc = 0;
1649
1650     cache_re(prog);
1651 #ifdef DEBUGGING
1652     PL_regnarrate = DEBUG_r_TEST;
1653 #endif
1654
1655     /* Be paranoid... */
1656     if (prog == NULL || startpos == NULL) {
1657         Perl_croak(aTHX_ "NULL regexp parameter");
1658         return 0;
1659     }
1660
1661     minlen = prog->minlen;
1662     if (strend - startpos < minlen) {
1663         DEBUG_r(PerlIO_printf(Perl_debug_log,
1664                               "String too short [regexec_flags]...\n"));
1665         goto phooey;
1666     }
1667
1668     /* Check validity of program. */
1669     if (UCHARAT(prog->program) != REG_MAGIC) {
1670         Perl_croak(aTHX_ "corrupted regexp program");
1671     }
1672
1673     PL_reg_flags = 0;
1674     PL_reg_eval_set = 0;
1675     PL_reg_maxiter = 0;
1676
1677     if (prog->reganch & ROPT_UTF8)
1678         PL_reg_flags |= RF_utf8;
1679
1680     /* Mark beginning of line for ^ and lookbehind. */
1681     PL_regbol = startpos;
1682     PL_bostr  = strbeg;
1683     PL_reg_sv = sv;
1684
1685     /* Mark end of line for $ (and such) */
1686     PL_regeol = strend;
1687
1688     /* see how far we have to get to not match where we matched before */
1689     PL_regtill = startpos+minend;
1690
1691     /* We start without call_cc context.  */
1692     PL_reg_call_cc = 0;
1693
1694     /* If there is a "must appear" string, look for it. */
1695     s = startpos;
1696
1697     if (prog->reganch & ROPT_GPOS_SEEN) { /* Need to have PL_reg_ganch */
1698         MAGIC *mg;
1699
1700         if (flags & REXEC_IGNOREPOS)    /* Means: check only at start */
1701             PL_reg_ganch = startpos;
1702         else if (sv && SvTYPE(sv) >= SVt_PVMG
1703                   && SvMAGIC(sv)
1704                   && (mg = mg_find(sv, PERL_MAGIC_regex_global))
1705                   && mg->mg_len >= 0) {
1706             PL_reg_ganch = strbeg + mg->mg_len; /* Defined pos() */
1707             if (prog->reganch & ROPT_ANCH_GPOS) {
1708                 if (s > PL_reg_ganch)
1709                     goto phooey;
1710                 s = PL_reg_ganch;
1711             }
1712         }
1713         else                            /* pos() not defined */
1714             PL_reg_ganch = strbeg;
1715     }
1716
1717     if (!(flags & REXEC_CHECKED) && (prog->check_substr != Nullsv || prog->check_utf8 != Nullsv)) {
1718         re_scream_pos_data d;
1719
1720         d.scream_olds = &scream_olds;
1721         d.scream_pos = &scream_pos;
1722         s = re_intuit_start(prog, sv, s, strend, flags, &d);
1723         if (!s) {
1724             DEBUG_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
1725             goto phooey;        /* not present */
1726         }
1727     }
1728
1729     DEBUG_r({
1730         const char * const s0   = UTF
1731             ? pv_uni_display(dsv0, (U8*)prog->precomp, prog->prelen, 60,
1732                           UNI_DISPLAY_REGEX)
1733             : prog->precomp;
1734         const int len0 = UTF ? SvCUR(dsv0) : prog->prelen;
1735         const char * const s1 = do_utf8 ? sv_uni_display(dsv1, sv, 60,
1736                                                UNI_DISPLAY_REGEX) : startpos;
1737         const int len1 = do_utf8 ? SvCUR(dsv1) : strend - startpos;
1738          if (!PL_colorset)
1739              reginitcolors();
1740          PerlIO_printf(Perl_debug_log,
1741                        "%sMatching REx%s \"%s%*.*s%s%s\" against \"%s%.*s%s%s\"\n",
1742                        PL_colors[4],PL_colors[5],PL_colors[0],
1743                        len0, len0, s0,
1744                        PL_colors[1],
1745                        len0 > 60 ? "..." : "",
1746                        PL_colors[0],
1747                        (int)(len1 > 60 ? 60 : len1),
1748                        s1, PL_colors[1],
1749                        (len1 > 60 ? "..." : "")
1750               );
1751     });
1752
1753     /* Simplest case:  anchored match need be tried only once. */
1754     /*  [unless only anchor is BOL and multiline is set] */
1755     if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
1756         if (s == startpos && regtry(prog, startpos))
1757             goto got_it;
1758         else if (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
1759                  || (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
1760         {
1761             char *end;
1762
1763             if (minlen)
1764                 dontbother = minlen - 1;
1765             end = HOP3c(strend, -dontbother, strbeg) - 1;
1766             /* for multiline we only have to try after newlines */
1767             if (prog->check_substr || prog->check_utf8) {
1768                 if (s == startpos)
1769                     goto after_try;
1770                 while (1) {
1771                     if (regtry(prog, s))
1772                         goto got_it;
1773                   after_try:
1774                     if (s >= end)
1775                         goto phooey;
1776                     if (prog->reganch & RE_USE_INTUIT) {
1777                         s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
1778                         if (!s)
1779                             goto phooey;
1780                     }
1781                     else
1782                         s++;
1783                 }
1784             } else {
1785                 if (s > startpos)
1786                     s--;
1787                 while (s < end) {
1788                     if (*s++ == '\n') { /* don't need PL_utf8skip here */
1789                         if (regtry(prog, s))
1790                             goto got_it;
1791                     }
1792                 }
1793             }
1794         }
1795         goto phooey;
1796     } else if (prog->reganch & ROPT_ANCH_GPOS) {
1797         if (regtry(prog, PL_reg_ganch))
1798             goto got_it;
1799         goto phooey;
1800     }
1801
1802     /* Messy cases:  unanchored match. */
1803     if ((prog->anchored_substr || prog->anchored_utf8) && prog->reganch & ROPT_SKIP) {
1804         /* we have /x+whatever/ */
1805         /* it must be a one character string (XXXX Except UTF?) */
1806         char ch;
1807 #ifdef DEBUGGING
1808         int did_match = 0;
1809 #endif
1810         if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1811             do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1812         ch = SvPVX_const(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr)[0];
1813
1814         if (do_utf8) {
1815             while (s < strend) {
1816                 if (*s == ch) {
1817                     DEBUG_r( did_match = 1 );
1818                     if (regtry(prog, s)) goto got_it;
1819                     s += UTF8SKIP(s);
1820                     while (s < strend && *s == ch)
1821                         s += UTF8SKIP(s);
1822                 }
1823                 s += UTF8SKIP(s);
1824             }
1825         }
1826         else {
1827             while (s < strend) {
1828                 if (*s == ch) {
1829                     DEBUG_r( did_match = 1 );
1830                     if (regtry(prog, s)) goto got_it;
1831                     s++;
1832                     while (s < strend && *s == ch)
1833                         s++;
1834                 }
1835                 s++;
1836             }
1837         }
1838         DEBUG_r(if (!did_match)
1839                 PerlIO_printf(Perl_debug_log,
1840                                   "Did not find anchored character...\n")
1841                );
1842     }
1843     else if (prog->anchored_substr != Nullsv
1844               || prog->anchored_utf8 != Nullsv
1845               || ((prog->float_substr != Nullsv || prog->float_utf8 != Nullsv)
1846                   && prog->float_max_offset < strend - s)) {
1847         SV *must;
1848         I32 back_max;
1849         I32 back_min;
1850         char *last;
1851         char *last1;            /* Last position checked before */
1852 #ifdef DEBUGGING
1853         int did_match = 0;
1854 #endif
1855         if (prog->anchored_substr || prog->anchored_utf8) {
1856             if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1857                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1858             must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
1859             back_max = back_min = prog->anchored_offset;
1860         } else {
1861             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
1862                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1863             must = do_utf8 ? prog->float_utf8 : prog->float_substr;
1864             back_max = prog->float_max_offset;
1865             back_min = prog->float_min_offset;
1866         }
1867         if (must == &PL_sv_undef)
1868             /* could not downgrade utf8 check substring, so must fail */
1869             goto phooey;
1870
1871         last = HOP3c(strend,    /* Cannot start after this */
1872                           -(I32)(CHR_SVLEN(must)
1873                                  - (SvTAIL(must) != 0) + back_min), strbeg);
1874
1875         if (s > PL_bostr)
1876             last1 = HOPc(s, -1);
1877         else
1878             last1 = s - 1;      /* bogus */
1879
1880         /* XXXX check_substr already used to find "s", can optimize if
1881            check_substr==must. */
1882         scream_pos = -1;
1883         dontbother = end_shift;
1884         strend = HOPc(strend, -dontbother);
1885         while ( (s <= last) &&
1886                 ((flags & REXEC_SCREAM)
1887                  ? (s = screaminstr(sv, must, HOP3c(s, back_min, strend) - strbeg,
1888                                     end_shift, &scream_pos, 0))
1889                  : (s = fbm_instr((unsigned char*)HOP3(s, back_min, strend),
1890                                   (unsigned char*)strend, must,
1891                                   PL_multiline ? FBMrf_MULTILINE : 0))) ) {
1892             /* we may be pointing at the wrong string */
1893             if ((flags & REXEC_SCREAM) && RX_MATCH_COPIED(prog))
1894                 s = strbeg + (s - SvPVX_const(sv));
1895             DEBUG_r( did_match = 1 );
1896             if (HOPc(s, -back_max) > last1) {
1897                 last1 = HOPc(s, -back_min);
1898                 s = HOPc(s, -back_max);
1899             }
1900             else {
1901                 char *t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
1902
1903                 last1 = HOPc(s, -back_min);
1904                 s = t;
1905             }
1906             if (do_utf8) {
1907                 while (s <= last1) {
1908                     if (regtry(prog, s))
1909                         goto got_it;
1910                     s += UTF8SKIP(s);
1911                 }
1912             }
1913             else {
1914                 while (s <= last1) {
1915                     if (regtry(prog, s))
1916                         goto got_it;
1917                     s++;
1918                 }
1919             }
1920         }
1921         DEBUG_r(if (!did_match)
1922                     PerlIO_printf(Perl_debug_log,
1923                                   "Did not find %s substr \"%s%.*s%s\"%s...\n",
1924                               ((must == prog->anchored_substr || must == prog->anchored_utf8)
1925                                ? "anchored" : "floating"),
1926                               PL_colors[0],
1927                               (int)(SvCUR(must) - (SvTAIL(must)!=0)),
1928                               SvPVX_const(must),
1929                                   PL_colors[1], (SvTAIL(must) ? "$" : ""))
1930                );
1931         goto phooey;
1932     }
1933     else if ((c = prog->regstclass)) {
1934         if (minlen) {
1935             I32 op = (U8)OP(prog->regstclass);
1936             /* don't bother with what can't match */
1937             if (PL_regkind[op] != EXACT && op != CANY)
1938                 strend = HOPc(strend, -(minlen - 1));
1939         }
1940         DEBUG_r({
1941             SV *prop = sv_newmortal();
1942             const char *s0;
1943             const char *s1;
1944             int len0;
1945             int len1;
1946
1947             regprop(prop, c);
1948             s0 = UTF ?
1949               pv_uni_display(dsv0, (U8*)SvPVX_const(prop), SvCUR(prop), 60,
1950                              UNI_DISPLAY_REGEX) :
1951               SvPVX_const(prop);
1952             len0 = UTF ? SvCUR(dsv0) : SvCUR(prop);
1953             s1 = UTF ?
1954               sv_uni_display(dsv1, sv, 60, UNI_DISPLAY_REGEX) : s;
1955             len1 = UTF ? SvCUR(dsv1) : strend - s;
1956             PerlIO_printf(Perl_debug_log,
1957                           "Matching stclass \"%*.*s\" against \"%*.*s\"\n",
1958                           len0, len0, s0,
1959                           len1, len1, s1);
1960         });
1961         if (find_byclass(prog, c, s, strend, 0))
1962             goto got_it;
1963         DEBUG_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass...\n"));
1964     }
1965     else {
1966         dontbother = 0;
1967         if (prog->float_substr != Nullsv || prog->float_utf8 != Nullsv) {
1968             /* Trim the end. */
1969             char *last;
1970             SV* float_real;
1971
1972             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
1973                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1974             float_real = do_utf8 ? prog->float_utf8 : prog->float_substr;
1975
1976             if (flags & REXEC_SCREAM) {
1977                 last = screaminstr(sv, float_real, s - strbeg,
1978                                    end_shift, &scream_pos, 1); /* last one */
1979                 if (!last)
1980                     last = scream_olds; /* Only one occurrence. */
1981                 /* we may be pointing at the wrong string */
1982                 else if (RX_MATCH_COPIED(prog))
1983                     s = strbeg + (s - SvPVX_const(sv));
1984             }
1985             else {
1986                 STRLEN len;
1987                 const char * const little = SvPV_const(float_real, len);
1988
1989                 if (SvTAIL(float_real)) {
1990                     if (memEQ(strend - len + 1, little, len - 1))
1991                         last = strend - len + 1;
1992                     else if (!PL_multiline)
1993                         last = memEQ(strend - len, little, len)
1994                             ? strend - len : Nullch;
1995                     else
1996                         goto find_last;
1997                 } else {
1998                   find_last:
1999                     if (len)
2000                         last = rninstr(s, strend, little, little + len);
2001                     else
2002                         last = strend;  /* matching "$" */
2003                 }
2004             }
2005             if (last == NULL) {
2006                 DEBUG_r(PerlIO_printf(Perl_debug_log,
2007                                       "%sCan't trim the tail, match fails (should not happen)%s\n",
2008                                       PL_colors[4],PL_colors[5]));
2009                 goto phooey; /* Should not happen! */
2010             }
2011             dontbother = strend - last + prog->float_min_offset;
2012         }
2013         if (minlen && (dontbother < minlen))
2014             dontbother = minlen - 1;
2015         strend -= dontbother;              /* this one's always in bytes! */
2016         /* We don't know much -- general case. */
2017         if (do_utf8) {
2018             for (;;) {
2019                 if (regtry(prog, s))
2020                     goto got_it;
2021                 if (s >= strend)
2022                     break;
2023                 s += UTF8SKIP(s);
2024             };
2025         }
2026         else {
2027             do {
2028                 if (regtry(prog, s))
2029                     goto got_it;
2030             } while (s++ < strend);
2031         }
2032     }
2033
2034     /* Failure. */
2035     goto phooey;
2036
2037 got_it:
2038     RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
2039
2040     if (PL_reg_eval_set) {
2041         /* Preserve the current value of $^R */
2042         if (oreplsv != GvSV(PL_replgv))
2043             sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
2044                                                   restored, the value remains
2045                                                   the same. */
2046         restore_pos(aTHX_ 0);
2047     }
2048
2049     /* make sure $`, $&, $', and $digit will work later */
2050     if ( !(flags & REXEC_NOT_FIRST) ) {
2051         if (RX_MATCH_COPIED(prog)) {
2052             Safefree(prog->subbeg);
2053             RX_MATCH_COPIED_off(prog);
2054         }
2055         if (flags & REXEC_COPY_STR) {
2056             I32 i = PL_regeol - startpos + (stringarg - strbeg);
2057
2058             s = savepvn(strbeg, i);
2059             prog->subbeg = s;
2060             prog->sublen = i;
2061             RX_MATCH_COPIED_on(prog);
2062         }
2063         else {
2064             prog->subbeg = strbeg;
2065             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
2066         }
2067     }
2068
2069     return 1;
2070
2071 phooey:
2072     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
2073                           PL_colors[4],PL_colors[5]));
2074     if (PL_reg_eval_set)
2075         restore_pos(aTHX_ 0);
2076     return 0;
2077 }
2078
2079 /*
2080  - regtry - try match at specific point
2081  */
2082 STATIC I32                      /* 0 failure, 1 success */
2083 S_regtry(pTHX_ regexp *prog, char *startpos)
2084 {
2085     register I32 i;
2086     register I32 *sp;
2087     register I32 *ep;
2088     CHECKPOINT lastcp;
2089
2090 #ifdef DEBUGGING
2091     PL_regindent = 0;   /* XXXX Not good when matches are reenterable... */
2092 #endif
2093     if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
2094         MAGIC *mg;
2095
2096         PL_reg_eval_set = RS_init;
2097         DEBUG_r(DEBUG_s(
2098             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %"IVdf"\n",
2099                           (IV)(PL_stack_sp - PL_stack_base));
2100             ));
2101         SAVEI32(cxstack[cxstack_ix].blk_oldsp);
2102         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
2103         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
2104         SAVETMPS;
2105         /* Apparently this is not needed, judging by wantarray. */
2106         /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
2107            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
2108
2109         if (PL_reg_sv) {
2110             /* Make $_ available to executed code. */
2111             if (PL_reg_sv != DEFSV) {
2112                 /* SAVE_DEFSV does *not* suffice here for USE_5005THREADS */
2113                 SAVESPTR(DEFSV);
2114                 DEFSV = PL_reg_sv;
2115             }
2116
2117             if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv)
2118                   && (mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global)))) {
2119                 /* prepare for quick setting of pos */
2120                 sv_magic(PL_reg_sv, (SV*)0,
2121                         PERL_MAGIC_regex_global, Nullch, 0);
2122                 mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global);
2123                 mg->mg_len = -1;
2124             }
2125             PL_reg_magic    = mg;
2126             PL_reg_oldpos   = mg->mg_len;
2127             SAVEDESTRUCTOR_X(restore_pos, 0);
2128         }
2129         if (!PL_reg_curpm) {
2130             Newxz(PL_reg_curpm, 1, PMOP);
2131 #ifdef USE_ITHREADS
2132             {
2133                 SV* repointer = newSViv(0);
2134                 /* so we know which PL_regex_padav element is PL_reg_curpm */
2135                 SvFLAGS(repointer) |= SVf_BREAK;
2136                 av_push(PL_regex_padav,repointer);
2137                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
2138                 PL_regex_pad = AvARRAY(PL_regex_padav);
2139             }
2140 #endif
2141         }
2142         PM_SETRE(PL_reg_curpm, prog);
2143         PL_reg_oldcurpm = PL_curpm;
2144         PL_curpm = PL_reg_curpm;
2145         if (RX_MATCH_COPIED(prog)) {
2146             /*  Here is a serious problem: we cannot rewrite subbeg,
2147                 since it may be needed if this match fails.  Thus
2148                 $` inside (?{}) could fail... */
2149             PL_reg_oldsaved = prog->subbeg;
2150             PL_reg_oldsavedlen = prog->sublen;
2151             RX_MATCH_COPIED_off(prog);
2152         }
2153         else
2154             PL_reg_oldsaved = Nullch;
2155         prog->subbeg = PL_bostr;
2156         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
2157     }
2158     prog->startp[0] = startpos - PL_bostr;
2159     PL_reginput = startpos;
2160     PL_regstartp = prog->startp;
2161     PL_regendp = prog->endp;
2162     PL_reglastparen = &prog->lastparen;
2163     PL_reglastcloseparen = &prog->lastcloseparen;
2164     prog->lastparen = 0;
2165     prog->lastcloseparen = 0;
2166     PL_regsize = 0;
2167     DEBUG_r(PL_reg_starttry = startpos);
2168     if (PL_reg_start_tmpl <= prog->nparens) {
2169         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
2170         if(PL_reg_start_tmp)
2171             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2172         else
2173             Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2174     }
2175
2176     /* XXXX What this code is doing here?!!!  There should be no need
2177        to do this again and again, PL_reglastparen should take care of
2178        this!  --ilya*/
2179
2180     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
2181      * Actually, the code in regcppop() (which Ilya may be meaning by
2182      * PL_reglastparen), is not needed at all by the test suite
2183      * (op/regexp, op/pat, op/split), but that code is needed, oddly
2184      * enough, for building DynaLoader, or otherwise this
2185      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
2186      * will happen.  Meanwhile, this code *is* needed for the
2187      * above-mentioned test suite tests to succeed.  The common theme
2188      * on those tests seems to be returning null fields from matches.
2189      * --jhi */
2190 #if 1
2191     sp = prog->startp;
2192     ep = prog->endp;
2193     if (prog->nparens) {
2194         for (i = prog->nparens; i > (I32)*PL_reglastparen; i--) {
2195             *++sp = -1;
2196             *++ep = -1;
2197         }
2198     }
2199 #endif
2200     REGCP_SET(lastcp);
2201     if (regmatch(prog->program + 1)) {
2202         prog->endp[0] = PL_reginput - PL_bostr;
2203         return 1;
2204     }
2205     REGCP_UNWIND(lastcp);
2206     return 0;
2207 }
2208
2209 #define RE_UNWIND_BRANCH        1
2210 #define RE_UNWIND_BRANCHJ       2
2211
2212 union re_unwind_t;
2213
2214 typedef struct {                /* XX: makes sense to enlarge it... */
2215     I32 type;
2216     I32 prev;
2217     CHECKPOINT lastcp;
2218 } re_unwind_generic_t;
2219
2220 typedef struct {
2221     I32 type;
2222     I32 prev;
2223     CHECKPOINT lastcp;
2224     I32 lastparen;
2225     regnode *next;
2226     char *locinput;
2227     I32 nextchr;
2228 #ifdef DEBUGGING
2229     int regindent;
2230 #endif
2231 } re_unwind_branch_t;
2232
2233 typedef union re_unwind_t {
2234     I32 type;
2235     re_unwind_generic_t generic;
2236     re_unwind_branch_t branch;
2237 } re_unwind_t;
2238
2239 #define sayYES goto yes
2240 #define sayNO goto no
2241 #define sayNO_ANYOF goto no_anyof
2242 #define sayYES_FINAL goto yes_final
2243 #define sayYES_LOUD  goto yes_loud
2244 #define sayNO_FINAL  goto no_final
2245 #define sayNO_SILENT goto do_no
2246 #define saySAME(x) if (x) goto yes; else goto no
2247
2248 #define POSCACHE_SUCCESS 0      /* caching success rather than failure */
2249 #define POSCACHE_SEEN 1         /* we know what we're caching */
2250 #define POSCACHE_START 2        /* the real cache: this bit maps to pos 0 */
2251 #define CACHEsayYES STMT_START { \
2252     if (cache_offset | cache_bit) { \
2253         if (!(PL_reg_poscache[0] & (1<<POSCACHE_SEEN))) \
2254             PL_reg_poscache[0] |= (1<<POSCACHE_SUCCESS) || (1<<POSCACHE_SEEN); \
2255         else if (!(PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))) { \
2256             /* cache records failure, but this is success */ \
2257             DEBUG_r( \
2258                 PerlIO_printf(Perl_debug_log, \
2259                     "%*s  (remove success from failure cache)\n", \
2260                     REPORT_CODE_OFF+PL_regindent*2, "") \
2261             ); \
2262             PL_reg_poscache[cache_offset] &= ~(1<<cache_bit); \
2263         } \
2264     } \
2265     sayYES; \
2266 } STMT_END
2267 #define CACHEsayNO STMT_START { \
2268     if (cache_offset | cache_bit) { \
2269         if (!(PL_reg_poscache[0] & (1<<POSCACHE_SEEN))) \
2270             PL_reg_poscache[0] |= (1<<POSCACHE_SEEN); \
2271         else if ((PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))) { \
2272             /* cache records success, but this is failure */ \
2273             DEBUG_r( \
2274                 PerlIO_printf(Perl_debug_log, \
2275                     "%*s  (remove failure from success cache)\n", \
2276                     REPORT_CODE_OFF+PL_regindent*2, "") \
2277             ); \
2278             PL_reg_poscache[cache_offset] &= ~(1<<cache_bit); \
2279         } \
2280     } \
2281     sayNO; \
2282 } STMT_END
2283
2284 #define REPORT_CODE_OFF 24
2285
2286 /*
2287  - regmatch - main matching routine
2288  *
2289  * Conceptually the strategy is simple:  check to see whether the current
2290  * node matches, call self recursively to see whether the rest matches,
2291  * and then act accordingly.  In practice we make some effort to avoid
2292  * recursion, in particular by going through "ordinary" nodes (that don't
2293  * need to know whether the rest of the match failed) by a loop instead of
2294  * by recursion.
2295  */
2296 /* [lwall] I've hoisted the register declarations to the outer block in order to
2297  * maybe save a little bit of pushing and popping on the stack.  It also takes
2298  * advantage of machines that use a register save mask on subroutine entry.
2299  */
2300 STATIC I32                      /* 0 failure, 1 success */
2301 S_regmatch(pTHX_ regnode *prog)
2302 {
2303     register regnode *scan;     /* Current node. */
2304     regnode *next;              /* Next node. */
2305     regnode *inner;             /* Next node in internal branch. */
2306     register I32 nextchr;       /* renamed nextchr - nextchar colides with
2307                                    function of same name */
2308     register I32 n;             /* no or next */
2309     register I32 ln = 0;        /* len or last */
2310     register char *s = Nullch;  /* operand or save */
2311     register char *locinput = PL_reginput;
2312     register I32 c1 = 0, c2 = 0, paren; /* case fold search, parenth */
2313     int minmod = 0, sw = 0, logical = 0;
2314     I32 unwind = 0;
2315 #if 0
2316     I32 firstcp = PL_savestack_ix;
2317 #endif
2318     const register bool do_utf8 = PL_reg_match_utf8;
2319 #ifdef DEBUGGING
2320     SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
2321     SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
2322     SV *dsv2 = PERL_DEBUG_PAD_ZERO(2);
2323 #endif
2324     U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
2325
2326 #ifdef DEBUGGING
2327     PL_regindent++;
2328 #endif
2329
2330     /* Note that nextchr is a byte even in UTF */
2331     nextchr = UCHARAT(locinput);
2332     scan = prog;
2333     while (scan != NULL) {
2334
2335         DEBUG_r( {
2336             SV *prop = sv_newmortal();
2337             const int docolor = *PL_colors[0];
2338             const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
2339             int l = (PL_regeol - locinput) > taill ? taill : (PL_regeol - locinput);
2340             /* The part of the string before starttry has one color
2341                (pref0_len chars), between starttry and current
2342                position another one (pref_len - pref0_len chars),
2343                after the current position the third one.
2344                We assume that pref0_len <= pref_len, otherwise we
2345                decrease pref0_len.  */
2346             int pref_len = (locinput - PL_bostr) > (5 + taill) - l
2347                 ? (5 + taill) - l : locinput - PL_bostr;
2348             int pref0_len;
2349
2350             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
2351                 pref_len++;
2352             pref0_len = pref_len  - (locinput - PL_reg_starttry);
2353             if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
2354                 l = ( PL_regeol - locinput > (5 + taill) - pref_len
2355                       ? (5 + taill) - pref_len : PL_regeol - locinput);
2356             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
2357                 l--;
2358             if (pref0_len < 0)
2359                 pref0_len = 0;
2360             if (pref0_len > pref_len)
2361                 pref0_len = pref_len;
2362             regprop(prop, scan);
2363             {
2364               const char * const s0 =
2365                 do_utf8 && OP(scan) != CANY ?
2366                 pv_uni_display(dsv0, (U8*)(locinput - pref_len),
2367                                pref0_len, 60, UNI_DISPLAY_REGEX) :
2368                 locinput - pref_len;
2369               const int len0 = do_utf8 ? strlen(s0) : pref0_len;
2370               const char * const s1 = do_utf8 && OP(scan) != CANY ?
2371                 pv_uni_display(dsv1, (U8*)(locinput - pref_len + pref0_len),
2372                                pref_len - pref0_len, 60, UNI_DISPLAY_REGEX) :
2373                 locinput - pref_len + pref0_len;
2374               const int len1 = do_utf8 ? strlen(s1) : pref_len - pref0_len;
2375               const char * const s2 = do_utf8 && OP(scan) != CANY ?
2376                 pv_uni_display(dsv2, (U8*)locinput,
2377                                PL_regeol - locinput, 60, UNI_DISPLAY_REGEX) :
2378                 locinput;
2379               const int len2 = do_utf8 ? strlen(s2) : l;
2380               PerlIO_printf(Perl_debug_log,
2381                             "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n",
2382                             (IV)(locinput - PL_bostr),
2383                             PL_colors[4],
2384                             len0, s0,
2385                             PL_colors[5],
2386                             PL_colors[2],
2387                             len1, s1,
2388                             PL_colors[3],
2389                             (docolor ? "" : "> <"),
2390                             PL_colors[0],
2391                             len2, s2,
2392                             PL_colors[1],
2393                             15 - l - pref_len + 1,
2394                             "",
2395                             (IV)(scan - PL_regprogram), PL_regindent*2, "",
2396                             SvPVX_const(prop));
2397             }
2398         });
2399
2400         next = scan + NEXT_OFF(scan);
2401         if (next == scan)
2402             next = NULL;
2403
2404         switch (OP(scan)) {
2405         case BOL:
2406             if (locinput == PL_bostr || (PL_multiline &&
2407                 (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
2408             {
2409                 /* regtill = regbol; */
2410                 break;
2411             }
2412             sayNO;
2413         case MBOL:
2414             if (locinput == PL_bostr ||
2415                 ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n'))
2416             {
2417                 break;
2418             }
2419             sayNO;
2420         case SBOL:
2421             if (locinput == PL_bostr)
2422                 break;
2423             sayNO;
2424         case GPOS:
2425             if (locinput == PL_reg_ganch)
2426                 break;
2427             sayNO;
2428         case EOL:
2429             if (PL_multiline)
2430                 goto meol;
2431             else
2432                 goto seol;
2433         case MEOL:
2434           meol:
2435             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2436                 sayNO;
2437             break;
2438         case SEOL:
2439           seol:
2440             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2441                 sayNO;
2442             if (PL_regeol - locinput > 1)
2443                 sayNO;
2444             break;
2445         case EOS:
2446             if (PL_regeol != locinput)
2447                 sayNO;
2448             break;
2449         case SANY:
2450             if (!nextchr && locinput >= PL_regeol)
2451                 sayNO;
2452             if (do_utf8) {
2453                 locinput += PL_utf8skip[nextchr];
2454                 if (locinput > PL_regeol)
2455                     sayNO;
2456                 nextchr = UCHARAT(locinput);
2457             }
2458             else
2459                 nextchr = UCHARAT(++locinput);
2460             break;
2461         case CANY:
2462             if (!nextchr && locinput >= PL_regeol)
2463                 sayNO;
2464             nextchr = UCHARAT(++locinput);
2465             break;
2466         case REG_ANY:
2467             if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
2468                 sayNO;
2469             if (do_utf8) {
2470                 locinput += PL_utf8skip[nextchr];
2471                 if (locinput > PL_regeol)
2472                     sayNO;
2473                 nextchr = UCHARAT(locinput);
2474             }
2475             else
2476                 nextchr = UCHARAT(++locinput);
2477             break;
2478         case EXACT:
2479             s = STRING(scan);
2480             ln = STR_LEN(scan);
2481             if (do_utf8 != UTF) {
2482                 /* The target and the pattern have differing utf8ness. */
2483                 char *l = locinput;
2484                 const char *e = s + ln;
2485
2486                 if (do_utf8) {
2487                     /* The target is utf8, the pattern is not utf8. */
2488                     while (s < e) {
2489                         STRLEN ulen;
2490                         if (l >= PL_regeol)
2491                              sayNO;
2492                         if (NATIVE_TO_UNI(*(U8*)s) !=
2493                             utf8n_to_uvuni((U8*)l, UTF8_MAXBYTES, &ulen,
2494                                             uniflags))
2495                              sayNO;
2496                         l += ulen;
2497                         s ++;
2498                     }
2499                 }
2500                 else {
2501                     /* The target is not utf8, the pattern is utf8. */
2502                     while (s < e) {
2503                         STRLEN ulen;
2504                         if (l >= PL_regeol)
2505                             sayNO;
2506                         if (NATIVE_TO_UNI(*((U8*)l)) !=
2507                             utf8n_to_uvuni((U8*)s, UTF8_MAXBYTES, &ulen,
2508                                            uniflags))
2509                             sayNO;
2510                         s += ulen;
2511                         l ++;
2512                     }
2513                 }
2514                 locinput = l;
2515                 nextchr = UCHARAT(locinput);
2516                 break;
2517             }
2518             /* The target and the pattern have the same utf8ness. */
2519             /* Inline the first character, for speed. */
2520             if (UCHARAT(s) != nextchr)
2521                 sayNO;
2522             if (PL_regeol - locinput < ln)
2523                 sayNO;
2524             if (ln > 1 && memNE(s, locinput, ln))
2525                 sayNO;
2526             locinput += ln;
2527             nextchr = UCHARAT(locinput);
2528             break;
2529         case EXACTFL:
2530             PL_reg_flags |= RF_tainted;
2531             /* FALL THROUGH */
2532         case EXACTF:
2533             s = STRING(scan);
2534             ln = STR_LEN(scan);
2535
2536             if (do_utf8 || UTF) {
2537               /* Either target or the pattern are utf8. */
2538                 char *l = locinput;
2539                 char *e = PL_regeol;
2540
2541                 if (ibcmp_utf8(s, 0,  ln, (bool)UTF,
2542                                l, &e, 0,  do_utf8)) {
2543                      /* One more case for the sharp s:
2544                       * pack("U0U*", 0xDF) =~ /ss/i,
2545                       * the 0xC3 0x9F are the UTF-8
2546                       * byte sequence for the U+00DF. */
2547                      if (!(do_utf8 &&
2548                            toLOWER(s[0]) == 's' &&
2549                            ln >= 2 &&
2550                            toLOWER(s[1]) == 's' &&
2551                            (U8)l[0] == 0xC3 &&
2552                            e - l >= 2 &&
2553                            (U8)l[1] == 0x9F))
2554                           sayNO;
2555                 }
2556                 locinput = e;
2557                 nextchr = UCHARAT(locinput);
2558                 break;
2559             }
2560
2561             /* Neither the target and the pattern are utf8. */
2562
2563             /* Inline the first character, for speed. */
2564             if (UCHARAT(s) != nextchr &&
2565                 UCHARAT(s) != ((OP(scan) == EXACTF)
2566                                ? PL_fold : PL_fold_locale)[nextchr])
2567                 sayNO;
2568             if (PL_regeol - locinput < ln)
2569                 sayNO;
2570             if (ln > 1 && (OP(scan) == EXACTF
2571                            ? ibcmp(s, locinput, ln)
2572                            : ibcmp_locale(s, locinput, ln)))
2573                 sayNO;
2574             locinput += ln;
2575             nextchr = UCHARAT(locinput);
2576             break;
2577         case ANYOF:
2578             if (do_utf8) {
2579                 STRLEN inclasslen = PL_regeol - locinput;
2580
2581                 if (!reginclass(scan, (U8*)locinput, &inclasslen, do_utf8))
2582                     sayNO_ANYOF;
2583                 if (locinput >= PL_regeol)
2584                     sayNO;
2585                 locinput += inclasslen ? inclasslen : UTF8SKIP(locinput);
2586                 nextchr = UCHARAT(locinput);
2587                 break;
2588             }
2589             else {
2590                 if (nextchr < 0)
2591                     nextchr = UCHARAT(locinput);
2592                 if (!REGINCLASS(scan, (U8*)locinput))
2593                     sayNO_ANYOF;
2594                 if (!nextchr && locinput >= PL_regeol)
2595                     sayNO;
2596                 nextchr = UCHARAT(++locinput);
2597                 break;
2598             }
2599         no_anyof:
2600             /* If we might have the case of the German sharp s
2601              * in a casefolding Unicode character class. */
2602
2603             if (ANYOF_FOLD_SHARP_S(scan, locinput, PL_regeol)) {
2604                  locinput += SHARP_S_SKIP;
2605                  nextchr = UCHARAT(locinput);
2606             }
2607             else
2608                  sayNO;
2609             break;
2610         case ALNUML:
2611             PL_reg_flags |= RF_tainted;
2612             /* FALL THROUGH */
2613         case ALNUM:
2614             if (!nextchr)
2615                 sayNO;
2616             if (do_utf8) {
2617                 LOAD_UTF8_CHARCLASS_ALNUM();
2618                 if (!(OP(scan) == ALNUM
2619                       ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2620                       : isALNUM_LC_utf8((U8*)locinput)))
2621                 {
2622                     sayNO;
2623                 }
2624                 locinput += PL_utf8skip[nextchr];
2625                 nextchr = UCHARAT(locinput);
2626                 break;
2627             }
2628             if (!(OP(scan) == ALNUM
2629                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
2630                 sayNO;
2631             nextchr = UCHARAT(++locinput);
2632             break;
2633         case NALNUML:
2634             PL_reg_flags |= RF_tainted;
2635             /* FALL THROUGH */
2636         case NALNUM:
2637             if (!nextchr && locinput >= PL_regeol)
2638                 sayNO;
2639             if (do_utf8) {
2640                 LOAD_UTF8_CHARCLASS_ALNUM();
2641                 if (OP(scan) == NALNUM
2642                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2643                     : isALNUM_LC_utf8((U8*)locinput))
2644                 {
2645                     sayNO;
2646                 }
2647                 locinput += PL_utf8skip[nextchr];
2648                 nextchr = UCHARAT(locinput);
2649                 break;
2650             }
2651             if (OP(scan) == NALNUM
2652                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
2653                 sayNO;
2654             nextchr = UCHARAT(++locinput);
2655             break;
2656         case BOUNDL:
2657         case NBOUNDL:
2658             PL_reg_flags |= RF_tainted;
2659             /* FALL THROUGH */
2660         case BOUND:
2661         case NBOUND:
2662             /* was last char in word? */
2663             if (do_utf8) {
2664                 if (locinput == PL_bostr)
2665                     ln = '\n';
2666                 else {
2667                     const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
2668
2669                     ln = utf8n_to_uvchr((U8 *)r, UTF8SKIP(r), 0, 0);
2670                 }
2671                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2672                     ln = isALNUM_uni(ln);
2673                     LOAD_UTF8_CHARCLASS_ALNUM();
2674                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
2675                 }
2676                 else {
2677                     ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
2678                     n = isALNUM_LC_utf8((U8*)locinput);
2679                 }
2680             }
2681             else {
2682                 ln = (locinput != PL_bostr) ?
2683                     UCHARAT(locinput - 1) : '\n';
2684                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2685                     ln = isALNUM(ln);
2686                     n = isALNUM(nextchr);
2687                 }
2688                 else {
2689                     ln = isALNUM_LC(ln);
2690                     n = isALNUM_LC(nextchr);
2691                 }
2692             }
2693             if (((!ln) == (!n)) == (OP(scan) == BOUND ||
2694                                     OP(scan) == BOUNDL))
2695                     sayNO;
2696             break;
2697         case SPACEL:
2698             PL_reg_flags |= RF_tainted;
2699             /* FALL THROUGH */
2700         case SPACE:
2701             if (!nextchr)
2702                 sayNO;
2703             if (do_utf8) {
2704                 if (UTF8_IS_CONTINUED(nextchr)) {
2705                     LOAD_UTF8_CHARCLASS_SPACE();
2706                     if (!(OP(scan) == SPACE
2707                           ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
2708                           : isSPACE_LC_utf8((U8*)locinput)))
2709                     {
2710                         sayNO;
2711                     }
2712                     locinput += PL_utf8skip[nextchr];
2713                     nextchr = UCHARAT(locinput);
2714                     break;
2715                 }
2716                 if (!(OP(scan) == SPACE
2717                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
2718                     sayNO;
2719                 nextchr = UCHARAT(++locinput);
2720             }
2721             else {
2722                 if (!(OP(scan) == SPACE
2723                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
2724                     sayNO;
2725                 nextchr = UCHARAT(++locinput);
2726             }
2727             break;
2728         case NSPACEL:
2729             PL_reg_flags |= RF_tainted;
2730             /* FALL THROUGH */
2731         case NSPACE:
2732             if (!nextchr && locinput >= PL_regeol)
2733                 sayNO;
2734             if (do_utf8) {
2735                 LOAD_UTF8_CHARCLASS_SPACE();
2736                 if (OP(scan) == NSPACE
2737                     ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
2738                     : isSPACE_LC_utf8((U8*)locinput))
2739                 {
2740                     sayNO;
2741                 }
2742                 locinput += PL_utf8skip[nextchr];
2743                 nextchr = UCHARAT(locinput);
2744                 break;
2745             }
2746             if (OP(scan) == NSPACE
2747                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
2748                 sayNO;
2749             nextchr = UCHARAT(++locinput);
2750             break;
2751         case DIGITL:
2752             PL_reg_flags |= RF_tainted;
2753             /* FALL THROUGH */
2754         case DIGIT:
2755             if (!nextchr)
2756                 sayNO;
2757             if (do_utf8) {
2758                 LOAD_UTF8_CHARCLASS_DIGIT();
2759                 if (!(OP(scan) == DIGIT
2760                       ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
2761                       : isDIGIT_LC_utf8((U8*)locinput)))
2762                 {
2763                     sayNO;
2764                 }
2765                 locinput += PL_utf8skip[nextchr];
2766                 nextchr = UCHARAT(locinput);
2767                 break;
2768             }
2769             if (!(OP(scan) == DIGIT
2770                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
2771                 sayNO;
2772             nextchr = UCHARAT(++locinput);
2773             break;
2774         case NDIGITL:
2775             PL_reg_flags |= RF_tainted;
2776             /* FALL THROUGH */
2777         case NDIGIT:
2778             if (!nextchr && locinput >= PL_regeol)
2779                 sayNO;
2780             if (do_utf8) {
2781                 LOAD_UTF8_CHARCLASS_DIGIT();
2782                 if (OP(scan) == NDIGIT
2783                     ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
2784                     : isDIGIT_LC_utf8((U8*)locinput))
2785                 {
2786                     sayNO;
2787                 }
2788                 locinput += PL_utf8skip[nextchr];
2789                 nextchr = UCHARAT(locinput);
2790                 break;
2791             }
2792             if (OP(scan) == NDIGIT
2793                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
2794                 sayNO;
2795             nextchr = UCHARAT(++locinput);
2796             break;
2797         case CLUMP:
2798             if (locinput >= PL_regeol)
2799                 sayNO;
2800             if  (do_utf8) {
2801                 LOAD_UTF8_CHARCLASS_MARK();
2802                 if (swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
2803                     sayNO;
2804                 locinput += PL_utf8skip[nextchr];
2805                 while (locinput < PL_regeol &&
2806                        swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
2807                     locinput += UTF8SKIP(locinput);
2808                 if (locinput > PL_regeol)
2809                     sayNO;
2810             }
2811             else
2812                locinput++;
2813             nextchr = UCHARAT(locinput);
2814             break;
2815         case REFFL:
2816             PL_reg_flags |= RF_tainted;
2817             /* FALL THROUGH */
2818         case REF:
2819         case REFF:
2820             n = ARG(scan);  /* which paren pair */
2821             ln = PL_regstartp[n];
2822             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2823             if ((I32)*PL_reglastparen < n || ln == -1)
2824                 sayNO;                  /* Do not match unless seen CLOSEn. */
2825             if (ln == PL_regendp[n])
2826                 break;
2827
2828             s = PL_bostr + ln;
2829             if (do_utf8 && OP(scan) != REF) {   /* REF can do byte comparison */
2830                 char *l = locinput;
2831                 const char *e = PL_bostr + PL_regendp[n];
2832                 /*
2833                  * Note that we can't do the "other character" lookup trick as
2834                  * in the 8-bit case (no pun intended) because in Unicode we
2835                  * have to map both upper and title case to lower case.
2836                  */
2837                 if (OP(scan) == REFF) {
2838                     while (s < e) {
2839                         STRLEN ulen1, ulen2;
2840                         U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
2841                         U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
2842
2843                         if (l >= PL_regeol)
2844                             sayNO;
2845                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
2846                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
2847                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
2848                             sayNO;
2849                         s += ulen1;
2850                         l += ulen2;
2851                     }
2852                 }
2853                 locinput = l;
2854                 nextchr = UCHARAT(locinput);
2855                 break;
2856             }
2857
2858             /* Inline the first character, for speed. */
2859             if (UCHARAT(s) != nextchr &&
2860                 (OP(scan) == REF ||
2861                  (UCHARAT(s) != ((OP(scan) == REFF
2862                                   ? PL_fold : PL_fold_locale)[nextchr]))))
2863                 sayNO;
2864             ln = PL_regendp[n] - ln;
2865             if (locinput + ln > PL_regeol)
2866                 sayNO;
2867             if (ln > 1 && (OP(scan) == REF
2868                            ? memNE(s, locinput, ln)
2869                            : (OP(scan) == REFF
2870                               ? ibcmp(s, locinput, ln)
2871                               : ibcmp_locale(s, locinput, ln))))
2872                 sayNO;
2873             locinput += ln;
2874             nextchr = UCHARAT(locinput);
2875             break;
2876
2877         case NOTHING:
2878         case TAIL:
2879             break;
2880         case BACK:
2881             break;
2882         case EVAL:
2883         {
2884             dSP;
2885             OP_4tree *oop = PL_op;
2886             COP *ocurcop = PL_curcop;
2887             PAD *old_comppad;
2888             SV *ret;
2889             struct regexp *oreg = PL_reg_re;
2890
2891             n = ARG(scan);
2892             PL_op = (OP_4tree*)PL_regdata->data[n];
2893             DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
2894             PAD_SAVE_LOCAL(old_comppad, (PAD*)PL_regdata->data[n + 2]);
2895             PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
2896
2897             {
2898                 SV **before = SP;
2899                 CALLRUNOPS(aTHX);                       /* Scalar context. */
2900                 SPAGAIN;
2901                 if (SP == before)
2902                     ret = &PL_sv_undef;   /* protect against empty (?{}) blocks. */
2903                 else {
2904                     ret = POPs;
2905                     PUTBACK;
2906                 }
2907             }
2908
2909             PL_op = oop;
2910             PAD_RESTORE_LOCAL(old_comppad);
2911             PL_curcop = ocurcop;
2912             if (logical) {
2913                 if (logical == 2) {     /* Postponed subexpression. */
2914                     regexp *re;
2915                     MAGIC *mg = Null(MAGIC*);
2916                     re_cc_state state;
2917                     CHECKPOINT cp, lastcp;
2918                     int toggleutf;
2919                     register SV *sv;
2920
2921                     if(SvROK(ret) && SvSMAGICAL(sv = SvRV(ret)))
2922                         mg = mg_find(sv, PERL_MAGIC_qr);
2923                     else if (SvSMAGICAL(ret)) {
2924                         if (SvGMAGICAL(ret))
2925                             sv_unmagic(ret, PERL_MAGIC_qr);
2926                         else
2927                             mg = mg_find(ret, PERL_MAGIC_qr);
2928                     }
2929
2930                     if (mg) {
2931                         re = (regexp *)mg->mg_obj;
2932                         (void)ReREFCNT_inc(re);
2933                     }
2934                     else {
2935                         STRLEN len;
2936                         const char *t = SvPV_const(ret, len);
2937                         PMOP pm;
2938                         char * const oprecomp = PL_regprecomp;
2939                         const I32 osize = PL_regsize;
2940                         const I32 onpar = PL_regnpar;
2941
2942                         Zero(&pm, 1, PMOP);
2943                         if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
2944                         re = CALLREGCOMP(aTHX_ (char*)t, (char*)t + len, &pm);
2945                         if (!(SvFLAGS(ret)
2946                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
2947                                 | SVs_GMG)))
2948                             sv_magic(ret,(SV*)ReREFCNT_inc(re),
2949                                         PERL_MAGIC_qr,0,0);
2950                         PL_regprecomp = oprecomp;
2951                         PL_regsize = osize;
2952                         PL_regnpar = onpar;
2953                     }
2954                     DEBUG_r(
2955                         PerlIO_printf(Perl_debug_log,
2956                                       "Entering embedded \"%s%.60s%s%s\"\n",
2957                                       PL_colors[0],
2958                                       re->precomp,
2959                                       PL_colors[1],
2960                                       (strlen(re->precomp) > 60 ? "..." : ""))
2961                         );
2962                     state.node = next;
2963                     state.prev = PL_reg_call_cc;
2964                     state.cc = PL_regcc;
2965                     state.re = PL_reg_re;
2966
2967                     PL_regcc = 0;
2968
2969                     cp = regcppush(0);  /* Save *all* the positions. */
2970                     REGCP_SET(lastcp);
2971                     cache_re(re);
2972                     state.ss = PL_savestack_ix;
2973                     *PL_reglastparen = 0;
2974                     *PL_reglastcloseparen = 0;
2975                     PL_reg_call_cc = &state;
2976                     PL_reginput = locinput;
2977                     toggleutf = ((PL_reg_flags & RF_utf8) != 0) ^
2978                                 ((re->reganch & ROPT_UTF8) != 0);
2979                     if (toggleutf) PL_reg_flags ^= RF_utf8;
2980
2981                     /* XXXX This is too dramatic a measure... */
2982                     PL_reg_maxiter = 0;
2983
2984                     if (regmatch(re->program + 1)) {
2985                         /* Even though we succeeded, we need to restore
2986                            global variables, since we may be wrapped inside
2987                            SUSPEND, thus the match may be not finished yet. */
2988
2989                         /* XXXX Do this only if SUSPENDed? */
2990                         PL_reg_call_cc = state.prev;
2991                         PL_regcc = state.cc;
2992                         PL_reg_re = state.re;
2993                         cache_re(PL_reg_re);
2994                         if (toggleutf) PL_reg_flags ^= RF_utf8;
2995
2996                         /* XXXX This is too dramatic a measure... */
2997                         PL_reg_maxiter = 0;
2998
2999                         /* These are needed even if not SUSPEND. */
3000                         ReREFCNT_dec(re);
3001                         regcpblow(cp);
3002                         sayYES;
3003                     }
3004                     ReREFCNT_dec(re);
3005                     REGCP_UNWIND(lastcp);
3006                     regcppop();
3007                     PL_reg_call_cc = state.prev;
3008                     PL_regcc = state.cc;
3009                     PL_reg_re = state.re;
3010                     cache_re(PL_reg_re);
3011                     if (toggleutf) PL_reg_flags ^= RF_utf8;
3012
3013                     /* XXXX This is too dramatic a measure... */
3014                     PL_reg_maxiter = 0;
3015
3016                     logical = 0;
3017                     sayNO;
3018                 }
3019                 sw = SvTRUE(ret);
3020                 logical = 0;
3021             }
3022             else {
3023                 sv_setsv(save_scalar(PL_replgv), ret);
3024                 cache_re(oreg);
3025             }
3026             break;
3027         }
3028         case OPEN:
3029             n = ARG(scan);  /* which paren pair */
3030             PL_reg_start_tmp[n] = locinput;
3031             if (n > PL_regsize)
3032                 PL_regsize = n;
3033             break;
3034         case CLOSE:
3035             n = ARG(scan);  /* which paren pair */
3036             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
3037             PL_regendp[n] = locinput - PL_bostr;
3038             if (n > (I32)*PL_reglastparen)
3039                 *PL_reglastparen = n;
3040             *PL_reglastcloseparen = n;
3041             break;
3042         case GROUPP:
3043             n = ARG(scan);  /* which paren pair */
3044             sw = ((I32)*PL_reglastparen >= n && PL_regendp[n] != -1);
3045             break;
3046         case IFTHEN:
3047             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3048             if (sw)
3049                 next = NEXTOPER(NEXTOPER(scan));
3050             else {
3051                 next = scan + ARG(scan);
3052                 if (OP(next) == IFTHEN) /* Fake one. */
3053                     next = NEXTOPER(NEXTOPER(next));
3054             }
3055             break;
3056         case LOGICAL:
3057             logical = scan->flags;
3058             break;
3059 /*******************************************************************
3060  PL_regcc contains infoblock about the innermost (...)* loop, and
3061  a pointer to the next outer infoblock.
3062
3063  Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM):
3064
3065    1) After matching X, regnode for CURLYX is processed;
3066
3067    2) This regnode creates infoblock on the stack, and calls
3068       regmatch() recursively with the starting point at WHILEM node;
3069
3070    3) Each hit of WHILEM node tries to match A and Z (in the order
3071       depending on the current iteration, min/max of {min,max} and
3072       greediness).  The information about where are nodes for "A"
3073       and "Z" is read from the infoblock, as is info on how many times "A"
3074       was already matched, and greediness.
3075
3076    4) After A matches, the same WHILEM node is hit again.
3077
3078    5) Each time WHILEM is hit, PL_regcc is the infoblock created by CURLYX
3079       of the same pair.  Thus when WHILEM tries to match Z, it temporarily
3080       resets PL_regcc, since this Y(A)*Z can be a part of some other loop:
3081       as in (Y(A)*Z)*.  If Z matches, the automaton will hit the WHILEM node
3082       of the external loop.
3083
3084  Currently present infoblocks form a tree with a stem formed by PL_curcc
3085  and whatever it mentions via ->next, and additional attached trees
3086  corresponding to temporarily unset infoblocks as in "5" above.
3087
3088  In the following picture infoblocks for outer loop of
3089  (Y(A)*?Z)*?T are denoted O, for inner I.  NULL starting block
3090  is denoted by x.  The matched string is YAAZYAZT.  Temporarily postponed
3091  infoblocks are drawn below the "reset" infoblock.
3092
3093  In fact in the picture below we do not show failed matches for Z and T
3094  by WHILEM blocks.  [We illustrate minimal matches, since for them it is
3095  more obvious *why* one needs to *temporary* unset infoblocks.]
3096
3097   Matched       REx position    InfoBlocks      Comment
3098                 (Y(A)*?Z)*?T    x
3099                 Y(A)*?Z)*?T     x <- O
3100   Y             (A)*?Z)*?T      x <- O
3101   Y             A)*?Z)*?T       x <- O <- I
3102   YA            )*?Z)*?T        x <- O <- I
3103   YA            A)*?Z)*?T       x <- O <- I
3104   YAA           )*?Z)*?T        x <- O <- I
3105   YAA           Z)*?T           x <- O          # Temporary unset I
3106                                      I
3107
3108   YAAZ          Y(A)*?Z)*?T     x <- O
3109                                      I
3110
3111   YAAZY         (A)*?Z)*?T      x <- O
3112                                      I
3113
3114   YAAZY         A)*?Z)*?T       x <- O <- I
3115                                      I
3116
3117   YAAZYA        )*?Z)*?T        x <- O <- I
3118                                      I
3119
3120   YAAZYA        Z)*?T           x <- O          # Temporary unset I
3121                                      I,I
3122
3123   YAAZYAZ       )*?T            x <- O
3124                                      I,I
3125
3126   YAAZYAZ       T               x               # Temporary unset O
3127                                 O
3128                                 I,I
3129
3130   YAAZYAZT                      x
3131                                 O
3132                                 I,I
3133  *******************************************************************/
3134         case CURLYX: {
3135                 CURCUR cc;
3136                 CHECKPOINT cp = PL_savestack_ix;
3137                 /* No need to save/restore up to this paren */
3138                 I32 parenfloor = scan->flags;
3139
3140                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
3141                     next += ARG(next);
3142                 cc.oldcc = PL_regcc;
3143                 PL_regcc = &cc;
3144                 /* XXXX Probably it is better to teach regpush to support
3145                    parenfloor > PL_regsize... */
3146                 if (parenfloor > (I32)*PL_reglastparen)
3147                     parenfloor = *PL_reglastparen; /* Pessimization... */
3148                 cc.parenfloor = parenfloor;
3149                 cc.cur = -1;
3150                 cc.min = ARG1(scan);
3151                 cc.max  = ARG2(scan);
3152                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3153                 cc.next = next;
3154                 cc.minmod = minmod;
3155                 cc.lastloc = 0;
3156                 PL_reginput = locinput;
3157                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
3158                 regcpblow(cp);
3159                 PL_regcc = cc.oldcc;
3160                 saySAME(n);
3161             }
3162             /* NOT REACHED */
3163         case WHILEM: {
3164                 /*
3165                  * This is really hard to understand, because after we match
3166                  * what we're trying to match, we must make sure the rest of
3167                  * the REx is going to match for sure, and to do that we have
3168                  * to go back UP the parse tree by recursing ever deeper.  And
3169                  * if it fails, we have to reset our parent's current state
3170                  * that we can try again after backing off.
3171                  */
3172
3173                 CHECKPOINT cp, lastcp;
3174                 CURCUR* cc = PL_regcc;
3175                 char *lastloc = cc->lastloc; /* Detection of 0-len. */
3176                 I32 cache_offset = 0, cache_bit = 0;
3177
3178                 n = cc->cur + 1;        /* how many we know we matched */
3179                 PL_reginput = locinput;
3180
3181                 DEBUG_r(
3182                     PerlIO_printf(Perl_debug_log,
3183                                   "%*s  %ld out of %ld..%ld  cc=%"UVxf"\n",
3184                                   REPORT_CODE_OFF+PL_regindent*2, "",
3185                                   (long)n, (long)cc->min,
3186                                   (long)cc->max, PTR2UV(cc))
3187                     );
3188
3189                 /* If degenerate scan matches "", assume scan done. */
3190
3191                 if (locinput == cc->lastloc && n >= cc->min) {
3192                     PL_regcc = cc->oldcc;
3193                     if (PL_regcc)
3194                         ln = PL_regcc->cur;
3195                     DEBUG_r(
3196                         PerlIO_printf(Perl_debug_log,
3197                            "%*s  empty match detected, try continuation...\n",
3198                            REPORT_CODE_OFF+PL_regindent*2, "")
3199                         );
3200                     if (regmatch(cc->next))
3201                         sayYES;
3202                     if (PL_regcc)
3203                         PL_regcc->cur = ln;
3204                     PL_regcc = cc;
3205                     sayNO;
3206                 }
3207
3208                 /* First just match a string of min scans. */
3209
3210                 if (n < cc->min) {
3211                     cc->cur = n;
3212                     cc->lastloc = locinput;
3213                     if (regmatch(cc->scan))
3214                         sayYES;
3215                     cc->cur = n - 1;
3216                     cc->lastloc = lastloc;
3217                     sayNO;
3218                 }
3219
3220                 if (scan->flags) {
3221                     /* Check whether we already were at this position.
3222                         Postpone detection until we know the match is not
3223                         *that* much linear. */
3224                 if (!PL_reg_maxiter) {
3225                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
3226                     PL_reg_leftiter = PL_reg_maxiter;
3227                 }
3228                 if (PL_reg_leftiter-- == 0) {
3229                     const I32 size = (PL_reg_maxiter + 7 + POSCACHE_START)/8;
3230                     if (PL_reg_poscache) {
3231                         if ((I32)PL_reg_poscache_size < size) {
3232                             Renew(PL_reg_poscache, size, char);
3233                             PL_reg_poscache_size = size;
3234                         }
3235                         Zero(PL_reg_poscache, size, char);
3236                     }
3237                     else {
3238                         PL_reg_poscache_size = size;
3239                         Newxz(PL_reg_poscache, size, char);
3240                     }
3241                     DEBUG_r(
3242                         PerlIO_printf(Perl_debug_log,
3243               "%sDetected a super-linear match, switching on caching%s...\n",
3244                                       PL_colors[4], PL_colors[5])
3245                         );
3246                 }
3247                 if (PL_reg_leftiter < 0) {
3248                     cache_offset = locinput - PL_bostr;
3249
3250                     cache_offset = (scan->flags & 0xf) - 1 + POSCACHE_START
3251                             + cache_offset * (scan->flags>>4);
3252                     cache_bit = cache_offset % 8;
3253                     cache_offset /= 8;
3254                     if (PL_reg_poscache[cache_offset] & (1<<cache_bit)) {
3255                     DEBUG_r(
3256                         PerlIO_printf(Perl_debug_log,
3257                                       "%*s  already tried at this position...\n",
3258                                       REPORT_CODE_OFF+PL_regindent*2, "")
3259                         );
3260                         if (PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))
3261                             /* cache records success */
3262                             sayYES;
3263                         else
3264                             /* cache records failure */
3265                             sayNO_SILENT;
3266                     }
3267                     PL_reg_poscache[cache_offset] |= (1<<cache_bit);
3268                 }
3269                 }
3270
3271                 /* Prefer next over scan for minimal matching. */
3272
3273                 if (cc->minmod) {
3274                     PL_regcc = cc->oldcc;
3275                     if (PL_regcc)
3276                         ln = PL_regcc->cur;
3277                     cp = regcppush(cc->parenfloor);
3278                     REGCP_SET(lastcp);
3279                     if (regmatch(cc->next)) {
3280                         regcpblow(cp);
3281                         CACHEsayYES;    /* All done. */
3282                     }
3283                     REGCP_UNWIND(lastcp);
3284                     regcppop();
3285                     if (PL_regcc)
3286                         PL_regcc->cur = ln;
3287                     PL_regcc = cc;
3288
3289                     if (n >= cc->max) { /* Maximum greed exceeded? */
3290                         if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3291                             && !(PL_reg_flags & RF_warned)) {
3292                             PL_reg_flags |= RF_warned;
3293                             Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
3294                                  "Complex regular subexpression recursion",
3295                                  REG_INFTY - 1);
3296                         }
3297                         CACHEsayNO;
3298                     }
3299
3300                     DEBUG_r(
3301                         PerlIO_printf(Perl_debug_log,
3302                                       "%*s  trying longer...\n",
3303                                       REPORT_CODE_OFF+PL_regindent*2, "")
3304                         );
3305                     /* Try scanning more and see if it helps. */
3306                     PL_reginput = locinput;
3307                     cc->cur = n;
3308                     cc->lastloc = locinput;
3309                     cp = regcppush(cc->parenfloor);
3310                     REGCP_SET(lastcp);
3311                     if (regmatch(cc->scan)) {
3312                         regcpblow(cp);
3313                         CACHEsayYES;
3314                     }
3315                     REGCP_UNWIND(lastcp);
3316                     regcppop();
3317                     cc->cur = n - 1;
3318                     cc->lastloc = lastloc;
3319                     CACHEsayNO;
3320                 }
3321
3322                 /* Prefer scan over next for maximal matching. */
3323
3324                 if (n < cc->max) {      /* More greed allowed? */
3325                     cp = regcppush(cc->parenfloor);
3326                     cc->cur = n;
3327                     cc->lastloc = locinput;
3328                     REGCP_SET(lastcp);
3329                     if (regmatch(cc->scan)) {
3330                         regcpblow(cp);
3331                         CACHEsayYES;
3332                     }
3333                     REGCP_UNWIND(lastcp);
3334                     regcppop();         /* Restore some previous $<digit>s? */
3335                     PL_reginput = locinput;
3336                     DEBUG_r(
3337                         PerlIO_printf(Perl_debug_log,
3338                                       "%*s  failed, try continuation...\n",
3339                                       REPORT_CODE_OFF+PL_regindent*2, "")
3340                         );
3341                 }
3342                 if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3343                         && !(PL_reg_flags & RF_warned)) {
3344                     PL_reg_flags |= RF_warned;
3345                     Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
3346                          "Complex regular subexpression recursion",
3347                          REG_INFTY - 1);
3348                 }
3349
3350                 /* Failed deeper matches of scan, so see if this one works. */
3351                 PL_regcc = cc->oldcc;
3352                 if (PL_regcc)
3353                     ln = PL_regcc->cur;
3354                 if (regmatch(cc->next))
3355                     CACHEsayYES;
3356                 if (PL_regcc)
3357                     PL_regcc->cur = ln;
3358                 PL_regcc = cc;
3359                 cc->cur = n - 1;
3360                 cc->lastloc = lastloc;
3361                 CACHEsayNO;
3362             }
3363             /* NOT REACHED */
3364         case BRANCHJ:
3365             next = scan + ARG(scan);
3366             if (next == scan)
3367                 next = NULL;
3368             inner = NEXTOPER(NEXTOPER(scan));
3369             goto do_branch;
3370         case BRANCH:
3371             inner = NEXTOPER(scan);
3372           do_branch:
3373             {
3374                 c1 = OP(scan);
3375                 if (OP(next) != c1)     /* No choice. */
3376                     next = inner;       /* Avoid recursion. */
3377                 else {
3378                     const I32 lastparen = *PL_reglastparen;
3379                     I32 unwind1;
3380                     re_unwind_branch_t *uw;
3381
3382                     /* Put unwinding data on stack */
3383                     unwind1 = SSNEWt(1,re_unwind_branch_t);
3384                     uw = SSPTRt(unwind1,re_unwind_branch_t);
3385                     uw->prev = unwind;
3386                     unwind = unwind1;
3387                     uw->type = ((c1 == BRANCH)
3388                                 ? RE_UNWIND_BRANCH
3389                                 : RE_UNWIND_BRANCHJ);
3390                     uw->lastparen = lastparen;
3391                     uw->next = next;
3392                     uw->locinput = locinput;
3393                     uw->nextchr = nextchr;
3394 #ifdef DEBUGGING
3395                     uw->regindent = ++PL_regindent;
3396 #endif
3397
3398                     REGCP_SET(uw->lastcp);
3399
3400                     /* Now go into the first branch */
3401                     next = inner;
3402                 }
3403             }
3404             break;
3405         case MINMOD:
3406             minmod = 1;
3407             break;
3408         case CURLYM:
3409         {
3410             I32 l = 0;
3411             CHECKPOINT lastcp;
3412
3413             /* We suppose that the next guy does not need
3414                backtracking: in particular, it is of constant non-zero length,
3415                and has no parenths to influence future backrefs. */
3416             ln = ARG1(scan);  /* min to match */
3417             n  = ARG2(scan);  /* max to match */
3418             paren = scan->flags;
3419             if (paren) {
3420                 if (paren > PL_regsize)
3421                     PL_regsize = paren;
3422                 if (paren > (I32)*PL_reglastparen)
3423                     *PL_reglastparen = paren;
3424             }
3425             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3426             if (paren)
3427                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
3428             PL_reginput = locinput;
3429             if (minmod) {
3430                 minmod = 0;
3431                 if (ln && regrepeat_hard(scan, ln, &l) < ln)
3432                     sayNO;
3433                 locinput = PL_reginput;
3434                 if (HAS_TEXT(next) || JUMPABLE(next)) {
3435                     regnode *text_node = next;
3436
3437                     if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3438
3439                     if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3440                     else {
3441                         if (PL_regkind[(U8)OP(text_node)] == REF) {
3442                             c1 = c2 = -1000;
3443                             goto assume_ok_MM;
3444                         }
3445                         else { c1 = (U8)*STRING(text_node); }
3446                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3447                             c2 = PL_fold[c1];
3448                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3449                             c2 = PL_fold_locale[c1];
3450                         else
3451                             c2 = c1;
3452                     }
3453                 }
3454                 else
3455                     c1 = c2 = -1000;
3456             assume_ok_MM:
3457                 REGCP_SET(lastcp);
3458                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
3459                     /* If it could work, try it. */
3460                     if (c1 == -1000 ||
3461                         UCHARAT(PL_reginput) == c1 ||
3462                         UCHARAT(PL_reginput) == c2)
3463                     {
3464                         if (paren) {
3465                             if (ln) {
3466                                 PL_regstartp[paren] =
3467                                     HOPc(PL_reginput, -l) - PL_bostr;
3468                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3469                             }
3470                             else
3471                                 PL_regendp[paren] = -1;
3472                         }
3473                         if (regmatch(next))
3474                             sayYES;
3475                         REGCP_UNWIND(lastcp);
3476                     }
3477                     /* Couldn't or didn't -- move forward. */
3478                     PL_reginput = locinput;
3479                     if (regrepeat_hard(scan, 1, &l)) {
3480                         ln++;
3481                         locinput = PL_reginput;
3482                     }
3483                     else
3484                         sayNO;
3485                 }
3486             }
3487             else {
3488                 n = regrepeat_hard(scan, n, &l);
3489                 locinput = PL_reginput;
3490                 DEBUG_r(
3491                     PerlIO_printf(Perl_debug_log,
3492                                   "%*s  matched %"IVdf" times, len=%"IVdf"...\n",
3493                                   (int)(REPORT_CODE_OFF+PL_regindent*2), "",
3494                                   (IV) n, (IV)l)
3495                     );
3496                 if (n >= ln) {
3497                     if (HAS_TEXT(next) || JUMPABLE(next)) {
3498                         regnode *text_node = next;
3499
3500                         if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3501
3502                         if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3503                         else {
3504                             if (PL_regkind[(U8)OP(text_node)] == REF) {
3505                                 c1 = c2 = -1000;
3506                                 goto assume_ok_REG;
3507                             }
3508                             else { c1 = (U8)*STRING(text_node); }
3509
3510                             if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3511                                 c2 = PL_fold[c1];
3512                             else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3513                                 c2 = PL_fold_locale[c1];
3514                             else
3515                                 c2 = c1;
3516                         }
3517                     }
3518                     else
3519                         c1 = c2 = -1000;
3520                 }
3521             assume_ok_REG:
3522                 REGCP_SET(lastcp);
3523                 while (n >= ln) {
3524                     /* If it could work, try it. */
3525                     if (c1 == -1000 ||
3526                         UCHARAT(PL_reginput) == c1 ||
3527                         UCHARAT(PL_reginput) == c2)
3528                     {
3529                         DEBUG_r(
3530                                 PerlIO_printf(Perl_debug_log,
3531                                               "%*s  trying tail with n=%"IVdf"...\n",
3532                                               (int)(REPORT_CODE_OFF+PL_regindent*2), "", (IV)n)
3533                             );
3534                         if (paren) {
3535                             if (n) {
3536                                 PL_regstartp[paren] = HOPc(PL_reginput, -l) - PL_bostr;
3537                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3538                             }
3539                             else
3540                                 PL_regendp[paren] = -1;
3541                         }
3542                         if (regmatch(next))
3543                             sayYES;
3544                         REGCP_UNWIND(lastcp);
3545                     }
3546                     /* Couldn't or didn't -- back up. */
3547                     n--;
3548                     locinput = HOPc(locinput, -l);
3549                     PL_reginput = locinput;
3550                 }
3551             }
3552             sayNO;
3553             break;
3554         }
3555         case CURLYN:
3556             paren = scan->flags;        /* Which paren to set */
3557             if (paren > PL_regsize)
3558                 PL_regsize = paren;
3559             if (paren > (I32)*PL_reglastparen)
3560                 *PL_reglastparen = paren;
3561             ln = ARG1(scan);  /* min to match */
3562             n  = ARG2(scan);  /* max to match */
3563             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
3564             goto repeat;
3565         case CURLY:
3566             paren = 0;
3567             ln = ARG1(scan);  /* min to match */
3568             n  = ARG2(scan);  /* max to match */
3569             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3570             goto repeat;
3571         case STAR:
3572             ln = 0;
3573             n = REG_INFTY;
3574             scan = NEXTOPER(scan);
3575             paren = 0;
3576             goto repeat;
3577         case PLUS:
3578             ln = 1;
3579             n = REG_INFTY;
3580             scan = NEXTOPER(scan);
3581             paren = 0;
3582           repeat:
3583             /*
3584             * Lookahead to avoid useless match attempts
3585             * when we know what character comes next.
3586             */
3587
3588             /*
3589             * Used to only do .*x and .*?x, but now it allows
3590             * for )'s, ('s and (?{ ... })'s to be in the way
3591             * of the quantifier and the EXACT-like node.  -- japhy
3592             */
3593
3594             if (HAS_TEXT(next) || JUMPABLE(next)) {
3595                 U8 *s;
3596                 regnode *text_node = next;
3597
3598                 if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3599
3600                 if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3601                 else {
3602                     if (PL_regkind[(U8)OP(text_node)] == REF) {
3603                         c1 = c2 = -1000;
3604                         goto assume_ok_easy;
3605                     }
3606                     else { s = (U8*)STRING(text_node); }
3607
3608                     if (!UTF) {
3609                         c2 = c1 = *s;
3610                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3611                             c2 = PL_fold[c1];
3612                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3613                             c2 = PL_fold_locale[c1];
3614                     }
3615                     else { /* UTF */
3616                         if (OP(text_node) == EXACTF || OP(text_node) == REFF) {
3617                              STRLEN ulen1, ulen2;
3618                              U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
3619                              U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
3620
3621                              to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
3622                              to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
3623
3624                              c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
3625                                                  uniflags);
3626                              c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
3627                                                  uniflags);
3628                         }
3629                         else {
3630                             c2 = c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
3631                                                      uniflags);
3632                         }
3633                     }
3634                 }
3635             }
3636             else
3637                 c1 = c2 = -1000;
3638         assume_ok_easy:
3639             PL_reginput = locinput;
3640             if (minmod) {
3641                 CHECKPOINT lastcp;
3642                 minmod = 0;
3643                 if (ln && regrepeat(scan, ln) < ln)
3644                     sayNO;
3645                 locinput = PL_reginput;
3646                 REGCP_SET(lastcp);
3647                 if (c1 != -1000) {
3648                     char *e; /* Should not check after this */
3649                     char *old = locinput;
3650                     int count = 0;
3651
3652                     if  (n == REG_INFTY) {
3653                         e = PL_regeol - 1;
3654                         if (do_utf8)
3655                             while (UTF8_IS_CONTINUATION(*(U8*)e))
3656                                 e--;
3657                     }
3658                     else if (do_utf8) {
3659                         int m = n - ln;
3660                         for (e = locinput;
3661                              m >0 && e + UTF8SKIP(e) <= PL_regeol; m--)
3662                             e += UTF8SKIP(e);
3663                     }
3664                     else {
3665                         e = locinput + n - ln;
3666                         if (e >= PL_regeol)
3667                             e = PL_regeol - 1;
3668                     }
3669                     while (1) {
3670                         /* Find place 'next' could work */
3671                         if (!do_utf8) {
3672                             if (c1 == c2) {
3673                                 while (locinput <= e &&
3674                                        UCHARAT(locinput) != c1)
3675                                     locinput++;
3676                             } else {
3677                                 while (locinput <= e
3678                                        && UCHARAT(locinput) != c1
3679                                        && UCHARAT(locinput) != c2)
3680                                     locinput++;
3681                             }
3682                             count = locinput - old;
3683                         }
3684                         else {
3685                             if (c1 == c2) {
3686                                 STRLEN len;
3687                                 /* count initialised to
3688                                  * utf8_distance(old, locinput) */
3689                                 while (locinput <= e &&
3690                                        utf8n_to_uvchr((U8*)locinput,
3691                                                       UTF8_MAXBYTES, &len,
3692                                                       uniflags) != (UV)c1) {
3693                                     locinput += len;
3694                                     count++;
3695                                 }
3696                             } else {
3697                                 STRLEN len;
3698                                 /* count initialised to
3699                                  * utf8_distance(old, locinput) */
3700                                 while (locinput <= e) {
3701                                     UV c = utf8n_to_uvchr((U8*)locinput,
3702                                                           UTF8_MAXBYTES, &len,
3703                                                           uniflags);
3704                                     if (c == (UV)c1 || c == (UV)c2)
3705                                         break;
3706                                     locinput += len;
3707                                     count++;
3708                                 }
3709                             }
3710                         }
3711                         if (locinput > e)
3712                             sayNO;
3713                         /* PL_reginput == old now */
3714                         if (locinput != old) {
3715                             ln = 1;     /* Did some */
3716                             if (regrepeat(scan, count) < count)
3717                                 sayNO;
3718                         }
3719                         /* PL_reginput == locinput now */
3720                         TRYPAREN(paren, ln, locinput);
3721                         PL_reginput = locinput; /* Could be reset... */
3722                         REGCP_UNWIND(lastcp);
3723                         /* Couldn't or didn't -- move forward. */
3724                         old = locinput;
3725                         if (do_utf8)
3726                             locinput += UTF8SKIP(locinput);
3727                         else
3728                             locinput++;
3729                         count = 1;
3730                     }
3731                 }
3732                 else
3733                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
3734                     UV c;
3735                     if (c1 != -1000) {
3736                         if (do_utf8)
3737                             c = utf8n_to_uvchr((U8*)PL_reginput,
3738                                                UTF8_MAXBYTES, 0,
3739                                                uniflags);
3740                         else
3741                             c = UCHARAT(PL_reginput);
3742                         /* If it could work, try it. */
3743                         if (c == (UV)c1 || c == (UV)c2)
3744                         {
3745                             TRYPAREN(paren, ln, PL_reginput);
3746                             REGCP_UNWIND(lastcp);
3747                         }
3748                     }
3749                     /* If it could work, try it. */
3750                     else if (c1 == -1000)
3751                     {
3752                         TRYPAREN(paren, ln, PL_reginput);
3753                         REGCP_UNWIND(lastcp);
3754                     }
3755                     /* Couldn't or didn't -- move forward. */
3756                     PL_reginput = locinput;
3757                     if (regrepeat(scan, 1)) {
3758                         ln++;
3759                         locinput = PL_reginput;
3760                     }
3761                     else
3762                         sayNO;
3763                 }
3764             }
3765             else {
3766                 CHECKPOINT lastcp;
3767                 n = regrepeat(scan, n);
3768                 locinput = PL_reginput;
3769                 if (ln < n && PL_regkind[(U8)OP(next)] == EOL &&
3770                     ((!PL_multiline && OP(next) != MEOL) ||
3771                         OP(next) == SEOL || OP(next) == EOS))
3772                 {
3773                     ln = n;                     /* why back off? */
3774                     /* ...because $ and \Z can match before *and* after
3775                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
3776                        We should back off by one in this case. */
3777                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(next) != EOS)
3778                         ln--;
3779                 }
3780                 REGCP_SET(lastcp);
3781                 if (paren) {
3782                     UV c = 0;
3783                     while (n >= ln) {
3784                         if (c1 != -1000) {
3785                             if (do_utf8)
3786                                 c = utf8n_to_uvchr((U8*)PL_reginput,
3787                                                    UTF8_MAXBYTES, 0,
3788                                                    uniflags);
3789                             else
3790                                 c = UCHARAT(PL_reginput);
3791                         }
3792                         /* If it could work, try it. */
3793                         if (c1 == -1000 || c == (UV)c1 || c == (UV)c2)
3794                             {
3795                                 TRYPAREN(paren, n, PL_reginput);
3796                                 REGCP_UNWIND(lastcp);
3797                             }
3798                         /* Couldn't or didn't -- back up. */
3799                         n--;
3800                         PL_reginput = locinput = HOPc(locinput, -1);
3801                     }
3802                 }
3803                 else {
3804                     UV c = 0;
3805                     while (n >= ln) {
3806                         if (c1 != -1000) {
3807                             if (do_utf8)
3808                                 c = utf8n_to_uvchr((U8*)PL_reginput,
3809                                                    UTF8_MAXBYTES, 0,
3810                                                    uniflags);
3811                             else
3812                                 c = UCHARAT(PL_reginput);
3813                         }
3814                         /* If it could work, try it. */
3815                         if (c1 == -1000 || c == (UV)c1 || c == (UV)c2)
3816                             {
3817                                 TRYPAREN(paren, n, PL_reginput);
3818                                 REGCP_UNWIND(lastcp);
3819                             }
3820                         /* Couldn't or didn't -- back up. */
3821                         n--;
3822                         PL_reginput = locinput = HOPc(locinput, -1);
3823                     }
3824                 }
3825             }
3826             sayNO;
3827             break;
3828         case END:
3829             if (PL_reg_call_cc) {
3830                 re_cc_state *cur_call_cc = PL_reg_call_cc;
3831                 CURCUR *cctmp = PL_regcc;
3832                 regexp *re = PL_reg_re;
3833                 CHECKPOINT cp, lastcp;
3834
3835                 cp = regcppush(0);      /* Save *all* the positions. */
3836                 REGCP_SET(lastcp);
3837                 regcp_set_to(PL_reg_call_cc->ss); /* Restore parens of
3838                                                     the caller. */
3839                 PL_reginput = locinput; /* Make position available to
3840                                            the callcc. */
3841                 cache_re(PL_reg_call_cc->re);
3842                 PL_regcc = PL_reg_call_cc->cc;
3843                 PL_reg_call_cc = PL_reg_call_cc->prev;
3844                 if (regmatch(cur_call_cc->node)) {
3845                     PL_reg_call_cc = cur_call_cc;
3846                     regcpblow(cp);
3847                     sayYES;
3848                 }
3849                 REGCP_UNWIND(lastcp);
3850                 regcppop();
3851                 PL_reg_call_cc = cur_call_cc;
3852                 PL_regcc = cctmp;
3853                 PL_reg_re = re;
3854                 cache_re(re);
3855
3856                 DEBUG_r(
3857                     PerlIO_printf(Perl_debug_log,
3858                                   "%*s  continuation failed...\n",
3859                                   REPORT_CODE_OFF+PL_regindent*2, "")
3860                     );
3861                 sayNO_SILENT;
3862             }
3863             if (locinput < PL_regtill) {
3864                 DEBUG_r(PerlIO_printf(Perl_debug_log,
3865                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
3866                                       PL_colors[4],
3867                                       (long)(locinput - PL_reg_starttry),
3868                                       (long)(PL_regtill - PL_reg_starttry),
3869                                       PL_colors[5]));
3870                 sayNO_FINAL;            /* Cannot match: too short. */
3871             }
3872             PL_reginput = locinput;     /* put where regtry can find it */
3873             sayYES_FINAL;               /* Success! */
3874         case SUCCEED:
3875             PL_reginput = locinput;     /* put where regtry can find it */
3876             sayYES_LOUD;                /* Success! */
3877         case SUSPEND:
3878             n = 1;
3879             PL_reginput = locinput;
3880             goto do_ifmatch;
3881         case UNLESSM:
3882             n = 0;
3883             if (scan->flags) {
3884                 s = HOPBACKc(locinput, scan->flags);
3885                 if (!s)
3886                     goto say_yes;
3887                 PL_reginput = s;
3888             }
3889             else
3890                 PL_reginput = locinput;
3891             goto do_ifmatch;
3892         case IFMATCH:
3893             n = 1;
3894             if (scan->flags) {
3895                 s = HOPBACKc(locinput, scan->flags);
3896                 if (!s)
3897                     goto say_no;
3898                 PL_reginput = s;
3899             }
3900             else
3901                 PL_reginput = locinput;
3902
3903           do_ifmatch:
3904             inner = NEXTOPER(NEXTOPER(scan));
3905             if (regmatch(inner) != n) {
3906               say_no:
3907                 if (logical) {
3908                     logical = 0;
3909                     sw = 0;
3910                     goto do_longjump;
3911                 }
3912                 else
3913                     sayNO;
3914             }
3915           say_yes:
3916             if (logical) {
3917                 logical = 0;
3918                 sw = 1;
3919             }
3920             if (OP(scan) == SUSPEND) {
3921                 locinput = PL_reginput;
3922                 nextchr = UCHARAT(locinput);
3923             }
3924             /* FALL THROUGH. */
3925         case LONGJMP:
3926           do_longjump:
3927             next = scan + ARG(scan);
3928             if (next == scan)
3929                 next = NULL;
3930             break;
3931         default:
3932             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
3933                           PTR2UV(scan), OP(scan));
3934             Perl_croak(aTHX_ "regexp memory corruption");
3935         }
3936       reenter:
3937         scan = next;
3938     }
3939
3940     /*
3941     * We get here only if there's trouble -- normally "case END" is
3942     * the terminating point.
3943     */
3944     Perl_croak(aTHX_ "corrupted regexp pointers");
3945     /*NOTREACHED*/
3946     sayNO;
3947
3948 yes_loud:
3949     DEBUG_r(
3950         PerlIO_printf(Perl_debug_log,
3951                       "%*s  %scould match...%s\n",
3952                       REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],PL_colors[5])
3953         );
3954     goto yes;
3955 yes_final:
3956     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
3957                           PL_colors[4],PL_colors[5]));
3958 yes:
3959 #ifdef DEBUGGING
3960     PL_regindent--;
3961 #endif
3962
3963 #if 0                                   /* Breaks $^R */
3964     if (unwind)
3965         regcpblow(firstcp);
3966 #endif
3967     return 1;
3968
3969 no:
3970     DEBUG_r(
3971         PerlIO_printf(Perl_debug_log,
3972                       "%*s  %sfailed...%s\n",
3973                       REPORT_CODE_OFF+PL_regindent*2, "",PL_colors[4],PL_colors[5])
3974         );
3975     goto do_no;
3976 no_final:
3977 do_no:
3978     if (unwind) {
3979         re_unwind_t *uw = SSPTRt(unwind,re_unwind_t);
3980
3981         switch (uw->type) {
3982         case RE_UNWIND_BRANCH:
3983         case RE_UNWIND_BRANCHJ:
3984         {
3985             re_unwind_branch_t *uwb = &(uw->branch);
3986             const I32 lastparen = uwb->lastparen;
3987
3988             REGCP_UNWIND(uwb->lastcp);
3989             for (n = *PL_reglastparen; n > lastparen; n--)
3990                 PL_regendp[n] = -1;
3991             *PL_reglastparen = n;
3992             scan = next = uwb->next;
3993             if ( !scan ||
3994                  OP(scan) != (uwb->type == RE_UNWIND_BRANCH
3995                               ? BRANCH : BRANCHJ) ) {           /* Failure */
3996                 unwind = uwb->prev;
3997 #ifdef DEBUGGING
3998                 PL_regindent--;
3999 #endif
4000                 goto do_no;
4001             }
4002             /* Have more choice yet.  Reuse the same uwb.  */
4003             if ((n = (uwb->type == RE_UNWIND_BRANCH
4004                       ? NEXT_OFF(next) : ARG(next))))
4005                 next += n;
4006             else
4007                 next = NULL;    /* XXXX Needn't unwinding in this case... */
4008             uwb->next = next;
4009             next = NEXTOPER(scan);
4010             if (uwb->type == RE_UNWIND_BRANCHJ)
4011                 next = NEXTOPER(next);
4012             locinput = uwb->locinput;
4013             nextchr = uwb->nextchr;
4014 #ifdef DEBUGGING
4015             PL_regindent = uwb->regindent;
4016 #endif
4017
4018             goto reenter;
4019         }
4020         /* NOT REACHED */
4021         default:
4022             Perl_croak(aTHX_ "regexp unwind memory corruption");
4023         }
4024         /* NOT REACHED */
4025     }
4026 #ifdef DEBUGGING
4027     PL_regindent--;
4028 #endif
4029     return 0;
4030 }
4031
4032 /*
4033  - regrepeat - repeatedly match something simple, report how many
4034  */
4035 /*
4036  * [This routine now assumes that it will only match on things of length 1.
4037  * That was true before, but now we assume scan - reginput is the count,
4038  * rather than incrementing count on every character.  [Er, except utf8.]]
4039  */
4040 STATIC I32
4041 S_regrepeat(pTHX_ const regnode *p, I32 max)
4042 {
4043     register char *scan;
4044     register I32 c;
4045     register char *loceol = PL_regeol;
4046     register I32 hardcount = 0;
4047     register bool do_utf8 = PL_reg_match_utf8;
4048
4049     scan = PL_reginput;
4050     if (max == REG_INFTY)
4051         max = I32_MAX;
4052     else if (max < loceol - scan)
4053       loceol = scan + max;
4054     switch (OP(p)) {
4055     case REG_ANY:
4056         if (do_utf8) {
4057             loceol = PL_regeol;
4058             while (scan < loceol && hardcount < max && *scan != '\n') {
4059                 scan += UTF8SKIP(scan);
4060                 hardcount++;
4061             }
4062         } else {
4063             while (scan < loceol && *scan != '\n')
4064                 scan++;
4065         }
4066         break;
4067     case SANY:
4068         if (do_utf8) {
4069             loceol = PL_regeol;
4070             while (scan < loceol && hardcount < max) {
4071                 scan += UTF8SKIP(scan);
4072                 hardcount++;
4073             }
4074         }
4075         else
4076             scan = loceol;
4077         break;
4078     case CANY:
4079         scan = loceol;
4080         break;
4081     case EXACT:         /* length of string is 1 */
4082         c = (U8)*STRING(p);
4083         while (scan < loceol && UCHARAT(scan) == c)
4084             scan++;
4085         break;
4086     case EXACTF:        /* length of string is 1 */
4087         c = (U8)*STRING(p);
4088         while (scan < loceol &&
4089                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
4090             scan++;
4091         break;
4092     case EXACTFL:       /* length of string is 1 */
4093         PL_reg_flags |= RF_tainted;
4094         c = (U8)*STRING(p);
4095         while (scan < loceol &&
4096                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
4097             scan++;
4098         break;
4099     case ANYOF:
4100         if (do_utf8) {
4101             loceol = PL_regeol;
4102             while (hardcount < max && scan < loceol &&
4103                    reginclass(p, (U8*)scan, 0, do_utf8)) {
4104                 scan += UTF8SKIP(scan);
4105                 hardcount++;
4106             }
4107         } else {
4108             while (scan < loceol && REGINCLASS(p, (U8*)scan))
4109                 scan++;
4110         }
4111         break;
4112     case ALNUM:
4113         if (do_utf8) {
4114             loceol = PL_regeol;
4115             LOAD_UTF8_CHARCLASS_ALNUM();
4116             while (hardcount < max && scan < loceol &&
4117                    swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
4118                 scan += UTF8SKIP(scan);
4119                 hardcount++;
4120             }
4121         } else {
4122             while (scan < loceol && isALNUM(*scan))
4123                 scan++;
4124         }
4125         break;
4126     case ALNUML:
4127         PL_reg_flags |= RF_tainted;
4128         if (do_utf8) {
4129             loceol = PL_regeol;
4130             while (hardcount < max && scan < loceol &&
4131                    isALNUM_LC_utf8((U8*)scan)) {
4132                 scan += UTF8SKIP(scan);
4133                 hardcount++;
4134             }
4135         } else {
4136             while (scan < loceol && isALNUM_LC(*scan))
4137                 scan++;
4138         }
4139         break;
4140     case NALNUM:
4141         if (do_utf8) {
4142             loceol = PL_regeol;
4143             LOAD_UTF8_CHARCLASS_ALNUM();
4144             while (hardcount < max && scan < loceol &&
4145                    !swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
4146                 scan += UTF8SKIP(scan);
4147                 hardcount++;
4148             }
4149         } else {
4150             while (scan < loceol && !isALNUM(*scan))
4151                 scan++;
4152         }
4153         break;
4154     case NALNUML:
4155         PL_reg_flags |= RF_tainted;
4156         if (do_utf8) {
4157             loceol = PL_regeol;
4158             while (hardcount < max && scan < loceol &&
4159                    !isALNUM_LC_utf8((U8*)scan)) {
4160                 scan += UTF8SKIP(scan);
4161                 hardcount++;
4162             }
4163         } else {
4164             while (scan < loceol && !isALNUM_LC(*scan))
4165                 scan++;
4166         }
4167         break;
4168     case SPACE:
4169         if (do_utf8) {
4170             loceol = PL_regeol;
4171             LOAD_UTF8_CHARCLASS_SPACE();
4172             while (hardcount < max && scan < loceol &&
4173                    (*scan == ' ' ||
4174                     swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
4175                 scan += UTF8SKIP(scan);
4176                 hardcount++;
4177             }
4178         } else {
4179             while (scan < loceol && isSPACE(*scan))
4180                 scan++;
4181         }
4182         break;
4183     case SPACEL:
4184         PL_reg_flags |= RF_tainted;
4185         if (do_utf8) {
4186             loceol = PL_regeol;
4187             while (hardcount < max && scan < loceol &&
4188                    (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
4189                 scan += UTF8SKIP(scan);
4190                 hardcount++;
4191             }
4192         } else {
4193             while (scan < loceol && isSPACE_LC(*scan))
4194                 scan++;
4195         }
4196         break;
4197     case NSPACE:
4198         if (do_utf8) {
4199             loceol = PL_regeol;
4200             LOAD_UTF8_CHARCLASS_SPACE();
4201             while (hardcount < max && scan < loceol &&
4202                    !(*scan == ' ' ||
4203                      swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
4204                 scan += UTF8SKIP(scan);
4205                 hardcount++;
4206             }
4207         } else {
4208             while (scan < loceol && !isSPACE(*scan))
4209                 scan++;
4210             break;
4211         }
4212     case NSPACEL:
4213         PL_reg_flags |= RF_tainted;
4214         if (do_utf8) {
4215             loceol = PL_regeol;
4216             while (hardcount < max && scan < loceol &&
4217                    !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
4218                 scan += UTF8SKIP(scan);
4219                 hardcount++;
4220             }
4221         } else {
4222             while (scan < loceol && !isSPACE_LC(*scan))
4223                 scan++;
4224         }
4225         break;
4226     case DIGIT:
4227         if (do_utf8) {
4228             loceol = PL_regeol;
4229             LOAD_UTF8_CHARCLASS_DIGIT();
4230             while (hardcount < max && scan < loceol &&
4231                    swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4232                 scan += UTF8SKIP(scan);
4233                 hardcount++;
4234             }
4235         } else {
4236             while (scan < loceol && isDIGIT(*scan))
4237                 scan++;
4238         }
4239         break;
4240     case NDIGIT:
4241         if (do_utf8) {
4242             loceol = PL_regeol;
4243             LOAD_UTF8_CHARCLASS_DIGIT();
4244             while (hardcount < max && scan < loceol &&
4245                    !swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4246                 scan += UTF8SKIP(scan);
4247                 hardcount++;
4248             }
4249         } else {
4250             while (scan < loceol && !isDIGIT(*scan))
4251                 scan++;
4252         }
4253         break;
4254     default:            /* Called on something of 0 width. */
4255         break;          /* So match right here or not at all. */
4256     }
4257
4258     if (hardcount)
4259         c = hardcount;
4260     else
4261         c = scan - PL_reginput;
4262     PL_reginput = scan;
4263
4264     DEBUG_r(
4265         {
4266                 SV *prop = sv_newmortal();
4267
4268                 regprop(prop, (regnode *)p);
4269                 PerlIO_printf(Perl_debug_log,
4270                               "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
4271                               REPORT_CODE_OFF+1, "", SvPVX_const(prop),(IV)c,(IV)max);
4272         });
4273
4274     return(c);
4275 }
4276
4277 /*
4278  - regrepeat_hard - repeatedly match something, report total lenth and length
4279  *
4280  * The repeater is supposed to have constant non-zero length.
4281  */
4282
4283 STATIC I32
4284 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp)
4285 {
4286     register char *scan = Nullch;
4287     register char *start;
4288     register char *loceol = PL_regeol;
4289     I32 l = 0;
4290     I32 count = 0, res = 1;
4291
4292     if (!max)
4293         return 0;
4294
4295     start = PL_reginput;
4296     if (PL_reg_match_utf8) {
4297         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
4298             if (!count++) {
4299                 l = 0;
4300                 while (start < PL_reginput) {
4301                     l++;
4302                     start += UTF8SKIP(start);
4303                 }
4304                 *lp = l;
4305                 if (l == 0)
4306                     return max;
4307             }
4308             if (count == max)
4309                 return count;
4310         }
4311     }
4312     else {
4313         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
4314             if (!count++) {
4315                 *lp = l = PL_reginput - start;
4316                 if (max != REG_INFTY && l*max < loceol - scan)
4317                     loceol = scan + l*max;
4318                 if (l == 0)
4319                     return max;
4320             }
4321         }
4322     }
4323     if (!res)
4324         PL_reginput = scan;
4325
4326     return count;
4327 }
4328
4329 /*
4330 - regclass_swash - prepare the utf8 swash
4331 */
4332
4333 SV *
4334 Perl_regclass_swash(pTHX_ register regnode* node, bool doinit, SV** listsvp, SV **altsvp)
4335 {
4336     SV *sw  = NULL;
4337     SV *si  = NULL;
4338     SV *alt = NULL;
4339
4340     if (PL_regdata && PL_regdata->count) {
4341         const U32 n = ARG(node);
4342
4343         if (PL_regdata->what[n] == 's') {
4344             SV * const rv = (SV*)PL_regdata->data[n];
4345             AV * const av = (AV*)SvRV((SV*)rv);
4346             SV **const ary = AvARRAY(av);
4347             SV **a, **b;
4348
4349             /* See the end of regcomp.c:S_reglass() for
4350              * documentation of these array elements. */
4351
4352             si = *ary;
4353             a  = SvTYPE(ary[1]) == SVt_RV   ? &ary[1] : 0;
4354             b  = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : 0;
4355
4356             if (a)
4357                 sw = *a;
4358             else if (si && doinit) {
4359                 sw = swash_init("utf8", "", si, 1, 0);
4360                 (void)av_store(av, 1, sw);
4361             }
4362             if (b)
4363                 alt = *b;
4364         }
4365     }
4366
4367     if (listsvp)
4368         *listsvp = si;
4369     if (altsvp)
4370         *altsvp  = alt;
4371
4372     return sw;
4373 }
4374
4375 /*
4376  - reginclass - determine if a character falls into a character class
4377
4378   The n is the ANYOF regnode, the p is the target string, lenp
4379   is pointer to the maximum length of how far to go in the p
4380   (if the lenp is zero, UTF8SKIP(p) is used),
4381   do_utf8 tells whether the target string is in UTF-8.
4382
4383  */
4384
4385 STATIC bool
4386 S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp, register bool do_utf8)
4387 {
4388     const char flags = ANYOF_FLAGS(n);
4389     bool match = FALSE;
4390     UV c = *p;
4391     STRLEN len = 0;
4392     STRLEN plen;
4393
4394     if (do_utf8 && !UTF8_IS_INVARIANT(c))
4395         c = utf8n_to_uvchr((U8 *)p, UTF8_MAXBYTES, &len,
4396                             ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
4397
4398     plen = lenp ? *lenp : UNISKIP(NATIVE_TO_UNI(c));
4399     if (do_utf8 || (flags & ANYOF_UNICODE)) {
4400         if (lenp)
4401             *lenp = 0;
4402         if (do_utf8 && !ANYOF_RUNTIME(n)) {
4403             if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
4404                 match = TRUE;
4405         }
4406         if (!match && do_utf8 && (flags & ANYOF_UNICODE_ALL) && c >= 256)
4407             match = TRUE;
4408         if (!match) {
4409             AV *av;
4410             SV * const sw = regclass_swash((regnode *)n, TRUE, 0, (SV**)&av);
4411
4412             if (sw) {
4413                 if (swash_fetch(sw, (U8 *)p, do_utf8))
4414                     match = TRUE;
4415                 else if (flags & ANYOF_FOLD) {
4416                     if (!match && lenp && av) {
4417                         I32 i;
4418                         for (i = 0; i <= av_len(av); i++) {
4419                             SV* const sv = *av_fetch(av, i, FALSE);
4420                             STRLEN len;
4421                             const char * const s = SvPV_const(sv, len);
4422
4423                             if (len <= plen && memEQ(s, (char*)p, len)) {
4424                                 *lenp = len;
4425                                 match = TRUE;
4426                                 break;
4427                             }
4428                         }
4429                     }
4430                     if (!match) {
4431                         U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
4432                         STRLEN tmplen;
4433
4434                         to_utf8_fold((U8 *)p, tmpbuf, &tmplen);
4435                         if (swash_fetch(sw, tmpbuf, do_utf8))
4436                             match = TRUE;
4437                     }
4438                 }
4439             }
4440         }
4441         if (match && lenp && *lenp == 0)
4442             *lenp = UNISKIP(NATIVE_TO_UNI(c));
4443     }
4444     if (!match && c < 256) {
4445         if (ANYOF_BITMAP_TEST(n, c))
4446             match = TRUE;
4447         else if (flags & ANYOF_FOLD) {
4448             U8 f;
4449
4450             if (flags & ANYOF_LOCALE) {
4451                 PL_reg_flags |= RF_tainted;
4452                 f = PL_fold_locale[c];
4453             }
4454             else
4455                 f = PL_fold[c];
4456             if (f != c && ANYOF_BITMAP_TEST(n, f))
4457                 match = TRUE;
4458         }
4459
4460         if (!match && (flags & ANYOF_CLASS)) {
4461             PL_reg_flags |= RF_tainted;
4462             if (
4463                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
4464                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
4465                 (ANYOF_CLASS_TEST(n, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
4466                 (ANYOF_CLASS_TEST(n, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
4467                 (ANYOF_CLASS_TEST(n, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
4468                 (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
4469                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
4470                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
4471                 (ANYOF_CLASS_TEST(n, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
4472                 (ANYOF_CLASS_TEST(n, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
4473                 (ANYOF_CLASS_TEST(n, ANYOF_ASCII)   &&  isASCII(c))     ||
4474                 (ANYOF_CLASS_TEST(n, ANYOF_NASCII)  && !isASCII(c))     ||
4475                 (ANYOF_CLASS_TEST(n, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
4476                 (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
4477                 (ANYOF_CLASS_TEST(n, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
4478                 (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
4479                 (ANYOF_CLASS_TEST(n, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
4480                 (ANYOF_CLASS_TEST(n, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
4481                 (ANYOF_CLASS_TEST(n, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
4482                 (ANYOF_CLASS_TEST(n, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
4483                 (ANYOF_CLASS_TEST(n, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
4484                 (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
4485                 (ANYOF_CLASS_TEST(n, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
4486                 (ANYOF_CLASS_TEST(n, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
4487                 (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
4488                 (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c))    ||
4489                 (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC)  &&  isPSXSPC(c))    ||
4490                 (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c))    ||
4491                 (ANYOF_CLASS_TEST(n, ANYOF_BLANK)   &&  isBLANK(c))     ||
4492                 (ANYOF_CLASS_TEST(n, ANYOF_NBLANK)  && !isBLANK(c))
4493                 ) /* How's that for a conditional? */
4494             {
4495                 match = TRUE;
4496             }
4497         }
4498     }
4499
4500     return (flags & ANYOF_INVERT) ? !match : match;
4501 }
4502
4503 STATIC U8 *
4504 S_reghop(pTHX_ U8 *s, I32 off)
4505 {
4506     return S_reghop3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4507 }
4508
4509 STATIC U8 *
4510 S_reghop3(pTHX_ U8 *s, I32 off, U8* lim)
4511 {
4512     if (off >= 0) {
4513         while (off-- && s < lim) {
4514             /* XXX could check well-formedness here */
4515             s += UTF8SKIP(s);
4516         }
4517     }
4518     else {
4519         while (off++) {
4520             if (s > lim) {
4521                 s--;
4522                 if (UTF8_IS_CONTINUED(*s)) {
4523                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4524                         s--;
4525                 }
4526                 /* XXX could check well-formedness here */
4527             }
4528         }
4529     }
4530     return s;
4531 }
4532
4533 STATIC U8 *
4534 S_reghopmaybe(pTHX_ U8 *s, I32 off)
4535 {
4536     return S_reghopmaybe3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4537 }
4538
4539 STATIC U8 *
4540 S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim)
4541 {
4542     if (off >= 0) {
4543         while (off-- && s < lim) {
4544             /* XXX could check well-formedness here */
4545             s += UTF8SKIP(s);
4546         }
4547         if (off >= 0)
4548             return 0;
4549     }
4550     else {
4551         while (off++) {
4552             if (s > lim) {
4553                 s--;
4554                 if (UTF8_IS_CONTINUED(*s)) {
4555                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4556                         s--;
4557                 }
4558                 /* XXX could check well-formedness here */
4559             }
4560             else
4561                 break;
4562         }
4563         if (off <= 0)
4564             return 0;
4565     }
4566     return s;
4567 }
4568
4569 static void
4570 restore_pos(pTHX_ void *arg)
4571 {
4572     PERL_UNUSED_ARG(arg);
4573     if (PL_reg_eval_set) {
4574         if (PL_reg_oldsaved) {
4575             PL_reg_re->subbeg = PL_reg_oldsaved;
4576             PL_reg_re->sublen = PL_reg_oldsavedlen;
4577             RX_MATCH_COPIED_on(PL_reg_re);
4578         }
4579         PL_reg_magic->mg_len = PL_reg_oldpos;
4580         PL_reg_eval_set = 0;
4581         PL_curpm = PL_reg_oldcurpm;
4582     }
4583 }
4584
4585 STATIC void
4586 S_to_utf8_substr(pTHX_ register regexp *prog)
4587 {
4588     if (prog->float_substr && !prog->float_utf8) {
4589         SV* sv;
4590         prog->float_utf8 = sv = newSVsv(prog->float_substr);
4591         sv_utf8_upgrade(sv);
4592         if (SvTAIL(prog->float_substr))
4593             SvTAIL_on(sv);
4594         if (prog->float_substr == prog->check_substr)
4595             prog->check_utf8 = sv;
4596     }
4597     if (prog->anchored_substr && !prog->anchored_utf8) {
4598         SV* sv;
4599         prog->anchored_utf8 = sv = newSVsv(prog->anchored_substr);
4600         sv_utf8_upgrade(sv);
4601         if (SvTAIL(prog->anchored_substr))
4602             SvTAIL_on(sv);
4603         if (prog->anchored_substr == prog->check_substr)
4604             prog->check_utf8 = sv;
4605     }
4606 }
4607
4608 STATIC void
4609 S_to_byte_substr(pTHX_ register regexp *prog)
4610 {
4611     if (prog->float_utf8 && !prog->float_substr) {
4612         SV* sv;
4613         prog->float_substr = sv = newSVsv(prog->float_utf8);
4614         if (sv_utf8_downgrade(sv, TRUE)) {
4615             if (SvTAIL(prog->float_utf8))
4616                 SvTAIL_on(sv);
4617         } else {
4618             SvREFCNT_dec(sv);
4619             prog->float_substr = sv = &PL_sv_undef;
4620         }
4621         if (prog->float_utf8 == prog->check_utf8)
4622             prog->check_substr = sv;
4623     }
4624     if (prog->anchored_utf8 && !prog->anchored_substr) {
4625         SV* sv;
4626         prog->anchored_substr = sv = newSVsv(prog->anchored_utf8);
4627         if (sv_utf8_downgrade(sv, TRUE)) {
4628             if (SvTAIL(prog->anchored_utf8))
4629                 SvTAIL_on(sv);
4630         } else {
4631             SvREFCNT_dec(sv);
4632             prog->anchored_substr = sv = &PL_sv_undef;
4633         }
4634         if (prog->anchored_utf8 == prog->check_utf8)
4635             prog->check_substr = sv;
4636     }
4637 }
4638
4639 /*
4640  * Local variables:
4641  * c-indentation-style: bsd
4642  * c-basic-offset: 4
4643  * indent-tabs-mode: t
4644  * End:
4645  *
4646  * ex: set ts=8 sts=4 sw=4 noet:
4647  */