regexec.c

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