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 = Nullch; /* other substr checked before this */
 409     char *check_at = Nullch;            /* 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 = Nullsv;     /* disable */
 836             prog->float_substr = prog->float_utf8 = Nullsv;     /* clear */
 837             check = Nullsv;                     /* 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 Nullch;
 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;
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 != Nullsv || prog->check_utf8 != Nullsv)) {
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 != Nullsv
1845               || prog->anchored_utf8 != Nullsv
1846               || ((prog->float_substr != Nullsv || prog->float_utf8 != Nullsv)
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 != Nullsv || prog->float_utf8 != Nullsv) {
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 : Nullch;
1996                     else
1997                         goto find_last;
1998                 } else {
1999                   find_last:
2000                     if (len)
2001                         last = rninstr(s, strend, little, little + len);
2002                     else
2003                         last = strend;  /* matching "$" */
2004                 }
2005             }
2006             if (last == NULL) {
2007                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
2008                                       "%sCan't trim the tail, match fails (should not happen)%s\n",
2009                                       PL_colors[4], PL_colors[5]));
2010                 goto phooey; /* Should not happen! */
2011             }
2012             dontbother = strend - last + prog->float_min_offset;
2013         }
2014         if (minlen && (dontbother < minlen))
2015             dontbother = minlen - 1;
2016         strend -= dontbother;              /* this one's always in bytes! */
2017         /* We don't know much -- general case. */
2018         if (do_utf8) {
2019             for (;;) {
2020                 if (regtry(prog, s))
2021                     goto got_it;
2022                 if (s >= strend)
2023                     break;
2024                 s += UTF8SKIP(s);
2025             };
2026         }
2027         else {
2028             do {
2029                 if (regtry(prog, s))
2030                     goto got_it;
2031             } while (s++ < strend);
2032         }
2033     }
2034
2035     /* Failure. */
2036     goto phooey;
2037
2038 got_it:
2039     RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
2040
2041     if (PL_reg_eval_set) {
2042         /* Preserve the current value of $^R */
2043         if (oreplsv != GvSV(PL_replgv))
2044             sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
2045                                                   restored, the value remains
2046                                                   the same. */
2047         restore_pos(aTHX_ 0);
2048     }
2049
2050     /* make sure $`, $&, $', and $digit will work later */
2051     if ( !(flags & REXEC_NOT_FIRST) ) {
2052         RX_MATCH_COPY_FREE(prog);
2053         if (flags & REXEC_COPY_STR) {
2054             I32 i = PL_regeol - startpos + (stringarg - strbeg);
2055 #ifdef PERL_OLD_COPY_ON_WRITE
2056             if ((SvIsCOW(sv)
2057                  || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) {
2058                 if (DEBUG_C_TEST) {
2059                     PerlIO_printf(Perl_debug_log,
2060                                   "Copy on write: regexp capture, type %d\n",
2061                                   (int) SvTYPE(sv));
2062                 }
2063                 prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
2064                 prog->subbeg = (char *)SvPVX_const(prog->saved_copy);
2065                 assert (SvPOKp(prog->saved_copy));
2066             } else
2067 #endif
2068             {
2069                 RX_MATCH_COPIED_on(prog);
2070                 s = savepvn(strbeg, i);
2071                 prog->subbeg = s;
2072             }
2073             prog->sublen = i;
2074         }
2075         else {
2076             prog->subbeg = strbeg;
2077             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
2078         }
2079     }
2080
2081     return 1;
2082
2083 phooey:
2084     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
2085                           PL_colors[4], PL_colors[5]));
2086     if (PL_reg_eval_set)
2087         restore_pos(aTHX_ 0);
2088     return 0;
2089 }
2090
2091 /*
2092  - regtry - try match at specific point
2093  */
2094 STATIC I32                      /* 0 failure, 1 success */
2095 S_regtry(pTHX_ regexp *prog, char *startpos)
2096 {
2097     dVAR;
2098     register I32 i;
2099     register I32 *sp;
2100     register I32 *ep;
2101     CHECKPOINT lastcp;
2102     GET_RE_DEBUG_FLAGS_DECL;
2103
2104 #ifdef DEBUGGING
2105     PL_regindent = 0;   /* XXXX Not good when matches are reenterable... */
2106 #endif
2107     if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
2108         MAGIC *mg;
2109
2110         PL_reg_eval_set = RS_init;
2111         DEBUG_EXECUTE_r(DEBUG_s(
2112             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %"IVdf"\n",
2113                           (IV)(PL_stack_sp - PL_stack_base));
2114             ));
2115         SAVEI32(cxstack[cxstack_ix].blk_oldsp);
2116         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
2117         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
2118         SAVETMPS;
2119         /* Apparently this is not needed, judging by wantarray. */
2120         /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
2121            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
2122
2123         if (PL_reg_sv) {
2124             /* Make $_ available to executed code. */
2125             if (PL_reg_sv != DEFSV) {
2126                 SAVE_DEFSV;
2127                 DEFSV = PL_reg_sv;
2128             }
2129
2130             if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv)
2131                   && (mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global)))) {
2132                 /* prepare for quick setting of pos */
2133                 sv_magic(PL_reg_sv, (SV*)0,
2134                         PERL_MAGIC_regex_global, Nullch, 0);
2135                 mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global);
2136                 mg->mg_len = -1;
2137             }
2138             PL_reg_magic    = mg;
2139             PL_reg_oldpos   = mg->mg_len;
2140             SAVEDESTRUCTOR_X(restore_pos, 0);
2141         }
2142         if (!PL_reg_curpm) {
2143             Newxz(PL_reg_curpm, 1, PMOP);
2144 #ifdef USE_ITHREADS
2145             {
2146                 SV* repointer = newSViv(0);
2147                 /* so we know which PL_regex_padav element is PL_reg_curpm */
2148                 SvFLAGS(repointer) |= SVf_BREAK;
2149                 av_push(PL_regex_padav,repointer);
2150                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
2151                 PL_regex_pad = AvARRAY(PL_regex_padav);
2152             }
2153 #endif
2154         }
2155         PM_SETRE(PL_reg_curpm, prog);
2156         PL_reg_oldcurpm = PL_curpm;
2157         PL_curpm = PL_reg_curpm;
2158         if (RX_MATCH_COPIED(prog)) {
2159             /*  Here is a serious problem: we cannot rewrite subbeg,
2160                 since it may be needed if this match fails.  Thus
2161                 $` inside (?{}) could fail... */
2162             PL_reg_oldsaved = prog->subbeg;
2163             PL_reg_oldsavedlen = prog->sublen;
2164 #ifdef PERL_OLD_COPY_ON_WRITE
2165             PL_nrs = prog->saved_copy;
2166 #endif
2167             RX_MATCH_COPIED_off(prog);
2168         }
2169         else
2170             PL_reg_oldsaved = Nullch;
2171         prog->subbeg = PL_bostr;
2172         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
2173     }
2174     prog->startp[0] = startpos - PL_bostr;
2175     PL_reginput = startpos;
2176     PL_regstartp = prog->startp;
2177     PL_regendp = prog->endp;
2178     PL_reglastparen = &prog->lastparen;
2179     PL_reglastcloseparen = &prog->lastcloseparen;
2180     prog->lastparen = 0;
2181     prog->lastcloseparen = 0;
2182     PL_regsize = 0;
2183     DEBUG_EXECUTE_r(PL_reg_starttry = startpos);
2184     if (PL_reg_start_tmpl <= prog->nparens) {
2185         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
2186         if(PL_reg_start_tmp)
2187             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2188         else
2189             Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2190     }
2191
2192     /* XXXX What this code is doing here?!!!  There should be no need
2193        to do this again and again, PL_reglastparen should take care of
2194        this!  --ilya*/
2195
2196     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
2197      * Actually, the code in regcppop() (which Ilya may be meaning by
2198      * PL_reglastparen), is not needed at all by the test suite
2199      * (op/regexp, op/pat, op/split), but that code is needed, oddly
2200      * enough, for building DynaLoader, or otherwise this
2201      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
2202      * will happen.  Meanwhile, this code *is* needed for the
2203      * above-mentioned test suite tests to succeed.  The common theme
2204      * on those tests seems to be returning null fields from matches.
2205      * --jhi */
2206 #if 1
2207     sp = prog->startp;
2208     ep = prog->endp;
2209     if (prog->nparens) {
2210         for (i = prog->nparens; i > (I32)*PL_reglastparen; i--) {
2211             *++sp = -1;
2212             *++ep = -1;
2213         }
2214     }
2215 #endif
2216     REGCP_SET(lastcp);
2217     if (regmatch(prog->program + 1)) {
2218         prog->endp[0] = PL_reginput - PL_bostr;
2219         return 1;
2220     }
2221     REGCP_UNWIND(lastcp);
2222     return 0;
2223 }
2224
2225 #define RE_UNWIND_BRANCH        1
2226 #define RE_UNWIND_BRANCHJ       2
2227
2228 union re_unwind_t;
2229
2230 typedef struct {                /* XX: makes sense to enlarge it... */
2231     I32 type;
2232     I32 prev;
2233     CHECKPOINT lastcp;
2234 } re_unwind_generic_t;
2235
2236 typedef struct {
2237     I32 type;
2238     I32 prev;
2239     CHECKPOINT lastcp;
2240     I32 lastparen;
2241     regnode *next;
2242     char *locinput;
2243     I32 nextchr;
2244 #ifdef DEBUGGING
2245     int regindent;
2246 #endif
2247 } re_unwind_branch_t;
2248
2249 typedef union re_unwind_t {
2250     I32 type;
2251     re_unwind_generic_t generic;
2252     re_unwind_branch_t branch;
2253 } re_unwind_t;
2254
2255 #define sayYES goto yes
2256 #define sayNO goto no
2257 #define sayNO_ANYOF goto no_anyof
2258 #define sayYES_FINAL goto yes_final
2259 #define sayYES_LOUD  goto yes_loud
2260 #define sayNO_FINAL  goto no_final
2261 #define sayNO_SILENT goto do_no
2262 #define saySAME(x) if (x) goto yes; else goto no
2263
2264 #define POSCACHE_SUCCESS 0      /* caching success rather than failure */
2265 #define POSCACHE_SEEN 1         /* we know what we're caching */
2266 #define POSCACHE_START 2        /* the real cache: this bit maps to pos 0 */
2267 #define CACHEsayYES STMT_START { \
2268     if (cache_offset | cache_bit) { \
2269         if (!(PL_reg_poscache[0] & (1<<POSCACHE_SEEN))) \
2270             PL_reg_poscache[0] |= (1<<POSCACHE_SUCCESS) || (1<<POSCACHE_SEEN); \
2271         else if (!(PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))) { \
2272             /* cache records failure, but this is success */ \
2273             DEBUG_r( \
2274                 PerlIO_printf(Perl_debug_log, \
2275                     "%*s  (remove success from failure cache)\n", \
2276                     REPORT_CODE_OFF+PL_regindent*2, "") \
2277             ); \
2278             PL_reg_poscache[cache_offset] &= ~(1<<cache_bit); \
2279         } \
2280     } \
2281     sayYES; \
2282 } STMT_END
2283 #define CACHEsayNO STMT_START { \
2284     if (cache_offset | cache_bit) { \
2285         if (!(PL_reg_poscache[0] & (1<<POSCACHE_SEEN))) \
2286             PL_reg_poscache[0] |= (1<<POSCACHE_SEEN); \
2287         else if ((PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))) { \
2288             /* cache records success, but this is failure */ \
2289             DEBUG_r( \
2290                 PerlIO_printf(Perl_debug_log, \
2291                     "%*s  (remove failure from success cache)\n", \
2292                     REPORT_CODE_OFF+PL_regindent*2, "") \
2293             ); \
2294             PL_reg_poscache[cache_offset] &= ~(1<<cache_bit); \
2295         } \
2296     } \
2297     sayNO; \
2298 } STMT_END
2299
2300 /* this is used to determine how far from the left messages like
2301    'failed...' are printed. Currently 29 makes these messages line
2302    up with the opcode they refer to. Earlier perls used 25 which
2303    left these messages outdented making reviewing a debug output
2304    quite difficult.
2305 */
2306 #define REPORT_CODE_OFF 29
2307
2308
2309 /* Make sure there is a test for this +1 options in re_tests */
2310 #define TRIE_INITAL_ACCEPT_BUFFLEN 4;
2311
2312 #define TRIE_CHECK_STATE_IS_ACCEPTING STMT_START {                       \
2313     if ( trie->states[ state ].wordnum ) {                               \
2314         if ( !accepted ) {                                               \
2315             ENTER;                                                       \
2316             SAVETMPS;                                                    \
2317             bufflen = TRIE_INITAL_ACCEPT_BUFFLEN ;                       \
2318             sv_accept_buff=newSV(bufflen * sizeof(reg_trie_accepted) - 1 );\
2319             SvCUR_set( sv_accept_buff, sizeof(reg_trie_accepted) );      \
2320             SvPOK_on( sv_accept_buff );                                  \
2321             sv_2mortal( sv_accept_buff );                                \
2322             accept_buff = (reg_trie_accepted*)SvPV_nolen( sv_accept_buff );\
2323         } else {                                                         \
2324             if ( accepted >= bufflen ) {                                 \
2325                 bufflen *= 2;                                            \
2326                 accept_buff =(reg_trie_accepted*)SvGROW( sv_accept_buff, \
2327                     bufflen * sizeof(reg_trie_accepted) );               \
2328             }                                                            \
2329             SvCUR_set( sv_accept_buff,SvCUR( sv_accept_buff )            \
2330                 + sizeof( reg_trie_accepted ) );                         \
2331         }                                                                \
2332         accept_buff[ accepted ].wordnum = trie->states[ state ].wordnum; \
2333         accept_buff[ accepted ].endpos = uc;                             \
2334         ++accepted;                                                      \
2335     } } STMT_END
2336
2337 #define TRIE_HANDLE_CHAR STMT_START {                                   \
2338         if ( uvc < 256 ) {                                              \
2339             charid = trie->charmap[ uvc ];                              \
2340         } else {                                                        \
2341             charid = 0;                                                 \
2342             if( trie->widecharmap ) {                                   \
2343             SV** svpp = (SV**)NULL;                                     \
2344             svpp = hv_fetch( trie->widecharmap, (char*)&uvc,            \
2345                           sizeof( UV ), 0 );                            \
2346             if ( svpp ) {                                               \
2347                 charid = (U16)SvIV( *svpp );                            \
2348                 }                                                       \
2349             }                                                           \
2350         }                                                               \
2351         if ( charid &&                                                  \
2352              ( base + charid > trie->uniquecharcount ) &&               \
2353              ( base + charid - 1 - trie->uniquecharcount < trie->lasttrans) && \
2354              trie->trans[ base + charid - 1 - trie->uniquecharcount ].check == state ) \
2355         {                                                               \
2356             state = trie->trans[ base + charid - 1 - trie->uniquecharcount ].next;     \
2357         } else {                                                        \
2358             state = 0;                                                  \
2359         }                                                               \
2360         uc += len;                                                      \
2361     } STMT_END
2362
2363 /*
2364  - regmatch - main matching routine
2365  *
2366  * Conceptually the strategy is simple:  check to see whether the current
2367  * node matches, call self recursively to see whether the rest matches,
2368  * and then act accordingly.  In practice we make some effort to avoid
2369  * recursion, in particular by going through "ordinary" nodes (that don't
2370  * need to know whether the rest of the match failed) by a loop instead of
2371  * by recursion.
2372  */
2373 /* [lwall] I've hoisted the register declarations to the outer block in order to
2374  * maybe save a little bit of pushing and popping on the stack.  It also takes
2375  * advantage of machines that use a register save mask on subroutine entry.
2376  */
2377 STATIC I32                      /* 0 failure, 1 success */
2378 S_regmatch(pTHX_ regnode *prog)
2379 {
2380     dVAR;
2381     register regnode *scan;     /* Current node. */
2382     regnode *next;              /* Next node. */
2383     regnode *inner;             /* Next node in internal branch. */
2384     register I32 nextchr;       /* renamed nextchr - nextchar colides with
2385                                    function of same name */
2386     register I32 n;             /* no or next */
2387     register I32 ln = 0;        /* len or last */
2388     register char *s = Nullch;  /* operand or save */
2389     register char *locinput = PL_reginput;
2390     register I32 c1 = 0, c2 = 0, paren; /* case fold search, parenth */
2391     int minmod = 0, sw = 0, logical = 0;
2392     I32 unwind = 0;
2393
2394     /* used by the trie code */
2395     SV                 *sv_accept_buff = NULL; /* accepting states we have traversed */
2396     reg_trie_accepted  *accept_buff = NULL;  /* "" */
2397     reg_trie_data      *trie;                /* what trie are we using right now */
2398     U32 accepted = 0;                        /* how many accepting states we have seen*/
2399
2400 #if 0
2401     I32 firstcp = PL_savestack_ix;
2402 #endif
2403     register const bool do_utf8 = PL_reg_match_utf8;
2404 #ifdef DEBUGGING
2405     SV * const dsv0 = PERL_DEBUG_PAD_ZERO(0);
2406     SV * const dsv1 = PERL_DEBUG_PAD_ZERO(1);
2407     SV * const dsv2 = PERL_DEBUG_PAD_ZERO(2);
2408
2409     SV *re_debug_flags = NULL;
2410 #endif
2411     U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
2412
2413     GET_RE_DEBUG_FLAGS;
2414
2415 #ifdef DEBUGGING
2416     PL_regindent++;
2417 #endif
2418
2419
2420     /* Note that nextchr is a byte even in UTF */
2421     nextchr = UCHARAT(locinput);
2422     scan = prog;
2423     while (scan != NULL) {
2424
2425         DEBUG_EXECUTE_r( {
2426             SV * const prop = sv_newmortal();
2427             const int docolor = *PL_colors[0];
2428             const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
2429             int l = (PL_regeol - locinput) > taill ? taill : (PL_regeol - locinput);
2430             /* The part of the string before starttry has one color
2431                (pref0_len chars), between starttry and current
2432                position another one (pref_len - pref0_len chars),
2433                after the current position the third one.
2434                We assume that pref0_len <= pref_len, otherwise we
2435                decrease pref0_len.  */
2436             int pref_len = (locinput - PL_bostr) > (5 + taill) - l
2437                 ? (5 + taill) - l : locinput - PL_bostr;
2438             int pref0_len;
2439
2440             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
2441                 pref_len++;
2442             pref0_len = pref_len  - (locinput - PL_reg_starttry);
2443             if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
2444                 l = ( PL_regeol - locinput > (5 + taill) - pref_len
2445                       ? (5 + taill) - pref_len : PL_regeol - locinput);
2446             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
2447                 l--;
2448             if (pref0_len < 0)
2449                 pref0_len = 0;
2450             if (pref0_len > pref_len)
2451                 pref0_len = pref_len;
2452             regprop(prop, scan);
2453             {
2454               const char * const s0 =
2455                 do_utf8 && OP(scan) != CANY ?
2456                 pv_uni_display(dsv0, (U8*)(locinput - pref_len),
2457                                pref0_len, 60, UNI_DISPLAY_REGEX) :
2458                 locinput - pref_len;
2459               const int len0 = do_utf8 ? strlen(s0) : pref0_len;
2460               const char * const s1 = do_utf8 && OP(scan) != CANY ?
2461                 pv_uni_display(dsv1, (U8*)(locinput - pref_len + pref0_len),
2462                                pref_len - pref0_len, 60, UNI_DISPLAY_REGEX) :
2463                 locinput - pref_len + pref0_len;
2464               const int len1 = do_utf8 ? strlen(s1) : pref_len - pref0_len;
2465               const char * const s2 = do_utf8 && OP(scan) != CANY ?
2466                 pv_uni_display(dsv2, (U8*)locinput,
2467                                PL_regeol - locinput, 60, UNI_DISPLAY_REGEX) :
2468                 locinput;
2469               const int len2 = do_utf8 ? strlen(s2) : l;
2470               PerlIO_printf(Perl_debug_log,
2471                             "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n",
2472                             (IV)(locinput - PL_bostr),
2473                             PL_colors[4],
2474                             len0, s0,
2475                             PL_colors[5],
2476                             PL_colors[2],
2477                             len1, s1,
2478                             PL_colors[3],
2479                             (docolor ? "" : "> <"),
2480                             PL_colors[0],
2481                             len2, s2,
2482                             PL_colors[1],
2483                             15 - l - pref_len + 1,
2484                             "",
2485                             (IV)(scan - PL_regprogram), PL_regindent*2, "",
2486                             SvPVX_const(prop));
2487             }
2488         });
2489
2490         next = scan + NEXT_OFF(scan);
2491         if (next == scan)
2492             next = NULL;
2493
2494         switch (OP(scan)) {
2495         case BOL:
2496             if (locinput == PL_bostr)
2497             {
2498                 /* regtill = regbol; */
2499                 break;
2500             }
2501             sayNO;
2502         case MBOL:
2503             if (locinput == PL_bostr ||
2504                 ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n'))
2505             {
2506                 break;
2507             }
2508             sayNO;
2509         case SBOL:
2510             if (locinput == PL_bostr)
2511                 break;
2512             sayNO;
2513         case GPOS:
2514             if (locinput == PL_reg_ganch)
2515                 break;
2516             sayNO;
2517         case EOL:
2518                 goto seol;
2519         case MEOL:
2520             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2521                 sayNO;
2522             break;
2523         case SEOL:
2524           seol:
2525             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2526                 sayNO;
2527             if (PL_regeol - locinput > 1)
2528                 sayNO;
2529             break;
2530         case EOS:
2531             if (PL_regeol != locinput)
2532                 sayNO;
2533             break;
2534         case SANY:
2535             if (!nextchr && locinput >= PL_regeol)
2536                 sayNO;
2537             if (do_utf8) {
2538                 locinput += PL_utf8skip[nextchr];
2539                 if (locinput > PL_regeol)
2540                     sayNO;
2541                 nextchr = UCHARAT(locinput);
2542             }
2543             else
2544                 nextchr = UCHARAT(++locinput);
2545             break;
2546         case CANY:
2547             if (!nextchr && locinput >= PL_regeol)
2548                 sayNO;
2549             nextchr = UCHARAT(++locinput);
2550             break;
2551         case REG_ANY:
2552             if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
2553                 sayNO;
2554             if (do_utf8) {
2555                 locinput += PL_utf8skip[nextchr];
2556                 if (locinput > PL_regeol)
2557                     sayNO;
2558                 nextchr = UCHARAT(locinput);
2559             }
2560             else
2561                 nextchr = UCHARAT(++locinput);
2562             break;
2563
2564
2565
2566         /*
2567            traverse the TRIE keeping track of all accepting states
2568            we transition through until we get to a failing node.
2569
2570            we use two slightly different pieces of code to handle
2571            the traversal depending on whether its case sensitive or
2572            not. we reuse the accept code however. (this should probably
2573            be turned into a macro.)
2574
2575         */
2576         case TRIEF:
2577         case TRIEFL:
2578             {
2579                 U8 *uc = ( U8* )locinput;
2580                 U32 state = 1;
2581                 U16 charid = 0;
2582                 U32 base = 0;
2583                 UV uvc = 0;
2584                 STRLEN len = 0;
2585                 STRLEN foldlen = 0;
2586                 U8 *uscan = (U8*)NULL;
2587                 STRLEN bufflen=0;
2588                 accepted = 0;
2589
2590                 trie = (reg_trie_data*)PL_regdata->data[ ARG( scan ) ];
2591
2592                 while ( state && uc <= (U8*)PL_regeol ) {
2593
2594                     TRIE_CHECK_STATE_IS_ACCEPTING;
2595
2596                     base = trie->states[ state ].trans.base;
2597
2598                     DEBUG_TRIE_EXECUTE_r(
2599                                 PerlIO_printf( Perl_debug_log,
2600                                     "%*s  %sState: %4"UVxf", Base: %4"UVxf", Accepted: %4"UVxf" ",
2601                                     REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
2602                                     (UV)state, (UV)base, (UV)accepted );
2603                     );
2604
2605                     if ( base ) {
2606
2607                         if ( do_utf8 ) {
2608                             if ( foldlen>0 ) {
2609                                 uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags );
2610                                 foldlen -= len;
2611                                 uscan += len;
2612                                 len=0;
2613                             } else {
2614                                 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
2615                                 uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );
2616                                 uvc = to_uni_fold( uvc, foldbuf, &foldlen );
2617                                 foldlen -= UNISKIP( uvc );
2618                                 uscan = foldbuf + UNISKIP( uvc );
2619                             }
2620                         } else {
2621                             uvc = (UV)*uc;
2622                             len = 1;
2623                         }
2624
2625                         TRIE_HANDLE_CHAR;
2626
2627                     } else {
2628                         state = 0;
2629                     }
2630                     DEBUG_TRIE_EXECUTE_r(
2631                         PerlIO_printf( Perl_debug_log,
2632                             "Charid:%3x CV:%4"UVxf" After State: %4"UVxf"%s\n",
2633                             charid, uvc, (UV)state, PL_colors[5] );
2634                     );
2635                 }
2636                 if ( !accepted ) {
2637                    sayNO;
2638                 } else {
2639                     goto TrieAccept;
2640                 }
2641             }
2642             /* unreached codepoint: we jump into the middle of the next case
2643                from previous if blocks */
2644         case TRIE:
2645             {
2646                 U8 *uc = (U8*)locinput;
2647                 U32 state = 1;
2648                 U16 charid = 0;
2649                 U32 base = 0;
2650                 UV uvc = 0;
2651                 STRLEN len = 0;
2652                 STRLEN bufflen = 0;
2653                 accepted = 0;
2654
2655                 trie = (reg_trie_data*)PL_regdata->data[ ARG( scan ) ];
2656
2657                 while ( state && uc <= (U8*)PL_regeol ) {
2658
2659                     TRIE_CHECK_STATE_IS_ACCEPTING;
2660
2661                     base = trie->states[ state ].trans.base;
2662
2663                     DEBUG_TRIE_EXECUTE_r(
2664                             PerlIO_printf( Perl_debug_log,
2665                                 "%*s  %sState: %4"UVxf", Base: %4"UVxf", Accepted: %4"UVxf" ",
2666                                 REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
2667                                 (UV)state, (UV)base, (UV)accepted );
2668                     );
2669
2670                     if ( base ) {
2671
2672                         if ( do_utf8 ) {
2673                             uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );
2674                         } else {
2675                             uvc = (U32)*uc;
2676                             len = 1;
2677                         }
2678
2679                         TRIE_HANDLE_CHAR;
2680
2681                     } else {
2682                         state = 0;
2683                     }
2684                     DEBUG_TRIE_EXECUTE_r(
2685                             PerlIO_printf( Perl_debug_log,
2686                                 "Charid:%3x CV:%4"UVxf" After State: %4"UVxf"%s\n",
2687                                 charid, uvc, (UV)state, PL_colors[5] );
2688                     );
2689                 }
2690                 if ( !accepted ) {
2691                    sayNO;
2692                 }
2693             }
2694
2695
2696             /*
2697                There was at least one accepting state that we
2698                transitioned through. Presumably the number of accepting
2699                states is going to be low, typically one or two. So we
2700                simply scan through to find the one with lowest wordnum.
2701                Once we find it, we swap the last state into its place
2702                and decrement the size. We then try to match the rest of
2703                the pattern at the point where the word ends, if we
2704                succeed then we end the loop, otherwise the loop
2705                eventually terminates once all of the accepting states
2706                have been tried.
2707             */
2708         TrieAccept:
2709             {
2710                 int gotit = 0;
2711
2712                 if ( accepted == 1 ) {
2713                     DEBUG_EXECUTE_r({
2714                         SV **tmp = av_fetch( trie->words, accept_buff[ 0 ].wordnum-1, 0 );
2715                         PerlIO_printf( Perl_debug_log,
2716                             "%*s  %sonly one match : #%d <%s>%s\n",
2717                             REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
2718                             accept_buff[ 0 ].wordnum,
2719                             tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",
2720                             PL_colors[5] );
2721                     });
2722                     PL_reginput = (char *)accept_buff[ 0 ].endpos;
2723                     /* in this case we free tmps/leave before we call regmatch
2724                        as we wont be using accept_buff again. */
2725                     FREETMPS;
2726                     LEAVE;
2727                     gotit = regmatch( scan + NEXT_OFF( scan ) );
2728                 } else {
2729                     DEBUG_EXECUTE_r(
2730                         PerlIO_printf( Perl_debug_log,"%*s  %sgot %"IVdf" possible matches%s\n",
2731                             REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4], (IV)accepted,
2732                             PL_colors[5] );
2733                     );
2734                     while ( !gotit && accepted-- ) {
2735                         U32 best = 0;
2736                         U32 cur;
2737                         for( cur = 1 ; cur <= accepted ; cur++ ) {
2738                             DEBUG_TRIE_EXECUTE_r(
2739                                 PerlIO_printf( Perl_debug_log,
2740                                     "%*s  %sgot %"IVdf" (%d) as best, looking at %"IVdf" (%d)%s\n",
2741                                     REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
2742                                     (IV)best, accept_buff[ best ].wordnum, (IV)cur,
2743                                     accept_buff[ cur ].wordnum, PL_colors[5] );
2744                             );
2745
2746                             if ( accept_buff[ cur ].wordnum < accept_buff[ best ].wordnum )
2747                                     best = cur;
2748                         }
2749                         DEBUG_EXECUTE_r({
2750                             SV ** const tmp = av_fetch( trie->words, accept_buff[ best ].wordnum - 1, 0 );
2751                             PerlIO_printf( Perl_debug_log, "%*s  %strying alternation #%d <%s> at 0x%p%s\n",
2752                                 REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
2753                                 accept_buff[best].wordnum,
2754                                 tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",scan,
2755                                 PL_colors[5] );
2756                         });
2757                         if ( best<accepted ) {
2758                             reg_trie_accepted tmp = accept_buff[ best ];
2759                             accept_buff[ best ] = accept_buff[ accepted ];
2760                             accept_buff[ accepted ] = tmp;
2761                             best = accepted;
2762                         }
2763                         PL_reginput = (char *)accept_buff[ best ].endpos;
2764
2765                         /*
2766                            as far as I can tell we only need the SAVETMPS/FREETMPS
2767                            for re's with EVAL in them but I'm leaving them in for
2768                            all until I can be sure.
2769                          */
2770                         SAVETMPS;
2771                         gotit = regmatch( scan + NEXT_OFF( scan ) ) ;
2772                         FREETMPS;
2773                     }
2774                     FREETMPS;
2775                     LEAVE;
2776                 }
2777
2778                 if ( gotit ) {
2779                     sayYES;
2780                 } else {
2781                     sayNO;
2782                 }
2783             }
2784             /* unreached codepoint */
2785         case EXACT:
2786             s = STRING(scan);
2787             ln = STR_LEN(scan);
2788             if (do_utf8 != UTF) {
2789                 /* The target and the pattern have differing utf8ness. */
2790                 char *l = locinput;
2791                 const char *e = s + ln;
2792
2793                 if (do_utf8) {
2794                     /* The target is utf8, the pattern is not utf8. */
2795                     while (s < e) {
2796                         STRLEN ulen;
2797                         if (l >= PL_regeol)
2798                              sayNO;
2799                         if (NATIVE_TO_UNI(*(U8*)s) !=
2800                             utf8n_to_uvuni((U8*)l, UTF8_MAXBYTES, &ulen,
2801                                             uniflags))
2802                              sayNO;
2803                         l += ulen;
2804                         s ++;
2805                     }
2806                 }
2807                 else {
2808                     /* The target is not utf8, the pattern is utf8. */
2809                     while (s < e) {
2810                         STRLEN ulen;
2811                         if (l >= PL_regeol)
2812                             sayNO;
2813                         if (NATIVE_TO_UNI(*((U8*)l)) !=
2814                             utf8n_to_uvuni((U8*)s, UTF8_MAXBYTES, &ulen,
2815                                            uniflags))
2816                             sayNO;
2817                         s += ulen;
2818                         l ++;
2819                     }
2820                 }
2821                 locinput = l;
2822                 nextchr = UCHARAT(locinput);
2823                 break;
2824             }
2825             /* The target and the pattern have the same utf8ness. */
2826             /* Inline the first character, for speed. */
2827             if (UCHARAT(s) != nextchr)
2828                 sayNO;
2829             if (PL_regeol - locinput < ln)
2830                 sayNO;
2831             if (ln > 1 && memNE(s, locinput, ln))
2832                 sayNO;
2833             locinput += ln;
2834             nextchr = UCHARAT(locinput);
2835             break;
2836         case EXACTFL:
2837             PL_reg_flags |= RF_tainted;
2838             /* FALL THROUGH */
2839         case EXACTF:
2840             s = STRING(scan);
2841             ln = STR_LEN(scan);
2842
2843             if (do_utf8 || UTF) {
2844               /* Either target or the pattern are utf8. */
2845                 char *l = locinput;
2846                 char *e = PL_regeol;
2847
2848                 if (ibcmp_utf8(s, 0,  ln, (bool)UTF,
2849                                l, &e, 0,  do_utf8)) {
2850                      /* One more case for the sharp s:
2851                       * pack("U0U*", 0xDF) =~ /ss/i,
2852                       * the 0xC3 0x9F are the UTF-8
2853                       * byte sequence for the U+00DF. */
2854                      if (!(do_utf8 &&
2855                            toLOWER(s[0]) == 's' &&
2856                            ln >= 2 &&
2857                            toLOWER(s[1]) == 's' &&
2858                            (U8)l[0] == 0xC3 &&
2859                            e - l >= 2 &&
2860                            (U8)l[1] == 0x9F))
2861                           sayNO;
2862                 }
2863                 locinput = e;
2864                 nextchr = UCHARAT(locinput);
2865                 break;
2866             }
2867
2868             /* Neither the target and the pattern are utf8. */
2869
2870             /* Inline the first character, for speed. */
2871             if (UCHARAT(s) != nextchr &&
2872                 UCHARAT(s) != ((OP(scan) == EXACTF)
2873                                ? PL_fold : PL_fold_locale)[nextchr])
2874                 sayNO;
2875             if (PL_regeol - locinput < ln)
2876                 sayNO;
2877             if (ln > 1 && (OP(scan) == EXACTF
2878                            ? ibcmp(s, locinput, ln)
2879                            : ibcmp_locale(s, locinput, ln)))
2880                 sayNO;
2881             locinput += ln;
2882             nextchr = UCHARAT(locinput);
2883             break;
2884         case ANYOF:
2885             if (do_utf8) {
2886                 STRLEN inclasslen = PL_regeol - locinput;
2887
2888                 if (!reginclass(scan, (U8*)locinput, &inclasslen, do_utf8))
2889                     sayNO_ANYOF;
2890                 if (locinput >= PL_regeol)
2891                     sayNO;
2892                 locinput += inclasslen ? inclasslen : UTF8SKIP(locinput);
2893                 nextchr = UCHARAT(locinput);
2894                 break;
2895             }
2896             else {
2897                 if (nextchr < 0)
2898                     nextchr = UCHARAT(locinput);
2899                 if (!REGINCLASS(scan, (U8*)locinput))
2900                     sayNO_ANYOF;
2901                 if (!nextchr && locinput >= PL_regeol)
2902                     sayNO;
2903                 nextchr = UCHARAT(++locinput);
2904                 break;
2905             }
2906         no_anyof:
2907             /* If we might have the case of the German sharp s
2908              * in a casefolding Unicode character class. */
2909
2910             if (ANYOF_FOLD_SHARP_S(scan, locinput, PL_regeol)) {
2911                  locinput += SHARP_S_SKIP;
2912                  nextchr = UCHARAT(locinput);
2913             }
2914             else
2915                  sayNO;
2916             break;
2917         case ALNUML:
2918             PL_reg_flags |= RF_tainted;
2919             /* FALL THROUGH */
2920         case ALNUM:
2921             if (!nextchr)
2922                 sayNO;
2923             if (do_utf8) {
2924                 LOAD_UTF8_CHARCLASS_ALNUM();
2925                 if (!(OP(scan) == ALNUM
2926                       ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2927                       : isALNUM_LC_utf8((U8*)locinput)))
2928                 {
2929                     sayNO;
2930                 }
2931                 locinput += PL_utf8skip[nextchr];
2932                 nextchr = UCHARAT(locinput);
2933                 break;
2934             }
2935             if (!(OP(scan) == ALNUM
2936                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
2937                 sayNO;
2938             nextchr = UCHARAT(++locinput);
2939             break;
2940         case NALNUML:
2941             PL_reg_flags |= RF_tainted;
2942             /* FALL THROUGH */
2943         case NALNUM:
2944             if (!nextchr && locinput >= PL_regeol)
2945                 sayNO;
2946             if (do_utf8) {
2947                 LOAD_UTF8_CHARCLASS_ALNUM();
2948                 if (OP(scan) == NALNUM
2949                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2950                     : isALNUM_LC_utf8((U8*)locinput))
2951                 {
2952                     sayNO;
2953                 }
2954                 locinput += PL_utf8skip[nextchr];
2955                 nextchr = UCHARAT(locinput);
2956                 break;
2957             }
2958             if (OP(scan) == NALNUM
2959                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
2960                 sayNO;
2961             nextchr = UCHARAT(++locinput);
2962             break;
2963         case BOUNDL:
2964         case NBOUNDL:
2965             PL_reg_flags |= RF_tainted;
2966             /* FALL THROUGH */
2967         case BOUND:
2968         case NBOUND:
2969             /* was last char in word? */
2970             if (do_utf8) {
2971                 if (locinput == PL_bostr)
2972                     ln = '\n';
2973                 else {
2974                     const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
2975
2976                     ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, 0);
2977                 }
2978                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2979                     ln = isALNUM_uni(ln);
2980                     LOAD_UTF8_CHARCLASS_ALNUM();
2981                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
2982                 }
2983                 else {
2984                     ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
2985                     n = isALNUM_LC_utf8((U8*)locinput);
2986                 }
2987             }
2988             else {
2989                 ln = (locinput != PL_bostr) ?
2990                     UCHARAT(locinput - 1) : '\n';
2991                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2992                     ln = isALNUM(ln);
2993                     n = isALNUM(nextchr);
2994                 }
2995                 else {
2996                     ln = isALNUM_LC(ln);
2997                     n = isALNUM_LC(nextchr);
2998                 }
2999             }
3000             if (((!ln) == (!n)) == (OP(scan) == BOUND ||
3001                                     OP(scan) == BOUNDL))
3002                     sayNO;
3003             break;
3004         case SPACEL:
3005             PL_reg_flags |= RF_tainted;
3006             /* FALL THROUGH */
3007         case SPACE:
3008             if (!nextchr)
3009                 sayNO;
3010             if (do_utf8) {
3011                 if (UTF8_IS_CONTINUED(nextchr)) {
3012                     LOAD_UTF8_CHARCLASS_SPACE();
3013                     if (!(OP(scan) == SPACE
3014                           ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3015                           : isSPACE_LC_utf8((U8*)locinput)))
3016                     {
3017                         sayNO;
3018                     }
3019                     locinput += PL_utf8skip[nextchr];
3020                     nextchr = UCHARAT(locinput);
3021                     break;
3022                 }
3023                 if (!(OP(scan) == SPACE
3024                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3025                     sayNO;
3026                 nextchr = UCHARAT(++locinput);
3027             }
3028             else {
3029                 if (!(OP(scan) == SPACE
3030                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3031                     sayNO;
3032                 nextchr = UCHARAT(++locinput);
3033             }
3034             break;
3035         case NSPACEL:
3036             PL_reg_flags |= RF_tainted;
3037             /* FALL THROUGH */
3038         case NSPACE:
3039             if (!nextchr && locinput >= PL_regeol)
3040                 sayNO;
3041             if (do_utf8) {
3042                 LOAD_UTF8_CHARCLASS_SPACE();
3043                 if (OP(scan) == NSPACE
3044                     ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3045                     : isSPACE_LC_utf8((U8*)locinput))
3046                 {
3047                     sayNO;
3048                 }
3049                 locinput += PL_utf8skip[nextchr];
3050                 nextchr = UCHARAT(locinput);
3051                 break;
3052             }
3053             if (OP(scan) == NSPACE
3054                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
3055                 sayNO;
3056             nextchr = UCHARAT(++locinput);
3057             break;
3058         case DIGITL:
3059             PL_reg_flags |= RF_tainted;
3060             /* FALL THROUGH */
3061         case DIGIT:
3062             if (!nextchr)
3063                 sayNO;
3064             if (do_utf8) {
3065                 LOAD_UTF8_CHARCLASS_DIGIT();
3066                 if (!(OP(scan) == DIGIT
3067                       ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3068                       : isDIGIT_LC_utf8((U8*)locinput)))
3069                 {
3070                     sayNO;
3071                 }
3072                 locinput += PL_utf8skip[nextchr];
3073                 nextchr = UCHARAT(locinput);
3074                 break;
3075             }
3076             if (!(OP(scan) == DIGIT
3077                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
3078                 sayNO;
3079             nextchr = UCHARAT(++locinput);
3080             break;
3081         case NDIGITL:
3082             PL_reg_flags |= RF_tainted;
3083             /* FALL THROUGH */
3084         case NDIGIT:
3085             if (!nextchr && locinput >= PL_regeol)
3086                 sayNO;
3087             if (do_utf8) {
3088                 LOAD_UTF8_CHARCLASS_DIGIT();
3089                 if (OP(scan) == NDIGIT
3090                     ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3091                     : isDIGIT_LC_utf8((U8*)locinput))
3092                 {
3093                     sayNO;
3094                 }
3095                 locinput += PL_utf8skip[nextchr];
3096                 nextchr = UCHARAT(locinput);
3097                 break;
3098             }
3099             if (OP(scan) == NDIGIT
3100                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
3101                 sayNO;
3102             nextchr = UCHARAT(++locinput);
3103             break;
3104         case CLUMP:
3105             if (locinput >= PL_regeol)
3106                 sayNO;
3107             if  (do_utf8) {
3108                 LOAD_UTF8_CHARCLASS_MARK();
3109                 if (swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3110                     sayNO;
3111                 locinput += PL_utf8skip[nextchr];
3112                 while (locinput < PL_regeol &&
3113                        swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3114                     locinput += UTF8SKIP(locinput);
3115                 if (locinput > PL_regeol)
3116                     sayNO;
3117             }
3118             else
3119                locinput++;
3120             nextchr = UCHARAT(locinput);
3121             break;
3122         case REFFL:
3123             PL_reg_flags |= RF_tainted;
3124             /* FALL THROUGH */
3125         case REF:
3126         case REFF:
3127             n = ARG(scan);  /* which paren pair */
3128             ln = PL_regstartp[n];
3129             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3130             if ((I32)*PL_reglastparen < n || ln == -1)
3131                 sayNO;                  /* Do not match unless seen CLOSEn. */
3132             if (ln == PL_regendp[n])
3133                 break;
3134
3135             s = PL_bostr + ln;
3136             if (do_utf8 && OP(scan) != REF) {   /* REF can do byte comparison */
3137                 char *l = locinput;
3138                 const char *e = PL_bostr + PL_regendp[n];
3139                 /*
3140                  * Note that we can't do the "other character" lookup trick as
3141                  * in the 8-bit case (no pun intended) because in Unicode we
3142                  * have to map both upper and title case to lower case.
3143                  */
3144                 if (OP(scan) == REFF) {
3145                     while (s < e) {
3146                         STRLEN ulen1, ulen2;
3147                         U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
3148                         U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
3149
3150                         if (l >= PL_regeol)
3151                             sayNO;
3152                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
3153                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
3154                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
3155                             sayNO;
3156                         s += ulen1;
3157                         l += ulen2;
3158                     }
3159                 }
3160                 locinput = l;
3161                 nextchr = UCHARAT(locinput);
3162                 break;
3163             }
3164
3165             /* Inline the first character, for speed. */
3166             if (UCHARAT(s) != nextchr &&
3167                 (OP(scan) == REF ||
3168                  (UCHARAT(s) != ((OP(scan) == REFF
3169                                   ? PL_fold : PL_fold_locale)[nextchr]))))
3170                 sayNO;
3171             ln = PL_regendp[n] - ln;
3172             if (locinput + ln > PL_regeol)
3173                 sayNO;
3174             if (ln > 1 && (OP(scan) == REF
3175                            ? memNE(s, locinput, ln)
3176                            : (OP(scan) == REFF
3177                               ? ibcmp(s, locinput, ln)
3178                               : ibcmp_locale(s, locinput, ln))))
3179                 sayNO;
3180             locinput += ln;
3181             nextchr = UCHARAT(locinput);
3182             break;
3183
3184         case NOTHING:
3185         case TAIL:
3186             break;
3187         case BACK:
3188             break;
3189         case EVAL:
3190         {
3191             dSP;
3192             OP_4tree * const oop = PL_op;
3193             COP * const ocurcop = PL_curcop;
3194             PAD *old_comppad;
3195             SV *ret;
3196             struct regexp * const oreg = PL_reg_re;
3197
3198             n = ARG(scan);
3199             PL_op = (OP_4tree*)PL_regdata->data[n];
3200             DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
3201             PAD_SAVE_LOCAL(old_comppad, (PAD*)PL_regdata->data[n + 2]);
3202             PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
3203
3204             {
3205                 SV ** const before = SP;
3206                 CALLRUNOPS(aTHX);                       /* Scalar context. */
3207                 SPAGAIN;
3208                 if (SP == before)
3209                     ret = &PL_sv_undef;   /* protect against empty (?{}) blocks. */
3210                 else {
3211                     ret = POPs;
3212                     PUTBACK;
3213                 }
3214             }
3215
3216             PL_op = oop;
3217             PAD_RESTORE_LOCAL(old_comppad);
3218             PL_curcop = ocurcop;
3219             if (logical) {
3220                 if (logical == 2) {     /* Postponed subexpression. */
3221                     regexp *re;
3222                     MAGIC *mg = NULL;
3223                     re_cc_state state;
3224                     CHECKPOINT cp, lastcp;
3225                     int toggleutf;
3226                     register SV *sv;
3227
3228                     if(SvROK(ret) && SvSMAGICAL(sv = SvRV(ret)))
3229                         mg = mg_find(sv, PERL_MAGIC_qr);
3230                     else if (SvSMAGICAL(ret)) {
3231                         if (SvGMAGICAL(ret))
3232                             sv_unmagic(ret, PERL_MAGIC_qr);
3233                         else
3234                             mg = mg_find(ret, PERL_MAGIC_qr);
3235                     }
3236
3237                     if (mg) {
3238                         re = (regexp *)mg->mg_obj;
3239                         (void)ReREFCNT_inc(re);
3240                     }
3241                     else {
3242                         STRLEN len;
3243                         const char * const t = SvPV_const(ret, len);
3244                         PMOP pm;
3245                         char * const oprecomp = PL_regprecomp;
3246                         const I32 osize = PL_regsize;
3247                         const I32 onpar = PL_regnpar;
3248
3249                         Zero(&pm, 1, PMOP);
3250                         if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
3251                         re = CALLREGCOMP(aTHX_ (char*)t, (char*)t + len, &pm);
3252                         if (!(SvFLAGS(ret)
3253                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
3254                                 | SVs_GMG)))
3255                             sv_magic(ret,(SV*)ReREFCNT_inc(re),
3256                                         PERL_MAGIC_qr,0,0);
3257                         PL_regprecomp = oprecomp;
3258                         PL_regsize = osize;
3259                         PL_regnpar = onpar;
3260                     }
3261                     DEBUG_EXECUTE_r(
3262                         PerlIO_printf(Perl_debug_log,
3263                                       "Entering embedded \"%s%.60s%s%s\"\n",
3264                                       PL_colors[0],
3265                                       re->precomp,
3266                                       PL_colors[1],
3267                                       (strlen(re->precomp) > 60 ? "..." : ""))
3268                         );
3269                     state.node = next;
3270                     state.prev = PL_reg_call_cc;
3271                     state.cc = PL_regcc;
3272                     state.re = PL_reg_re;
3273
3274                     PL_regcc = 0;
3275
3276                     cp = regcppush(0);  /* Save *all* the positions. */
3277                     REGCP_SET(lastcp);
3278                     cache_re(re);
3279                     state.ss = PL_savestack_ix;
3280                     *PL_reglastparen = 0;
3281                     *PL_reglastcloseparen = 0;
3282                     PL_reg_call_cc = &state;
3283                     PL_reginput = locinput;
3284                     toggleutf = ((PL_reg_flags & RF_utf8) != 0) ^
3285                                 ((re->reganch & ROPT_UTF8) != 0);
3286                     if (toggleutf) PL_reg_flags ^= RF_utf8;
3287
3288                     /* XXXX This is too dramatic a measure... */
3289                     PL_reg_maxiter = 0;
3290
3291                     if (regmatch(re->program + 1)) {
3292                         /* Even though we succeeded, we need to restore
3293                            global variables, since we may be wrapped inside
3294                            SUSPEND, thus the match may be not finished yet. */
3295
3296                         /* XXXX Do this only if SUSPENDed? */
3297                         PL_reg_call_cc = state.prev;
3298                         PL_regcc = state.cc;
3299                         PL_reg_re = state.re;
3300                         cache_re(PL_reg_re);
3301                         if (toggleutf) PL_reg_flags ^= RF_utf8;
3302
3303                         /* XXXX This is too dramatic a measure... */
3304                         PL_reg_maxiter = 0;
3305
3306                         /* These are needed even if not SUSPEND. */
3307                         ReREFCNT_dec(re);
3308                         regcpblow(cp);
3309                         sayYES;
3310                     }
3311                     ReREFCNT_dec(re);
3312                     REGCP_UNWIND(lastcp);
3313                     regcppop();
3314                     PL_reg_call_cc = state.prev;
3315                     PL_regcc = state.cc;
3316                     PL_reg_re = state.re;
3317                     cache_re(PL_reg_re);
3318                     if (toggleutf) PL_reg_flags ^= RF_utf8;
3319
3320                     /* XXXX This is too dramatic a measure... */
3321                     PL_reg_maxiter = 0;
3322
3323                     logical = 0;
3324                     sayNO;
3325                 }
3326                 sw = SvTRUE(ret);
3327                 logical = 0;
3328             }
3329             else {
3330                 sv_setsv(save_scalar(PL_replgv), ret);
3331                 cache_re(oreg);
3332             }
3333             break;
3334         }
3335         case OPEN:
3336             n = ARG(scan);  /* which paren pair */
3337             PL_reg_start_tmp[n] = locinput;
3338             if (n > PL_regsize)
3339                 PL_regsize = n;
3340             break;
3341         case CLOSE:
3342             n = ARG(scan);  /* which paren pair */
3343             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
3344             PL_regendp[n] = locinput - PL_bostr;
3345             if (n > (I32)*PL_reglastparen)
3346                 *PL_reglastparen = n;
3347             *PL_reglastcloseparen = n;
3348             break;
3349         case GROUPP:
3350             n = ARG(scan);  /* which paren pair */
3351             sw = ((I32)*PL_reglastparen >= n && PL_regendp[n] != -1);
3352             break;
3353         case IFTHEN:
3354             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3355             if (sw)
3356                 next = NEXTOPER(NEXTOPER(scan));
3357             else {
3358                 next = scan + ARG(scan);
3359                 if (OP(next) == IFTHEN) /* Fake one. */
3360                     next = NEXTOPER(NEXTOPER(next));
3361             }
3362             break;
3363         case LOGICAL:
3364             logical = scan->flags;
3365             break;
3366 /*******************************************************************
3367  PL_regcc contains infoblock about the innermost (...)* loop, and
3368  a pointer to the next outer infoblock.
3369
3370  Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM):
3371
3372    1) After matching X, regnode for CURLYX is processed;
3373
3374    2) This regnode creates infoblock on the stack, and calls
3375       regmatch() recursively with the starting point at WHILEM node;
3376
3377    3) Each hit of WHILEM node tries to match A and Z (in the order
3378       depending on the current iteration, min/max of {min,max} and
3379       greediness).  The information about where are nodes for "A"
3380       and "Z" is read from the infoblock, as is info on how many times "A"
3381       was already matched, and greediness.
3382
3383    4) After A matches, the same WHILEM node is hit again.
3384
3385    5) Each time WHILEM is hit, PL_regcc is the infoblock created by CURLYX
3386       of the same pair.  Thus when WHILEM tries to match Z, it temporarily
3387       resets PL_regcc, since this Y(A)*Z can be a part of some other loop:
3388       as in (Y(A)*Z)*.  If Z matches, the automaton will hit the WHILEM node
3389       of the external loop.
3390
3391  Currently present infoblocks form a tree with a stem formed by PL_curcc
3392  and whatever it mentions via ->next, and additional attached trees
3393  corresponding to temporarily unset infoblocks as in "5" above.
3394
3395  In the following picture infoblocks for outer loop of
3396  (Y(A)*?Z)*?T are denoted O, for inner I.  NULL starting block
3397  is denoted by x.  The matched string is YAAZYAZT.  Temporarily postponed
3398  infoblocks are drawn below the "reset" infoblock.
3399
3400  In fact in the picture below we do not show failed matches for Z and T
3401  by WHILEM blocks.  [We illustrate minimal matches, since for them it is
3402  more obvious *why* one needs to *temporary* unset infoblocks.]
3403
3404   Matched       REx position    InfoBlocks      Comment
3405                 (Y(A)*?Z)*?T    x
3406                 Y(A)*?Z)*?T     x <- O
3407   Y             (A)*?Z)*?T      x <- O
3408   Y             A)*?Z)*?T       x <- O <- I
3409   YA            )*?Z)*?T        x <- O <- I
3410   YA            A)*?Z)*?T       x <- O <- I
3411   YAA           )*?Z)*?T        x <- O <- I
3412   YAA           Z)*?T           x <- O          # Temporary unset I
3413                                      I
3414
3415   YAAZ          Y(A)*?Z)*?T     x <- O
3416                                      I
3417
3418   YAAZY         (A)*?Z)*?T      x <- O
3419                                      I
3420
3421   YAAZY         A)*?Z)*?T       x <- O <- I
3422                                      I
3423
3424   YAAZYA        )*?Z)*?T        x <- O <- I
3425                                      I
3426
3427   YAAZYA        Z)*?T           x <- O          # Temporary unset I
3428                                      I,I
3429
3430   YAAZYAZ       )*?T            x <- O
3431                                      I,I
3432
3433   YAAZYAZ       T               x               # Temporary unset O
3434                                 O
3435                                 I,I
3436
3437   YAAZYAZT                      x
3438                                 O
3439                                 I,I
3440  *******************************************************************/
3441         case CURLYX: {
3442                 CURCUR cc;
3443                 CHECKPOINT cp = PL_savestack_ix;
3444                 /* No need to save/restore up to this paren */
3445                 I32 parenfloor = scan->flags;
3446
3447                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
3448                     next += ARG(next);
3449                 cc.oldcc = PL_regcc;
3450                 PL_regcc = &cc;
3451                 /* XXXX Probably it is better to teach regpush to support
3452                    parenfloor > PL_regsize... */
3453                 if (parenfloor > (I32)*PL_reglastparen)
3454                     parenfloor = *PL_reglastparen; /* Pessimization... */
3455                 cc.parenfloor = parenfloor;
3456                 cc.cur = -1;
3457                 cc.min = ARG1(scan);
3458                 cc.max  = ARG2(scan);
3459                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3460                 cc.next = next;
3461                 cc.minmod = minmod;
3462                 cc.lastloc = 0;
3463                 PL_reginput = locinput;
3464                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
3465                 regcpblow(cp);
3466                 PL_regcc = cc.oldcc;
3467                 saySAME(n);
3468             }
3469             /* NOT REACHED */
3470         case WHILEM: {
3471                 /*
3472                  * This is really hard to understand, because after we match
3473                  * what we're trying to match, we must make sure the rest of
3474                  * the REx is going to match for sure, and to do that we have
3475                  * to go back UP the parse tree by recursing ever deeper.  And
3476                  * if it fails, we have to reset our parent's current state
3477                  * that we can try again after backing off.
3478                  */
3479
3480                 CHECKPOINT cp, lastcp;
3481                 CURCUR* cc = PL_regcc;
3482                 char * const lastloc = cc->lastloc; /* Detection of 0-len. */
3483                 I32 cache_offset = 0, cache_bit = 0;
3484
3485                 n = cc->cur + 1;        /* how many we know we matched */
3486                 PL_reginput = locinput;
3487
3488                 DEBUG_EXECUTE_r(
3489                     PerlIO_printf(Perl_debug_log,
3490                                   "%*s  %ld out of %ld..%ld  cc=%"UVxf"\n",
3491                                   REPORT_CODE_OFF+PL_regindent*2, "",
3492                                   (long)n, (long)cc->min,
3493                                   (long)cc->max, PTR2UV(cc))
3494                     );
3495
3496                 /* If degenerate scan matches "", assume scan done. */
3497
3498                 if (locinput == cc->lastloc && n >= cc->min) {
3499                     PL_regcc = cc->oldcc;
3500                     if (PL_regcc)
3501                         ln = PL_regcc->cur;
3502                     DEBUG_EXECUTE_r(
3503                         PerlIO_printf(Perl_debug_log,
3504                            "%*s  empty match detected, try continuation...\n",
3505                            REPORT_CODE_OFF+PL_regindent*2, "")
3506                         );
3507                     if (regmatch(cc->next))
3508                         sayYES;
3509                     if (PL_regcc)
3510                         PL_regcc->cur = ln;
3511                     PL_regcc = cc;
3512                     sayNO;
3513                 }
3514
3515                 /* First just match a string of min scans. */
3516
3517                 if (n < cc->min) {
3518                     cc->cur = n;
3519                     cc->lastloc = locinput;
3520                     if (regmatch(cc->scan))
3521                         sayYES;
3522                     cc->cur = n - 1;
3523                     cc->lastloc = lastloc;
3524                     sayNO;
3525                 }
3526
3527                 if (scan->flags) {
3528                     /* Check whether we already were at this position.
3529                         Postpone detection until we know the match is not
3530                         *that* much linear. */
3531                 if (!PL_reg_maxiter) {
3532                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
3533                     PL_reg_leftiter = PL_reg_maxiter;
3534                 }
3535                 if (PL_reg_leftiter-- == 0) {
3536                     const I32 size = (PL_reg_maxiter + 7 + POSCACHE_START)/8;
3537                     if (PL_reg_poscache) {
3538                         if ((I32)PL_reg_poscache_size < size) {
3539                             Renew(PL_reg_poscache, size, char);
3540                             PL_reg_poscache_size = size;
3541                         }
3542                         Zero(PL_reg_poscache, size, char);
3543                     }
3544                     else {
3545                         PL_reg_poscache_size = size;
3546                         Newxz(PL_reg_poscache, size, char);
3547                     }
3548                     DEBUG_EXECUTE_r(
3549                         PerlIO_printf(Perl_debug_log,
3550               "%sDetected a super-linear match, switching on caching%s...\n",
3551                                       PL_colors[4], PL_colors[5])
3552                         );
3553                 }
3554                 if (PL_reg_leftiter < 0) {
3555                     cache_offset = locinput - PL_bostr;
3556
3557                     cache_offset = (scan->flags & 0xf) - 1 + POSCACHE_START
3558                             + cache_offset * (scan->flags>>4);
3559                     cache_bit = cache_offset % 8;
3560                     cache_offset /= 8;
3561                     if (PL_reg_poscache[cache_offset] & (1<<cache_bit)) {
3562                     DEBUG_EXECUTE_r(
3563                         PerlIO_printf(Perl_debug_log,
3564                                       "%*s  already tried at this position...\n",
3565                                       REPORT_CODE_OFF+PL_regindent*2, "")
3566                         );
3567                         if (PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))
3568                             /* cache records success */
3569                             sayYES;
3570                         else
3571                             /* cache records failure */
3572                             sayNO_SILENT;
3573                     }
3574                     PL_reg_poscache[cache_offset] |= (1<<cache_bit);
3575                 }
3576                 }
3577
3578                 /* Prefer next over scan for minimal matching. */
3579
3580                 if (cc->minmod) {
3581                     PL_regcc = cc->oldcc;
3582                     if (PL_regcc)
3583                         ln = PL_regcc->cur;
3584                     cp = regcppush(cc->parenfloor);
3585                     REGCP_SET(lastcp);
3586                     if (regmatch(cc->next)) {
3587                         regcpblow(cp);
3588                         CACHEsayYES;    /* All done. */
3589                     }
3590                     REGCP_UNWIND(lastcp);
3591                     regcppop();
3592                     if (PL_regcc)
3593                         PL_regcc->cur = ln;
3594                     PL_regcc = cc;
3595
3596                     if (n >= cc->max) { /* Maximum greed exceeded? */
3597                         if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3598                             && !(PL_reg_flags & RF_warned)) {
3599                             PL_reg_flags |= RF_warned;
3600                             Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
3601                                  "Complex regular subexpression recursion",
3602                                  REG_INFTY - 1);
3603                         }
3604                         CACHEsayNO;
3605                     }
3606
3607                     DEBUG_EXECUTE_r(
3608                         PerlIO_printf(Perl_debug_log,
3609                                       "%*s  trying longer...\n",
3610                                       REPORT_CODE_OFF+PL_regindent*2, "")
3611                         );
3612                     /* Try scanning more and see if it helps. */
3613                     PL_reginput = locinput;
3614                     cc->cur = n;
3615                     cc->lastloc = locinput;
3616                     cp = regcppush(cc->parenfloor);
3617                     REGCP_SET(lastcp);
3618                     if (regmatch(cc->scan)) {
3619                         regcpblow(cp);
3620                         CACHEsayYES;
3621                     }
3622                     REGCP_UNWIND(lastcp);
3623                     regcppop();
3624                     cc->cur = n - 1;
3625                     cc->lastloc = lastloc;
3626                     CACHEsayNO;
3627                 }
3628
3629                 /* Prefer scan over next for maximal matching. */
3630
3631                 if (n < cc->max) {      /* More greed allowed? */
3632                     cp = regcppush(cc->parenfloor);
3633                     cc->cur = n;
3634                     cc->lastloc = locinput;
3635                     REGCP_SET(lastcp);
3636                     if (regmatch(cc->scan)) {
3637                         regcpblow(cp);
3638                         CACHEsayYES;
3639                     }
3640                     REGCP_UNWIND(lastcp);
3641                     regcppop();         /* Restore some previous $<digit>s? */
3642                     PL_reginput = locinput;
3643                     DEBUG_EXECUTE_r(
3644                         PerlIO_printf(Perl_debug_log,
3645                                       "%*s  failed, try continuation...\n",
3646                                       REPORT_CODE_OFF+PL_regindent*2, "")
3647                         );
3648                 }
3649                 if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3650                         && !(PL_reg_flags & RF_warned)) {
3651                     PL_reg_flags |= RF_warned;
3652                     Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
3653                          "Complex regular subexpression recursion",
3654                          REG_INFTY - 1);
3655                 }
3656
3657                 /* Failed deeper matches of scan, so see if this one works. */
3658                 PL_regcc = cc->oldcc;
3659                 if (PL_regcc)
3660                     ln = PL_regcc->cur;
3661                 if (regmatch(cc->next))
3662                     CACHEsayYES;
3663                 if (PL_regcc)
3664                     PL_regcc->cur = ln;
3665                 PL_regcc = cc;
3666                 cc->cur = n - 1;
3667                 cc->lastloc = lastloc;
3668                 CACHEsayNO;
3669             }
3670             /* NOT REACHED */
3671         case BRANCHJ:
3672             next = scan + ARG(scan);
3673             if (next == scan)
3674                 next = NULL;
3675             inner = NEXTOPER(NEXTOPER(scan));
3676             goto do_branch;
3677         case BRANCH:
3678             inner = NEXTOPER(scan);
3679           do_branch:
3680             {
3681                 c1 = OP(scan);
3682                 if (OP(next) != c1)     /* No choice. */
3683                     next = inner;       /* Avoid recursion. */
3684                 else {
3685                     const I32 lastparen = *PL_reglastparen;
3686                     /* Put unwinding data on stack */
3687                     const I32 unwind1 = SSNEWt(1,re_unwind_branch_t);
3688                     re_unwind_branch_t * const uw = SSPTRt(unwind1,re_unwind_branch_t);
3689
3690                     uw->prev = unwind;
3691                     unwind = unwind1;
3692                     uw->type = ((c1 == BRANCH)
3693                                 ? RE_UNWIND_BRANCH
3694                                 : RE_UNWIND_BRANCHJ);
3695                     uw->lastparen = lastparen;
3696                     uw->next = next;
3697                     uw->locinput = locinput;
3698                     uw->nextchr = nextchr;
3699 #ifdef DEBUGGING
3700                     uw->regindent = ++PL_regindent;
3701 #endif
3702
3703                     REGCP_SET(uw->lastcp);
3704
3705                     /* Now go into the first branch */
3706                     next = inner;
3707                 }
3708             }
3709             break;
3710         case MINMOD:
3711             minmod = 1;
3712             break;
3713         case CURLYM:
3714         {
3715             I32 l = 0;
3716             CHECKPOINT lastcp;
3717
3718             /* We suppose that the next guy does not need
3719                backtracking: in particular, it is of constant non-zero length,
3720                and has no parenths to influence future backrefs. */
3721             ln = ARG1(scan);  /* min to match */
3722             n  = ARG2(scan);  /* max to match */
3723             paren = scan->flags;
3724             if (paren) {
3725                 if (paren > PL_regsize)
3726                     PL_regsize = paren;
3727                 if (paren > (I32)*PL_reglastparen)
3728                     *PL_reglastparen = paren;
3729             }
3730             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3731             if (paren)
3732                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
3733             PL_reginput = locinput;
3734             if (minmod) {
3735                 minmod = 0;
3736                 if (ln && regrepeat_hard(scan, ln, &l) < ln)
3737                     sayNO;
3738                 locinput = PL_reginput;
3739                 if (HAS_TEXT(next) || JUMPABLE(next)) {
3740                     regnode *text_node = next;
3741
3742                     if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3743
3744                     if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3745                     else {
3746                         if (PL_regkind[(U8)OP(text_node)] == REF) {
3747                             c1 = c2 = -1000;
3748                             goto assume_ok_MM;
3749                         }
3750                         else { c1 = (U8)*STRING(text_node); }
3751                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3752                             c2 = PL_fold[c1];
3753                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3754                             c2 = PL_fold_locale[c1];
3755                         else
3756                             c2 = c1;
3757                     }
3758                 }
3759                 else
3760                     c1 = c2 = -1000;
3761             assume_ok_MM:
3762                 REGCP_SET(lastcp);
3763                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
3764                     /* If it could work, try it. */
3765                     if (c1 == -1000 ||
3766                         UCHARAT(PL_reginput) == c1 ||
3767                         UCHARAT(PL_reginput) == c2)
3768                     {
3769                         if (paren) {
3770                             if (ln) {
3771                                 PL_regstartp[paren] =
3772                                     HOPc(PL_reginput, -l) - PL_bostr;
3773                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3774                             }
3775                             else
3776                                 PL_regendp[paren] = -1;
3777                         }
3778                         if (regmatch(next))
3779                             sayYES;
3780                         REGCP_UNWIND(lastcp);
3781                     }
3782                     /* Couldn't or didn't -- move forward. */
3783                     PL_reginput = locinput;
3784                     if (regrepeat_hard(scan, 1, &l)) {
3785                         ln++;
3786                         locinput = PL_reginput;
3787                     }
3788                     else
3789                         sayNO;
3790                 }
3791             }
3792             else {
3793                 n = regrepeat_hard(scan, n, &l);
3794                 locinput = PL_reginput;
3795                 DEBUG_EXECUTE_r(
3796                     PerlIO_printf(Perl_debug_log,
3797                                   "%*s  matched %"IVdf" times, len=%"IVdf"...\n",
3798                                   (int)(REPORT_CODE_OFF+PL_regindent*2), "",
3799                                   (IV) n, (IV)l)
3800                     );
3801                 if (n >= ln) {
3802                     if (HAS_TEXT(next) || JUMPABLE(next)) {
3803                         regnode *text_node = next;
3804
3805                         if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3806
3807                         if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3808                         else {
3809                             if (PL_regkind[(U8)OP(text_node)] == REF) {
3810                                 c1 = c2 = -1000;
3811                                 goto assume_ok_REG;
3812                             }
3813                             else { c1 = (U8)*STRING(text_node); }
3814
3815                             if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3816                                 c2 = PL_fold[c1];
3817                             else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3818                                 c2 = PL_fold_locale[c1];
3819                             else
3820                                 c2 = c1;
3821                         }
3822                     }
3823                     else
3824                         c1 = c2 = -1000;
3825                 }
3826             assume_ok_REG:
3827                 REGCP_SET(lastcp);
3828                 while (n >= ln) {
3829                     /* If it could work, try it. */
3830                     if (c1 == -1000 ||
3831                         UCHARAT(PL_reginput) == c1 ||
3832                         UCHARAT(PL_reginput) == c2)
3833                     {
3834                         DEBUG_EXECUTE_r(
3835                                 PerlIO_printf(Perl_debug_log,
3836                                               "%*s  trying tail with n=%"IVdf"...\n",
3837                                               (int)(REPORT_CODE_OFF+PL_regindent*2), "", (IV)n)
3838                             );
3839                         if (paren) {
3840                             if (n) {
3841                                 PL_regstartp[paren] = HOPc(PL_reginput, -l) - PL_bostr;
3842                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3843                             }
3844                             else
3845                                 PL_regendp[paren] = -1;
3846                         }
3847                         if (regmatch(next))
3848                             sayYES;
3849                         REGCP_UNWIND(lastcp);
3850                     }
3851                     /* Couldn't or didn't -- back up. */
3852                     n--;
3853                     locinput = HOPc(locinput, -l);
3854                     PL_reginput = locinput;
3855                 }
3856             }
3857             sayNO;
3858             break;
3859         }
3860         case CURLYN:
3861             paren = scan->flags;        /* Which paren to set */
3862             if (paren > PL_regsize)
3863                 PL_regsize = paren;
3864             if (paren > (I32)*PL_reglastparen)
3865                 *PL_reglastparen = paren;
3866             ln = ARG1(scan);  /* min to match */
3867             n  = ARG2(scan);  /* max to match */
3868             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
3869             goto repeat;
3870         case CURLY:
3871             paren = 0;
3872             ln = ARG1(scan);  /* min to match */
3873             n  = ARG2(scan);  /* max to match */
3874             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3875             goto repeat;
3876         case STAR:
3877             ln = 0;
3878             n = REG_INFTY;
3879             scan = NEXTOPER(scan);
3880             paren = 0;
3881             goto repeat;
3882         case PLUS:
3883             ln = 1;
3884             n = REG_INFTY;
3885             scan = NEXTOPER(scan);
3886             paren = 0;
3887           repeat:
3888             /*
3889             * Lookahead to avoid useless match attempts
3890             * when we know what character comes next.
3891             */
3892
3893             /*
3894             * Used to only do .*x and .*?x, but now it allows
3895             * for )'s, ('s and (?{ ... })'s to be in the way
3896             * of the quantifier and the EXACT-like node.  -- japhy
3897             */
3898
3899             if (HAS_TEXT(next) || JUMPABLE(next)) {
3900                 U8 *s;
3901                 regnode *text_node = next;
3902
3903                 if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3904
3905                 if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3906                 else {
3907                     if (PL_regkind[(U8)OP(text_node)] == REF) {
3908                         c1 = c2 = -1000;
3909                         goto assume_ok_easy;
3910                     }
3911                     else { s = (U8*)STRING(text_node); }
3912
3913                     if (!UTF) {
3914                         c2 = c1 = *s;
3915                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3916                             c2 = PL_fold[c1];
3917                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3918                             c2 = PL_fold_locale[c1];
3919                     }
3920                     else { /* UTF */
3921                         if (OP(text_node) == EXACTF || OP(text_node) == REFF) {
3922                              STRLEN ulen1, ulen2;
3923                              U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
3924                              U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
3925
3926                              to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
3927                              to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
3928
3929                              c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
3930                                                  uniflags);
3931                              c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
3932                                                  uniflags);
3933                         }
3934                         else {
3935                             c2 = c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
3936                                                      uniflags);
3937                         }
3938                     }
3939                 }
3940             }
3941             else
3942                 c1 = c2 = -1000;
3943         assume_ok_easy:
3944             PL_reginput = locinput;
3945             if (minmod) {
3946                 CHECKPOINT lastcp;
3947                 minmod = 0;
3948                 if (ln && regrepeat(scan, ln) < ln)
3949                     sayNO;
3950                 locinput = PL_reginput;
3951                 REGCP_SET(lastcp);
3952                 if (c1 != -1000) {
3953                     char *e; /* Should not check after this */
3954                     char *old = locinput;
3955                     int count = 0;
3956
3957                     if  (n == REG_INFTY) {
3958                         e = PL_regeol - 1;
3959                         if (do_utf8)
3960                             while (UTF8_IS_CONTINUATION(*(U8*)e))
3961                                 e--;
3962                     }
3963                     else if (do_utf8) {
3964                         int m = n - ln;
3965                         for (e = locinput;
3966                              m >0 && e + UTF8SKIP(e) <= PL_regeol; m--)
3967                             e += UTF8SKIP(e);
3968                     }
3969                     else {
3970                         e = locinput + n - ln;
3971                         if (e >= PL_regeol)
3972                             e = PL_regeol - 1;
3973                     }
3974                     while (1) {
3975                         /* Find place 'next' could work */
3976                         if (!do_utf8) {
3977                             if (c1 == c2) {
3978                                 while (locinput <= e &&
3979                                        UCHARAT(locinput) != c1)
3980                                     locinput++;
3981                             } else {
3982                                 while (locinput <= e
3983                                        && UCHARAT(locinput) != c1
3984                                        && UCHARAT(locinput) != c2)
3985                                     locinput++;
3986                             }
3987                             count = locinput - old;
3988                         }
3989                         else {
3990                             if (c1 == c2) {
3991                                 STRLEN len;
3992                                 /* count initialised to
3993                                  * utf8_distance(old, locinput) */
3994                                 while (locinput <= e &&
3995                                        utf8n_to_uvchr((U8*)locinput,
3996                                                       UTF8_MAXBYTES, &len,
3997                                                       uniflags) != (UV)c1) {
3998                                     locinput += len;
3999                                     count++;
4000                                 }
4001                             } else {
4002                                 STRLEN len;
4003                                 /* count initialised to
4004                                  * utf8_distance(old, locinput) */
4005                                 while (locinput <= e) {
4006                                     UV c = utf8n_to_uvchr((U8*)locinput,
4007                                                           UTF8_MAXBYTES, &len,
4008                                                           uniflags);
4009                                     if (c == (UV)c1 || c == (UV)c2)
4010                                         break;
4011                                     locinput += len;
4012                                     count++;
4013                                 }
4014                             }
4015                         }
4016                         if (locinput > e)
4017                             sayNO;
4018                         /* PL_reginput == old now */
4019                         if (locinput != old) {
4020                             ln = 1;     /* Did some */
4021                             if (regrepeat(scan, count) < count)
4022                                 sayNO;
4023                         }
4024                         /* PL_reginput == locinput now */
4025                         TRYPAREN(paren, ln, locinput);
4026                         PL_reginput = locinput; /* Could be reset... */
4027                         REGCP_UNWIND(lastcp);
4028                         /* Couldn't or didn't -- move forward. */
4029                         old = locinput;
4030                         if (do_utf8)
4031                             locinput += UTF8SKIP(locinput);
4032                         else
4033                             locinput++;
4034                         count = 1;
4035                     }
4036                 }
4037                 else
4038                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
4039                     UV c;
4040                     if (c1 != -1000) {
4041                         if (do_utf8)
4042                             c = utf8n_to_uvchr((U8*)PL_reginput,
4043                                                UTF8_MAXBYTES, 0,
4044                                                uniflags);
4045                         else
4046                             c = UCHARAT(PL_reginput);
4047                         /* If it could work, try it. */
4048                         if (c == (UV)c1 || c == (UV)c2)
4049                         {
4050                             TRYPAREN(paren, ln, PL_reginput);
4051                             REGCP_UNWIND(lastcp);
4052                         }
4053                     }
4054                     /* If it could work, try it. */
4055                     else if (c1 == -1000)
4056                     {
4057                         TRYPAREN(paren, ln, PL_reginput);
4058                         REGCP_UNWIND(lastcp);
4059                     }
4060                     /* Couldn't or didn't -- move forward. */
4061                     PL_reginput = locinput;
4062                     if (regrepeat(scan, 1)) {
4063                         ln++;
4064                         locinput = PL_reginput;
4065                     }
4066                     else
4067                         sayNO;
4068                 }
4069             }
4070             else {
4071                 CHECKPOINT lastcp;
4072                 n = regrepeat(scan, n);
4073                 locinput = PL_reginput;
4074                 if (ln < n && PL_regkind[(U8)OP(next)] == EOL &&
4075                     (OP(next) != MEOL ||
4076                         OP(next) == SEOL || OP(next) == EOS))
4077                 {
4078                     ln = n;                     /* why back off? */
4079                     /* ...because $ and \Z can match before *and* after
4080                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
4081                        We should back off by one in this case. */
4082                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(next) != EOS)
4083                         ln--;
4084                 }
4085                 REGCP_SET(lastcp);
4086                 if (paren) {
4087                     UV c = 0;
4088                     while (n >= ln) {
4089                         if (c1 != -1000) {
4090                             if (do_utf8)
4091                                 c = utf8n_to_uvchr((U8*)PL_reginput,
4092                                                    UTF8_MAXBYTES, 0,
4093                                                    uniflags);
4094                             else
4095                                 c = UCHARAT(PL_reginput);
4096                         }
4097                         /* If it could work, try it. */
4098                         if (c1 == -1000 || c == (UV)c1 || c == (UV)c2)
4099                             {
4100                                 TRYPAREN(paren, n, PL_reginput);
4101                                 REGCP_UNWIND(lastcp);
4102                             }
4103                         /* Couldn't or didn't -- back up. */
4104                         n--;
4105                         PL_reginput = locinput = HOPc(locinput, -1);
4106                     }
4107                 }
4108                 else {
4109                     UV c = 0;
4110                     while (n >= ln) {
4111                         if (c1 != -1000) {
4112                             if (do_utf8)
4113                                 c = utf8n_to_uvchr((U8*)PL_reginput,
4114                                                    UTF8_MAXBYTES, 0,
4115                                                    uniflags);
4116                             else
4117                                 c = UCHARAT(PL_reginput);
4118                         }
4119                         /* If it could work, try it. */
4120                         if (c1 == -1000 || c == (UV)c1 || c == (UV)c2)
4121                             {
4122                                 TRYPAREN(paren, n, PL_reginput);
4123                                 REGCP_UNWIND(lastcp);
4124                             }
4125                         /* Couldn't or didn't -- back up. */
4126                         n--;
4127                         PL_reginput = locinput = HOPc(locinput, -1);
4128                     }
4129                 }
4130             }
4131             sayNO;
4132             break;
4133         case END:
4134             if (PL_reg_call_cc) {
4135                 re_cc_state *cur_call_cc = PL_reg_call_cc;
4136                 CURCUR *cctmp = PL_regcc;
4137                 regexp *re = PL_reg_re;
4138                 CHECKPOINT lastcp;
4139                 I32 tmp;
4140
4141                 /* Save *all* the positions. */
4142                 const CHECKPOINT cp = regcppush(0);
4143                 REGCP_SET(lastcp);
4144
4145                 /* Restore parens of the caller. */
4146                 tmp = PL_savestack_ix;
4147                 PL_savestack_ix = PL_reg_call_cc->ss;
4148                 regcppop();
4149                 PL_savestack_ix = tmp;
4150
4151                 /* Make position available to the callcc. */
4152                 PL_reginput = locinput;
4153
4154                 cache_re(PL_reg_call_cc->re);
4155                 PL_regcc = PL_reg_call_cc->cc;
4156                 PL_reg_call_cc = PL_reg_call_cc->prev;
4157                 if (regmatch(cur_call_cc->node)) {
4158                     PL_reg_call_cc = cur_call_cc;
4159                     regcpblow(cp);
4160                     sayYES;
4161                 }
4162                 REGCP_UNWIND(lastcp);
4163                 regcppop();
4164                 PL_reg_call_cc = cur_call_cc;
4165                 PL_regcc = cctmp;
4166                 PL_reg_re = re;
4167                 cache_re(re);
4168
4169                 DEBUG_EXECUTE_r(
4170                     PerlIO_printf(Perl_debug_log,
4171                                   "%*s  continuation failed...\n",
4172                                   REPORT_CODE_OFF+PL_regindent*2, "")
4173                     );
4174                 sayNO_SILENT;
4175             }
4176             if (locinput < PL_regtill) {
4177                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4178                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
4179                                       PL_colors[4],
4180                                       (long)(locinput - PL_reg_starttry),
4181                                       (long)(PL_regtill - PL_reg_starttry),
4182                                       PL_colors[5]));
4183                 sayNO_FINAL;            /* Cannot match: too short. */
4184             }
4185             PL_reginput = locinput;     /* put where regtry can find it */
4186             sayYES_FINAL;               /* Success! */
4187         case SUCCEED:
4188             PL_reginput = locinput;     /* put where regtry can find it */
4189             sayYES_LOUD;                /* Success! */
4190         case SUSPEND:
4191             n = 1;
4192             PL_reginput = locinput;
4193             goto do_ifmatch;
4194         case UNLESSM:
4195             n = 0;
4196             if (scan->flags) {
4197                 s = HOPBACKc(locinput, scan->flags);
4198                 if (!s)
4199                     goto say_yes;
4200                 PL_reginput = s;
4201             }
4202             else
4203                 PL_reginput = locinput;
4204             goto do_ifmatch;
4205         case IFMATCH:
4206             n = 1;
4207             if (scan->flags) {
4208                 s = HOPBACKc(locinput, scan->flags);
4209                 if (!s)
4210                     goto say_no;
4211                 PL_reginput = s;
4212             }
4213             else
4214                 PL_reginput = locinput;
4215
4216           do_ifmatch:
4217             inner = NEXTOPER(NEXTOPER(scan));
4218             if (regmatch(inner) != n) {
4219               say_no:
4220                 if (logical) {
4221                     logical = 0;
4222                     sw = 0;
4223                     goto do_longjump;
4224                 }
4225                 else
4226                     sayNO;
4227             }
4228           say_yes:
4229             if (logical) {
4230                 logical = 0;
4231                 sw = 1;
4232             }
4233             if (OP(scan) == SUSPEND) {
4234                 locinput = PL_reginput;
4235                 nextchr = UCHARAT(locinput);
4236             }
4237             /* FALL THROUGH. */
4238         case LONGJMP:
4239           do_longjump:
4240             next = scan + ARG(scan);
4241             if (next == scan)
4242                 next = NULL;
4243             break;
4244         default:
4245             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
4246                           PTR2UV(scan), OP(scan));
4247             Perl_croak(aTHX_ "regexp memory corruption");
4248         }
4249       reenter:
4250         scan = next;
4251     }
4252
4253     /*
4254     * We get here only if there's trouble -- normally "case END" is
4255     * the terminating point.
4256     */
4257     Perl_croak(aTHX_ "corrupted regexp pointers");
4258     /*NOTREACHED*/
4259     sayNO;
4260
4261 yes_loud:
4262     DEBUG_EXECUTE_r(
4263         PerlIO_printf(Perl_debug_log,
4264                       "%*s  %scould match...%s\n",
4265                       REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], PL_colors[5])
4266         );
4267     goto yes;
4268 yes_final:
4269     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
4270                           PL_colors[4], PL_colors[5]));
4271 yes:
4272 #ifdef DEBUGGING
4273     PL_regindent--;
4274 #endif
4275
4276 #if 0                                   /* Breaks $^R */
4277     if (unwind)
4278         regcpblow(firstcp);
4279 #endif
4280     return 1;
4281
4282 no:
4283     DEBUG_EXECUTE_r(
4284         PerlIO_printf(Perl_debug_log,
4285                       "%*s  %sfailed...%s\n",
4286                       REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], PL_colors[5])
4287         );
4288     goto do_no;
4289 no_final:
4290 do_no:
4291     if (unwind) {
4292         re_unwind_t * const uw = SSPTRt(unwind,re_unwind_t);
4293
4294         switch (uw->type) {
4295         case RE_UNWIND_BRANCH:
4296         case RE_UNWIND_BRANCHJ:
4297         {
4298             re_unwind_branch_t * const uwb = &(uw->branch);
4299             const I32 lastparen = uwb->lastparen;
4300
4301             REGCP_UNWIND(uwb->lastcp);
4302             for (n = *PL_reglastparen; n > lastparen; n--)
4303                 PL_regendp[n] = -1;
4304             *PL_reglastparen = n;
4305             scan = next = uwb->next;
4306             if ( !scan ||
4307                  OP(scan) != (uwb->type == RE_UNWIND_BRANCH
4308                               ? BRANCH : BRANCHJ) ) {           /* Failure */
4309                 unwind = uwb->prev;
4310 #ifdef DEBUGGING
4311                 PL_regindent--;
4312 #endif
4313                 goto do_no;
4314             }
4315             /* Have more choice yet.  Reuse the same uwb.  */
4316             if ((n = (uwb->type == RE_UNWIND_BRANCH
4317                       ? NEXT_OFF(next) : ARG(next))))
4318                 next += n;
4319             else
4320                 next = NULL;    /* XXXX Needn't unwinding in this case... */
4321             uwb->next = next;
4322             next = NEXTOPER(scan);
4323             if (uwb->type == RE_UNWIND_BRANCHJ)
4324                 next = NEXTOPER(next);
4325             locinput = uwb->locinput;
4326             nextchr = uwb->nextchr;
4327 #ifdef DEBUGGING
4328             PL_regindent = uwb->regindent;
4329 #endif
4330
4331             goto reenter;
4332         }
4333         /* NOT REACHED */
4334         default:
4335             Perl_croak(aTHX_ "regexp unwind memory corruption");
4336         }
4337         /* NOT REACHED */
4338     }
4339 #ifdef DEBUGGING
4340     PL_regindent--;
4341 #endif
4342     return 0;
4343 }
4344
4345 /*
4346  - regrepeat - repeatedly match something simple, report how many
4347  */
4348 /*
4349  * [This routine now assumes that it will only match on things of length 1.
4350  * That was true before, but now we assume scan - reginput is the count,
4351  * rather than incrementing count on every character.  [Er, except utf8.]]
4352  */
4353 STATIC I32
4354 S_regrepeat(pTHX_ const regnode *p, I32 max)
4355 {
4356     dVAR;
4357     register char *scan;
4358     register I32 c;
4359     register char *loceol = PL_regeol;
4360     register I32 hardcount = 0;
4361     register bool do_utf8 = PL_reg_match_utf8;
4362
4363     scan = PL_reginput;
4364     if (max == REG_INFTY)
4365         max = I32_MAX;
4366     else if (max < loceol - scan)
4367       loceol = scan + max;
4368     switch (OP(p)) {
4369     case REG_ANY:
4370         if (do_utf8) {
4371             loceol = PL_regeol;
4372             while (scan < loceol && hardcount < max && *scan != '\n') {
4373                 scan += UTF8SKIP(scan);
4374                 hardcount++;
4375             }
4376         } else {
4377             while (scan < loceol && *scan != '\n')
4378                 scan++;
4379         }
4380         break;
4381     case SANY:
4382         if (do_utf8) {
4383             loceol = PL_regeol;
4384             while (scan < loceol && hardcount < max) {
4385                 scan += UTF8SKIP(scan);
4386                 hardcount++;
4387             }
4388         }
4389         else
4390             scan = loceol;
4391         break;
4392     case CANY:
4393         scan = loceol;
4394         break;
4395     case EXACT:         /* length of string is 1 */
4396         c = (U8)*STRING(p);
4397         while (scan < loceol && UCHARAT(scan) == c)
4398             scan++;
4399         break;
4400     case EXACTF:        /* length of string is 1 */
4401         c = (U8)*STRING(p);
4402         while (scan < loceol &&
4403                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
4404             scan++;
4405         break;
4406     case EXACTFL:       /* length of string is 1 */
4407         PL_reg_flags |= RF_tainted;
4408         c = (U8)*STRING(p);
4409         while (scan < loceol &&
4410                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
4411             scan++;
4412         break;
4413     case ANYOF:
4414         if (do_utf8) {
4415             loceol = PL_regeol;
4416             while (hardcount < max && scan < loceol &&
4417                    reginclass(p, (U8*)scan, 0, do_utf8)) {
4418                 scan += UTF8SKIP(scan);
4419                 hardcount++;
4420             }
4421         } else {
4422             while (scan < loceol && REGINCLASS(p, (U8*)scan))
4423                 scan++;
4424         }
4425         break;
4426     case ALNUM:
4427         if (do_utf8) {
4428             loceol = PL_regeol;
4429             LOAD_UTF8_CHARCLASS_ALNUM();
4430             while (hardcount < max && scan < loceol &&
4431                    swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
4432                 scan += UTF8SKIP(scan);
4433                 hardcount++;
4434             }
4435         } else {
4436             while (scan < loceol && isALNUM(*scan))
4437                 scan++;
4438         }
4439         break;
4440     case ALNUML:
4441         PL_reg_flags |= RF_tainted;
4442         if (do_utf8) {
4443             loceol = PL_regeol;
4444             while (hardcount < max && scan < loceol &&
4445                    isALNUM_LC_utf8((U8*)scan)) {
4446                 scan += UTF8SKIP(scan);
4447                 hardcount++;
4448             }
4449         } else {
4450             while (scan < loceol && isALNUM_LC(*scan))
4451                 scan++;
4452         }
4453         break;
4454     case NALNUM:
4455         if (do_utf8) {
4456             loceol = PL_regeol;
4457             LOAD_UTF8_CHARCLASS_ALNUM();
4458             while (hardcount < max && scan < loceol &&
4459                    !swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
4460                 scan += UTF8SKIP(scan);
4461                 hardcount++;
4462             }
4463         } else {
4464             while (scan < loceol && !isALNUM(*scan))
4465                 scan++;
4466         }
4467         break;
4468     case NALNUML:
4469         PL_reg_flags |= RF_tainted;
4470         if (do_utf8) {
4471             loceol = PL_regeol;
4472             while (hardcount < max && scan < loceol &&
4473                    !isALNUM_LC_utf8((U8*)scan)) {
4474                 scan += UTF8SKIP(scan);
4475                 hardcount++;
4476             }
4477         } else {
4478             while (scan < loceol && !isALNUM_LC(*scan))
4479                 scan++;
4480         }
4481         break;
4482     case SPACE:
4483         if (do_utf8) {
4484             loceol = PL_regeol;
4485             LOAD_UTF8_CHARCLASS_SPACE();
4486             while (hardcount < max && scan < loceol &&
4487                    (*scan == ' ' ||
4488                     swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
4489                 scan += UTF8SKIP(scan);
4490                 hardcount++;
4491             }
4492         } else {
4493             while (scan < loceol && isSPACE(*scan))
4494                 scan++;
4495         }
4496         break;
4497     case SPACEL:
4498         PL_reg_flags |= RF_tainted;
4499         if (do_utf8) {
4500             loceol = PL_regeol;
4501             while (hardcount < max && scan < loceol &&
4502                    (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
4503                 scan += UTF8SKIP(scan);
4504                 hardcount++;
4505             }
4506         } else {
4507             while (scan < loceol && isSPACE_LC(*scan))
4508                 scan++;
4509         }
4510         break;
4511     case NSPACE:
4512         if (do_utf8) {
4513             loceol = PL_regeol;
4514             LOAD_UTF8_CHARCLASS_SPACE();
4515             while (hardcount < max && scan < loceol &&
4516                    !(*scan == ' ' ||
4517                      swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
4518                 scan += UTF8SKIP(scan);
4519                 hardcount++;
4520             }
4521         } else {
4522             while (scan < loceol && !isSPACE(*scan))
4523                 scan++;
4524             break;
4525         }
4526     case NSPACEL:
4527         PL_reg_flags |= RF_tainted;
4528         if (do_utf8) {
4529             loceol = PL_regeol;
4530             while (hardcount < max && scan < loceol &&
4531                    !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
4532                 scan += UTF8SKIP(scan);
4533                 hardcount++;
4534             }
4535         } else {
4536             while (scan < loceol && !isSPACE_LC(*scan))
4537                 scan++;
4538         }
4539         break;
4540     case DIGIT:
4541         if (do_utf8) {
4542             loceol = PL_regeol;
4543             LOAD_UTF8_CHARCLASS_DIGIT();
4544             while (hardcount < max && scan < loceol &&
4545                    swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4546                 scan += UTF8SKIP(scan);
4547                 hardcount++;
4548             }
4549         } else {
4550             while (scan < loceol && isDIGIT(*scan))
4551                 scan++;
4552         }
4553         break;
4554     case NDIGIT:
4555         if (do_utf8) {
4556             loceol = PL_regeol;
4557             LOAD_UTF8_CHARCLASS_DIGIT();
4558             while (hardcount < max && scan < loceol &&
4559                    !swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4560                 scan += UTF8SKIP(scan);
4561                 hardcount++;
4562             }
4563         } else {
4564             while (scan < loceol && !isDIGIT(*scan))
4565                 scan++;
4566         }
4567         break;
4568     default:            /* Called on something of 0 width. */
4569         break;          /* So match right here or not at all. */
4570     }
4571
4572     if (hardcount)
4573         c = hardcount;
4574     else
4575         c = scan - PL_reginput;
4576     PL_reginput = scan;
4577
4578     DEBUG_r({
4579                 SV *re_debug_flags = NULL;
4580                 SV * const prop = sv_newmortal();
4581                 GET_RE_DEBUG_FLAGS;
4582                 DEBUG_EXECUTE_r({
4583                 regprop(prop, p);
4584                 PerlIO_printf(Perl_debug_log,
4585                               "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
4586                               REPORT_CODE_OFF+1, "", SvPVX_const(prop),(IV)c,(IV)max);
4587         });
4588         });
4589
4590     return(c);
4591 }
4592
4593 /*
4594  - regrepeat_hard - repeatedly match something, report total lenth and length
4595  *
4596  * The repeater is supposed to have constant non-zero length.
4597  */
4598
4599 STATIC I32
4600 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp)
4601 {
4602     dVAR;
4603     register char *scan = Nullch;
4604     register char *start;
4605     register char *loceol = PL_regeol;
4606     I32 l = 0;
4607     I32 count = 0, res = 1;
4608
4609     if (!max)
4610         return 0;
4611
4612     start = PL_reginput;
4613     if (PL_reg_match_utf8) {
4614         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
4615             if (!count++) {
4616                 l = 0;
4617                 while (start < PL_reginput) {
4618                     l++;
4619                     start += UTF8SKIP(start);
4620                 }
4621                 *lp = l;
4622                 if (l == 0)
4623                     return max;
4624             }
4625             if (count == max)
4626                 return count;
4627         }
4628     }
4629     else {
4630         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
4631             if (!count++) {
4632                 *lp = l = PL_reginput - start;
4633                 if (max != REG_INFTY && l*max < loceol - scan)
4634                     loceol = scan + l*max;
4635                 if (l == 0)
4636                     return max;
4637             }
4638         }
4639     }
4640     if (!res)
4641         PL_reginput = scan;
4642
4643     return count;
4644 }
4645
4646 /*
4647 - regclass_swash - prepare the utf8 swash
4648 */
4649
4650 SV *
4651 Perl_regclass_swash(pTHX_ register const regnode* node, bool doinit, SV** listsvp, SV **altsvp)
4652 {
4653     dVAR;
4654     SV *sw  = NULL;
4655     SV *si  = NULL;
4656     SV *alt = NULL;
4657
4658     if (PL_regdata && PL_regdata->count) {
4659         const U32 n = ARG(node);
4660
4661         if (PL_regdata->what[n] == 's') {
4662             SV * const rv = (SV*)PL_regdata->data[n];
4663             AV * const av = (AV*)SvRV((SV*)rv);
4664             SV **const ary = AvARRAY(av);
4665             SV **a, **b;
4666
4667             /* See the end of regcomp.c:S_regclass() for
4668              * documentation of these array elements. */
4669
4670             si = *ary;
4671             a  = SvROK(ary[1]) ? &ary[1] : 0;
4672             b  = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : 0;
4673
4674             if (a)
4675                 sw = *a;
4676             else if (si && doinit) {
4677                 sw = swash_init("utf8", "", si, 1, 0);
4678                 (void)av_store(av, 1, sw);
4679             }
4680             if (b)
4681                 alt = *b;
4682         }
4683     }
4684
4685     if (listsvp)
4686         *listsvp = si;
4687     if (altsvp)
4688         *altsvp  = alt;
4689
4690     return sw;
4691 }
4692
4693 /*
4694  - reginclass - determine if a character falls into a character class
4695
4696   The n is the ANYOF regnode, the p is the target string, lenp
4697   is pointer to the maximum length of how far to go in the p
4698   (if the lenp is zero, UTF8SKIP(p) is used),
4699   do_utf8 tells whether the target string is in UTF-8.
4700
4701  */
4702
4703 STATIC bool
4704 S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp, register bool do_utf8)
4705 {
4706     dVAR;
4707     const char flags = ANYOF_FLAGS(n);
4708     bool match = FALSE;
4709     UV c = *p;
4710     STRLEN len = 0;
4711     STRLEN plen;
4712
4713     if (do_utf8 && !UTF8_IS_INVARIANT(c)) {
4714         c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &len,
4715                             ckWARN(WARN_UTF8) ? UTF8_CHECK_ONLY :
4716                                         UTF8_ALLOW_ANYUV|UTF8_CHECK_ONLY);
4717         if (len == (STRLEN)-1)
4718             Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
4719     }
4720
4721     plen = lenp ? *lenp : UNISKIP(NATIVE_TO_UNI(c));
4722     if (do_utf8 || (flags & ANYOF_UNICODE)) {
4723         if (lenp)
4724             *lenp = 0;
4725         if (do_utf8 && !ANYOF_RUNTIME(n)) {
4726             if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
4727                 match = TRUE;
4728         }
4729         if (!match && do_utf8 && (flags & ANYOF_UNICODE_ALL) && c >= 256)
4730             match = TRUE;
4731         if (!match) {
4732             AV *av;
4733             SV * const sw = regclass_swash(n, TRUE, 0, (SV**)&av);
4734
4735             if (sw) {
4736                 if (swash_fetch(sw, p, do_utf8))
4737                     match = TRUE;
4738                 else if (flags & ANYOF_FOLD) {
4739                     if (!match && lenp && av) {
4740                         I32 i;
4741                         for (i = 0; i <= av_len(av); i++) {
4742                             SV* const sv = *av_fetch(av, i, FALSE);
4743                             STRLEN len;
4744                             const char * const s = SvPV_const(sv, len);
4745
4746                             if (len <= plen && memEQ(s, (char*)p, len)) {
4747                                 *lenp = len;
4748                                 match = TRUE;
4749                                 break;
4750                             }
4751                         }
4752                     }
4753                     if (!match) {
4754                         U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
4755                         STRLEN tmplen;
4756
4757                         to_utf8_fold(p, tmpbuf, &tmplen);
4758                         if (swash_fetch(sw, tmpbuf, do_utf8))
4759                             match = TRUE;
4760                     }
4761                 }
4762             }
4763         }
4764         if (match && lenp && *lenp == 0)
4765             *lenp = UNISKIP(NATIVE_TO_UNI(c));
4766     }
4767     if (!match && c < 256) {
4768         if (ANYOF_BITMAP_TEST(n, c))
4769             match = TRUE;
4770         else if (flags & ANYOF_FOLD) {
4771             U8 f;
4772
4773             if (flags & ANYOF_LOCALE) {
4774                 PL_reg_flags |= RF_tainted;
4775                 f = PL_fold_locale[c];
4776             }
4777             else
4778                 f = PL_fold[c];
4779             if (f != c && ANYOF_BITMAP_TEST(n, f))
4780                 match = TRUE;
4781         }
4782
4783         if (!match && (flags & ANYOF_CLASS)) {
4784             PL_reg_flags |= RF_tainted;
4785             if (
4786                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
4787                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
4788                 (ANYOF_CLASS_TEST(n, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
4789                 (ANYOF_CLASS_TEST(n, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
4790                 (ANYOF_CLASS_TEST(n, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
4791                 (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
4792                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
4793                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
4794                 (ANYOF_CLASS_TEST(n, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
4795                 (ANYOF_CLASS_TEST(n, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
4796                 (ANYOF_CLASS_TEST(n, ANYOF_ASCII)   &&  isASCII(c))     ||
4797                 (ANYOF_CLASS_TEST(n, ANYOF_NASCII)  && !isASCII(c))     ||
4798                 (ANYOF_CLASS_TEST(n, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
4799                 (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
4800                 (ANYOF_CLASS_TEST(n, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
4801                 (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
4802                 (ANYOF_CLASS_TEST(n, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
4803                 (ANYOF_CLASS_TEST(n, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
4804                 (ANYOF_CLASS_TEST(n, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
4805                 (ANYOF_CLASS_TEST(n, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
4806                 (ANYOF_CLASS_TEST(n, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
4807                 (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
4808                 (ANYOF_CLASS_TEST(n, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
4809                 (ANYOF_CLASS_TEST(n, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
4810                 (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
4811                 (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c))    ||
4812                 (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC)  &&  isPSXSPC(c))    ||
4813                 (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c))    ||
4814                 (ANYOF_CLASS_TEST(n, ANYOF_BLANK)   &&  isBLANK(c))     ||
4815                 (ANYOF_CLASS_TEST(n, ANYOF_NBLANK)  && !isBLANK(c))
4816                 ) /* How's that for a conditional? */
4817             {
4818                 match = TRUE;
4819             }
4820         }
4821     }
4822
4823     return (flags & ANYOF_INVERT) ? !match : match;
4824 }
4825
4826 STATIC U8 *
4827 S_reghop(pTHX_ U8 *s, I32 off)
4828 {
4829     dVAR;
4830     return S_reghop3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4831 }
4832
4833 STATIC U8 *
4834 S_reghop3(pTHX_ U8 *s, I32 off, U8* lim)
4835 {
4836     dVAR;
4837     if (off >= 0) {
4838         while (off-- && s < lim) {
4839             /* XXX could check well-formedness here */
4840             s += UTF8SKIP(s);
4841         }
4842     }
4843     else {
4844         while (off++) {
4845             if (s > lim) {
4846                 s--;
4847                 if (UTF8_IS_CONTINUED(*s)) {
4848                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4849                         s--;
4850                 }
4851                 /* XXX could check well-formedness here */
4852             }
4853         }
4854     }
4855     return s;
4856 }
4857
4858 STATIC U8 *
4859 S_reghopmaybe(pTHX_ U8 *s, I32 off)
4860 {
4861     dVAR;
4862     return S_reghopmaybe3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4863 }
4864
4865 STATIC U8 *
4866 S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim)
4867 {
4868     dVAR;
4869     if (off >= 0) {
4870         while (off-- && s < lim) {
4871             /* XXX could check well-formedness here */
4872             s += UTF8SKIP(s);
4873         }
4874         if (off >= 0)
4875             return 0;
4876     }
4877     else {
4878         while (off++) {
4879             if (s > lim) {
4880                 s--;
4881                 if (UTF8_IS_CONTINUED(*s)) {
4882                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4883                         s--;
4884                 }
4885                 /* XXX could check well-formedness here */
4886             }
4887             else
4888                 break;
4889         }
4890         if (off <= 0)
4891             return 0;
4892     }
4893     return s;
4894 }
4895
4896 static void
4897 restore_pos(pTHX_ void *arg)
4898 {
4899     dVAR;
4900     PERL_UNUSED_ARG(arg);
4901     if (PL_reg_eval_set) {
4902         if (PL_reg_oldsaved) {
4903             PL_reg_re->subbeg = PL_reg_oldsaved;
4904             PL_reg_re->sublen = PL_reg_oldsavedlen;
4905 #ifdef PERL_OLD_COPY_ON_WRITE
4906             PL_reg_re->saved_copy = PL_nrs;
4907 #endif
4908             RX_MATCH_COPIED_on(PL_reg_re);
4909         }
4910         PL_reg_magic->mg_len = PL_reg_oldpos;
4911         PL_reg_eval_set = 0;
4912         PL_curpm = PL_reg_oldcurpm;
4913     }
4914 }
4915
4916 STATIC void
4917 S_to_utf8_substr(pTHX_ register regexp *prog)
4918 {
4919     if (prog->float_substr && !prog->float_utf8) {
4920         SV* sv;
4921         prog->float_utf8 = sv = newSVsv(prog->float_substr);
4922         sv_utf8_upgrade(sv);
4923         if (SvTAIL(prog->float_substr))
4924             SvTAIL_on(sv);
4925         if (prog->float_substr == prog->check_substr)
4926             prog->check_utf8 = sv;
4927     }
4928     if (prog->anchored_substr && !prog->anchored_utf8) {
4929         SV* sv;
4930         prog->anchored_utf8 = sv = newSVsv(prog->anchored_substr);
4931         sv_utf8_upgrade(sv);
4932         if (SvTAIL(prog->anchored_substr))
4933             SvTAIL_on(sv);
4934         if (prog->anchored_substr == prog->check_substr)
4935             prog->check_utf8 = sv;
4936     }
4937 }
4938
4939 STATIC void
4940 S_to_byte_substr(pTHX_ register regexp *prog)
4941 {
4942     dVAR;
4943     if (prog->float_utf8 && !prog->float_substr) {
4944         SV* sv;
4945         prog->float_substr = sv = newSVsv(prog->float_utf8);
4946         if (sv_utf8_downgrade(sv, TRUE)) {
4947             if (SvTAIL(prog->float_utf8))
4948                 SvTAIL_on(sv);
4949         } else {
4950             SvREFCNT_dec(sv);
4951             prog->float_substr = sv = &PL_sv_undef;
4952         }
4953         if (prog->float_utf8 == prog->check_utf8)
4954             prog->check_substr = sv;
4955     }
4956     if (prog->anchored_utf8 && !prog->anchored_substr) {
4957         SV* sv;
4958         prog->anchored_substr = sv = newSVsv(prog->anchored_utf8);
4959         if (sv_utf8_downgrade(sv, TRUE)) {
4960             if (SvTAIL(prog->anchored_utf8))
4961                 SvTAIL_on(sv);
4962         } else {
4963             SvREFCNT_dec(sv);
4964             prog->anchored_substr = sv = &PL_sv_undef;
4965         }
4966         if (prog->anchored_utf8 == prog->check_utf8)
4967             prog->check_substr = sv;
4968     }
4969 }
4970
4971 /*
4972  * Local variables:
4973  * c-indentation-style: bsd
4974  * c-basic-offset: 4
4975  * indent-tabs-mode: t
4976  * End:
4977  *
4978  * ex: set ts=8 sts=4 sw=4 noet:
4979  */