regexec.c

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