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