regexec.c

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