regexec.c

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