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