regexec.c

   1 /*    regexec.c
   2  */
   3
   4 /*
   5  * "One Ring to rule them all, One Ring to find them..."
   6  */
   7
   8 /* NOTE: this is derived from Henry Spencer's regexp code, and should not
   9  * confused with the original package (see point 3 below).  Thanks, Henry!
  10  */
  11
  12 /* Additional note: this code is very heavily munged from Henry's version
  13  * in places.  In some spots I've traded clarity for efficiency, so don't
  14  * blame Henry for some of the lack of readability.
  15  */
  16
  17 /* The names of the functions have been changed from regcomp and
  18  * regexec to  pregcomp and pregexec in order to avoid conflicts
  19  * with the POSIX routines of the same names.
  20 */
  21
  22 #ifdef PERL_EXT_RE_BUILD
  23 /* need to replace pregcomp et al, so enable that */
  24 #  ifndef PERL_IN_XSUB_RE
  25 #    define PERL_IN_XSUB_RE
  26 #  endif
  27 /* need access to debugger hooks */
  28 #  if defined(PERL_EXT_RE_DEBUG) && !defined(DEBUGGING)
  29 #    define DEBUGGING
  30 #  endif
  31 #endif
  32
  33 #ifdef PERL_IN_XSUB_RE
  34 /* We *really* need to overwrite these symbols: */
  35 #  define Perl_regexec_flags my_regexec
  36 #  define Perl_regdump my_regdump
  37 #  define Perl_regprop my_regprop
  38 #  define Perl_re_intuit_start my_re_intuit_start
  39 /* *These* symbols are masked to allow static link. */
  40 #  define Perl_pregexec my_pregexec
  41 #  define Perl_reginitcolors my_reginitcolors
  42 #  define Perl_regclass_swash my_regclass_swash
  43
  44 #  define PERL_NO_GET_CONTEXT
  45 #endif
  46
  47 /*SUPPRESS 112*/
  48 /*
  49  * pregcomp and pregexec -- regsub and regerror are not used in perl
  50  *
  51  *      Copyright (c) 1986 by University of Toronto.
  52  *      Written by Henry Spencer.  Not derived from licensed software.
  53  *
  54  *      Permission is granted to anyone to use this software for any
  55  *      purpose on any computer system, and to redistribute it freely,
  56  *      subject to the following restrictions:
  57  *
  58  *      1. The author is not responsible for the consequences of use of
  59  *              this software, no matter how awful, even if they arise
  60  *              from defects in it.
  61  *
  62  *      2. The origin of this software must not be misrepresented, either
  63  *              by explicit claim or by omission.
  64  *
  65  *      3. Altered versions must be plainly marked as such, and must not
  66  *              be misrepresented as being the original software.
  67  *
  68  ****    Alterations to Henry's code are...
  69  ****
  70  ****    Copyright (c) 1991-2001, Larry Wall
  71  ****
  72  ****    You may distribute under the terms of either the GNU General Public
  73  ****    License or the Artistic License, as specified in the README file.
  74  *
  75  * Beware that some of this code is subtly aware of the way operator
  76  * precedence is structured in regular expressions.  Serious changes in
  77  * regular-expression syntax might require a total rethink.
  78  */
  79 #include "EXTERN.h"
  80 #define PERL_IN_REGEXEC_C
  81 #include "perl.h"
  82
  83 #include "regcomp.h"
  84
  85 #define RF_tainted      1               /* tainted information used? */
  86 #define RF_warned       2               /* warned about big count? */
  87 #define RF_evaled       4               /* Did an EVAL with setting? */
  88 #define RF_utf8         8               /* String contains multibyte chars? */
  89
  90 #define UTF (PL_reg_flags & RF_utf8)
  91
  92 #define RS_init         1               /* eval environment created */
  93 #define RS_set          2               /* replsv value is set */
  94
  95 #ifndef STATIC
  96 #define STATIC  static
  97 #endif
  98
  99 /*
 100  * Forwards.
 101  */
 102
 103 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
 104 #define CHR_DIST(a,b) (PL_reg_match_utf8 ? utf8_distance(a,b) : a - b)
 105
 106 #define reghop_c(pos,off) ((char*)reghop((U8*)pos, off))
 107 #define reghopmaybe_c(pos,off) ((char*)reghopmaybe((U8*)pos, off))
 108 #define HOP(pos,off) (PL_reg_match_utf8 ? reghop((U8*)pos, off) : (U8*)(pos + off))
 109 #define HOPMAYBE(pos,off) (PL_reg_match_utf8 ? reghopmaybe((U8*)pos, off) : (U8*)(pos + off))
 110 #define HOPc(pos,off) ((char*)HOP(pos,off))
 111 #define HOPMAYBEc(pos,off) ((char*)HOPMAYBE(pos,off))
 112
 113 #define HOPBACK(pos, off) (             \
 114     (UTF && PL_reg_match_utf8)          \
 115         ? reghopmaybe((U8*)pos, -off)   \
 116     : (pos - off >= PL_bostr)           \
 117         ? (U8*)(pos - off)              \
 118     : (U8*)NULL                         \
 119 )
 120 #define HOPBACKc(pos, off) (char*)HOPBACK(pos, off)
 121
 122 #define reghop3_c(pos,off,lim) ((char*)reghop3((U8*)pos, off, (U8*)lim))
 123 #define reghopmaybe3_c(pos,off,lim) ((char*)reghopmaybe3((U8*)pos, off, (U8*)lim))
 124 #define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
 125 #define HOPMAYBE3(pos,off,lim) (PL_reg_match_utf8 ? reghopmaybe3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
 126 #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
 127 #define HOPMAYBE3c(pos,off,lim) ((char*)HOPMAYBE3(pos,off,lim))
 128
 129 #define LOAD_UTF8_CHARCLASS(a,b) STMT_START { if (!CAT2(PL_utf8_,a)) (void)CAT2(is_utf8_, a)((U8*)b); } STMT_END
 130
 131 /* for use after a quantifier and before an EXACT-like node -- japhy */
 132 #define JUMPABLE(rn) ( \
 133     OP(rn) == OPEN || OP(rn) == CLOSE || OP(rn) == EVAL || \
 134     OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
 135     OP(rn) == PLUS || OP(rn) == MINMOD || \
 136     (PL_regkind[(U8)OP(rn)] == CURLY && ARG1(rn) > 0) \
 137 )
 138
 139 #define HAS_TEXT(rn) ( \
 140     PL_regkind[(U8)OP(rn)] == EXACT || PL_regkind[(U8)OP(rn)] == REF \
 141 )
 142
 143 #define FIND_NEXT_IMPT(rn) STMT_START { \
 144     while (JUMPABLE(rn)) \
 145         if (OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
 146             PL_regkind[(U8)OP(rn)] == CURLY) \
 147             rn = NEXTOPER(NEXTOPER(rn)); \
 148         else if (OP(rn) == PLUS) \
 149             rn = NEXTOPER(rn); \
 150         else rn += NEXT_OFF(rn); \
 151 } STMT_END
 152
 153 static void restore_pos(pTHX_ void *arg);
 154
 155 STATIC CHECKPOINT
 156 S_regcppush(pTHX_ I32 parenfloor)
 157 {
 158     int retval = PL_savestack_ix;
 159 #define REGCP_PAREN_ELEMS 4
 160     int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS;
 161     int p;
 162
 163     if (paren_elems_to_push < 0)
 164         Perl_croak(aTHX_ "panic: paren_elems_to_push < 0");
 165
 166 #define REGCP_OTHER_ELEMS 6
 167     SSCHECK(paren_elems_to_push + REGCP_OTHER_ELEMS);
 168     for (p = PL_regsize; p > parenfloor; p--) {
 169 /* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
 170         SSPUSHINT(PL_regendp[p]);
 171         SSPUSHINT(PL_regstartp[p]);
 172         SSPUSHPTR(PL_reg_start_tmp[p]);
 173         SSPUSHINT(p);
 174     }
 175 /* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
 176     SSPUSHINT(PL_regsize);
 177     SSPUSHINT(*PL_reglastparen);
 178     SSPUSHINT(*PL_reglastcloseparen);
 179     SSPUSHPTR(PL_reginput);
 180 #define REGCP_FRAME_ELEMS 2
 181 /* REGCP_FRAME_ELEMS are part of the REGCP_OTHER_ELEMS and
 182  * are needed for the regexp context stack bookkeeping. */
 183     SSPUSHINT(paren_elems_to_push + REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
 184     SSPUSHINT(SAVEt_REGCONTEXT); /* Magic cookie. */
 185
 186     return retval;
 187 }
 188
 189 /* These are needed since we do not localize EVAL nodes: */
 190 #  define REGCP_SET(cp)  DEBUG_r(PerlIO_printf(Perl_debug_log,          \
 191                              "  Setting an EVAL scope, savestack=%"IVdf"\n",    \
 192                              (IV)PL_savestack_ix)); cp = PL_savestack_ix
 193
 194 #  define REGCP_UNWIND(cp)  DEBUG_r(cp != PL_savestack_ix ?             \
 195                                 PerlIO_printf(Perl_debug_log,           \
 196                                 "  Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
 197                                 (IV)(cp), (IV)PL_savestack_ix) : 0); regcpblow(cp)
 198
 199 STATIC char *
 200 S_regcppop(pTHX)
 201 {
 202     I32 i;
 203     U32 paren = 0;
 204     char *input;
 205     I32 tmps;
 206
 207     /* Pop REGCP_OTHER_ELEMS before the parentheses loop starts. */
 208     i = SSPOPINT;
 209     assert(i == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
 210     i = SSPOPINT; /* Parentheses elements to pop. */
 211     input = (char *) SSPOPPTR;
 212     *PL_reglastcloseparen = SSPOPINT;
 213     *PL_reglastparen = SSPOPINT;
 214     PL_regsize = SSPOPINT;
 215
 216     /* Now restore the parentheses context. */
 217     for (i -= (REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
 218          i > 0; i -= REGCP_PAREN_ELEMS) {
 219         paren = (U32)SSPOPINT;
 220         PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
 221         PL_regstartp[paren] = SSPOPINT;
 222         tmps = SSPOPINT;
 223         if (paren <= *PL_reglastparen)
 224             PL_regendp[paren] = tmps;
 225         DEBUG_r(
 226             PerlIO_printf(Perl_debug_log,
 227                           "     restoring \\%"UVuf" to %"IVdf"(%"IVdf")..%"IVdf"%s\n",
 228                           (UV)paren, (IV)PL_regstartp[paren],
 229                           (IV)(PL_reg_start_tmp[paren] - PL_bostr),
 230                           (IV)PL_regendp[paren],
 231                           (paren > *PL_reglastparen ? "(no)" : ""));
 232         );
 233     }
 234     DEBUG_r(
 235         if (*PL_reglastparen + 1 <= PL_regnpar) {
 236             PerlIO_printf(Perl_debug_log,
 237                           "     restoring \\%"IVdf"..\\%"IVdf" to undef\n",
 238                           (IV)(*PL_reglastparen + 1), (IV)PL_regnpar);
 239         }
 240     );
 241 #if 1
 242     /* It would seem that the similar code in regtry()
 243      * already takes care of this, and in fact it is in
 244      * a better location to since this code can #if 0-ed out
 245      * but the code in regtry() is needed or otherwise tests
 246      * requiring null fields (pat.t#187 and split.t#{13,14}
 247      * (as of patchlevel 7877)  will fail.  Then again,
 248      * this code seems to be necessary or otherwise
 249      * building DynaLoader will fail:
 250      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
 251      * --jhi */
 252     for (paren = *PL_reglastparen + 1; paren <= PL_regnpar; paren++) {
 253         if (paren > PL_regsize)
 254             PL_regstartp[paren] = -1;
 255         PL_regendp[paren] = -1;
 256     }
 257 #endif
 258     return input;
 259 }
 260
 261 STATIC char *
 262 S_regcp_set_to(pTHX_ I32 ss)
 263 {
 264     I32 tmp = PL_savestack_ix;
 265
 266     PL_savestack_ix = ss;
 267     regcppop();
 268     PL_savestack_ix = tmp;
 269     return Nullch;
 270 }
 271
 272 typedef struct re_cc_state
 273 {
 274     I32 ss;
 275     regnode *node;
 276     struct re_cc_state *prev;
 277     CURCUR *cc;
 278     regexp *re;
 279 } re_cc_state;
 280
 281 #define regcpblow(cp) LEAVE_SCOPE(cp)   /* Ignores regcppush()ed data. */
 282
 283 #define TRYPAREN(paren, n, input) {                             \
 284     if (paren) {                                                \
 285         if (n) {                                                \
 286             PL_regstartp[paren] = HOPc(input, -1) - PL_bostr;   \
 287             PL_regendp[paren] = input - PL_bostr;               \
 288         }                                                       \
 289         else                                                    \
 290             PL_regendp[paren] = -1;                             \
 291     }                                                           \
 292     if (regmatch(next))                                         \
 293         sayYES;                                                 \
 294     if (paren && n)                                             \
 295         PL_regendp[paren] = -1;                                 \
 296 }
 297
 298
 299 /*
 300  * pregexec and friends
 301  */
 302
 303 /*
 304  - pregexec - match a regexp against a string
 305  */
 306 I32
 307 Perl_pregexec(pTHX_ register regexp *prog, char *stringarg, register char *strend,
 308          char *strbeg, I32 minend, SV *screamer, U32 nosave)
 309 /* strend: pointer to null at end of string */
 310 /* strbeg: real beginning of string */
 311 /* minend: end of match must be >=minend after stringarg. */
 312 /* nosave: For optimizations. */
 313 {
 314     return
 315         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
 316                       nosave ? 0 : REXEC_COPY_STR);
 317 }
 318
 319 STATIC void
 320 S_cache_re(pTHX_ regexp *prog)
 321 {
 322     PL_regprecomp = prog->precomp;              /* Needed for FAIL. */
 323 #ifdef DEBUGGING
 324     PL_regprogram = prog->program;
 325 #endif
 326     PL_regnpar = prog->nparens;
 327     PL_regdata = prog->data;
 328     PL_reg_re = prog;
 329 }
 330
 331 /*
 332  * Need to implement the following flags for reg_anch:
 333  *
 334  * USE_INTUIT_NOML              - Useful to call re_intuit_start() first
 335  * USE_INTUIT_ML
 336  * INTUIT_AUTORITATIVE_NOML     - Can trust a positive answer
 337  * INTUIT_AUTORITATIVE_ML
 338  * INTUIT_ONCE_NOML             - Intuit can match in one location only.
 339  * INTUIT_ONCE_ML
 340  *
 341  * Another flag for this function: SECOND_TIME (so that float substrs
 342  * with giant delta may be not rechecked).
 343  */
 344
 345 /* Assumptions: if ANCH_GPOS, then strpos is anchored. XXXX Check GPOS logic */
 346
 347 /* If SCREAM, then SvPVX(sv) should be compatible with strpos and strend.
 348    Otherwise, only SvCUR(sv) is used to get strbeg. */
 349
 350 /* XXXX We assume that strpos is strbeg unless sv. */
 351
 352 /* XXXX Some places assume that there is a fixed substring.
 353         An update may be needed if optimizer marks as "INTUITable"
 354         RExen without fixed substrings.  Similarly, it is assumed that
 355         lengths of all the strings are no more than minlen, thus they
 356         cannot come from lookahead.
 357         (Or minlen should take into account lookahead.) */
 358
 359 /* A failure to find a constant substring means that there is no need to make
 360    an expensive call to REx engine, thus we celebrate a failure.  Similarly,
 361    finding a substring too deep into the string means that less calls to
 362    regtry() should be needed.
 363
 364    REx compiler's optimizer found 4 possible hints:
 365         a) Anchored substring;
 366         b) Fixed substring;
 367         c) Whether we are anchored (beginning-of-line or \G);
 368         d) First node (of those at offset 0) which may distingush positions;
 369    We use a)b)d) and multiline-part of c), and try to find a position in the
 370    string which does not contradict any of them.
 371  */
 372
 373 /* Most of decisions we do here should have been done at compile time.
 374    The nodes of the REx which we used for the search should have been
 375    deleted from the finite automaton. */
 376
 377 char *
 378 Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 379                      char *strend, U32 flags, re_scream_pos_data *data)
 380 {
 381     register I32 start_shift = 0;
 382     /* Should be nonnegative! */
 383     register I32 end_shift   = 0;
 384     register char *s;
 385     register SV *check;
 386     char *strbeg;
 387     char *t;
 388     I32 ml_anch;
 389     register char *other_last = Nullch; /* other substr checked before this */
 390     char *check_at = Nullch;            /* check substr found at this pos */
 391 #ifdef DEBUGGING
 392     char *i_strpos = strpos;
 393     SV *dsv = PERL_DEBUG_PAD_ZERO(0);
 394 #endif
 395
 396     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 = PERL_DEBUG_PAD_ZERO(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 #ifdef DEBUGGING
1947     sv_setpvn(PERL_DEBUG_PAD(0), "", 0);
1948     sv_setpvn(PERL_DEBUG_PAD(1), "", 0);
1949     sv_setpvn(PERL_DEBUG_PAD(2), "", 0);
1950 #endif
1951
1952     /* XXXX What this code is doing here?!!!  There should be no need
1953        to do this again and again, PL_reglastparen should take care of
1954        this!  --ilya*/
1955
1956     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
1957      * Actually, the code in regcppop() (which Ilya may be meaning by
1958      * PL_reglastparen), is not needed at all by the test suite
1959      * (op/regexp, op/pat, op/split), but that code is needed, oddly
1960      * enough, for building DynaLoader, or otherwise this
1961      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
1962      * will happen.  Meanwhile, this code *is* needed for the
1963      * above-mentioned test suite tests to succeed.  The common theme
1964      * on those tests seems to be returning null fields from matches.
1965      * --jhi */
1966 #if 1
1967     sp = prog->startp;
1968     ep = prog->endp;
1969     if (prog->nparens) {
1970         for (i = prog->nparens; i > *PL_reglastparen; i--) {
1971             *++sp = -1;
1972             *++ep = -1;
1973         }
1974     }
1975 #endif
1976     REGCP_SET(lastcp);
1977     if (regmatch(prog->program + 1)) {
1978         prog->endp[0] = PL_reginput - PL_bostr;
1979         return 1;
1980     }
1981     REGCP_UNWIND(lastcp);
1982     return 0;
1983 }
1984
1985 #define RE_UNWIND_BRANCH        1
1986 #define RE_UNWIND_BRANCHJ       2
1987
1988 union re_unwind_t;
1989
1990 typedef struct {                /* XX: makes sense to enlarge it... */
1991     I32 type;
1992     I32 prev;
1993     CHECKPOINT lastcp;
1994 } re_unwind_generic_t;
1995
1996 typedef struct {
1997     I32 type;
1998     I32 prev;
1999     CHECKPOINT lastcp;
2000     I32 lastparen;
2001     regnode *next;
2002     char *locinput;
2003     I32 nextchr;
2004 #ifdef DEBUGGING
2005     int regindent;
2006 #endif
2007 } re_unwind_branch_t;
2008
2009 typedef union re_unwind_t {
2010     I32 type;
2011     re_unwind_generic_t generic;
2012     re_unwind_branch_t branch;
2013 } re_unwind_t;
2014
2015 #define sayYES goto yes
2016 #define sayNO goto no
2017 #define sayYES_FINAL goto yes_final
2018 #define sayYES_LOUD  goto yes_loud
2019 #define sayNO_FINAL  goto no_final
2020 #define sayNO_SILENT goto do_no
2021 #define saySAME(x) if (x) goto yes; else goto no
2022
2023 #define REPORT_CODE_OFF 24
2024
2025 /*
2026  - regmatch - main matching routine
2027  *
2028  * Conceptually the strategy is simple:  check to see whether the current
2029  * node matches, call self recursively to see whether the rest matches,
2030  * and then act accordingly.  In practice we make some effort to avoid
2031  * recursion, in particular by going through "ordinary" nodes (that don't
2032  * need to know whether the rest of the match failed) by a loop instead of
2033  * by recursion.
2034  */
2035 /* [lwall] I've hoisted the register declarations to the outer block in order to
2036  * maybe save a little bit of pushing and popping on the stack.  It also takes
2037  * advantage of machines that use a register save mask on subroutine entry.
2038  */
2039 STATIC I32                      /* 0 failure, 1 success */
2040 S_regmatch(pTHX_ regnode *prog)
2041 {
2042     register regnode *scan;     /* Current node. */
2043     regnode *next;              /* Next node. */
2044     regnode *inner;             /* Next node in internal branch. */
2045     register I32 nextchr;       /* renamed nextchr - nextchar colides with
2046                                    function of same name */
2047     register I32 n;             /* no or next */
2048     register I32 ln = 0;        /* len or last */
2049     register char *s = Nullch;  /* operand or save */
2050     register char *locinput = PL_reginput;
2051     register I32 c1 = 0, c2 = 0, paren; /* case fold search, parenth */
2052     int minmod = 0, sw = 0, logical = 0;
2053     I32 unwind = 0;
2054 #if 0
2055     I32 firstcp = PL_savestack_ix;
2056 #endif
2057     register bool do_utf8 = PL_reg_match_utf8;
2058 #ifdef DEBUGGING
2059     SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
2060     SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
2061     SV *dsv2 = PERL_DEBUG_PAD_ZERO(2);
2062 #endif
2063
2064 #ifdef DEBUGGING
2065     PL_regindent++;
2066 #endif
2067
2068     /* Note that nextchr is a byte even in UTF */
2069     nextchr = UCHARAT(locinput);
2070     scan = prog;
2071     while (scan != NULL) {
2072
2073         DEBUG_r( {
2074             SV *prop = sv_newmortal();
2075             int docolor = *PL_colors[0];
2076             int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
2077             int l = (PL_regeol - locinput) > taill ? taill : (PL_regeol - locinput);
2078             /* The part of the string before starttry has one color
2079                (pref0_len chars), between starttry and current
2080                position another one (pref_len - pref0_len chars),
2081                after the current position the third one.
2082                We assume that pref0_len <= pref_len, otherwise we
2083                decrease pref0_len.  */
2084             int pref_len = (locinput - PL_bostr) > (5 + taill) - l
2085                 ? (5 + taill) - l : locinput - PL_bostr;
2086             int pref0_len;
2087
2088             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
2089                 pref_len++;
2090             pref0_len = pref_len  - (locinput - PL_reg_starttry);
2091             if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
2092                 l = ( PL_regeol - locinput > (5 + taill) - pref_len
2093                       ? (5 + taill) - pref_len : PL_regeol - locinput);
2094             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
2095                 l--;
2096             if (pref0_len < 0)
2097                 pref0_len = 0;
2098             if (pref0_len > pref_len)
2099                 pref0_len = pref_len;
2100             regprop(prop, scan);
2101             {
2102               char *s0 =
2103                 do_utf8 ?
2104                 pv_uni_display(dsv0, (U8*)(locinput - pref_len),
2105                                pref0_len, 60, 0) :
2106                 locinput - pref_len;
2107               int len0 = do_utf8 ? strlen(s0) : pref0_len;
2108               char *s1 = do_utf8 ?
2109                 pv_uni_display(dsv1, (U8*)(locinput - pref_len + pref0_len),
2110                                pref_len - pref0_len, 60, 0) :
2111                 locinput - pref_len + pref0_len;
2112               int len1 = do_utf8 ? strlen(s1) : pref_len - pref0_len;
2113               char *s2 = do_utf8 ?
2114                 pv_uni_display(dsv2, (U8*)locinput,
2115                                PL_regeol - locinput, 60, 0) :
2116                 locinput;
2117               int len2 = do_utf8 ? strlen(s2) : l;
2118               PerlIO_printf(Perl_debug_log,
2119                             "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n",
2120                             (IV)(locinput - PL_bostr),
2121                             PL_colors[4],
2122                             len0, s0,
2123                             PL_colors[5],
2124                             PL_colors[2],
2125                             len1, s1,
2126                             PL_colors[3],
2127                             (docolor ? "" : "> <"),
2128                             PL_colors[0],
2129                             len2, s2,
2130                             PL_colors[1],
2131                             15 - l - pref_len + 1,
2132                             "",
2133                             (IV)(scan - PL_regprogram), PL_regindent*2, "",
2134                             SvPVX(prop));
2135             }
2136         });
2137
2138         next = scan + NEXT_OFF(scan);
2139         if (next == scan)
2140             next = NULL;
2141
2142         switch (OP(scan)) {
2143         case BOL:
2144             if (locinput == PL_bostr || (PL_multiline &&
2145                 (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
2146             {
2147                 /* regtill = regbol; */
2148                 break;
2149             }
2150             sayNO;
2151         case MBOL:
2152             if (locinput == PL_bostr ||
2153                 ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n'))
2154             {
2155                 break;
2156             }
2157             sayNO;
2158         case SBOL:
2159             if (locinput == PL_bostr)
2160                 break;
2161             sayNO;
2162         case GPOS:
2163             if (locinput == PL_reg_ganch)
2164                 break;
2165             sayNO;
2166         case EOL:
2167             if (PL_multiline)
2168                 goto meol;
2169             else
2170                 goto seol;
2171         case MEOL:
2172           meol:
2173             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2174                 sayNO;
2175             break;
2176         case SEOL:
2177           seol:
2178             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2179                 sayNO;
2180             if (PL_regeol - locinput > 1)
2181                 sayNO;
2182             break;
2183         case EOS:
2184             if (PL_regeol != locinput)
2185                 sayNO;
2186             break;
2187         case SANY:
2188             if (!nextchr && locinput >= PL_regeol)
2189                 sayNO;
2190             if (do_utf8) {
2191                 locinput += PL_utf8skip[nextchr];
2192                 if (locinput > PL_regeol)
2193                     sayNO;
2194                 nextchr = UCHARAT(locinput);
2195             }
2196             else
2197                 nextchr = UCHARAT(++locinput);
2198             break;
2199         case CANY:
2200             if (!nextchr && locinput >= PL_regeol)
2201                 sayNO;
2202             nextchr = UCHARAT(++locinput);
2203             break;
2204         case REG_ANY:
2205             if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
2206                 sayNO;
2207             if (do_utf8) {
2208                 locinput += PL_utf8skip[nextchr];
2209                 if (locinput > PL_regeol)
2210                     sayNO;
2211                 nextchr = UCHARAT(locinput);
2212             }
2213             else
2214                 nextchr = UCHARAT(++locinput);
2215             break;
2216         case EXACT:
2217             s = STRING(scan);
2218             ln = STR_LEN(scan);
2219             if (do_utf8 != (UTF!=0)) {
2220                 /* The target and the pattern have differing "utf8ness". */
2221                 char *l = locinput;
2222                 char *e = s + ln;
2223                 STRLEN len;
2224
2225                 if (do_utf8) {
2226                     /* The target is utf8, the pattern is not utf8. */
2227                     while (s < e) {
2228                         if (l >= PL_regeol)
2229                              sayNO;
2230                         if (NATIVE_TO_UNI(*(U8*)s) !=
2231                             utf8_to_uvchr((U8*)l, &len))
2232                              sayNO;
2233                         l += len;
2234                         s ++;
2235                     }
2236                 }
2237                 else {
2238                     /* The target is not utf8, the pattern is utf8. */
2239                     while (s < e) {
2240                         if (l >= PL_regeol)
2241                             sayNO;
2242                         if (NATIVE_TO_UNI(*((U8*)l)) !=
2243                             utf8_to_uvchr((U8*)s, &len))
2244                             sayNO;
2245                         s += len;
2246                         l ++;
2247                     }
2248                 }
2249                 locinput = l;
2250                 nextchr = UCHARAT(locinput);
2251                 break;
2252             }
2253             /* The target and the pattern have the same "utf8ness". */
2254             /* Inline the first character, for speed. */
2255             if (UCHARAT(s) != nextchr)
2256                 sayNO;
2257             if (PL_regeol - locinput < ln)
2258                 sayNO;
2259             if (ln > 1 && memNE(s, locinput, ln))
2260                 sayNO;
2261             locinput += ln;
2262             nextchr = UCHARAT(locinput);
2263             break;
2264         case EXACTFL:
2265             PL_reg_flags |= RF_tainted;
2266             /* FALL THROUGH */
2267         case EXACTF:
2268             s = STRING(scan);
2269             ln = STR_LEN(scan);
2270
2271             if (do_utf8) {
2272                 char *l = locinput;
2273                 char *e;
2274                 STRLEN ulen;
2275                 U8 tmpbuf[UTF8_MAXLEN*2+1];
2276                 e = s + ln;
2277                 while (s < e) {
2278                     if (l >= PL_regeol)
2279                         sayNO;
2280                     toLOWER_utf8((U8*)l, tmpbuf, &ulen);
2281                     if (memNE(s, (char*)tmpbuf, ulen))
2282                         sayNO;
2283                     s += UTF8SKIP(s);
2284                     l += ulen;
2285                 }
2286                 locinput = l;
2287                 nextchr = UCHARAT(locinput);
2288                 break;
2289             }
2290
2291             /* Inline the first character, for speed. */
2292             if (UCHARAT(s) != nextchr &&
2293                 UCHARAT(s) != ((OP(scan) == EXACTF)
2294                                ? PL_fold : PL_fold_locale)[nextchr])
2295                 sayNO;
2296             if (PL_regeol - locinput < ln)
2297                 sayNO;
2298             if (ln > 1 && (OP(scan) == EXACTF
2299                            ? ibcmp(s, locinput, ln)
2300                            : ibcmp_locale(s, locinput, ln)))
2301                 sayNO;
2302             locinput += ln;
2303             nextchr = UCHARAT(locinput);
2304             break;
2305         case ANYOF:
2306             if (do_utf8) {
2307                 if (!reginclass(scan, (U8*)locinput, do_utf8))
2308                     sayNO;
2309                 if (locinput >= PL_regeol)
2310                     sayNO;
2311                 locinput += PL_utf8skip[nextchr];
2312                 nextchr = UCHARAT(locinput);
2313             }
2314             else {
2315                 if (nextchr < 0)
2316                     nextchr = UCHARAT(locinput);
2317                 if (!reginclass(scan, (U8*)locinput, do_utf8))
2318                     sayNO;
2319                 if (!nextchr && locinput >= PL_regeol)
2320                     sayNO;
2321                 nextchr = UCHARAT(++locinput);
2322             }
2323             break;
2324         case ALNUML:
2325             PL_reg_flags |= RF_tainted;
2326             /* FALL THROUGH */
2327         case ALNUM:
2328             if (!nextchr)
2329                 sayNO;
2330             if (do_utf8) {
2331                 LOAD_UTF8_CHARCLASS(alnum,"a");
2332                 if (!(OP(scan) == ALNUM
2333                       ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2334                       : isALNUM_LC_utf8((U8*)locinput)))
2335                 {
2336                     sayNO;
2337                 }
2338                 locinput += PL_utf8skip[nextchr];
2339                 nextchr = UCHARAT(locinput);
2340                 break;
2341             }
2342             if (!(OP(scan) == ALNUM
2343                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
2344                 sayNO;
2345             nextchr = UCHARAT(++locinput);
2346             break;
2347         case NALNUML:
2348             PL_reg_flags |= RF_tainted;
2349             /* FALL THROUGH */
2350         case NALNUM:
2351             if (!nextchr && locinput >= PL_regeol)
2352                 sayNO;
2353             if (do_utf8) {
2354                 LOAD_UTF8_CHARCLASS(alnum,"a");
2355                 if (OP(scan) == NALNUM
2356                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2357                     : isALNUM_LC_utf8((U8*)locinput))
2358                 {
2359                     sayNO;
2360                 }
2361                 locinput += PL_utf8skip[nextchr];
2362                 nextchr = UCHARAT(locinput);
2363                 break;
2364             }
2365             if (OP(scan) == NALNUM
2366                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
2367                 sayNO;
2368             nextchr = UCHARAT(++locinput);
2369             break;
2370         case BOUNDL:
2371         case NBOUNDL:
2372             PL_reg_flags |= RF_tainted;
2373             /* FALL THROUGH */
2374         case BOUND:
2375         case NBOUND:
2376             /* was last char in word? */
2377             if (do_utf8) {
2378                 if (locinput == PL_bostr)
2379                     ln = '\n';
2380                 else {
2381                     U8 *r = reghop((U8*)locinput, -1);
2382
2383                     ln = utf8n_to_uvchr(r, s - (char*)r, 0, 0);
2384                 }
2385                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2386                     ln = isALNUM_uni(ln);
2387                     LOAD_UTF8_CHARCLASS(alnum,"a");
2388                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
2389                 }
2390                 else {
2391                     ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
2392                     n = isALNUM_LC_utf8((U8*)locinput);
2393                 }
2394             }
2395             else {
2396                 ln = (locinput != PL_bostr) ?
2397                     UCHARAT(locinput - 1) : '\n';
2398                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2399                     ln = isALNUM(ln);
2400                     n = isALNUM(nextchr);
2401                 }
2402                 else {
2403                     ln = isALNUM_LC(ln);
2404                     n = isALNUM_LC(nextchr);
2405                 }
2406             }
2407             if (((!ln) == (!n)) == (OP(scan) == BOUND ||
2408                                     OP(scan) == BOUNDL))
2409                     sayNO;
2410             break;
2411         case SPACEL:
2412             PL_reg_flags |= RF_tainted;
2413             /* FALL THROUGH */
2414         case SPACE:
2415             if (!nextchr)
2416                 sayNO;
2417             if (do_utf8) {
2418                 if (UTF8_IS_CONTINUED(nextchr)) {
2419                     LOAD_UTF8_CHARCLASS(space," ");
2420                     if (!(OP(scan) == SPACE
2421                           ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
2422                           : isSPACE_LC_utf8((U8*)locinput)))
2423                     {
2424                         sayNO;
2425                     }
2426                     locinput += PL_utf8skip[nextchr];
2427                     nextchr = UCHARAT(locinput);
2428                     break;
2429                 }
2430                 if (!(OP(scan) == SPACE
2431                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
2432                     sayNO;
2433                 nextchr = UCHARAT(++locinput);
2434             }
2435             else {
2436                 if (!(OP(scan) == SPACE
2437                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
2438                     sayNO;
2439                 nextchr = UCHARAT(++locinput);
2440             }
2441             break;
2442         case NSPACEL:
2443             PL_reg_flags |= RF_tainted;
2444             /* FALL THROUGH */
2445         case NSPACE:
2446             if (!nextchr && locinput >= PL_regeol)
2447                 sayNO;
2448             if (do_utf8) {
2449                 LOAD_UTF8_CHARCLASS(space," ");
2450                 if (OP(scan) == NSPACE
2451                     ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
2452                     : isSPACE_LC_utf8((U8*)locinput))
2453                 {
2454                     sayNO;
2455                 }
2456                 locinput += PL_utf8skip[nextchr];
2457                 nextchr = UCHARAT(locinput);
2458                 break;
2459             }
2460             if (OP(scan) == NSPACE
2461                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
2462                 sayNO;
2463             nextchr = UCHARAT(++locinput);
2464             break;
2465         case DIGITL:
2466             PL_reg_flags |= RF_tainted;
2467             /* FALL THROUGH */
2468         case DIGIT:
2469             if (!nextchr)
2470                 sayNO;
2471             if (do_utf8) {
2472                 LOAD_UTF8_CHARCLASS(digit,"0");
2473                 if (!(OP(scan) == DIGIT
2474                       ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
2475                       : isDIGIT_LC_utf8((U8*)locinput)))
2476                 {
2477                     sayNO;
2478                 }
2479                 locinput += PL_utf8skip[nextchr];
2480                 nextchr = UCHARAT(locinput);
2481                 break;
2482             }
2483             if (!(OP(scan) == DIGIT
2484                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
2485                 sayNO;
2486             nextchr = UCHARAT(++locinput);
2487             break;
2488         case NDIGITL:
2489             PL_reg_flags |= RF_tainted;
2490             /* FALL THROUGH */
2491         case NDIGIT:
2492             if (!nextchr && locinput >= PL_regeol)
2493                 sayNO;
2494             if (do_utf8) {
2495                 LOAD_UTF8_CHARCLASS(digit,"0");
2496                 if (OP(scan) == NDIGIT
2497                     ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
2498                     : isDIGIT_LC_utf8((U8*)locinput))
2499                 {
2500                     sayNO;
2501                 }
2502                 locinput += PL_utf8skip[nextchr];
2503                 nextchr = UCHARAT(locinput);
2504                 break;
2505             }
2506             if (OP(scan) == NDIGIT
2507                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
2508                 sayNO;
2509             nextchr = UCHARAT(++locinput);
2510             break;
2511         case CLUMP:
2512             LOAD_UTF8_CHARCLASS(mark,"~");
2513             if (locinput >= PL_regeol ||
2514                 swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
2515                 sayNO;
2516             locinput += PL_utf8skip[nextchr];
2517             while (locinput < PL_regeol &&
2518                    swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
2519                 locinput += UTF8SKIP(locinput);
2520             if (locinput > PL_regeol)
2521                 sayNO;
2522             nextchr = UCHARAT(locinput);
2523             break;
2524         case REFFL:
2525             PL_reg_flags |= RF_tainted;
2526             /* FALL THROUGH */
2527         case REF:
2528         case REFF:
2529             n = ARG(scan);  /* which paren pair */
2530             ln = PL_regstartp[n];
2531             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2532             if (*PL_reglastparen < n || ln == -1)
2533                 sayNO;                  /* Do not match unless seen CLOSEn. */
2534             if (ln == PL_regendp[n])
2535                 break;
2536
2537             s = PL_bostr + ln;
2538             if (do_utf8 && OP(scan) != REF) {   /* REF can do byte comparison */
2539                 char *l = locinput;
2540                 char *e = PL_bostr + PL_regendp[n];
2541                 /*
2542                  * Note that we can't do the "other character" lookup trick as
2543                  * in the 8-bit case (no pun intended) because in Unicode we
2544                  * have to map both upper and title case to lower case.
2545                  */
2546                 if (OP(scan) == REFF) {
2547                     STRLEN ulen1, ulen2;
2548                     U8 tmpbuf1[UTF8_MAXLEN*2+1];
2549                     U8 tmpbuf2[UTF8_MAXLEN*2+1];
2550                     while (s < e) {
2551                         if (l >= PL_regeol)
2552                             sayNO;
2553                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
2554                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
2555                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
2556                             sayNO;
2557                         s += ulen1;
2558                         l += ulen2;
2559                     }
2560                 }
2561                 locinput = l;
2562                 nextchr = UCHARAT(locinput);
2563                 break;
2564             }
2565
2566             /* Inline the first character, for speed. */
2567             if (UCHARAT(s) != nextchr &&
2568                 (OP(scan) == REF ||
2569                  (UCHARAT(s) != ((OP(scan) == REFF
2570                                   ? PL_fold : PL_fold_locale)[nextchr]))))
2571                 sayNO;
2572             ln = PL_regendp[n] - ln;
2573             if (locinput + ln > PL_regeol)
2574                 sayNO;
2575             if (ln > 1 && (OP(scan) == REF
2576                            ? memNE(s, locinput, ln)
2577                            : (OP(scan) == REFF
2578                               ? ibcmp(s, locinput, ln)
2579                               : ibcmp_locale(s, locinput, ln))))
2580                 sayNO;
2581             locinput += ln;
2582             nextchr = UCHARAT(locinput);
2583             break;
2584
2585         case NOTHING:
2586         case TAIL:
2587             break;
2588         case BACK:
2589             break;
2590         case EVAL:
2591         {
2592             dSP;
2593             OP_4tree *oop = PL_op;
2594             COP *ocurcop = PL_curcop;
2595             SV **ocurpad = PL_curpad;
2596             SV *ret;
2597
2598             n = ARG(scan);
2599             PL_op = (OP_4tree*)PL_regdata->data[n];
2600             DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
2601             PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 2]);
2602             PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
2603
2604             {
2605                 SV **before = SP;
2606                 CALLRUNOPS(aTHX);                       /* Scalar context. */
2607                 SPAGAIN;
2608                 if (SP == before)
2609                     ret = Nullsv;   /* protect against empty (?{}) blocks. */
2610                 else {
2611                     ret = POPs;
2612                     PUTBACK;
2613                 }
2614             }
2615
2616             PL_op = oop;
2617             PL_curpad = ocurpad;
2618             PL_curcop = ocurcop;
2619             if (logical) {
2620                 if (logical == 2) {     /* Postponed subexpression. */
2621                     regexp *re;
2622                     MAGIC *mg = Null(MAGIC*);
2623                     re_cc_state state;
2624                     CHECKPOINT cp, lastcp;
2625
2626                     if(SvROK(ret) || SvRMAGICAL(ret)) {
2627                         SV *sv = SvROK(ret) ? SvRV(ret) : ret;
2628
2629                         if(SvMAGICAL(sv))
2630                             mg = mg_find(sv, PERL_MAGIC_qr);
2631                     }
2632                     if (mg) {
2633                         re = (regexp *)mg->mg_obj;
2634                         (void)ReREFCNT_inc(re);
2635                     }
2636                     else {
2637                         STRLEN len;
2638                         char *t = SvPV(ret, len);
2639                         PMOP pm;
2640                         char *oprecomp = PL_regprecomp;
2641                         I32 osize = PL_regsize;
2642                         I32 onpar = PL_regnpar;
2643
2644                         Zero(&pm, 1, PMOP);
2645                         re = CALLREGCOMP(aTHX_ t, t + len, &pm);
2646                         if (!(SvFLAGS(ret)
2647                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)))
2648                             sv_magic(ret,(SV*)ReREFCNT_inc(re),
2649                                         PERL_MAGIC_qr,0,0);
2650                         PL_regprecomp = oprecomp;
2651                         PL_regsize = osize;
2652                         PL_regnpar = onpar;
2653                     }
2654                     DEBUG_r(
2655                         PerlIO_printf(Perl_debug_log,
2656                                       "Entering embedded `%s%.60s%s%s'\n",
2657                                       PL_colors[0],
2658                                       re->precomp,
2659                                       PL_colors[1],
2660                                       (strlen(re->precomp) > 60 ? "..." : ""))
2661                         );
2662                     state.node = next;
2663                     state.prev = PL_reg_call_cc;
2664                     state.cc = PL_regcc;
2665                     state.re = PL_reg_re;
2666
2667                     PL_regcc = 0;
2668
2669                     cp = regcppush(0);  /* Save *all* the positions. */
2670                     REGCP_SET(lastcp);
2671                     cache_re(re);
2672                     state.ss = PL_savestack_ix;
2673                     *PL_reglastparen = 0;
2674                     *PL_reglastcloseparen = 0;
2675                     PL_reg_call_cc = &state;
2676                     PL_reginput = locinput;
2677
2678                     /* XXXX This is too dramatic a measure... */
2679                     PL_reg_maxiter = 0;
2680
2681                     if (regmatch(re->program + 1)) {
2682                         /* Even though we succeeded, we need to restore
2683                            global variables, since we may be wrapped inside
2684                            SUSPEND, thus the match may be not finished yet. */
2685
2686                         /* XXXX Do this only if SUSPENDed? */
2687                         PL_reg_call_cc = state.prev;
2688                         PL_regcc = state.cc;
2689                         PL_reg_re = state.re;
2690                         cache_re(PL_reg_re);
2691
2692                         /* XXXX This is too dramatic a measure... */
2693                         PL_reg_maxiter = 0;
2694
2695                         /* These are needed even if not SUSPEND. */
2696                         ReREFCNT_dec(re);
2697                         regcpblow(cp);
2698                         sayYES;
2699                     }
2700                     ReREFCNT_dec(re);
2701                     REGCP_UNWIND(lastcp);
2702                     regcppop();
2703                     PL_reg_call_cc = state.prev;
2704                     PL_regcc = state.cc;
2705                     PL_reg_re = state.re;
2706                     cache_re(PL_reg_re);
2707
2708                     /* XXXX This is too dramatic a measure... */
2709                     PL_reg_maxiter = 0;
2710
2711                     logical = 0;
2712                     sayNO;
2713                 }
2714                 sw = SvTRUE(ret);
2715                 logical = 0;
2716             }
2717             else
2718                 sv_setsv(save_scalar(PL_replgv), ret);
2719             break;
2720         }
2721         case OPEN:
2722             n = ARG(scan);  /* which paren pair */
2723             PL_reg_start_tmp[n] = locinput;
2724             if (n > PL_regsize)
2725                 PL_regsize = n;
2726             break;
2727         case CLOSE:
2728             n = ARG(scan);  /* which paren pair */
2729             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
2730             PL_regendp[n] = locinput - PL_bostr;
2731             if (n > *PL_reglastparen)
2732                 *PL_reglastparen = n;
2733             *PL_reglastcloseparen = n;
2734             break;
2735         case GROUPP:
2736             n = ARG(scan);  /* which paren pair */
2737             sw = (*PL_reglastparen >= n && PL_regendp[n] != -1);
2738             break;
2739         case IFTHEN:
2740             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2741             if (sw)
2742                 next = NEXTOPER(NEXTOPER(scan));
2743             else {
2744                 next = scan + ARG(scan);
2745                 if (OP(next) == IFTHEN) /* Fake one. */
2746                     next = NEXTOPER(NEXTOPER(next));
2747             }
2748             break;
2749         case LOGICAL:
2750             logical = scan->flags;
2751             break;
2752 /*******************************************************************
2753  PL_regcc contains infoblock about the innermost (...)* loop, and
2754  a pointer to the next outer infoblock.
2755
2756  Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM):
2757
2758    1) After matching X, regnode for CURLYX is processed;
2759
2760    2) This regnode creates infoblock on the stack, and calls
2761       regmatch() recursively with the starting point at WHILEM node;
2762
2763    3) Each hit of WHILEM node tries to match A and Z (in the order
2764       depending on the current iteration, min/max of {min,max} and
2765       greediness).  The information about where are nodes for "A"
2766       and "Z" is read from the infoblock, as is info on how many times "A"
2767       was already matched, and greediness.
2768
2769    4) After A matches, the same WHILEM node is hit again.
2770
2771    5) Each time WHILEM is hit, PL_regcc is the infoblock created by CURLYX
2772       of the same pair.  Thus when WHILEM tries to match Z, it temporarily
2773       resets PL_regcc, since this Y(A)*Z can be a part of some other loop:
2774       as in (Y(A)*Z)*.  If Z matches, the automaton will hit the WHILEM node
2775       of the external loop.
2776
2777  Currently present infoblocks form a tree with a stem formed by PL_curcc
2778  and whatever it mentions via ->next, and additional attached trees
2779  corresponding to temporarily unset infoblocks as in "5" above.
2780
2781  In the following picture infoblocks for outer loop of
2782  (Y(A)*?Z)*?T are denoted O, for inner I.  NULL starting block
2783  is denoted by x.  The matched string is YAAZYAZT.  Temporarily postponed
2784  infoblocks are drawn below the "reset" infoblock.
2785
2786  In fact in the picture below we do not show failed matches for Z and T
2787  by WHILEM blocks.  [We illustrate minimal matches, since for them it is
2788  more obvious *why* one needs to *temporary* unset infoblocks.]
2789
2790   Matched       REx position    InfoBlocks      Comment
2791                 (Y(A)*?Z)*?T    x
2792                 Y(A)*?Z)*?T     x <- O
2793   Y             (A)*?Z)*?T      x <- O
2794   Y             A)*?Z)*?T       x <- O <- I
2795   YA            )*?Z)*?T        x <- O <- I
2796   YA            A)*?Z)*?T       x <- O <- I
2797   YAA           )*?Z)*?T        x <- O <- I
2798   YAA           Z)*?T           x <- O          # Temporary unset I
2799                                      I
2800
2801   YAAZ          Y(A)*?Z)*?T     x <- O
2802                                      I
2803
2804   YAAZY         (A)*?Z)*?T      x <- O
2805                                      I
2806
2807   YAAZY         A)*?Z)*?T       x <- O <- I
2808                                      I
2809
2810   YAAZYA        )*?Z)*?T        x <- O <- I
2811                                      I
2812
2813   YAAZYA        Z)*?T           x <- O          # Temporary unset I
2814                                      I,I
2815
2816   YAAZYAZ       )*?T            x <- O
2817                                      I,I
2818
2819   YAAZYAZ       T               x               # Temporary unset O
2820                                 O
2821                                 I,I
2822
2823   YAAZYAZT                      x
2824                                 O
2825                                 I,I
2826  *******************************************************************/
2827         case CURLYX: {
2828                 CURCUR cc;
2829                 CHECKPOINT cp = PL_savestack_ix;
2830                 /* No need to save/restore up to this paren */
2831                 I32 parenfloor = scan->flags;
2832
2833                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
2834                     next += ARG(next);
2835                 cc.oldcc = PL_regcc;
2836                 PL_regcc = &cc;
2837                 /* XXXX Probably it is better to teach regpush to support
2838                    parenfloor > PL_regsize... */
2839                 if (parenfloor > *PL_reglastparen)
2840                     parenfloor = *PL_reglastparen; /* Pessimization... */
2841                 cc.parenfloor = parenfloor;
2842                 cc.cur = -1;
2843                 cc.min = ARG1(scan);
2844                 cc.max  = ARG2(scan);
2845                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
2846                 cc.next = next;
2847                 cc.minmod = minmod;
2848                 cc.lastloc = 0;
2849                 PL_reginput = locinput;
2850                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
2851                 regcpblow(cp);
2852                 PL_regcc = cc.oldcc;
2853                 saySAME(n);
2854             }
2855             /* NOT REACHED */
2856         case WHILEM: {
2857                 /*
2858                  * This is really hard to understand, because after we match
2859                  * what we're trying to match, we must make sure the rest of
2860                  * the REx is going to match for sure, and to do that we have
2861                  * to go back UP the parse tree by recursing ever deeper.  And
2862                  * if it fails, we have to reset our parent's current state
2863                  * that we can try again after backing off.
2864                  */
2865
2866                 CHECKPOINT cp, lastcp;
2867                 CURCUR* cc = PL_regcc;
2868                 char *lastloc = cc->lastloc; /* Detection of 0-len. */
2869
2870                 n = cc->cur + 1;        /* how many we know we matched */
2871                 PL_reginput = locinput;
2872
2873                 DEBUG_r(
2874                     PerlIO_printf(Perl_debug_log,
2875                                   "%*s  %ld out of %ld..%ld  cc=%lx\n",
2876                                   REPORT_CODE_OFF+PL_regindent*2, "",
2877                                   (long)n, (long)cc->min,
2878                                   (long)cc->max, (long)cc)
2879                     );
2880
2881                 /* If degenerate scan matches "", assume scan done. */
2882
2883                 if (locinput == cc->lastloc && n >= cc->min) {
2884                     PL_regcc = cc->oldcc;
2885                     if (PL_regcc)
2886                         ln = PL_regcc->cur;
2887                     DEBUG_r(
2888                         PerlIO_printf(Perl_debug_log,
2889                            "%*s  empty match detected, try continuation...\n",
2890                            REPORT_CODE_OFF+PL_regindent*2, "")
2891                         );
2892                     if (regmatch(cc->next))
2893                         sayYES;
2894                     if (PL_regcc)
2895                         PL_regcc->cur = ln;
2896                     PL_regcc = cc;
2897                     sayNO;
2898                 }
2899
2900                 /* First just match a string of min scans. */
2901
2902                 if (n < cc->min) {
2903                     cc->cur = n;
2904                     cc->lastloc = locinput;
2905                     if (regmatch(cc->scan))
2906                         sayYES;
2907                     cc->cur = n - 1;
2908                     cc->lastloc = lastloc;
2909                     sayNO;
2910                 }
2911
2912                 if (scan->flags) {
2913                     /* Check whether we already were at this position.
2914                         Postpone detection until we know the match is not
2915                         *that* much linear. */
2916                 if (!PL_reg_maxiter) {
2917                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
2918                     PL_reg_leftiter = PL_reg_maxiter;
2919                 }
2920                 if (PL_reg_leftiter-- == 0) {
2921                     I32 size = (PL_reg_maxiter + 7)/8;
2922                     if (PL_reg_poscache) {
2923                         if (PL_reg_poscache_size < size) {
2924                             Renew(PL_reg_poscache, size, char);
2925                             PL_reg_poscache_size = size;
2926                         }
2927                         Zero(PL_reg_poscache, size, char);
2928                     }
2929                     else {
2930                         PL_reg_poscache_size = size;
2931                         Newz(29, PL_reg_poscache, size, char);
2932                     }
2933                     DEBUG_r(
2934                         PerlIO_printf(Perl_debug_log,
2935               "%sDetected a super-linear match, switching on caching%s...\n",
2936                                       PL_colors[4], PL_colors[5])
2937                         );
2938                 }
2939                 if (PL_reg_leftiter < 0) {
2940                     I32 o = locinput - PL_bostr, b;
2941
2942                     o = (scan->flags & 0xf) - 1 + o * (scan->flags>>4);
2943                     b = o % 8;
2944                     o /= 8;
2945                     if (PL_reg_poscache[o] & (1<<b)) {
2946                     DEBUG_r(
2947                         PerlIO_printf(Perl_debug_log,
2948                                       "%*s  already tried at this position...\n",
2949                                       REPORT_CODE_OFF+PL_regindent*2, "")
2950                         );
2951                         sayNO_SILENT;
2952                     }
2953                     PL_reg_poscache[o] |= (1<<b);
2954                 }
2955                 }
2956
2957                 /* Prefer next over scan for minimal matching. */
2958
2959                 if (cc->minmod) {
2960                     PL_regcc = cc->oldcc;
2961                     if (PL_regcc)
2962                         ln = PL_regcc->cur;
2963                     cp = regcppush(cc->parenfloor);
2964                     REGCP_SET(lastcp);
2965                     if (regmatch(cc->next)) {
2966                         regcpblow(cp);
2967                         sayYES; /* All done. */
2968                     }
2969                     REGCP_UNWIND(lastcp);
2970                     regcppop();
2971                     if (PL_regcc)
2972                         PL_regcc->cur = ln;
2973                     PL_regcc = cc;
2974
2975                     if (n >= cc->max) { /* Maximum greed exceeded? */
2976                         if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
2977                             && !(PL_reg_flags & RF_warned)) {
2978                             PL_reg_flags |= RF_warned;
2979                             Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded",
2980                                  "Complex regular subexpression recursion",
2981                                  REG_INFTY - 1);
2982                         }
2983                         sayNO;
2984                     }
2985
2986                     DEBUG_r(
2987                         PerlIO_printf(Perl_debug_log,
2988                                       "%*s  trying longer...\n",
2989                                       REPORT_CODE_OFF+PL_regindent*2, "")
2990                         );
2991                     /* Try scanning more and see if it helps. */
2992                     PL_reginput = locinput;
2993                     cc->cur = n;
2994                     cc->lastloc = locinput;
2995                     cp = regcppush(cc->parenfloor);
2996                     REGCP_SET(lastcp);
2997                     if (regmatch(cc->scan)) {
2998                         regcpblow(cp);
2999                         sayYES;
3000                     }
3001                     REGCP_UNWIND(lastcp);
3002                     regcppop();
3003                     cc->cur = n - 1;
3004                     cc->lastloc = lastloc;
3005                     sayNO;
3006                 }
3007
3008                 /* Prefer scan over next for maximal matching. */
3009
3010                 if (n < cc->max) {      /* More greed allowed? */
3011                     cp = regcppush(cc->parenfloor);
3012                     cc->cur = n;
3013                     cc->lastloc = locinput;
3014                     REGCP_SET(lastcp);
3015                     if (regmatch(cc->scan)) {
3016                         regcpblow(cp);
3017                         sayYES;
3018                     }
3019                     REGCP_UNWIND(lastcp);
3020                     regcppop();         /* Restore some previous $<digit>s? */
3021                     PL_reginput = locinput;
3022                     DEBUG_r(
3023                         PerlIO_printf(Perl_debug_log,
3024                                       "%*s  failed, try continuation...\n",
3025                                       REPORT_CODE_OFF+PL_regindent*2, "")
3026                         );
3027                 }
3028                 if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3029                         && !(PL_reg_flags & RF_warned)) {
3030                     PL_reg_flags |= RF_warned;
3031                     Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded",
3032                          "Complex regular subexpression recursion",
3033                          REG_INFTY - 1);
3034                 }
3035
3036                 /* Failed deeper matches of scan, so see if this one works. */
3037                 PL_regcc = cc->oldcc;
3038                 if (PL_regcc)
3039                     ln = PL_regcc->cur;
3040                 if (regmatch(cc->next))
3041                     sayYES;
3042                 if (PL_regcc)
3043                     PL_regcc->cur = ln;
3044                 PL_regcc = cc;
3045                 cc->cur = n - 1;
3046                 cc->lastloc = lastloc;
3047                 sayNO;
3048             }
3049             /* NOT REACHED */
3050         case BRANCHJ:
3051             next = scan + ARG(scan);
3052             if (next == scan)
3053                 next = NULL;
3054             inner = NEXTOPER(NEXTOPER(scan));
3055             goto do_branch;
3056         case BRANCH:
3057             inner = NEXTOPER(scan);
3058           do_branch:
3059             {
3060                 c1 = OP(scan);
3061                 if (OP(next) != c1)     /* No choice. */
3062                     next = inner;       /* Avoid recursion. */
3063                 else {
3064                     I32 lastparen = *PL_reglastparen;
3065                     I32 unwind1;
3066                     re_unwind_branch_t *uw;
3067
3068                     /* Put unwinding data on stack */
3069                     unwind1 = SSNEWt(1,re_unwind_branch_t);
3070                     uw = SSPTRt(unwind1,re_unwind_branch_t);
3071                     uw->prev = unwind;
3072                     unwind = unwind1;
3073                     uw->type = ((c1 == BRANCH)
3074                                 ? RE_UNWIND_BRANCH
3075                                 : RE_UNWIND_BRANCHJ);
3076                     uw->lastparen = lastparen;
3077                     uw->next = next;
3078                     uw->locinput = locinput;
3079                     uw->nextchr = nextchr;
3080 #ifdef DEBUGGING
3081                     uw->regindent = ++PL_regindent;
3082 #endif
3083
3084                     REGCP_SET(uw->lastcp);
3085
3086                     /* Now go into the first branch */
3087                     next = inner;
3088                 }
3089             }
3090             break;
3091         case MINMOD:
3092             minmod = 1;
3093             break;
3094         case CURLYM:
3095         {
3096             I32 l = 0;
3097             CHECKPOINT lastcp;
3098
3099             /* We suppose that the next guy does not need
3100                backtracking: in particular, it is of constant length,
3101                and has no parenths to influence future backrefs. */
3102             ln = ARG1(scan);  /* min to match */
3103             n  = ARG2(scan);  /* max to match */
3104             paren = scan->flags;
3105             if (paren) {
3106                 if (paren > PL_regsize)
3107                     PL_regsize = paren;
3108                 if (paren > *PL_reglastparen)
3109                     *PL_reglastparen = paren;
3110             }
3111             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3112             if (paren)
3113                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
3114             PL_reginput = locinput;
3115             if (minmod) {
3116                 minmod = 0;
3117                 if (ln && regrepeat_hard(scan, ln, &l) < ln)
3118                     sayNO;
3119                 /* if we matched something zero-length we don't need to
3120                    backtrack - capturing parens are already defined, so
3121                    the caveat in the maximal case doesn't apply
3122
3123                    XXXX if ln == 0, we can redo this check first time
3124                    through the following loop
3125                 */
3126                 if (ln && l == 0)
3127                     n = ln;     /* don't backtrack */
3128                 locinput = PL_reginput;
3129                 if (HAS_TEXT(next) || JUMPABLE(next)) {
3130                     regnode *text_node = next;
3131
3132                     if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3133
3134                     if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3135                     else {
3136                         if (PL_regkind[(U8)OP(text_node)] == REF) {
3137                             I32 n, ln;
3138                             n = ARG(text_node);  /* which paren pair */
3139                             ln = PL_regstartp[n];
3140                             /* assume yes if we haven't seen CLOSEn */
3141                             if (
3142                                 *PL_reglastparen < n ||
3143                                 ln == -1 ||
3144                                 ln == PL_regendp[n]
3145                             ) {
3146                                 c1 = c2 = -1000;
3147                                 goto assume_ok_MM;
3148                             }
3149                             c1 = *(PL_bostr + ln);
3150                         }
3151                         else { c1 = (U8)*STRING(text_node); }
3152                         if (OP(next) == EXACTF)
3153                             c2 = PL_fold[c1];
3154                         else if (OP(text_node) == EXACTFL)
3155                             c2 = PL_fold_locale[c1];
3156                         else
3157                             c2 = c1;
3158                     }
3159                 }
3160                 else
3161                     c1 = c2 = -1000;
3162             assume_ok_MM:
3163                 REGCP_SET(lastcp);
3164                 /* This may be improved if l == 0.  */
3165                 while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */
3166                     /* If it could work, try it. */
3167                     if (c1 == -1000 ||
3168                         UCHARAT(PL_reginput) == c1 ||
3169                         UCHARAT(PL_reginput) == c2)
3170                     {
3171                         if (paren) {
3172                             if (ln) {
3173                                 PL_regstartp[paren] =
3174                                     HOPc(PL_reginput, -l) - PL_bostr;
3175                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3176                             }
3177                             else
3178                                 PL_regendp[paren] = -1;
3179                         }
3180                         if (regmatch(next))
3181                             sayYES;
3182                         REGCP_UNWIND(lastcp);
3183                     }
3184                     /* Couldn't or didn't -- move forward. */
3185                     PL_reginput = locinput;
3186                     if (regrepeat_hard(scan, 1, &l)) {
3187                         ln++;
3188                         locinput = PL_reginput;
3189                     }
3190                     else
3191                         sayNO;
3192                 }
3193             }
3194             else {
3195                 n = regrepeat_hard(scan, n, &l);
3196                 /* if we matched something zero-length we don't need to
3197                    backtrack, unless the minimum count is zero and we
3198                    are capturing the result - in that case the capture
3199                    being defined or not may affect later execution
3200                 */
3201                 if (n != 0 && l == 0 && !(paren && ln == 0))
3202                     ln = n;     /* don't backtrack */
3203                 locinput = PL_reginput;
3204                 DEBUG_r(
3205                     PerlIO_printf(Perl_debug_log,
3206                                   "%*s  matched %"IVdf" times, len=%"IVdf"...\n",
3207                                   (int)(REPORT_CODE_OFF+PL_regindent*2), "",
3208                                   (IV) n, (IV)l)
3209                     );
3210                 if (n >= ln) {
3211                     if (HAS_TEXT(next) || JUMPABLE(next)) {
3212                         regnode *text_node = next;
3213
3214                         if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3215
3216                         if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3217                         else {
3218                             if (PL_regkind[(U8)OP(text_node)] == REF) {
3219                                 I32 n, ln;
3220                                 n = ARG(text_node);  /* which paren pair */
3221                                 ln = PL_regstartp[n];
3222                                 /* assume yes if we haven't seen CLOSEn */
3223                                 if (
3224                                     *PL_reglastparen < n ||
3225                                     ln == -1 ||
3226                                     ln == PL_regendp[n]
3227                                 ) {
3228                                     c1 = c2 = -1000;
3229                                     goto assume_ok_REG;
3230                                 }
3231                                 c1 = *(PL_bostr + ln);
3232                             }
3233                             else { c1 = (U8)*STRING(text_node); }
3234
3235                             if (OP(text_node) == EXACTF)
3236                                 c2 = PL_fold[c1];
3237                             else if (OP(text_node) == EXACTFL)
3238                                 c2 = PL_fold_locale[c1];
3239                             else
3240                                 c2 = c1;
3241                         }
3242                     }
3243                     else
3244                         c1 = c2 = -1000;
3245                 }
3246             assume_ok_REG:
3247                 REGCP_SET(lastcp);
3248                 while (n >= ln) {
3249                     /* If it could work, try it. */
3250                     if (c1 == -1000 ||
3251                         UCHARAT(PL_reginput) == c1 ||
3252                         UCHARAT(PL_reginput) == c2)
3253                     {
3254                         DEBUG_r(
3255                                 PerlIO_printf(Perl_debug_log,
3256                                               "%*s  trying tail with n=%"IVdf"...\n",
3257                                               (int)(REPORT_CODE_OFF+PL_regindent*2), "", (IV)n)
3258                             );
3259                         if (paren) {
3260                             if (n) {
3261                                 PL_regstartp[paren] = HOPc(PL_reginput, -l) - PL_bostr;
3262                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3263                             }
3264                             else
3265                                 PL_regendp[paren] = -1;
3266                         }
3267                         if (regmatch(next))
3268                             sayYES;
3269                         REGCP_UNWIND(lastcp);
3270                     }
3271                     /* Couldn't or didn't -- back up. */
3272                     n--;
3273                     locinput = HOPc(locinput, -l);
3274                     PL_reginput = locinput;
3275                 }
3276             }
3277             sayNO;
3278             break;
3279         }
3280         case CURLYN:
3281             paren = scan->flags;        /* Which paren to set */
3282             if (paren > PL_regsize)
3283                 PL_regsize = paren;
3284             if (paren > *PL_reglastparen)
3285                 *PL_reglastparen = paren;
3286             ln = ARG1(scan);  /* min to match */
3287             n  = ARG2(scan);  /* max to match */
3288             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
3289             goto repeat;
3290         case CURLY:
3291             paren = 0;
3292             ln = ARG1(scan);  /* min to match */
3293             n  = ARG2(scan);  /* max to match */
3294             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3295             goto repeat;
3296         case STAR:
3297             ln = 0;
3298             n = REG_INFTY;
3299             scan = NEXTOPER(scan);
3300             paren = 0;
3301             goto repeat;
3302         case PLUS:
3303             ln = 1;
3304             n = REG_INFTY;
3305             scan = NEXTOPER(scan);
3306             paren = 0;
3307           repeat:
3308             /*
3309             * Lookahead to avoid useless match attempts
3310             * when we know what character comes next.
3311             */
3312
3313             /*
3314             * Used to only do .*x and .*?x, but now it allows
3315             * for )'s, ('s and (?{ ... })'s to be in the way
3316             * of the quantifier and the EXACT-like node.  -- japhy
3317             */
3318
3319             if (HAS_TEXT(next) || JUMPABLE(next)) {
3320                 U8 *s;
3321                 regnode *text_node = next;
3322
3323                 if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3324
3325                 if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3326                 else {
3327                     if (PL_regkind[(U8)OP(text_node)] == REF) {
3328                         I32 n, ln;
3329                         n = ARG(text_node);  /* which paren pair */
3330                         ln = PL_regstartp[n];
3331                         /* assume yes if we haven't seen CLOSEn */
3332                         if (
3333                             *PL_reglastparen < n ||
3334                             ln == -1 ||
3335                             ln == PL_regendp[n]
3336                         ) {
3337                             c1 = c2 = -1000;
3338                             goto assume_ok_easy;
3339                         }
3340                         s = (U8*)PL_bostr + ln;
3341                     }
3342                     else { s = (U8*)STRING(text_node); }
3343
3344                     if (!UTF) {
3345                         c2 = c1 = *s;
3346                         if (OP(text_node) == EXACTF)
3347                             c2 = PL_fold[c1];
3348                         else if (OP(text_node) == EXACTFL)
3349                             c2 = PL_fold_locale[c1];
3350                     }
3351                     else { /* UTF */
3352                         if (OP(text_node) == EXACTF) {
3353                              STRLEN ulen1, ulen2;
3354                              U8 tmpbuf1[UTF8_MAXLEN*2+1];
3355                              U8 tmpbuf2[UTF8_MAXLEN*2+1];
3356
3357                              to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
3358                              to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
3359
3360                              c1 = utf8_to_uvuni(tmpbuf1, 0);
3361                              c2 = utf8_to_uvuni(tmpbuf2, 0);
3362                         }
3363                         else {
3364                             c2 = c1 = utf8_to_uvchr(s, NULL);
3365                         }
3366                     }
3367                 }
3368             }
3369             else
3370                 c1 = c2 = -1000;
3371         assume_ok_easy:
3372             PL_reginput = locinput;
3373             if (minmod) {
3374                 CHECKPOINT lastcp;
3375                 minmod = 0;
3376                 if (ln && regrepeat(scan, ln) < ln)
3377                     sayNO;
3378                 locinput = PL_reginput;
3379                 REGCP_SET(lastcp);
3380                 if (c1 != -1000) {
3381                     char *e; /* Should not check after this */
3382                     char *old = locinput;
3383
3384                     if  (n == REG_INFTY) {
3385                         e = PL_regeol - 1;
3386                         if (do_utf8)
3387                             while (UTF8_IS_CONTINUATION(*(U8*)e))
3388                                 e--;
3389                     }
3390                     else if (do_utf8) {
3391                         int m = n - ln;
3392                         for (e = locinput;
3393                              m >0 && e + UTF8SKIP(e) <= PL_regeol; m--)
3394                             e += UTF8SKIP(e);
3395                     }
3396                     else {
3397                         e = locinput + n - ln;
3398                         if (e >= PL_regeol)
3399                             e = PL_regeol - 1;
3400                     }
3401                     while (1) {
3402                         int count;
3403                         /* Find place 'next' could work */
3404                         if (!do_utf8) {
3405                             if (c1 == c2) {
3406                                 while (locinput <= e &&
3407                                        UCHARAT(locinput) != c1)
3408                                     locinput++;
3409                             } else {
3410                                 while (locinput <= e
3411                                        && UCHARAT(locinput) != c1
3412                                        && UCHARAT(locinput) != c2)
3413                                     locinput++;
3414                             }
3415                             count = locinput - old;
3416                         }
3417                         else {
3418                             STRLEN len;
3419                             if (c1 == c2) {
3420                                 for (count = 0;
3421                                      locinput <= e &&
3422                                          utf8_to_uvchr((U8*)locinput, &len) != c1;
3423                                      count++)
3424                                     locinput += len;
3425
3426                             } else {
3427                                 for (count = 0; locinput <= e; count++) {
3428                                     UV c = utf8_to_uvchr((U8*)locinput, &len);
3429                                     if (c == c1 || c == c2)
3430                                         break;
3431                                     locinput += len;
3432                                 }
3433                             }
3434                         }
3435                         if (locinput > e)
3436                             sayNO;
3437                         /* PL_reginput == old now */
3438                         if (locinput != old) {
3439                             ln = 1;     /* Did some */
3440                             if (regrepeat(scan, count) < count)
3441                                 sayNO;
3442                         }
3443                         /* PL_reginput == locinput now */
3444                         TRYPAREN(paren, ln, locinput);
3445                         PL_reginput = locinput; /* Could be reset... */
3446                         REGCP_UNWIND(lastcp);
3447                         /* Couldn't or didn't -- move forward. */
3448                         old = locinput;
3449                         if (do_utf8)
3450                             locinput += UTF8SKIP(locinput);
3451                         else
3452                             locinput++;
3453                     }
3454                 }
3455                 else
3456                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
3457                     UV c;
3458                     if (c1 != -1000) {
3459                         if (do_utf8)
3460                             c = utf8_to_uvchr((U8*)PL_reginput, NULL);
3461                         else
3462                             c = UCHARAT(PL_reginput);
3463                         /* If it could work, try it. */
3464                         if (c == c1 || c == c2)
3465                         {
3466                             TRYPAREN(paren, n, PL_reginput);
3467                             REGCP_UNWIND(lastcp);
3468                         }
3469                     }
3470                     /* If it could work, try it. */
3471                     else if (c1 == -1000)
3472                     {
3473                         TRYPAREN(paren, n, PL_reginput);
3474                         REGCP_UNWIND(lastcp);
3475                     }
3476                     /* Couldn't or didn't -- move forward. */
3477                     PL_reginput = locinput;
3478                     if (regrepeat(scan, 1)) {
3479                         ln++;
3480                         locinput = PL_reginput;
3481                     }
3482                     else
3483                         sayNO;
3484                 }
3485             }
3486             else {
3487                 CHECKPOINT lastcp;
3488                 n = regrepeat(scan, n);
3489                 locinput = PL_reginput;
3490                 if (ln < n && PL_regkind[(U8)OP(next)] == EOL &&
3491                     (!PL_multiline  || OP(next) == SEOL || OP(next) == EOS)) {
3492                     ln = n;                     /* why back off? */
3493                     /* ...because $ and \Z can match before *and* after
3494                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
3495                        We should back off by one in this case. */
3496                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(next) != EOS)
3497                         ln--;
3498                 }
3499                 REGCP_SET(lastcp);
3500                 if (paren) {
3501                     UV c = 0;
3502                     while (n >= ln) {
3503                         if (c1 != -1000) {
3504                             if (do_utf8)
3505                                 c = utf8_to_uvchr((U8*)PL_reginput, NULL);
3506                             else
3507                                 c = UCHARAT(PL_reginput);
3508                         }
3509                         /* If it could work, try it. */
3510                         if (c1 == -1000 || c == c1 || c == c2)
3511                             {
3512                                 TRYPAREN(paren, n, PL_reginput);
3513                                 REGCP_UNWIND(lastcp);
3514                             }
3515                         /* Couldn't or didn't -- back up. */
3516                         n--;
3517                         PL_reginput = locinput = HOPc(locinput, -1);
3518                     }
3519                 }
3520                 else {
3521                     UV c = 0;
3522                     while (n >= ln) {
3523                         if (c1 != -1000) {
3524                             if (do_utf8)
3525                                 c = utf8_to_uvchr((U8*)PL_reginput, NULL);
3526                             else
3527                                 c = UCHARAT(PL_reginput);
3528                         }
3529                         /* If it could work, try it. */
3530                         if (c1 == -1000 || c == c1 || c == c2)
3531                             {
3532                                 TRYPAREN(paren, n, PL_reginput);
3533                                 REGCP_UNWIND(lastcp);
3534                             }
3535                         /* Couldn't or didn't -- back up. */
3536                         n--;
3537                         PL_reginput = locinput = HOPc(locinput, -1);
3538                     }
3539                 }
3540             }
3541             sayNO;
3542             break;
3543         case END:
3544             if (PL_reg_call_cc) {
3545                 re_cc_state *cur_call_cc = PL_reg_call_cc;
3546                 CURCUR *cctmp = PL_regcc;
3547                 regexp *re = PL_reg_re;
3548                 CHECKPOINT cp, lastcp;
3549
3550                 cp = regcppush(0);      /* Save *all* the positions. */
3551                 REGCP_SET(lastcp);
3552                 regcp_set_to(PL_reg_call_cc->ss); /* Restore parens of
3553                                                     the caller. */
3554                 PL_reginput = locinput; /* Make position available to
3555                                            the callcc. */
3556                 cache_re(PL_reg_call_cc->re);
3557                 PL_regcc = PL_reg_call_cc->cc;
3558                 PL_reg_call_cc = PL_reg_call_cc->prev;
3559                 if (regmatch(cur_call_cc->node)) {
3560                     PL_reg_call_cc = cur_call_cc;
3561                     regcpblow(cp);
3562                     sayYES;
3563                 }
3564                 REGCP_UNWIND(lastcp);
3565                 regcppop();
3566                 PL_reg_call_cc = cur_call_cc;
3567                 PL_regcc = cctmp;
3568                 PL_reg_re = re;
3569                 cache_re(re);
3570
3571                 DEBUG_r(
3572                     PerlIO_printf(Perl_debug_log,
3573                                   "%*s  continuation failed...\n",
3574                                   REPORT_CODE_OFF+PL_regindent*2, "")
3575                     );
3576                 sayNO_SILENT;
3577             }
3578             if (locinput < PL_regtill) {
3579                 DEBUG_r(PerlIO_printf(Perl_debug_log,
3580                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
3581                                       PL_colors[4],
3582                                       (long)(locinput - PL_reg_starttry),
3583                                       (long)(PL_regtill - PL_reg_starttry),
3584                                       PL_colors[5]));
3585                 sayNO_FINAL;            /* Cannot match: too short. */
3586             }
3587             PL_reginput = locinput;     /* put where regtry can find it */
3588             sayYES_FINAL;               /* Success! */
3589         case SUCCEED:
3590             PL_reginput = locinput;     /* put where regtry can find it */
3591             sayYES_LOUD;                /* Success! */
3592         case SUSPEND:
3593             n = 1;
3594             PL_reginput = locinput;
3595             goto do_ifmatch;
3596         case UNLESSM:
3597             n = 0;
3598             if (scan->flags) {
3599                 s = HOPBACKc(locinput, scan->flags);
3600                 if (!s)
3601                     goto say_yes;
3602                 PL_reginput = s;
3603             }
3604             else
3605                 PL_reginput = locinput;
3606             goto do_ifmatch;
3607         case IFMATCH:
3608             n = 1;
3609             if (scan->flags) {
3610                 s = HOPBACKc(locinput, scan->flags);
3611                 if (!s)
3612                     goto say_no;
3613                 PL_reginput = s;
3614             }
3615             else
3616                 PL_reginput = locinput;
3617
3618           do_ifmatch:
3619             inner = NEXTOPER(NEXTOPER(scan));
3620             if (regmatch(inner) != n) {
3621               say_no:
3622                 if (logical) {
3623                     logical = 0;
3624                     sw = 0;
3625                     goto do_longjump;
3626                 }
3627                 else
3628                     sayNO;
3629             }
3630           say_yes:
3631             if (logical) {
3632                 logical = 0;
3633                 sw = 1;
3634             }
3635             if (OP(scan) == SUSPEND) {
3636                 locinput = PL_reginput;
3637                 nextchr = UCHARAT(locinput);
3638             }
3639             /* FALL THROUGH. */
3640         case LONGJMP:
3641           do_longjump:
3642             next = scan + ARG(scan);
3643             if (next == scan)
3644                 next = NULL;
3645             break;
3646         default:
3647             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
3648                           PTR2UV(scan), OP(scan));
3649             Perl_croak(aTHX_ "regexp memory corruption");
3650         }
3651       reenter:
3652         scan = next;
3653     }
3654
3655     /*
3656     * We get here only if there's trouble -- normally "case END" is
3657     * the terminating point.
3658     */
3659     Perl_croak(aTHX_ "corrupted regexp pointers");
3660     /*NOTREACHED*/
3661     sayNO;
3662
3663 yes_loud:
3664     DEBUG_r(
3665         PerlIO_printf(Perl_debug_log,
3666                       "%*s  %scould match...%s\n",
3667                       REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],PL_colors[5])
3668         );
3669     goto yes;
3670 yes_final:
3671     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
3672                           PL_colors[4],PL_colors[5]));
3673 yes:
3674 #ifdef DEBUGGING
3675     PL_regindent--;
3676 #endif
3677
3678 #if 0                                   /* Breaks $^R */
3679     if (unwind)
3680         regcpblow(firstcp);
3681 #endif
3682     return 1;
3683
3684 no:
3685     DEBUG_r(
3686         PerlIO_printf(Perl_debug_log,
3687                       "%*s  %sfailed...%s\n",
3688                       REPORT_CODE_OFF+PL_regindent*2, "",PL_colors[4],PL_colors[5])
3689         );
3690     goto do_no;
3691 no_final:
3692 do_no:
3693     if (unwind) {
3694         re_unwind_t *uw = SSPTRt(unwind,re_unwind_t);
3695
3696         switch (uw->type) {
3697         case RE_UNWIND_BRANCH:
3698         case RE_UNWIND_BRANCHJ:
3699         {
3700             re_unwind_branch_t *uwb = &(uw->branch);
3701             I32 lastparen = uwb->lastparen;
3702
3703             REGCP_UNWIND(uwb->lastcp);
3704             for (n = *PL_reglastparen; n > lastparen; n--)
3705                 PL_regendp[n] = -1;
3706             *PL_reglastparen = n;
3707             scan = next = uwb->next;
3708             if ( !scan ||
3709                  OP(scan) != (uwb->type == RE_UNWIND_BRANCH
3710                               ? BRANCH : BRANCHJ) ) {           /* Failure */
3711                 unwind = uwb->prev;
3712 #ifdef DEBUGGING
3713                 PL_regindent--;
3714 #endif
3715                 goto do_no;
3716             }
3717             /* Have more choice yet.  Reuse the same uwb.  */
3718             /*SUPPRESS 560*/
3719             if ((n = (uwb->type == RE_UNWIND_BRANCH
3720                       ? NEXT_OFF(next) : ARG(next))))
3721                 next += n;
3722             else
3723                 next = NULL;    /* XXXX Needn't unwinding in this case... */
3724             uwb->next = next;
3725             next = NEXTOPER(scan);
3726             if (uwb->type == RE_UNWIND_BRANCHJ)
3727                 next = NEXTOPER(next);
3728             locinput = uwb->locinput;
3729             nextchr = uwb->nextchr;
3730 #ifdef DEBUGGING
3731             PL_regindent = uwb->regindent;
3732 #endif
3733
3734             goto reenter;
3735         }
3736         /* NOT REACHED */
3737         default:
3738             Perl_croak(aTHX_ "regexp unwind memory corruption");
3739         }
3740         /* NOT REACHED */
3741     }
3742 #ifdef DEBUGGING
3743     PL_regindent--;
3744 #endif
3745     return 0;
3746 }
3747
3748 /*
3749  - regrepeat - repeatedly match something simple, report how many
3750  */
3751 /*
3752  * [This routine now assumes that it will only match on things of length 1.
3753  * That was true before, but now we assume scan - reginput is the count,
3754  * rather than incrementing count on every character.  [Er, except utf8.]]
3755  */
3756 STATIC I32
3757 S_regrepeat(pTHX_ regnode *p, I32 max)
3758 {
3759     register char *scan;
3760     register I32 c;
3761     register char *loceol = PL_regeol;
3762     register I32 hardcount = 0;
3763     register bool do_utf8 = PL_reg_match_utf8;
3764
3765     scan = PL_reginput;
3766     if (max != REG_INFTY && max < loceol - scan)
3767       loceol = scan + max;
3768     switch (OP(p)) {
3769     case REG_ANY:
3770         if (do_utf8) {
3771             loceol = PL_regeol;
3772             while (scan < loceol && hardcount < max && *scan != '\n') {
3773                 scan += UTF8SKIP(scan);
3774                 hardcount++;
3775             }
3776         } else {
3777             while (scan < loceol && *scan != '\n')
3778                 scan++;
3779         }
3780         break;
3781     case SANY:
3782         scan = loceol;
3783         break;
3784     case CANY:
3785         scan = loceol;
3786         break;
3787     case EXACT:         /* length of string is 1 */
3788         c = (U8)*STRING(p);
3789         while (scan < loceol && UCHARAT(scan) == c)
3790             scan++;
3791         break;
3792     case EXACTF:        /* length of string is 1 */
3793         c = (U8)*STRING(p);
3794         while (scan < loceol &&
3795                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
3796             scan++;
3797         break;
3798     case EXACTFL:       /* length of string is 1 */
3799         PL_reg_flags |= RF_tainted;
3800         c = (U8)*STRING(p);
3801         while (scan < loceol &&
3802                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
3803             scan++;
3804         break;
3805     case ANYOF:
3806         if (do_utf8) {
3807             loceol = PL_regeol;
3808             while (hardcount < max && scan < loceol &&
3809                    reginclass(p, (U8*)scan, do_utf8)) {
3810                 scan += UTF8SKIP(scan);
3811                 hardcount++;
3812             }
3813         } else {
3814             while (scan < loceol && reginclass(p, (U8*)scan, do_utf8))
3815                 scan++;
3816         }
3817         break;
3818     case ALNUM:
3819         if (do_utf8) {
3820             loceol = PL_regeol;
3821             LOAD_UTF8_CHARCLASS(alnum,"a");
3822             while (hardcount < max && scan < loceol &&
3823                    swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
3824                 scan += UTF8SKIP(scan);
3825                 hardcount++;
3826             }
3827         } else {
3828             while (scan < loceol && isALNUM(*scan))
3829                 scan++;
3830         }
3831         break;
3832     case ALNUML:
3833         PL_reg_flags |= RF_tainted;
3834         if (do_utf8) {
3835             loceol = PL_regeol;
3836             while (hardcount < max && scan < loceol &&
3837                    isALNUM_LC_utf8((U8*)scan)) {
3838                 scan += UTF8SKIP(scan);
3839                 hardcount++;
3840             }
3841         } else {
3842             while (scan < loceol && isALNUM_LC(*scan))
3843                 scan++;
3844         }
3845         break;
3846     case NALNUM:
3847         if (do_utf8) {
3848             loceol = PL_regeol;
3849             LOAD_UTF8_CHARCLASS(alnum,"a");
3850             while (hardcount < max && scan < loceol &&
3851                    !swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
3852                 scan += UTF8SKIP(scan);
3853                 hardcount++;
3854             }
3855         } else {
3856             while (scan < loceol && !isALNUM(*scan))
3857                 scan++;
3858         }
3859         break;
3860     case NALNUML:
3861         PL_reg_flags |= RF_tainted;
3862         if (do_utf8) {
3863             loceol = PL_regeol;
3864             while (hardcount < max && scan < loceol &&
3865                    !isALNUM_LC_utf8((U8*)scan)) {
3866                 scan += UTF8SKIP(scan);
3867                 hardcount++;
3868             }
3869         } else {
3870             while (scan < loceol && !isALNUM_LC(*scan))
3871                 scan++;
3872         }
3873         break;
3874     case SPACE:
3875         if (do_utf8) {
3876             loceol = PL_regeol;
3877             LOAD_UTF8_CHARCLASS(space," ");
3878             while (hardcount < max && scan < loceol &&
3879                    (*scan == ' ' ||
3880                     swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
3881                 scan += UTF8SKIP(scan);
3882                 hardcount++;
3883             }
3884         } else {
3885             while (scan < loceol && isSPACE(*scan))
3886                 scan++;
3887         }
3888         break;
3889     case SPACEL:
3890         PL_reg_flags |= RF_tainted;
3891         if (do_utf8) {
3892             loceol = PL_regeol;
3893             while (hardcount < max && scan < loceol &&
3894                    (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
3895                 scan += UTF8SKIP(scan);
3896                 hardcount++;
3897             }
3898         } else {
3899             while (scan < loceol && isSPACE_LC(*scan))
3900                 scan++;
3901         }
3902         break;
3903     case NSPACE:
3904         if (do_utf8) {
3905             loceol = PL_regeol;
3906             LOAD_UTF8_CHARCLASS(space," ");
3907             while (hardcount < max && scan < loceol &&
3908                    !(*scan == ' ' ||
3909                      swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
3910                 scan += UTF8SKIP(scan);
3911                 hardcount++;
3912             }
3913         } else {
3914             while (scan < loceol && !isSPACE(*scan))
3915                 scan++;
3916             break;
3917         }
3918     case NSPACEL:
3919         PL_reg_flags |= RF_tainted;
3920         if (do_utf8) {
3921             loceol = PL_regeol;
3922             while (hardcount < max && scan < loceol &&
3923                    !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
3924                 scan += UTF8SKIP(scan);
3925                 hardcount++;
3926             }
3927         } else {
3928             while (scan < loceol && !isSPACE_LC(*scan))
3929                 scan++;
3930         }
3931         break;
3932     case DIGIT:
3933         if (do_utf8) {
3934             loceol = PL_regeol;
3935             LOAD_UTF8_CHARCLASS(digit,"0");
3936             while (hardcount < max && scan < loceol &&
3937                    swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
3938                 scan += UTF8SKIP(scan);
3939                 hardcount++;
3940             }
3941         } else {
3942             while (scan < loceol && isDIGIT(*scan))
3943                 scan++;
3944         }
3945         break;
3946     case NDIGIT:
3947         if (do_utf8) {
3948             loceol = PL_regeol;
3949             LOAD_UTF8_CHARCLASS(digit,"0");
3950             while (hardcount < max && scan < loceol &&
3951                    !swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
3952                 scan += UTF8SKIP(scan);
3953                 hardcount++;
3954             }
3955         } else {
3956             while (scan < loceol && !isDIGIT(*scan))
3957                 scan++;
3958         }
3959         break;
3960     default:            /* Called on something of 0 width. */
3961         break;          /* So match right here or not at all. */
3962     }
3963
3964     if (hardcount)
3965         c = hardcount;
3966     else
3967         c = scan - PL_reginput;
3968     PL_reginput = scan;
3969
3970     DEBUG_r(
3971         {
3972                 SV *prop = sv_newmortal();
3973
3974                 regprop(prop, p);
3975                 PerlIO_printf(Perl_debug_log,
3976                               "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
3977                               REPORT_CODE_OFF+1, "", SvPVX(prop),(IV)c,(IV)max);
3978         });
3979
3980     return(c);
3981 }
3982
3983 /*
3984  - regrepeat_hard - repeatedly match something, report total lenth and length
3985  *
3986  * The repeater is supposed to have constant length.
3987  */
3988
3989 STATIC I32
3990 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp)
3991 {
3992     register char *scan = Nullch;
3993     register char *start;
3994     register char *loceol = PL_regeol;
3995     I32 l = 0;
3996     I32 count = 0, res = 1;
3997
3998     if (!max)
3999         return 0;
4000
4001     start = PL_reginput;
4002     if (PL_reg_match_utf8) {
4003         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
4004             if (!count++) {
4005                 l = 0;
4006                 while (start < PL_reginput) {
4007                     l++;
4008                     start += UTF8SKIP(start);
4009                 }
4010                 *lp = l;
4011                 if (l == 0)
4012                     return max;
4013             }
4014             if (count == max)
4015                 return count;
4016         }
4017     }
4018     else {
4019         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
4020             if (!count++) {
4021                 *lp = l = PL_reginput - start;
4022                 if (max != REG_INFTY && l*max < loceol - scan)
4023                     loceol = scan + l*max;
4024                 if (l == 0)
4025                     return max;
4026             }
4027         }
4028     }
4029     if (!res)
4030         PL_reginput = scan;
4031
4032     return count;
4033 }
4034
4035 /*
4036 - regclass_swash - prepare the utf8 swash
4037 */
4038
4039 SV *
4040 Perl_regclass_swash(pTHX_ register regnode* node, bool doinit, SV** initsvp)
4041 {
4042     SV *sw = NULL;
4043     SV *si = NULL;
4044
4045     if (PL_regdata && PL_regdata->count) {
4046         U32 n = ARG(node);
4047
4048         if (PL_regdata->what[n] == 's') {
4049             SV *rv = (SV*)PL_regdata->data[n];
4050             AV *av = (AV*)SvRV((SV*)rv);
4051             SV **a;
4052
4053             si = *av_fetch(av, 0, FALSE);
4054             a  =  av_fetch(av, 1, FALSE);
4055
4056             if (a)
4057                 sw = *a;
4058             else if (si && doinit) {
4059                 sw = swash_init("utf8", "", si, 1, 0);
4060                 (void)av_store(av, 1, sw);
4061             }
4062         }
4063     }
4064
4065     if (initsvp)
4066         *initsvp = si;
4067
4068     return sw;
4069 }
4070
4071 /*
4072  - reginclass - determine if a character falls into a character class
4073  */
4074
4075 STATIC bool
4076 S_reginclass(pTHX_ register regnode *n, register U8* p, register bool do_utf8)
4077 {
4078     char flags = ANYOF_FLAGS(n);
4079     bool match = FALSE;
4080     UV c;
4081     STRLEN len = 0;
4082
4083     c = do_utf8 ? utf8_to_uvchr(p, &len) : *p;
4084
4085     if (do_utf8 || (flags & ANYOF_UNICODE)) {
4086         if (do_utf8 && !ANYOF_RUNTIME(n)) {
4087             if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
4088                 match = TRUE;
4089         }
4090         if (!match && do_utf8 && (flags & ANYOF_UNICODE_ALL) && c >= 256)
4091             match = TRUE;
4092         if (!match) {
4093             SV *sw = regclass_swash(n, TRUE, 0);
4094
4095             if (sw) {
4096                 if (swash_fetch(sw, p, do_utf8))
4097                     match = TRUE;
4098                 else if (flags & ANYOF_FOLD) {
4099                     STRLEN ulen;
4100                     U8 tmpbuf[UTF8_MAXLEN*2+1];
4101
4102                     toLOWER_utf8(p, tmpbuf, &ulen);
4103                     if (swash_fetch(sw, tmpbuf, do_utf8))
4104                         match = TRUE;
4105                 }
4106             }
4107         }
4108     }
4109     if (!match && c < 256) {
4110         if (ANYOF_BITMAP_TEST(n, c))
4111             match = TRUE;
4112         else if (flags & ANYOF_FOLD) {
4113           I32 f;
4114
4115             if (flags & ANYOF_LOCALE) {
4116                 PL_reg_flags |= RF_tainted;
4117                 f = PL_fold_locale[c];
4118             }
4119             else
4120                 f = PL_fold[c];
4121             if (f != c && ANYOF_BITMAP_TEST(n, f))
4122                 match = TRUE;
4123         }
4124
4125         if (!match && (flags & ANYOF_CLASS)) {
4126             PL_reg_flags |= RF_tainted;
4127             if (
4128                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
4129                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
4130                 (ANYOF_CLASS_TEST(n, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
4131                 (ANYOF_CLASS_TEST(n, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
4132                 (ANYOF_CLASS_TEST(n, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
4133                 (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
4134                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
4135                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
4136                 (ANYOF_CLASS_TEST(n, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
4137                 (ANYOF_CLASS_TEST(n, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
4138                 (ANYOF_CLASS_TEST(n, ANYOF_ASCII)   &&  isASCII(c))     ||
4139                 (ANYOF_CLASS_TEST(n, ANYOF_NASCII)  && !isASCII(c))     ||
4140                 (ANYOF_CLASS_TEST(n, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
4141                 (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
4142                 (ANYOF_CLASS_TEST(n, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
4143                 (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
4144                 (ANYOF_CLASS_TEST(n, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
4145                 (ANYOF_CLASS_TEST(n, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
4146                 (ANYOF_CLASS_TEST(n, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
4147                 (ANYOF_CLASS_TEST(n, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
4148                 (ANYOF_CLASS_TEST(n, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
4149                 (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
4150                 (ANYOF_CLASS_TEST(n, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
4151                 (ANYOF_CLASS_TEST(n, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
4152                 (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
4153                 (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c))    ||
4154                 (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC)  &&  isPSXSPC(c))    ||
4155                 (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c))    ||
4156                 (ANYOF_CLASS_TEST(n, ANYOF_BLANK)   &&  isBLANK(c))     ||
4157                 (ANYOF_CLASS_TEST(n, ANYOF_NBLANK)  && !isBLANK(c))
4158                 ) /* How's that for a conditional? */
4159             {
4160                 match = TRUE;
4161             }
4162         }
4163     }
4164
4165     return (flags & ANYOF_INVERT) ? !match : match;
4166 }
4167
4168 STATIC U8 *
4169 S_reghop(pTHX_ U8 *s, I32 off)
4170 {
4171     return S_reghop3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4172 }
4173
4174 STATIC U8 *
4175 S_reghop3(pTHX_ U8 *s, I32 off, U8* lim)
4176 {
4177     if (off >= 0) {
4178         while (off-- && s < lim) {
4179             /* XXX could check well-formedness here */
4180             s += UTF8SKIP(s);
4181         }
4182     }
4183     else {
4184         while (off++) {
4185             if (s > lim) {
4186                 s--;
4187                 if (UTF8_IS_CONTINUED(*s)) {
4188                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4189                         s--;
4190                 }
4191                 /* XXX could check well-formedness here */
4192             }
4193         }
4194     }
4195     return s;
4196 }
4197
4198 STATIC U8 *
4199 S_reghopmaybe(pTHX_ U8 *s, I32 off)
4200 {
4201     return S_reghopmaybe3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4202 }
4203
4204 STATIC U8 *
4205 S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim)
4206 {
4207     if (off >= 0) {
4208         while (off-- && s < lim) {
4209             /* XXX could check well-formedness here */
4210             s += UTF8SKIP(s);
4211         }
4212         if (off >= 0)
4213             return 0;
4214     }
4215     else {
4216         while (off++) {
4217             if (s > lim) {
4218                 s--;
4219                 if (UTF8_IS_CONTINUED(*s)) {
4220                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4221                         s--;
4222                 }
4223                 /* XXX could check well-formedness here */
4224             }
4225             else
4226                 break;
4227         }
4228         if (off <= 0)
4229             return 0;
4230     }
4231     return s;
4232 }
4233
4234 static void
4235 restore_pos(pTHX_ void *arg)
4236 {
4237     if (PL_reg_eval_set) {
4238         if (PL_reg_oldsaved) {
4239             PL_reg_re->subbeg = PL_reg_oldsaved;
4240             PL_reg_re->sublen = PL_reg_oldsavedlen;
4241             RX_MATCH_COPIED_on(PL_reg_re);
4242         }
4243         PL_reg_magic->mg_len = PL_reg_oldpos;
4244         PL_reg_eval_set = 0;
4245         PL_curpm = PL_reg_oldcurpm;
4246     }
4247 }