regexec.c

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