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