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 #  ifndef 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 /* *These* symbols are masked to allow static link. */
  39 #  define Perl_pregexec my_pregexec
  40 #endif
  41
  42 /*SUPPRESS 112*/
  43 /*
  44  * pregcomp and pregexec -- regsub and regerror are not used in perl
  45  *
  46  *      Copyright (c) 1986 by University of Toronto.
  47  *      Written by Henry Spencer.  Not derived from licensed software.
  48  *
  49  *      Permission is granted to anyone to use this software for any
  50  *      purpose on any computer system, and to redistribute it freely,
  51  *      subject to the following restrictions:
  52  *
  53  *      1. The author is not responsible for the consequences of use of
  54  *              this software, no matter how awful, even if they arise
  55  *              from defects in it.
  56  *
  57  *      2. The origin of this software must not be misrepresented, either
  58  *              by explicit claim or by omission.
  59  *
  60  *      3. Altered versions must be plainly marked as such, and must not
  61  *              be misrepresented as being the original software.
  62  *
  63  ****    Alterations to Henry's code are...
  64  ****
  65  ****    Copyright (c) 1991-1998, Larry Wall
  66  ****
  67  ****    You may distribute under the terms of either the GNU General Public
  68  ****    License or the Artistic License, as specified in the README file.
  69  *
  70  * Beware that some of this code is subtly aware of the way operator
  71  * precedence is structured in regular expressions.  Serious changes in
  72  * regular-expression syntax might require a total rethink.
  73  */
  74 #include "EXTERN.h"
  75 #include "perl.h"
  76 #include "regcomp.h"
  77
  78 #define RF_tainted      1               /* tainted information used? */
  79 #define RF_warned       2               /* warned about big count? */
  80 #define RF_evaled       4               /* Did an EVAL with setting? */
  81 #define RF_utf8         8               /* String contains multibyte chars? */
  82
  83 #define UTF (PL_reg_flags & RF_utf8)
  84
  85 #define RS_init         1               /* eval environment created */
  86 #define RS_set          2               /* replsv value is set */
  87
  88 #ifndef STATIC
  89 #define STATIC  static
  90 #endif
  91
  92 #ifndef PERL_OBJECT
  93 typedef I32 CHECKPOINT;
  94
  95 /*
  96  * Forwards.
  97  */
  98
  99 static I32 regmatch _((regnode *prog));
 100 static I32 regrepeat _((regnode *p, I32 max));
 101 static I32 regrepeat_hard _((regnode *p, I32 max, I32 *lp));
 102 static I32 regtry _((regexp *prog, char *startpos));
 103
 104 static bool reginclass _((char *p, I32 c));
 105 static bool reginclassutf8 _((regnode *f, U8* p));
 106 static CHECKPOINT regcppush _((I32 parenfloor));
 107 static char * regcppop _((void));
 108 #endif
 109
 110 #define REGINCLASS(p,c)  (*(p) ? reginclass(p,c) : ANYOF_TEST(p,c))
 111 #define REGINCLASSUTF8(f,p)  (ARG1(f) ? reginclassutf8(f,p) : swash_fetch((SV*)PL_regdata->data[ARG2(f)],p))
 112
 113 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
 114 #define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
 115
 116 static char * reghop _((unsigned char *pos, I32 off));
 117 static char * reghopmaybe _((unsigned char *pos, I32 off));
 118 #define HOP(pos,off) (UTF ? reghop(pos, off) : (pos + off))
 119 #define HOPMAYBE(pos,off) (UTF ? reghopmaybe(pos, off) : (pos + off))
 120
 121 STATIC CHECKPOINT
 122 regcppush(I32 parenfloor)
 123 {
 124     dTHR;
 125     int retval = PL_savestack_ix;
 126     int i = (PL_regsize - parenfloor) * 4;
 127     int p;
 128
 129     SSCHECK(i + 5);
 130     for (p = PL_regsize; p > parenfloor; p--) {
 131         SSPUSHPTR(PL_regendp[p]);
 132         SSPUSHPTR(PL_regstartp[p]);
 133         SSPUSHPTR(PL_reg_start_tmp[p]);
 134         SSPUSHINT(p);
 135     }
 136     SSPUSHINT(PL_regsize);
 137     SSPUSHINT(*PL_reglastparen);
 138     SSPUSHPTR(PL_reginput);
 139     SSPUSHINT(i + 3);
 140     SSPUSHINT(SAVEt_REGCONTEXT);
 141     return retval;
 142 }
 143
 144 /* These are needed since we do not localize EVAL nodes: */
 145 #  define REGCP_SET  DEBUG_r(PerlIO_printf(Perl_debug_log,              \
 146                              "  Setting an EVAL scope, savestack=%i\n", \
 147                              PL_savestack_ix)); lastcp = PL_savestack_ix
 148
 149 #  define REGCP_UNWIND  DEBUG_r(lastcp != PL_savestack_ix ?             \
 150                                 PerlIO_printf(Perl_debug_log,           \
 151                                 "  Clearing an EVAL scope, savestack=%i..%i\n", \
 152                                 lastcp, PL_savestack_ix) : 0); regcpblow(lastcp)
 153
 154 STATIC char *
 155 regcppop(void)
 156 {
 157     dTHR;
 158     I32 i = SSPOPINT;
 159     U32 paren = 0;
 160     char *input;
 161     char *tmps;
 162     assert(i == SAVEt_REGCONTEXT);
 163     i = SSPOPINT;
 164     input = (char *) SSPOPPTR;
 165     *PL_reglastparen = SSPOPINT;
 166     PL_regsize = SSPOPINT;
 167     for (i -= 3; i > 0; i -= 4) {
 168         paren = (U32)SSPOPINT;
 169         PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
 170         PL_regstartp[paren] = (char *) SSPOPPTR;
 171         tmps = (char*)SSPOPPTR;
 172         if (paren <= *PL_reglastparen)
 173             PL_regendp[paren] = tmps;
 174         DEBUG_r(
 175             PerlIO_printf(Perl_debug_log,
 176                           "     restoring \\%d to %d(%d)..%d%s\n",
 177                           paren, PL_regstartp[paren] - PL_regbol,
 178                           PL_reg_start_tmp[paren] - PL_regbol,
 179                           PL_regendp[paren] - PL_regbol,
 180                           (paren > *PL_reglastparen ? "(no)" : ""));
 181         );
 182     }
 183     DEBUG_r(
 184         if (*PL_reglastparen + 1 <= PL_regnpar) {
 185             PerlIO_printf(Perl_debug_log,
 186                           "     restoring \\%d..\\%d to undef\n",
 187                           *PL_reglastparen + 1, PL_regnpar);
 188         }
 189     );
 190     for (paren = *PL_reglastparen + 1; paren <= PL_regnpar; paren++) {
 191         if (paren > PL_regsize)
 192             PL_regstartp[paren] = Nullch;
 193         PL_regendp[paren] = Nullch;
 194     }
 195     return input;
 196 }
 197
 198 #define regcpblow(cp) LEAVE_SCOPE(cp)
 199
 200 /*
 201  * pregexec and friends
 202  */
 203
 204 /*
 205  - pregexec - match a regexp against a string
 206  */
 207 I32
 208 pregexec(register regexp *prog, char *stringarg, register char *strend,
 209          char *strbeg, I32 minend, SV *screamer, U32 nosave)
 210 /* strend: pointer to null at end of string */
 211 /* strbeg: real beginning of string */
 212 /* minend: end of match must be >=minend after stringarg. */
 213 /* nosave: For optimizations. */
 214 {
 215     return
 216         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
 217                       nosave ? 0 : REXEC_COPY_STR);
 218 }
 219
 220 /*
 221  - regexec_flags - match a regexp against a string
 222  */
 223 I32
 224 regexec_flags(register regexp *prog, char *stringarg, register char *strend,
 225               char *strbeg, I32 minend, SV *screamer, void *data, U32 flags)
 226 /* strend: pointer to null at end of string */
 227 /* strbeg: real beginning of string */
 228 /* minend: end of match must be >=minend after stringarg. */
 229 /* data: May be used for some additional optimizations. */
 230 /* nosave: For optimizations. */
 231 {
 232     dTHR;
 233     register char *s;
 234     register regnode *c;
 235     register char *startpos = stringarg;
 236     register I32 tmp;
 237     I32 minlen;         /* must match at least this many chars */
 238     I32 dontbother = 0; /* how many characters not to try at end */
 239     CURCUR cc;
 240     I32 start_shift = 0;                /* Offset of the start to find
 241                                          constant substr. */            /* CC */
 242     I32 end_shift = 0;                  /* Same for the end. */         /* CC */
 243     I32 scream_pos = -1;                /* Internal iterator of scream. */
 244     char *scream_olds;
 245     SV* oreplsv = GvSV(PL_replgv);
 246
 247     cc.cur = 0;
 248     cc.oldcc = 0;
 249     PL_regcc = &cc;
 250
 251     PL_regprecomp = prog->precomp;              /* Needed for error messages. */
 252 #ifdef DEBUGGING
 253     PL_regnarrate = PL_debug & 512;
 254     PL_regprogram = prog->program;
 255 #endif
 256
 257     /* Be paranoid... */
 258     if (prog == NULL || startpos == NULL) {
 259         croak("NULL regexp parameter");
 260         return 0;
 261     }
 262
 263     minlen = prog->minlen;
 264     if (strend - startpos < minlen) goto phooey;
 265
 266     if (startpos == strbeg)     /* is ^ valid at stringarg? */
 267         PL_regprev = '\n';
 268     else {
 269         PL_regprev = (U32)stringarg[-1];
 270         if (!PL_multiline && PL_regprev == '\n')
 271             PL_regprev = '\0';          /* force ^ to NOT match */
 272     }
 273
 274     /* Check validity of program. */
 275     if (UCHARAT(prog->program) != MAGIC) {
 276         FAIL("corrupted regexp program");
 277     }
 278
 279     PL_regnpar = prog->nparens;
 280     PL_reg_flags = 0;
 281     PL_reg_eval_set = 0;
 282
 283     if (prog->reganch & ROPT_UTF8)
 284         PL_reg_flags |= RF_utf8;
 285
 286     /* Mark beginning of line for ^ and lookbehind. */
 287     PL_regbol = startpos;
 288     PL_bostr  = strbeg;
 289
 290     /* Mark end of line for $ (and such) */
 291     PL_regeol = strend;
 292
 293     /* see how far we have to get to not match where we matched before */
 294     PL_regtill = startpos+minend;
 295
 296     /* If there is a "must appear" string, look for it. */
 297     s = startpos;
 298     if (!(flags & REXEC_CHECKED)
 299         && prog->check_substr != Nullsv &&
 300         !(prog->reganch & ROPT_ANCH_GPOS) &&
 301         (!(prog->reganch & (ROPT_ANCH_BOL | ROPT_ANCH_MBOL))
 302          || (PL_multiline && prog->check_substr == prog->anchored_substr)) )
 303     {
 304         char *t;
 305         start_shift = prog->check_offset_min;   /* okay to underestimate on CC */
 306         /* Should be nonnegative! */
 307         end_shift = minlen - start_shift - CHR_SVLEN(prog->check_substr);
 308         if (screamer) {
 309             if (PL_screamfirst[BmRARE(prog->check_substr)] >= 0)
 310                     s = screaminstr(screamer, prog->check_substr,
 311                                     start_shift + (stringarg - strbeg),
 312                                     end_shift, &scream_pos, 0);
 313             else
 314                     s = Nullch;
 315             scream_olds = s;
 316         }
 317         else
 318             s = fbm_instr((unsigned char*)s + start_shift,
 319                           (unsigned char*)strend - end_shift,
 320                 prog->check_substr, 0);
 321         if (!s) {
 322             ++BmUSEFUL(prog->check_substr);     /* hooray */
 323             goto phooey;        /* not present */
 324         }
 325         else if (s - stringarg > prog->check_offset_max &&
 326                  (UTF
 327                     ? ((t = reghopmaybe(s, -(prog->check_offset_max))) && t >= stringarg)
 328                     : (t = s - prog->check_offset_max) != 0
 329                  )
 330                 )
 331         {
 332             ++BmUSEFUL(prog->check_substr);     /* hooray/2 */
 333             s = t;
 334         }
 335         else if (!(prog->reganch & ROPT_NAUGHTY)
 336                    && --BmUSEFUL(prog->check_substr) < 0
 337                    && prog->check_substr == prog->float_substr) { /* boo */
 338             SvREFCNT_dec(prog->check_substr);
 339             prog->check_substr = Nullsv;        /* disable */
 340             prog->float_substr = Nullsv;        /* clear */
 341             s = startpos;
 342         }
 343         else
 344             s = startpos;
 345     }
 346
 347     DEBUG_r(
 348         PerlIO_printf(Perl_debug_log,
 349                       "Matching `%.60s%s' against `%.*s%s'\n",
 350                       prog->precomp,
 351                       (strlen(prog->precomp) > 60 ? "..." : ""),
 352                       (strend - startpos > 60 ? 60 : strend - startpos),
 353                       startpos,
 354                       (strend - startpos > 60 ? "..." : ""))
 355         );
 356
 357     PL_regdata = prog->data;
 358
 359     /* Simplest case:  anchored match need be tried only once. */
 360     /*  [unless only anchor is BOL and multiline is set] */
 361     if (prog->reganch & ROPT_ANCH) {
 362         if (regtry(prog, startpos))
 363             goto got_it;
 364         else if (!(prog->reganch & ROPT_ANCH_GPOS) &&
 365                  (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
 366                   || (prog->reganch & ROPT_ANCH_MBOL)))
 367         {
 368             if (minlen)
 369                 dontbother = minlen - 1;
 370             strend = HOP(strend, -dontbother);
 371             /* for multiline we only have to try after newlines */
 372             if (s > startpos)
 373                 s--;
 374             while (s < strend) {
 375                 if (*s++ == '\n') {     /* don't need utf8skip here */
 376                     if (s < strend && regtry(prog, s))
 377                         goto got_it;
 378                 }
 379             }
 380         }
 381         goto phooey;
 382     }
 383
 384     /* Messy cases:  unanchored match. */
 385     if (prog->anchored_substr && prog->reganch & ROPT_SKIP) {
 386         /* we have /x+whatever/ */
 387         /* it must be a one character string */
 388         char ch = SvPVX(prog->anchored_substr)[0];
 389         if (UTF) {
 390             while (s < strend) {
 391                 if (*s == ch) {
 392                     if (regtry(prog, s)) goto got_it;
 393                     s += UTF8SKIP(s);
 394                     while (s < strend && *s == ch)
 395                         s += UTF8SKIP(s);
 396                 }
 397                 s += UTF8SKIP(s);
 398             }
 399         }
 400         else {
 401             while (s < strend) {
 402                 if (*s == ch) {
 403                     if (regtry(prog, s)) goto got_it;
 404                     s++;
 405                     while (s < strend && *s == ch)
 406                         s++;
 407                 }
 408                 s++;
 409             }
 410         }
 411     }
 412     /*SUPPRESS 560*/
 413     else if (prog->anchored_substr != Nullsv
 414              || (prog->float_substr != Nullsv
 415                  && prog->float_max_offset < strend - s)) {
 416         SV *must = prog->anchored_substr
 417             ? prog->anchored_substr : prog->float_substr;
 418         I32 back_max =
 419             prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset;
 420         I32 back_min =
 421             prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset;
 422         I32 delta = back_max - back_min;
 423         char *last = HOP(strend, -(CHR_SVLEN(must) + back_min)); /* Cannot start after this */
 424         char *last1;            /* Last position checked before */
 425
 426         if (s > PL_bostr)
 427             last1 = HOP(s, -1);
 428         else
 429             last1 = s - 1;      /* bogus */
 430
 431         /* XXXX check_substr already used to find `s', can optimize if
 432            check_substr==must. */
 433         scream_pos = -1;
 434         dontbother = end_shift;
 435         strend = HOP(strend, -dontbother);
 436         while ( (s <= last) &&
 437                 (screamer
 438                  ? (s = screaminstr(screamer, must, HOP(s, back_min) - strbeg,
 439                                     end_shift, &scream_pos, 0))
 440                  : (s = fbm_instr((unsigned char*)HOP(s, back_min),
 441                                   (unsigned char*)strend, must, 0))) ) {
 442             if (HOP(s, -back_max) > last1) {
 443                 last1 = HOP(s, -back_min);
 444                 s = HOP(s, -back_max);
 445             }
 446             else {
 447                 char *t = (last1 >= PL_bostr) ? HOP(last1, 1) : last + 1;
 448
 449                 last1 = HOP(s, -back_min);
 450                 s = t;
 451             }
 452             if (UTF) {
 453                 while (s <= last1) {
 454                     if (regtry(prog, s))
 455                         goto got_it;
 456                     s += UTF8SKIP(s);
 457                 }
 458             }
 459             else {
 460                 while (s <= last1) {
 461                     if (regtry(prog, s))
 462                         goto got_it;
 463                     s++;
 464                 }
 465             }
 466         }
 467         goto phooey;
 468     }
 469     else if (c = prog->regstclass) {
 470         I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
 471         char *cc;
 472
 473         if (minlen)
 474             dontbother = minlen - 1;
 475         strend = HOP(strend, -dontbother);      /* don't bother with what can't match */
 476         tmp = 1;
 477         /* We know what class it must start with. */
 478         switch (OP(c)) {
 479         case ANYOFUTF8:
 480             cc = (char *) OPERAND(c);
 481             while (s < strend) {
 482                 if (REGINCLASSUTF8(c, (U8*)s)) {
 483                     if (tmp && regtry(prog, s))
 484                         goto got_it;
 485                     else
 486                         tmp = doevery;
 487                 }
 488                 else
 489                     tmp = 1;
 490                 s += UTF8SKIP(s);
 491             }
 492             break;
 493         case ANYOF:
 494             cc = (char *) OPERAND(c);
 495             while (s < strend) {
 496                 if (REGINCLASS(cc, *s)) {
 497                     if (tmp && regtry(prog, s))
 498                         goto got_it;
 499                     else
 500                         tmp = doevery;
 501                 }
 502                 else
 503                     tmp = 1;
 504                 s++;
 505             }
 506             break;
 507         case BOUNDL:
 508             PL_reg_flags |= RF_tainted;
 509             /* FALL THROUGH */
 510         case BOUND:
 511             if (minlen) {
 512                 dontbother++;
 513                 strend -= 1;
 514             }
 515             tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev;
 516             tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
 517             while (s < strend) {
 518                 if (tmp == !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
 519                     tmp = !tmp;
 520                     if (regtry(prog, s))
 521                         goto got_it;
 522                 }
 523                 s++;
 524             }
 525             if ((minlen || tmp) && regtry(prog,s))
 526                 goto got_it;
 527             break;
 528         case BOUNDLUTF8:
 529             PL_reg_flags |= RF_tainted;
 530             /* FALL THROUGH */
 531         case BOUNDUTF8:
 532             if (minlen) {
 533                 dontbother++;
 534                 strend = reghop(strend, -1);
 535             }
 536             tmp = (I32)(s != startpos) ? utf8_to_uv(reghop(s, -1), 0) : PL_regprev;
 537             tmp = ((OP(c) == BOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
 538             while (s < strend) {
 539                 if (tmp == !(OP(c) == BOUND ? swash_fetch(PL_utf8_alnum, s) : isALNUM_LC_utf8(s))) {
 540                     tmp = !tmp;
 541                     if (regtry(prog, s))
 542                         goto got_it;
 543                 }
 544                 s += UTF8SKIP(s);
 545             }
 546             if ((minlen || tmp) && regtry(prog,s))
 547                 goto got_it;
 548             break;
 549         case NBOUNDL:
 550             PL_reg_flags |= RF_tainted;
 551             /* FALL THROUGH */
 552         case NBOUND:
 553             if (minlen) {
 554                 dontbother++;
 555                 strend -= 1;
 556             }
 557             tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev;
 558             tmp = ((OP(c) == NBOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
 559             while (s < strend) {
 560                 if (tmp == !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
 561                     tmp = !tmp;
 562                 else if (regtry(prog, s))
 563                     goto got_it;
 564                 s++;
 565             }
 566             if ((minlen || !tmp) && regtry(prog,s))
 567                 goto got_it;
 568             break;
 569         case NBOUNDLUTF8:
 570             PL_reg_flags |= RF_tainted;
 571             /* FALL THROUGH */
 572         case NBOUNDUTF8:
 573             if (minlen) {
 574                 dontbother++;
 575                 strend = reghop(strend, -1);
 576             }
 577             tmp = (I32)(s != startpos) ? utf8_to_uv(reghop(s, -1), 0) : PL_regprev;
 578             tmp = ((OP(c) == NBOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
 579             while (s < strend) {
 580                 if (tmp == !(OP(c) == NBOUND ? swash_fetch(PL_utf8_alnum, s) : isALNUM_LC_utf8(s)))
 581                     tmp = !tmp;
 582                 else if (regtry(prog, s))
 583                     goto got_it;
 584                 s += UTF8SKIP(s);
 585             }
 586             if ((minlen || !tmp) && regtry(prog,s))
 587                 goto got_it;
 588             break;
 589         case ALNUM:
 590             while (s < strend) {
 591                 if (isALNUM(*s)) {
 592                     if (tmp && regtry(prog, s))
 593                         goto got_it;
 594                     else
 595                         tmp = doevery;
 596                 }
 597                 else
 598                     tmp = 1;
 599                 s++;
 600             }
 601             break;
 602         case ALNUMUTF8:
 603             while (s < strend) {
 604                 if (swash_fetch(PL_utf8_alnum, s)) {
 605                     if (tmp && regtry(prog, s))
 606                         goto got_it;
 607                     else
 608                         tmp = doevery;
 609                 }
 610                 else
 611                     tmp = 1;
 612                 s += UTF8SKIP(s);
 613             }
 614             break;
 615         case ALNUML:
 616             PL_reg_flags |= RF_tainted;
 617             while (s < strend) {
 618                 if (isALNUM_LC(*s)) {
 619                     if (tmp && regtry(prog, s))
 620                         goto got_it;
 621                     else
 622                         tmp = doevery;
 623                 }
 624                 else
 625                     tmp = 1;
 626                 s++;
 627             }
 628             break;
 629         case ALNUMLUTF8:
 630             PL_reg_flags |= RF_tainted;
 631             while (s < strend) {
 632                 if (isALNUM_LC_utf8(s)) {
 633                     if (tmp && regtry(prog, s))
 634                         goto got_it;
 635                     else
 636                         tmp = doevery;
 637                 }
 638                 else
 639                     tmp = 1;
 640                 s += UTF8SKIP(s);
 641             }
 642             break;
 643         case NALNUM:
 644             while (s < strend) {
 645                 if (!isALNUM(*s)) {
 646                     if (tmp && regtry(prog, s))
 647                         goto got_it;
 648                     else
 649                         tmp = doevery;
 650                 }
 651                 else
 652                     tmp = 1;
 653                 s++;
 654             }
 655             break;
 656         case NALNUMUTF8:
 657             while (s < strend) {
 658                 if (!swash_fetch(PL_utf8_alnum, s)) {
 659                     if (tmp && regtry(prog, s))
 660                         goto got_it;
 661                     else
 662                         tmp = doevery;
 663                 }
 664                 else
 665                     tmp = 1;
 666                 s += UTF8SKIP(s);
 667             }
 668             break;
 669         case NALNUML:
 670             PL_reg_flags |= RF_tainted;
 671             while (s < strend) {
 672                 if (!isALNUM_LC(*s)) {
 673                     if (tmp && regtry(prog, s))
 674                         goto got_it;
 675                     else
 676                         tmp = doevery;
 677                 }
 678                 else
 679                     tmp = 1;
 680                 s++;
 681             }
 682             break;
 683         case NALNUMLUTF8:
 684             PL_reg_flags |= RF_tainted;
 685             while (s < strend) {
 686                 if (!isALNUM_LC_utf8(s)) {
 687                     if (tmp && regtry(prog, s))
 688                         goto got_it;
 689                     else
 690                         tmp = doevery;
 691                 }
 692                 else
 693                     tmp = 1;
 694                 s += UTF8SKIP(s);
 695             }
 696             break;
 697         case SPACE:
 698             while (s < strend) {
 699                 if (isSPACE(*s)) {
 700                     if (tmp && regtry(prog, s))
 701                         goto got_it;
 702                     else
 703                         tmp = doevery;
 704                 }
 705                 else
 706                     tmp = 1;
 707                 s++;
 708             }
 709             break;
 710         case SPACEUTF8:
 711             while (s < strend) {
 712                 if (*s == ' ' || swash_fetch(PL_utf8_space,s)) {
 713                     if (tmp && regtry(prog, s))
 714                         goto got_it;
 715                     else
 716                         tmp = doevery;
 717                 }
 718                 else
 719                     tmp = 1;
 720                 s += UTF8SKIP(s);
 721             }
 722             break;
 723         case SPACEL:
 724             PL_reg_flags |= RF_tainted;
 725             while (s < strend) {
 726                 if (isSPACE_LC(*s)) {
 727                     if (tmp && regtry(prog, s))
 728                         goto got_it;
 729                     else
 730                         tmp = doevery;
 731                 }
 732                 else
 733                     tmp = 1;
 734                 s++;
 735             }
 736             break;
 737         case SPACELUTF8:
 738             PL_reg_flags |= RF_tainted;
 739             while (s < strend) {
 740                 if (*s == ' ' || isSPACE_LC_utf8(s)) {
 741                     if (tmp && regtry(prog, s))
 742                         goto got_it;
 743                     else
 744                         tmp = doevery;
 745                 }
 746                 else
 747                     tmp = 1;
 748                 s += UTF8SKIP(s);
 749             }
 750             break;
 751         case NSPACE:
 752             while (s < strend) {
 753                 if (!isSPACE(*s)) {
 754                     if (tmp && regtry(prog, s))
 755                         goto got_it;
 756                     else
 757                         tmp = doevery;
 758                 }
 759                 else
 760                     tmp = 1;
 761                 s++;
 762             }
 763             break;
 764         case NSPACEUTF8:
 765             while (s < strend) {
 766                 if (!(*s == ' ' || swash_fetch(PL_utf8_space,s))) {
 767                     if (tmp && regtry(prog, s))
 768                         goto got_it;
 769                     else
 770                         tmp = doevery;
 771                 }
 772                 else
 773                     tmp = 1;
 774                 s += UTF8SKIP(s);
 775             }
 776             break;
 777         case NSPACEL:
 778             PL_reg_flags |= RF_tainted;
 779             while (s < strend) {
 780                 if (!isSPACE_LC(*s)) {
 781                     if (tmp && regtry(prog, s))
 782                         goto got_it;
 783                     else
 784                         tmp = doevery;
 785                 }
 786                 else
 787                     tmp = 1;
 788                 s++;
 789             }
 790             break;
 791         case NSPACELUTF8:
 792             PL_reg_flags |= RF_tainted;
 793             while (s < strend) {
 794                 if (!(*s == ' ' || isSPACE_LC_utf8(s))) {
 795                     if (tmp && regtry(prog, s))
 796                         goto got_it;
 797                     else
 798                         tmp = doevery;
 799                 }
 800                 else
 801                     tmp = 1;
 802                 s += UTF8SKIP(s);
 803             }
 804             break;
 805         case DIGIT:
 806             while (s < strend) {
 807                 if (isDIGIT(*s)) {
 808                     if (tmp && regtry(prog, s))
 809                         goto got_it;
 810                     else
 811                         tmp = doevery;
 812                 }
 813                 else
 814                     tmp = 1;
 815                 s++;
 816             }
 817             break;
 818         case DIGITUTF8:
 819             while (s < strend) {
 820                 if (swash_fetch(PL_utf8_digit,s)) {
 821                     if (tmp && regtry(prog, s))
 822                         goto got_it;
 823                     else
 824                         tmp = doevery;
 825                 }
 826                 else
 827                     tmp = 1;
 828                 s += UTF8SKIP(s);
 829             }
 830             break;
 831         case NDIGIT:
 832             while (s < strend) {
 833                 if (!isDIGIT(*s)) {
 834                     if (tmp && regtry(prog, s))
 835                         goto got_it;
 836                     else
 837                         tmp = doevery;
 838                 }
 839                 else
 840                     tmp = 1;
 841                 s++;
 842             }
 843             break;
 844         case NDIGITUTF8:
 845             while (s < strend) {
 846                 if (!swash_fetch(PL_utf8_digit,s)) {
 847                     if (tmp && regtry(prog, s))
 848                         goto got_it;
 849                     else
 850                         tmp = doevery;
 851                 }
 852                 else
 853                     tmp = 1;
 854                 s += UTF8SKIP(s);
 855             }
 856             break;
 857         }
 858     }
 859     else {
 860         dontbother = 0;
 861         if (prog->float_substr != Nullsv) {     /* Trim the end. */
 862             char *last;
 863             I32 oldpos = scream_pos;
 864
 865             if (screamer) {
 866                 last = screaminstr(screamer, prog->float_substr, s - strbeg,
 867                                    end_shift, &scream_pos, 1); /* last one */
 868                 if (!last) {
 869                     last = scream_olds; /* Only one occurence. */
 870                 }
 871             }
 872             else {
 873                 STRLEN len;
 874                 char *little = SvPV(prog->float_substr, len);
 875                 last = rninstr(s, strend, little, little + len);
 876             }
 877             if (last == NULL) goto phooey; /* Should not happen! */
 878             dontbother = strend - last - 1;
 879         }
 880         if (minlen && (dontbother < minlen))
 881             dontbother = minlen - 1;
 882         strend -= dontbother;              /* this one's always in bytes! */
 883         /* We don't know much -- general case. */
 884         if (UTF) {
 885             for (;;) {
 886                 if (regtry(prog, s)) {
 887                     strend += dontbother;  /* this one's always in bytes! */
 888                     dontbother = 0;
 889                     goto got_it;
 890                 }
 891                 if (s >= strend)
 892                     break;
 893                 s += UTF8SKIP(s);
 894             };
 895         }
 896         else {
 897             do {
 898                 if (regtry(prog, s))
 899                     goto got_it;
 900             } while (s++ < strend);
 901         }
 902     }
 903
 904     /* Failure. */
 905     goto phooey;
 906
 907 got_it:
 908     strend = HOP(strend, dontbother);   /* uncheat */
 909     prog->subbeg = strbeg;
 910     prog->subend = strend;
 911     RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
 912
 913     /* make sure $`, $&, $', and $digit will work later */
 914     if (strbeg != prog->subbase) {      /* second+ //g match.  */
 915         if (!(flags & REXEC_COPY_STR)) {
 916             if (prog->subbase) {
 917                 Safefree(prog->subbase);
 918                 prog->subbase = Nullch;
 919             }
 920         }
 921         else {
 922             I32 i = strend - startpos + (stringarg - strbeg);
 923             s = savepvn(strbeg, i);
 924             Safefree(prog->subbase);
 925             prog->subbase = s;
 926             prog->subbeg = prog->subbase;
 927             prog->subend = prog->subbase + i;
 928             s = prog->subbase + (stringarg - strbeg);
 929             for (i = 0; i <= prog->nparens; i++) {
 930                 if (prog->endp[i]) {
 931                     prog->startp[i] = s + (prog->startp[i] - startpos);
 932                     prog->endp[i] = s + (prog->endp[i] - startpos);
 933                 }
 934             }
 935         }
 936     }
 937     /* Preserve the current value of $^R */
 938     if (oreplsv != GvSV(PL_replgv)) {
 939         sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
 940                                            restored, the value remains
 941                                            the same. */
 942     }
 943     return 1;
 944
 945 phooey:
 946     return 0;
 947 }
 948
 949 /*
 950  - regtry - try match at specific point
 951  */
 952 STATIC I32                      /* 0 failure, 1 success */
 953 regtry(regexp *prog, char *startpos)
 954 {
 955     dTHR;
 956     register I32 i;
 957     register char **sp;
 958     register char **ep;
 959     CHECKPOINT lastcp;
 960
 961     if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
 962         PL_reg_eval_set = RS_init;
 963         DEBUG_r(DEBUG_s(
 964             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %i\n",
 965                           PL_stack_sp - PL_stack_base);
 966             ));
 967         SAVEINT(cxstack[cxstack_ix].blk_oldsp);
 968         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
 969         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
 970         SAVETMPS;
 971         /* Apparently this is not needed, judging by wantarray. */
 972         /* SAVEINT(cxstack[cxstack_ix].blk_gimme);
 973            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
 974     }
 975     PL_reginput = startpos;
 976     PL_regstartp = prog->startp;
 977     PL_regendp = prog->endp;
 978     PL_reglastparen = &prog->lastparen;
 979     prog->lastparen = 0;
 980     PL_regsize = 0;
 981     if (PL_reg_start_tmpl <= prog->nparens) {
 982         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
 983         if(PL_reg_start_tmp)
 984             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
 985         else
 986             New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*);
 987     }
 988
 989     sp = prog->startp;
 990     ep = prog->endp;
 991     if (prog->nparens) {
 992         for (i = prog->nparens; i >= 0; i--) {
 993             *sp++ = NULL;
 994             *ep++ = NULL;
 995         }
 996     }
 997     REGCP_SET;
 998     if (regmatch(prog->program + 1)) {
 999         prog->startp[0] = startpos;
1000         prog->endp[0] = PL_reginput;
1001         return 1;
1002     }
1003     REGCP_UNWIND;
1004     return 0;
1005 }
1006
1007 /*
1008  - regmatch - main matching routine
1009  *
1010  * Conceptually the strategy is simple:  check to see whether the current
1011  * node matches, call self recursively to see whether the rest matches,
1012  * and then act accordingly.  In practice we make some effort to avoid
1013  * recursion, in particular by going through "ordinary" nodes (that don't
1014  * need to know whether the rest of the match failed) by a loop instead of
1015  * by recursion.
1016  */
1017 /* [lwall] I've hoisted the register declarations to the outer block in order to
1018  * maybe save a little bit of pushing and popping on the stack.  It also takes
1019  * advantage of machines that use a register save mask on subroutine entry.
1020  */
1021 STATIC I32                      /* 0 failure, 1 success */
1022 regmatch(regnode *prog)
1023 {
1024     dTHR;
1025     register regnode *scan;     /* Current node. */
1026     regnode *next;              /* Next node. */
1027     regnode *inner;             /* Next node in internal branch. */
1028     register I32 nextchr;       /* renamed nextchr - nextchar colides with
1029                                    function of same name */
1030     register I32 n;             /* no or next */
1031     register I32 ln;            /* len or last */
1032     register char *s;           /* operand or save */
1033     register char *locinput = PL_reginput;
1034     register I32 c1, c2, paren; /* case fold search, parenth */
1035     int minmod = 0, sw = 0, logical = 0;
1036 #ifdef DEBUGGING
1037     PL_regindent++;
1038 #endif
1039
1040     /* Note that nextchr is a byte even in UTF */
1041     nextchr = UCHARAT(locinput);
1042     scan = prog;
1043     while (scan != NULL) {
1044 #define sayNO_L (logical ? (logical = 0, sw = 0, goto cont) : sayNO)
1045 #ifdef DEBUGGING
1046 #  define sayYES goto yes
1047 #  define sayNO goto no
1048 #  define saySAME(x) if (x) goto yes; else goto no
1049 #  define REPORT_CODE_OFF 24
1050 #else
1051 #  define sayYES return 1
1052 #  define sayNO return 0
1053 #  define saySAME(x) return x
1054 #endif
1055         DEBUG_r( {
1056             SV *prop = sv_newmortal();
1057             int docolor = *PL_colors[0];
1058             int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
1059             int l = (PL_regeol - locinput > taill ? taill : PL_regeol - locinput);
1060             int pref_len = (locinput - PL_bostr > (5 + taill) - l
1061                             ? (5 + taill) - l : locinput - PL_bostr);
1062
1063             if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
1064                 l = ( PL_regeol - locinput > (5 + taill) - pref_len
1065                       ? (5 + taill) - pref_len : PL_regeol - locinput);
1066             regprop(prop, scan);
1067             PerlIO_printf(Perl_debug_log,
1068                           "%4i <%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n",
1069                           locinput - PL_bostr,
1070                           PL_colors[2], pref_len, locinput - pref_len, PL_colors[3],
1071                           (docolor ? "" : "> <"),
1072                           PL_colors[0], l, locinput, PL_colors[1],
1073                           15 - l - pref_len + 1,
1074                           "",
1075                           scan - PL_regprogram, PL_regindent*2, "",
1076                           SvPVX(prop));
1077         } );
1078
1079         next = scan + NEXT_OFF(scan);
1080         if (next == scan)
1081             next = NULL;
1082
1083         switch (OP(scan)) {
1084         case BOL:
1085             if (locinput == PL_bostr
1086                 ? PL_regprev == '\n'
1087                 : (PL_multiline &&
1088                    (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
1089             {
1090                 /* regtill = regbol; */
1091                 break;
1092             }
1093             sayNO;
1094         case MBOL:
1095             if (locinput == PL_bostr
1096                 ? PL_regprev == '\n'
1097                 : ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
1098             {
1099                 break;
1100             }
1101             sayNO;
1102         case SBOL:
1103             if (locinput == PL_regbol && PL_regprev == '\n')
1104                 break;
1105             sayNO;
1106         case GPOS:
1107             if (locinput == PL_regbol)
1108                 break;
1109             sayNO;
1110         case EOL:
1111             if (PL_multiline)
1112                 goto meol;
1113             else
1114                 goto seol;
1115         case MEOL:
1116           meol:
1117             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
1118                 sayNO;
1119             break;
1120         case SEOL:
1121           seol:
1122             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
1123                 sayNO;
1124             if (PL_regeol - locinput > 1)
1125                 sayNO;
1126             break;
1127         case EOS:
1128             if (PL_regeol != locinput)
1129                 sayNO;
1130             break;
1131         case SANYUTF8:
1132             if (nextchr & 0x80) {
1133                 locinput += PL_utf8skip[nextchr];
1134                 if (locinput > PL_regeol)
1135                     sayNO;
1136                 nextchr = UCHARAT(locinput);
1137                 break;
1138             }
1139             if (!nextchr && locinput >= PL_regeol)
1140                 sayNO;
1141             nextchr = UCHARAT(++locinput);
1142             break;
1143         case SANY:
1144             if (!nextchr && locinput >= PL_regeol)
1145                 sayNO;
1146             nextchr = UCHARAT(++locinput);
1147             break;
1148         case ANYUTF8:
1149             if (nextchr & 0x80) {
1150                 locinput += PL_utf8skip[nextchr];
1151                 if (locinput > PL_regeol)
1152                     sayNO;
1153                 nextchr = UCHARAT(locinput);
1154                 break;
1155             }
1156             if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
1157                 sayNO;
1158             nextchr = UCHARAT(++locinput);
1159             break;
1160         case ANY:
1161             if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
1162                 sayNO;
1163             nextchr = UCHARAT(++locinput);
1164             break;
1165         case EXACT:
1166             s = (char *) OPERAND(scan);
1167             ln = UCHARAT(s++);
1168             /* Inline the first character, for speed. */
1169             if (UCHARAT(s) != nextchr)
1170                 sayNO;
1171             if (PL_regeol - locinput < ln)
1172                 sayNO;
1173             if (ln > 1 && memNE(s, locinput, ln))
1174                 sayNO;
1175             locinput += ln;
1176             nextchr = UCHARAT(locinput);
1177             break;
1178         case EXACTFL:
1179             PL_reg_flags |= RF_tainted;
1180             /* FALL THROUGH */
1181         case EXACTF:
1182             s = (char *) OPERAND(scan);
1183             ln = UCHARAT(s++);
1184
1185             if (UTF) {
1186                 char *l = locinput;
1187                 char *e = s + ln;
1188                 c1 = OP(scan) == EXACTF;
1189                 while (s < e) {
1190                     if (l >= PL_regeol)
1191                         sayNO;
1192                     if (utf8_to_uv(s, 0) != (c1 ? toLOWER_utf8(l) : toLOWER_LC_utf8(l)))
1193                         sayNO;
1194                     s += UTF8SKIP(s);
1195                     l += UTF8SKIP(l);
1196                 }
1197                 locinput = l;
1198                 nextchr = UCHARAT(locinput);
1199                 break;
1200             }
1201
1202             /* Inline the first character, for speed. */
1203             if (UCHARAT(s) != nextchr &&
1204                 UCHARAT(s) != ((OP(scan) == EXACTF)
1205                                ? fold : fold_locale)[nextchr])
1206                 sayNO;
1207             if (PL_regeol - locinput < ln)
1208                 sayNO;
1209             if (ln > 1 && (OP(scan) == EXACTF
1210                            ? ibcmp(s, locinput, ln)
1211                            : ibcmp_locale(s, locinput, ln)))
1212                 sayNO;
1213             locinput += ln;
1214             nextchr = UCHARAT(locinput);
1215             break;
1216         case ANYOFUTF8:
1217             s = (char *) OPERAND(scan);
1218             if (!REGINCLASSUTF8(scan, (U8*)locinput))
1219                 sayNO;
1220             if (locinput >= PL_regeol)
1221                 sayNO;
1222             locinput += PL_utf8skip[nextchr];
1223             nextchr = UCHARAT(locinput);
1224             break;
1225         case ANYOF:
1226             s = (char *) OPERAND(scan);
1227             if (nextchr < 0)
1228                 nextchr = UCHARAT(locinput);
1229             if (!REGINCLASS(s, nextchr))
1230                 sayNO;
1231             if (!nextchr && locinput >= PL_regeol)
1232                 sayNO;
1233             nextchr = UCHARAT(++locinput);
1234             break;
1235         case ALNUML:
1236             PL_reg_flags |= RF_tainted;
1237             /* FALL THROUGH */
1238         case ALNUM:
1239             if (!nextchr)
1240                 sayNO;
1241             if (!(OP(scan) == ALNUM
1242                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
1243                 sayNO;
1244             nextchr = UCHARAT(++locinput);
1245             break;
1246         case ALNUMLUTF8:
1247             PL_reg_flags |= RF_tainted;
1248             /* FALL THROUGH */
1249         case ALNUMUTF8:
1250             if (!nextchr)
1251                 sayNO;
1252             if (nextchr & 0x80) {
1253                 if (!(OP(scan) == ALNUMUTF8
1254                       ? swash_fetch(PL_utf8_alnum, locinput) : isALNUM_LC_utf8(locinput)))
1255                     sayNO;
1256                 locinput += PL_utf8skip[nextchr];
1257                 nextchr = UCHARAT(locinput);
1258                 break;
1259             }
1260             if (!(OP(scan) == ALNUMUTF8
1261                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
1262                 sayNO;
1263             nextchr = UCHARAT(++locinput);
1264             break;
1265         case NALNUML:
1266             PL_reg_flags |= RF_tainted;
1267             /* FALL THROUGH */
1268         case NALNUM:
1269             if (!nextchr && locinput >= PL_regeol)
1270                 sayNO;
1271             if (OP(scan) == NALNUM
1272                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
1273                 sayNO;
1274             nextchr = UCHARAT(++locinput);
1275             break;
1276         case NALNUMLUTF8:
1277             PL_reg_flags |= RF_tainted;
1278             /* FALL THROUGH */
1279         case NALNUMUTF8:
1280             if (!nextchr && locinput >= PL_regeol)
1281                 sayNO;
1282             if (nextchr & 0x80) {
1283                 if (OP(scan) == NALNUMUTF8
1284                       ? swash_fetch(PL_utf8_alnum, locinput) : isALNUM_LC_utf8(locinput))
1285                     sayNO;
1286                 locinput += PL_utf8skip[nextchr];
1287                 nextchr = UCHARAT(locinput);
1288                 break;
1289             }
1290             if (OP(scan) == NALNUMUTF8
1291                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
1292                 sayNO;
1293             nextchr = UCHARAT(++locinput);
1294             break;
1295         case BOUNDL:
1296         case NBOUNDL:
1297             PL_reg_flags |= RF_tainted;
1298             /* FALL THROUGH */
1299         case BOUND:
1300         case NBOUND:
1301             /* was last char in word? */
1302             ln = (locinput != PL_regbol) ? UCHARAT(locinput - 1) : PL_regprev;
1303             if (OP(scan) == BOUND || OP(scan) == NBOUND) {
1304                 ln = isALNUM(ln);
1305                 n = isALNUM(nextchr);
1306             }
1307             else {
1308                 ln = isALNUM_LC(ln);
1309                 n = isALNUM_LC(nextchr);
1310             }
1311             if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL))
1312                 sayNO;
1313             break;
1314         case BOUNDLUTF8:
1315         case NBOUNDLUTF8:
1316             PL_reg_flags |= RF_tainted;
1317             /* FALL THROUGH */
1318         case BOUNDUTF8:
1319         case NBOUNDUTF8:
1320             /* was last char in word? */
1321             ln = (locinput != PL_regbol) ? utf8_to_uv(reghop(locinput, -1), 0) : PL_regprev;
1322             if (OP(scan) == BOUNDUTF8 || OP(scan) == NBOUNDUTF8) {
1323                 ln = isALNUM_uni(ln);
1324                 n = swash_fetch(PL_utf8_alnum, locinput);
1325             }
1326             else {
1327                 ln = isALNUM_LC_uni(ln);
1328                 n = isALNUM_LC_utf8(locinput);
1329             }
1330             if (((!ln) == (!n)) == (OP(scan) == BOUNDUTF8 || OP(scan) == BOUNDLUTF8))
1331                 sayNO;
1332             break;
1333         case SPACEL:
1334             PL_reg_flags |= RF_tainted;
1335             /* FALL THROUGH */
1336         case SPACE:
1337             if (!nextchr && locinput >= PL_regeol)
1338                 sayNO;
1339             if (!(OP(scan) == SPACE
1340                   ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
1341                 sayNO;
1342             nextchr = UCHARAT(++locinput);
1343             break;
1344         case SPACELUTF8:
1345             PL_reg_flags |= RF_tainted;
1346             /* FALL THROUGH */
1347         case SPACEUTF8:
1348             if (!nextchr && locinput >= PL_regeol)
1349                 sayNO;
1350             if (nextchr & 0x80) {
1351                 if (!(OP(scan) == SPACEUTF8
1352                       ? swash_fetch(PL_utf8_space,locinput) : isSPACE_LC_utf8(locinput)))
1353                     sayNO;
1354                 locinput += PL_utf8skip[nextchr];
1355                 nextchr = UCHARAT(locinput);
1356                 break;
1357             }
1358             if (!(OP(scan) == SPACEUTF8
1359                   ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
1360                 sayNO;
1361             nextchr = UCHARAT(++locinput);
1362             break;
1363         case NSPACEL:
1364             PL_reg_flags |= RF_tainted;
1365             /* FALL THROUGH */
1366         case NSPACE:
1367             if (!nextchr)
1368                 sayNO;
1369             if (OP(scan) == SPACE
1370                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
1371                 sayNO;
1372             nextchr = UCHARAT(++locinput);
1373             break;
1374         case NSPACELUTF8:
1375             PL_reg_flags |= RF_tainted;
1376             /* FALL THROUGH */
1377         case NSPACEUTF8:
1378             if (!nextchr)
1379                 sayNO;
1380             if (nextchr & 0x80) {
1381                 if (OP(scan) == NSPACEUTF8
1382                       ? swash_fetch(PL_utf8_space,locinput) : isSPACE_LC_utf8(locinput))
1383                     sayNO;
1384                 locinput += PL_utf8skip[nextchr];
1385                 nextchr = UCHARAT(locinput);
1386                 break;
1387             }
1388             if (OP(scan) == NSPACEUTF8
1389                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
1390                 sayNO;
1391             nextchr = UCHARAT(++locinput);
1392             break;
1393         case DIGIT:
1394             if (!isDIGIT(nextchr))
1395                 sayNO;
1396             nextchr = UCHARAT(++locinput);
1397             break;
1398         case DIGITUTF8:
1399             if (nextchr & 0x80) {
1400                 if (!(swash_fetch(PL_utf8_digit,locinput)))
1401                     sayNO;
1402                 locinput += PL_utf8skip[nextchr];
1403                 nextchr = UCHARAT(locinput);
1404                 break;
1405             }
1406             if (!isDIGIT(nextchr))
1407                 sayNO;
1408             nextchr = UCHARAT(++locinput);
1409             break;
1410         case NDIGIT:
1411             if (!nextchr && locinput >= PL_regeol)
1412                 sayNO;
1413             if (isDIGIT(nextchr))
1414                 sayNO;
1415             nextchr = UCHARAT(++locinput);
1416             break;
1417         case NDIGITUTF8:
1418             if (!nextchr && locinput >= PL_regeol)
1419                 sayNO;
1420             if (nextchr & 0x80) {
1421                 if (swash_fetch(PL_utf8_digit,locinput))
1422                     sayNO;
1423                 locinput += PL_utf8skip[nextchr];
1424                 nextchr = UCHARAT(locinput);
1425                 break;
1426             }
1427             if (isDIGIT(nextchr))
1428                 sayNO;
1429             nextchr = UCHARAT(++locinput);
1430             break;
1431         case CLUMP:
1432             if (locinput >= PL_regeol || swash_fetch(PL_utf8_mark, locinput))
1433                 sayNO;
1434             locinput += PL_utf8skip[nextchr];
1435             while (locinput < PL_regeol && swash_fetch(PL_utf8_mark, locinput))
1436                 locinput += UTF8SKIP(locinput);
1437             if (locinput > PL_regeol)
1438                 sayNO;
1439             nextchr = UCHARAT(locinput);
1440             break;
1441         case REFFL:
1442             PL_reg_flags |= RF_tainted;
1443             /* FALL THROUGH */
1444         case REF:
1445         case REFF:
1446             n = ARG(scan);  /* which paren pair */
1447             s = PL_regstartp[n];
1448             if (*PL_reglastparen < n || !s)
1449                 sayNO;                  /* Do not match unless seen CLOSEn. */
1450             if (s == PL_regendp[n])
1451                 break;
1452
1453             if (UTF && OP(scan) != REF) {       /* REF can do byte comparison */
1454                 char *l = locinput;
1455                 char *e = PL_regendp[n];
1456                 /*
1457                  * Note that we can't do the "other character" lookup trick as
1458                  * in the 8-bit case (no pun intended) because in Unicode we
1459                  * have to map both upper and title case to lower case.
1460                  */
1461                 if (OP(scan) == REFF) {
1462                     while (s < e) {
1463                         if (l >= PL_regeol)
1464                             sayNO;
1465                         if (toLOWER_utf8(s) != toLOWER_utf8(l))
1466                             sayNO;
1467                         s += UTF8SKIP(s);
1468                         l += UTF8SKIP(l);
1469                     }
1470                 }
1471                 else {
1472                     while (s < e) {
1473                         if (l >= PL_regeol)
1474                             sayNO;
1475                         if (toLOWER_LC_utf8(s) != toLOWER_LC_utf8(l))
1476                             sayNO;
1477                         s += UTF8SKIP(s);
1478                         l += UTF8SKIP(l);
1479                     }
1480                 }
1481                 locinput = l;
1482                 nextchr = UCHARAT(locinput);
1483                 break;
1484             }
1485
1486             /* Inline the first character, for speed. */
1487             if (UCHARAT(s) != nextchr &&
1488                 (OP(scan) == REF ||
1489                  (UCHARAT(s) != ((OP(scan) == REFF
1490                                   ? fold : fold_locale)[nextchr]))))
1491                 sayNO;
1492             ln = PL_regendp[n] - s;
1493             if (locinput + ln > PL_regeol)
1494                 sayNO;
1495             if (ln > 1 && (OP(scan) == REF
1496                            ? memNE(s, locinput, ln)
1497                            : (OP(scan) == REFF
1498                               ? ibcmp(s, locinput, ln)
1499                               : ibcmp_locale(s, locinput, ln))))
1500                 sayNO;
1501             locinput += ln;
1502             nextchr = UCHARAT(locinput);
1503             break;
1504
1505         case NOTHING:
1506         case TAIL:
1507             break;
1508         case BACK:
1509             break;
1510         case EVAL:
1511         {
1512             dSP;
1513             OP_4tree *oop = PL_op;
1514             COP *ocurcop = PL_curcop;
1515             SV **ocurpad = PL_curpad;
1516             SV *ret;
1517
1518             n = ARG(scan);
1519             PL_op = (OP_4tree*)PL_regdata->data[n];
1520             DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%x\n", PL_op) );
1521             PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 1]);
1522
1523             CALLRUNOPS();                       /* Scalar context. */
1524             SPAGAIN;
1525             ret = POPs;
1526             PUTBACK;
1527
1528             if (logical) {
1529                 logical = 0;
1530                 sw = SvTRUE(ret);
1531             }
1532             else
1533                 sv_setsv(save_scalar(PL_replgv), ret);
1534             PL_op = oop;
1535             PL_curpad = ocurpad;
1536             PL_curcop = ocurcop;
1537             break;
1538         }
1539         case OPEN:
1540             n = ARG(scan);  /* which paren pair */
1541             PL_reg_start_tmp[n] = locinput;
1542             if (n > PL_regsize)
1543                 PL_regsize = n;
1544             break;
1545         case CLOSE:
1546             n = ARG(scan);  /* which paren pair */
1547             PL_regstartp[n] = PL_reg_start_tmp[n];
1548             PL_regendp[n] = locinput;
1549             if (n > *PL_reglastparen)
1550                 *PL_reglastparen = n;
1551             break;
1552         case GROUPP:
1553             n = ARG(scan);  /* which paren pair */
1554             sw = (*PL_reglastparen >= n && PL_regendp[n] != NULL);
1555             break;
1556         case IFTHEN:
1557             if (sw)
1558                 next = NEXTOPER(NEXTOPER(scan));
1559             else {
1560                 next = scan + ARG(scan);
1561                 if (OP(next) == IFTHEN) /* Fake one. */
1562                     next = NEXTOPER(NEXTOPER(next));
1563             }
1564             break;
1565         case LOGICAL:
1566             logical = 1;
1567             break;
1568         case CURLYX: {
1569                 CURCUR cc;
1570                 CHECKPOINT cp = PL_savestack_ix;
1571
1572                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
1573                     next += ARG(next);
1574                 cc.oldcc = PL_regcc;
1575                 PL_regcc = &cc;
1576                 cc.parenfloor = *PL_reglastparen;
1577                 cc.cur = -1;
1578                 cc.min = ARG1(scan);
1579                 cc.max  = ARG2(scan);
1580                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
1581                 cc.next = next;
1582                 cc.minmod = minmod;
1583                 cc.lastloc = 0;
1584                 PL_reginput = locinput;
1585                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
1586                 regcpblow(cp);
1587                 PL_regcc = cc.oldcc;
1588                 saySAME(n);
1589             }
1590             /* NOT REACHED */
1591         case WHILEM: {
1592                 /*
1593                  * This is really hard to understand, because after we match
1594                  * what we're trying to match, we must make sure the rest of
1595                  * the RE is going to match for sure, and to do that we have
1596                  * to go back UP the parse tree by recursing ever deeper.  And
1597                  * if it fails, we have to reset our parent's current state
1598                  * that we can try again after backing off.
1599                  */
1600
1601                 CHECKPOINT cp, lastcp;
1602                 CURCUR* cc = PL_regcc;
1603                 char *lastloc = cc->lastloc; /* Detection of 0-len. */
1604
1605                 n = cc->cur + 1;        /* how many we know we matched */
1606                 PL_reginput = locinput;
1607
1608                 DEBUG_r(
1609                     PerlIO_printf(Perl_debug_log,
1610                                   "%*s  %ld out of %ld..%ld  cc=%lx\n",
1611                                   REPORT_CODE_OFF+PL_regindent*2, "",
1612                                   (long)n, (long)cc->min,
1613                                   (long)cc->max, (long)cc)
1614                     );
1615
1616                 /* If degenerate scan matches "", assume scan done. */
1617
1618                 if (locinput == cc->lastloc && n >= cc->min) {
1619                     PL_regcc = cc->oldcc;
1620                     ln = PL_regcc->cur;
1621                     DEBUG_r(
1622                         PerlIO_printf(Perl_debug_log,
1623                            "%*s  empty match detected, try continuation...\n",
1624                            REPORT_CODE_OFF+PL_regindent*2, "")
1625                         );
1626                     if (regmatch(cc->next))
1627                         sayYES;
1628                     DEBUG_r(
1629                         PerlIO_printf(Perl_debug_log,
1630                                       "%*s  failed...\n",
1631                                       REPORT_CODE_OFF+PL_regindent*2, "")
1632                         );
1633                     PL_regcc->cur = ln;
1634                     PL_regcc = cc;
1635                     sayNO;
1636                 }
1637
1638                 /* First just match a string of min scans. */
1639
1640                 if (n < cc->min) {
1641                     cc->cur = n;
1642                     cc->lastloc = locinput;
1643                     if (regmatch(cc->scan))
1644                         sayYES;
1645                     cc->cur = n - 1;
1646                     cc->lastloc = lastloc;
1647                     DEBUG_r(
1648                         PerlIO_printf(Perl_debug_log,
1649                                       "%*s  failed...\n",
1650                                       REPORT_CODE_OFF+PL_regindent*2, "")
1651                         );
1652                     sayNO;
1653                 }
1654
1655                 /* Prefer next over scan for minimal matching. */
1656
1657                 if (cc->minmod) {
1658                     PL_regcc = cc->oldcc;
1659                     ln = PL_regcc->cur;
1660                     cp = regcppush(cc->parenfloor);
1661                     REGCP_SET;
1662                     if (regmatch(cc->next)) {
1663                         regcpblow(cp);
1664                         sayYES; /* All done. */
1665                     }
1666                     REGCP_UNWIND;
1667                     regcppop();
1668                     PL_regcc->cur = ln;
1669                     PL_regcc = cc;
1670
1671                     if (n >= cc->max) { /* Maximum greed exceeded? */
1672                         if (PL_dowarn && n >= REG_INFTY
1673                             && !(PL_reg_flags & RF_warned)) {
1674                             PL_reg_flags |= RF_warned;
1675                             warn("%s limit (%d) exceeded",
1676                                  "Complex regular subexpression recursion",
1677                                  REG_INFTY - 1);
1678                         }
1679                         sayNO;
1680                     }
1681
1682                     DEBUG_r(
1683                         PerlIO_printf(Perl_debug_log,
1684                                       "%*s  trying longer...\n",
1685                                       REPORT_CODE_OFF+PL_regindent*2, "")
1686                         );
1687                     /* Try scanning more and see if it helps. */
1688                     PL_reginput = locinput;
1689                     cc->cur = n;
1690                     cc->lastloc = locinput;
1691                     cp = regcppush(cc->parenfloor);
1692                     REGCP_SET;
1693                     if (regmatch(cc->scan)) {
1694                         regcpblow(cp);
1695                         sayYES;
1696                     }
1697                     DEBUG_r(
1698                         PerlIO_printf(Perl_debug_log,
1699                                       "%*s  failed...\n",
1700                                       REPORT_CODE_OFF+PL_regindent*2, "")
1701                         );
1702                     REGCP_UNWIND;
1703                     regcppop();
1704                     cc->cur = n - 1;
1705                     cc->lastloc = lastloc;
1706                     sayNO;
1707                 }
1708
1709                 /* Prefer scan over next for maximal matching. */
1710
1711                 if (n < cc->max) {      /* More greed allowed? */
1712                     cp = regcppush(cc->parenfloor);
1713                     cc->cur = n;
1714                     cc->lastloc = locinput;
1715                     REGCP_SET;
1716                     if (regmatch(cc->scan)) {
1717                         regcpblow(cp);
1718                         sayYES;
1719                     }
1720                     REGCP_UNWIND;
1721                     regcppop();         /* Restore some previous $<digit>s? */
1722                     PL_reginput = locinput;
1723                     DEBUG_r(
1724                         PerlIO_printf(Perl_debug_log,
1725                                       "%*s  failed, try continuation...\n",
1726                                       REPORT_CODE_OFF+PL_regindent*2, "")
1727                         );
1728                 }
1729                 if (PL_dowarn && n >= REG_INFTY && !(PL_reg_flags & RF_warned)) {
1730                     PL_reg_flags |= RF_warned;
1731                     warn("count exceeded %d", REG_INFTY - 1);
1732                 }
1733
1734                 /* Failed deeper matches of scan, so see if this one works. */
1735                 PL_regcc = cc->oldcc;
1736                 ln = PL_regcc->cur;
1737                 if (regmatch(cc->next))
1738                     sayYES;
1739                 DEBUG_r(
1740                     PerlIO_printf(Perl_debug_log, "%*s  failed...\n",
1741                                   REPORT_CODE_OFF+PL_regindent*2, "")
1742                     );
1743                 PL_regcc->cur = ln;
1744                 PL_regcc = cc;
1745                 cc->cur = n - 1;
1746                 cc->lastloc = lastloc;
1747                 sayNO;
1748             }
1749             /* NOT REACHED */
1750         case BRANCHJ:
1751             next = scan + ARG(scan);
1752             if (next == scan)
1753                 next = NULL;
1754             inner = NEXTOPER(NEXTOPER(scan));
1755             goto do_branch;
1756         case BRANCH:
1757             inner = NEXTOPER(scan);
1758           do_branch:
1759             {
1760                 CHECKPOINT lastcp;
1761                 c1 = OP(scan);
1762                 if (OP(next) != c1)     /* No choice. */
1763                     next = inner;       /* Avoid recursion. */
1764                 else {
1765                     int lastparen = *PL_reglastparen;
1766
1767                     REGCP_SET;
1768                     do {
1769                         PL_reginput = locinput;
1770                         if (regmatch(inner))
1771                             sayYES;
1772                         REGCP_UNWIND;
1773                         for (n = *PL_reglastparen; n > lastparen; n--)
1774                             PL_regendp[n] = 0;
1775                         *PL_reglastparen = n;
1776                         scan = next;
1777                         /*SUPPRESS 560*/
1778                         if (n = (c1 == BRANCH ? NEXT_OFF(next) : ARG(next)))
1779                             next += n;
1780                         else
1781                             next = NULL;
1782                         inner = NEXTOPER(scan);
1783                         if (c1 == BRANCHJ) {
1784                             inner = NEXTOPER(inner);
1785                         }
1786                     } while (scan != NULL && OP(scan) == c1);
1787                     sayNO;
1788                     /* NOTREACHED */
1789                 }
1790             }
1791             break;
1792         case MINMOD:
1793             minmod = 1;
1794             break;
1795         case CURLYM:
1796         {
1797             I32 l = 0;
1798             CHECKPOINT lastcp;
1799
1800             /* We suppose that the next guy does not need
1801                backtracking: in particular, it is of constant length,
1802                and has no parenths to influence future backrefs. */
1803             ln = ARG1(scan);  /* min to match */
1804             n  = ARG2(scan);  /* max to match */
1805             paren = scan->flags;
1806             if (paren) {
1807                 if (paren > PL_regsize)
1808                     PL_regsize = paren;
1809                 if (paren > *PL_reglastparen)
1810                     *PL_reglastparen = paren;
1811             }
1812             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
1813             if (paren)
1814                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
1815             PL_reginput = locinput;
1816             if (minmod) {
1817                 minmod = 0;
1818                 if (ln && regrepeat_hard(scan, ln, &l) < ln)
1819                     sayNO;
1820                 if (ln && l == 0 && n >= ln
1821                     /* In fact, this is tricky.  If paren, then the
1822                        fact that we did/didnot match may influence
1823                        future execution. */
1824                     && !(paren && ln == 0))
1825                     ln = n;
1826                 locinput = PL_reginput;
1827                 if (regkind[(U8)OP(next)] == EXACT) {
1828                     c1 = UCHARAT(OPERAND(next) + 1);
1829                     if (OP(next) == EXACTF)
1830                         c2 = fold[c1];
1831                     else if (OP(next) == EXACTFL)
1832                         c2 = fold_locale[c1];
1833                     else
1834                         c2 = c1;
1835                 }
1836                 else
1837                     c1 = c2 = -1000;
1838                 REGCP_SET;
1839                 /* This may be improved if l == 0.  */
1840                 while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */
1841                     /* If it could work, try it. */
1842                     if (c1 == -1000 ||
1843                         UCHARAT(PL_reginput) == c1 ||
1844                         UCHARAT(PL_reginput) == c2)
1845                     {
1846                         if (paren) {
1847                             if (n) {
1848                                 PL_regstartp[paren] = HOP(PL_reginput, -l);
1849                                 PL_regendp[paren] = PL_reginput;
1850                             }
1851                             else
1852                                 PL_regendp[paren] = NULL;
1853                         }
1854                         if (regmatch(next))
1855                             sayYES;
1856                         REGCP_UNWIND;
1857                     }
1858                     /* Couldn't or didn't -- move forward. */
1859                     PL_reginput = locinput;
1860                     if (regrepeat_hard(scan, 1, &l)) {
1861                         ln++;
1862                         locinput = PL_reginput;
1863                     }
1864                     else
1865                         sayNO;
1866                 }
1867             }
1868             else {
1869                 n = regrepeat_hard(scan, n, &l);
1870                 if (n != 0 && l == 0
1871                     /* In fact, this is tricky.  If paren, then the
1872                        fact that we did/didnot match may influence
1873                        future execution. */
1874                     && !(paren && ln == 0))
1875                     ln = n;
1876                 locinput = PL_reginput;
1877                 DEBUG_r(
1878                     PerlIO_printf(Perl_debug_log,
1879                                   "%*s  matched %ld times, len=%ld...\n",
1880                                   REPORT_CODE_OFF+PL_regindent*2, "", n, l)
1881                     );
1882                 if (n >= ln) {
1883                     if (regkind[(U8)OP(next)] == EXACT) {
1884                         c1 = UCHARAT(OPERAND(next) + 1);
1885                         if (OP(next) == EXACTF)
1886                             c2 = fold[c1];
1887                         else if (OP(next) == EXACTFL)
1888                             c2 = fold_locale[c1];
1889                         else
1890                             c2 = c1;
1891                     }
1892                     else
1893                         c1 = c2 = -1000;
1894                 }
1895                 REGCP_SET;
1896                 while (n >= ln) {
1897                     /* If it could work, try it. */
1898                     if (c1 == -1000 ||
1899                         UCHARAT(PL_reginput) == c1 ||
1900                         UCHARAT(PL_reginput) == c2)
1901                     {
1902                         DEBUG_r(
1903                                 PerlIO_printf(Perl_debug_log,
1904                                               "%*s  trying tail with n=%ld...\n",
1905                                               REPORT_CODE_OFF+PL_regindent*2, "", n)
1906                             );
1907                         if (paren) {
1908                             if (n) {
1909                                 PL_regstartp[paren] = HOP(PL_reginput, -l);
1910                                 PL_regendp[paren] = PL_reginput;
1911                             }
1912                             else
1913                                 PL_regendp[paren] = NULL;
1914                         }
1915                         if (regmatch(next))
1916                             sayYES;
1917                         REGCP_UNWIND;
1918                     }
1919                     /* Couldn't or didn't -- back up. */
1920                     n--;
1921                     locinput = HOP(locinput, -l);
1922                     PL_reginput = locinput;
1923                 }
1924             }
1925             sayNO;
1926             break;
1927         }
1928         case CURLYN:
1929             paren = scan->flags;        /* Which paren to set */
1930             if (paren > PL_regsize)
1931                 PL_regsize = paren;
1932             if (paren > *PL_reglastparen)
1933                 *PL_reglastparen = paren;
1934             ln = ARG1(scan);  /* min to match */
1935             n  = ARG2(scan);  /* max to match */
1936             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
1937             goto repeat;
1938         case CURLY:
1939             paren = 0;
1940             ln = ARG1(scan);  /* min to match */
1941             n  = ARG2(scan);  /* max to match */
1942             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
1943             goto repeat;
1944         case STAR:
1945             ln = 0;
1946             n = REG_INFTY;
1947             scan = NEXTOPER(scan);
1948             paren = 0;
1949             goto repeat;
1950         case PLUS:
1951             ln = 1;
1952             n = REG_INFTY;
1953             scan = NEXTOPER(scan);
1954             paren = 0;
1955           repeat:
1956             /*
1957             * Lookahead to avoid useless match attempts
1958             * when we know what character comes next.
1959             */
1960             if (regkind[(U8)OP(next)] == EXACT) {
1961                 c1 = UCHARAT(OPERAND(next) + 1);
1962                 if (OP(next) == EXACTF)
1963                     c2 = fold[c1];
1964                 else if (OP(next) == EXACTFL)
1965                     c2 = fold_locale[c1];
1966                 else
1967                     c2 = c1;
1968             }
1969             else
1970                 c1 = c2 = -1000;
1971             PL_reginput = locinput;
1972             if (minmod) {
1973                 CHECKPOINT lastcp;
1974                 minmod = 0;
1975                 if (ln && regrepeat(scan, ln) < ln)
1976                     sayNO;
1977                 locinput = PL_reginput;
1978                 REGCP_SET;
1979                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
1980                     /* If it could work, try it. */
1981                     if (c1 == -1000 ||
1982                         UCHARAT(PL_reginput) == c1 ||
1983                         UCHARAT(PL_reginput) == c2)
1984                     {
1985                         if (paren) {
1986                             if (n) {
1987                                 PL_regstartp[paren] = HOP(PL_reginput, -1);
1988                                 PL_regendp[paren] = PL_reginput;
1989                             }
1990                             else
1991                                 PL_regendp[paren] = NULL;
1992                         }
1993                         if (regmatch(next))
1994                             sayYES;
1995                         REGCP_UNWIND;
1996                     }
1997                     /* Couldn't or didn't -- move forward. */
1998                     PL_reginput = locinput;
1999                     if (regrepeat(scan, 1)) {
2000                         ln++;
2001                         locinput = PL_reginput;
2002                     }
2003                     else
2004                         sayNO;
2005                 }
2006             }
2007             else {
2008                 CHECKPOINT lastcp;
2009                 n = regrepeat(scan, n);
2010                 locinput = PL_reginput;
2011                 if (ln < n && regkind[(U8)OP(next)] == EOL &&
2012                     (!PL_multiline  || OP(next) == SEOL))
2013                     ln = n;                     /* why back off? */
2014                 REGCP_SET;
2015                 if (paren) {
2016                     while (n >= ln) {
2017                         /* If it could work, try it. */
2018                         if (c1 == -1000 ||
2019                             UCHARAT(PL_reginput) == c1 ||
2020                             UCHARAT(PL_reginput) == c2)
2021                             {
2022                                 if (paren && n) {
2023                                     if (n) {
2024                                         PL_regstartp[paren] = HOP(PL_reginput, -1);
2025                                         PL_regendp[paren] = PL_reginput;
2026                                     }
2027                                     else
2028                                         PL_regendp[paren] = NULL;
2029                                 }
2030                                 if (regmatch(next))
2031                                     sayYES;
2032                                 REGCP_UNWIND;
2033                             }
2034                         /* Couldn't or didn't -- back up. */
2035                         n--;
2036                         PL_reginput = locinput = HOP(locinput, -1);
2037                     }
2038                 }
2039                 else {
2040                     while (n >= ln) {
2041                         /* If it could work, try it. */
2042                         if (c1 == -1000 ||
2043                             UCHARAT(PL_reginput) == c1 ||
2044                             UCHARAT(PL_reginput) == c2)
2045                             {
2046                                 if (regmatch(next))
2047                                     sayYES;
2048                                 REGCP_UNWIND;
2049                             }
2050                         /* Couldn't or didn't -- back up. */
2051                         n--;
2052                         PL_reginput = locinput = HOP(locinput, -1);
2053                     }
2054                 }
2055             }
2056             sayNO;
2057             break;
2058         case END:
2059             if (locinput < PL_regtill)
2060                 sayNO;                  /* Cannot match: too short. */
2061             /* Fall through */
2062         case SUCCEED:
2063             PL_reginput = locinput;     /* put where regtry can find it */
2064             sayYES;                     /* Success! */
2065         case SUSPEND:
2066             n = 1;
2067             goto do_ifmatch;
2068         case UNLESSM:
2069             n = 0;
2070             if (scan->flags) {
2071                 s = HOPMAYBE(locinput, -scan->flags);
2072                 if (!s)
2073                     goto say_yes;
2074                 PL_reginput = s;
2075             }
2076             else
2077                 PL_reginput = locinput;
2078             goto do_ifmatch;
2079         case IFMATCH:
2080             n = 1;
2081             if (scan->flags) {
2082                 s = HOPMAYBE(locinput, -scan->flags);
2083                 if (!s)
2084                     goto say_no;
2085                 PL_reginput = s;
2086             }
2087             else
2088                 PL_reginput = locinput;
2089
2090           do_ifmatch:
2091             inner = NEXTOPER(NEXTOPER(scan));
2092             if (regmatch(inner) != n) {
2093               say_no:
2094                 if (logical) {
2095                     logical = 0;
2096                     sw = 0;
2097                     goto do_longjump;
2098                 }
2099                 else
2100                     sayNO;
2101             }
2102           say_yes:
2103             if (logical) {
2104                 logical = 0;
2105                 sw = 1;
2106             }
2107             if (OP(scan) == SUSPEND) {
2108                 locinput = PL_reginput;
2109                 nextchr = UCHARAT(locinput);
2110             }
2111             /* FALL THROUGH. */
2112         case LONGJMP:
2113           do_longjump:
2114             next = scan + ARG(scan);
2115             if (next == scan)
2116                 next = NULL;
2117             break;
2118         default:
2119             PerlIO_printf(PerlIO_stderr(), "%lx %d\n",
2120                           (unsigned long)scan, OP(scan));
2121             FAIL("regexp memory corruption");
2122         }
2123         scan = next;
2124     }
2125
2126     /*
2127     * We get here only if there's trouble -- normally "case END" is
2128     * the terminating point.
2129     */
2130     FAIL("corrupted regexp pointers");
2131     /*NOTREACHED*/
2132     sayNO;
2133
2134 yes:
2135 #ifdef DEBUGGING
2136     PL_regindent--;
2137 #endif
2138     return 1;
2139
2140 no:
2141 #ifdef DEBUGGING
2142     PL_regindent--;
2143 #endif
2144     return 0;
2145 }
2146
2147 /*
2148  - regrepeat - repeatedly match something simple, report how many
2149  */
2150 /*
2151  * [This routine now assumes that it will only match on things of length 1.
2152  * That was true before, but now we assume scan - reginput is the count,
2153  * rather than incrementing count on every character.  [Er, except utf8.]]
2154  */
2155 STATIC I32
2156 regrepeat(regnode *p, I32 max)
2157 {
2158     dTHR;
2159     register char *scan;
2160     register char *opnd;
2161     register I32 c;
2162     register char *loceol = PL_regeol;
2163     register I32 hardcount = 0;
2164
2165     scan = PL_reginput;
2166     if (max != REG_INFTY && max < loceol - scan)
2167       loceol = scan + max;
2168     opnd = (char *) OPERAND(p);
2169     switch (OP(p)) {
2170     case ANY:
2171         while (scan < loceol && *scan != '\n')
2172             scan++;
2173         break;
2174     case SANY:
2175         scan = loceol;
2176         break;
2177     case ANYUTF8:
2178         loceol = PL_regeol;
2179         while (scan < loceol && *scan != '\n') {
2180             scan += UTF8SKIP(scan);
2181             hardcount++;
2182         }
2183         break;
2184     case SANYUTF8:
2185         loceol = PL_regeol;
2186         while (scan < loceol) {
2187             scan += UTF8SKIP(scan);
2188             hardcount++;
2189         }
2190         break;
2191     case EXACT:         /* length of string is 1 */
2192         c = UCHARAT(++opnd);
2193         while (scan < loceol && UCHARAT(scan) == c)
2194             scan++;
2195         break;
2196     case EXACTF:        /* length of string is 1 */
2197         c = UCHARAT(++opnd);
2198         while (scan < loceol &&
2199                (UCHARAT(scan) == c || UCHARAT(scan) == fold[c]))
2200             scan++;
2201         break;
2202     case EXACTFL:       /* length of string is 1 */
2203         PL_reg_flags |= RF_tainted;
2204         c = UCHARAT(++opnd);
2205         while (scan < loceol &&
2206                (UCHARAT(scan) == c || UCHARAT(scan) == fold_locale[c]))
2207             scan++;
2208         break;
2209     case ANYOFUTF8:
2210         loceol = PL_regeol;
2211         while (scan < loceol && REGINCLASSUTF8(p, (U8*)scan)) {
2212             scan += UTF8SKIP(scan);
2213             hardcount++;
2214         }
2215         break;
2216     case ANYOF:
2217         while (scan < loceol && REGINCLASS(opnd, *scan))
2218             scan++;
2219         break;
2220     case ALNUM:
2221         while (scan < loceol && isALNUM(*scan))
2222             scan++;
2223         break;
2224     case ALNUMUTF8:
2225         loceol = PL_regeol;
2226         while (scan < loceol && swash_fetch(PL_utf8_alnum, scan)) {
2227             scan += UTF8SKIP(scan);
2228             hardcount++;
2229         }
2230         break;
2231     case ALNUML:
2232         PL_reg_flags |= RF_tainted;
2233         while (scan < loceol && isALNUM_LC(*scan))
2234             scan++;
2235         break;
2236     case ALNUMLUTF8:
2237         PL_reg_flags |= RF_tainted;
2238         loceol = PL_regeol;
2239         while (scan < loceol && isALNUM_LC_utf8(scan)) {
2240             scan += UTF8SKIP(scan);
2241             hardcount++;
2242         }
2243         break;
2244         break;
2245     case NALNUM:
2246         while (scan < loceol && !isALNUM(*scan))
2247             scan++;
2248         break;
2249     case NALNUMUTF8:
2250         loceol = PL_regeol;
2251         while (scan < loceol && !swash_fetch(PL_utf8_alnum, scan)) {
2252             scan += UTF8SKIP(scan);
2253             hardcount++;
2254         }
2255         break;
2256     case NALNUML:
2257         PL_reg_flags |= RF_tainted;
2258         while (scan < loceol && !isALNUM_LC(*scan))
2259             scan++;
2260         break;
2261     case NALNUMLUTF8:
2262         PL_reg_flags |= RF_tainted;
2263         loceol = PL_regeol;
2264         while (scan < loceol && !isALNUM_LC_utf8(scan)) {
2265             scan += UTF8SKIP(scan);
2266             hardcount++;
2267         }
2268         break;
2269     case SPACE:
2270         while (scan < loceol && isSPACE(*scan))
2271             scan++;
2272         break;
2273     case SPACEUTF8:
2274         loceol = PL_regeol;
2275         while (scan < loceol && (*scan == ' ' || swash_fetch(PL_utf8_space,scan))) {
2276             scan += UTF8SKIP(scan);
2277             hardcount++;
2278         }
2279         break;
2280     case SPACEL:
2281         PL_reg_flags |= RF_tainted;
2282         while (scan < loceol && isSPACE_LC(*scan))
2283             scan++;
2284         break;
2285     case SPACELUTF8:
2286         PL_reg_flags |= RF_tainted;
2287         loceol = PL_regeol;
2288         while (scan < loceol && (*scan == ' ' || isSPACE_LC_utf8(scan))) {
2289             scan += UTF8SKIP(scan);
2290             hardcount++;
2291         }
2292         break;
2293     case NSPACE:
2294         while (scan < loceol && !isSPACE(*scan))
2295             scan++;
2296         break;
2297     case NSPACEUTF8:
2298         loceol = PL_regeol;
2299         while (scan < loceol && !(*scan == ' ' || swash_fetch(PL_utf8_space,scan))) {
2300             scan += UTF8SKIP(scan);
2301             hardcount++;
2302         }
2303         break;
2304     case NSPACEL:
2305         PL_reg_flags |= RF_tainted;
2306         while (scan < loceol && !isSPACE_LC(*scan))
2307             scan++;
2308         break;
2309     case NSPACELUTF8:
2310         PL_reg_flags |= RF_tainted;
2311         loceol = PL_regeol;
2312         while (scan < loceol && !(*scan == ' ' || isSPACE_LC_utf8(scan))) {
2313             scan += UTF8SKIP(scan);
2314             hardcount++;
2315         }
2316         break;
2317     case DIGIT:
2318         while (scan < loceol && isDIGIT(*scan))
2319             scan++;
2320         break;
2321     case DIGITUTF8:
2322         loceol = PL_regeol;
2323         while (scan < loceol && swash_fetch(PL_utf8_digit,scan)) {
2324             scan += UTF8SKIP(scan);
2325             hardcount++;
2326         }
2327         break;
2328         break;
2329     case NDIGIT:
2330         while (scan < loceol && !isDIGIT(*scan))
2331             scan++;
2332         break;
2333     case NDIGITUTF8:
2334         loceol = PL_regeol;
2335         while (scan < loceol && !swash_fetch(PL_utf8_digit,scan)) {
2336             scan += UTF8SKIP(scan);
2337             hardcount++;
2338         }
2339         break;
2340     default:            /* Called on something of 0 width. */
2341         break;          /* So match right here or not at all. */
2342     }
2343
2344     if (hardcount)
2345         c = hardcount;
2346     else
2347         c = scan - PL_reginput;
2348     PL_reginput = scan;
2349
2350     DEBUG_r(
2351         {
2352                 SV *prop = sv_newmortal();
2353
2354                 regprop(prop, p);
2355                 PerlIO_printf(Perl_debug_log,
2356                               "%*s  %s can match %ld times out of %ld...\n",
2357                               REPORT_CODE_OFF+1, "", SvPVX(prop),c,max);
2358         });
2359
2360     return(c);
2361 }
2362
2363 /*
2364  - regrepeat_hard - repeatedly match something, report total lenth and length
2365  *
2366  * The repeater is supposed to have constant length.
2367  */
2368
2369 STATIC I32
2370 regrepeat_hard(regnode *p, I32 max, I32 *lp)
2371 {
2372     dTHR;
2373     register char *scan;
2374     register char *start;
2375     register char *loceol = PL_regeol;
2376     I32 l = 0;
2377     I32 count = 0;
2378
2379     if (!max)
2380         return 0;
2381
2382     start = PL_reginput;
2383     if (UTF) {
2384         while (PL_reginput < loceol && (scan = PL_reginput, regmatch(p))) {
2385             if (!count++) {
2386                 l = 0;
2387                 while (start < PL_reginput) {
2388                     l++;
2389                     start += UTF8SKIP(start);
2390                 }
2391                 *lp = l;
2392                 if (l == 0)
2393                     return max;
2394             }
2395             if (count == max)
2396                 return count;
2397         }
2398     }
2399     else {
2400         while (PL_reginput < loceol && (scan = PL_reginput, regmatch(p))) {
2401             if (!count++) {
2402                 *lp = l = PL_reginput - start;
2403                 if (max != REG_INFTY && l*max < loceol - scan)
2404                     loceol = scan + l*max;
2405                 if (l == 0)
2406                     return max;
2407             }
2408         }
2409     }
2410     if (PL_reginput < loceol)
2411         PL_reginput = scan;
2412
2413     return count;
2414 }
2415
2416 /*
2417  - regclass - determine if a character falls into a character class
2418  */
2419
2420 STATIC bool
2421 reginclass(register char *p, register I32 c)
2422 {
2423     dTHR;
2424     char flags = *p;
2425     bool match = FALSE;
2426
2427     c &= 0xFF;
2428     if (ANYOF_TEST(p, c))
2429         match = TRUE;
2430     else if (flags & ANYOF_FOLD) {
2431         I32 cf;
2432         if (flags & ANYOF_LOCALE) {
2433             PL_reg_flags |= RF_tainted;
2434             cf = fold_locale[c];
2435         }
2436         else
2437             cf = fold[c];
2438         if (ANYOF_TEST(p, cf))
2439             match = TRUE;
2440     }
2441
2442     if (!match && (flags & ANYOF_ISA)) {
2443         PL_reg_flags |= RF_tainted;
2444
2445         if (((flags & ANYOF_ALNUML)  && isALNUM_LC(c))  ||
2446             ((flags & ANYOF_NALNUML) && !isALNUM_LC(c)) ||
2447             ((flags & ANYOF_SPACEL)  && isSPACE_LC(c))  ||
2448             ((flags & ANYOF_NSPACEL) && !isSPACE_LC(c)))
2449         {
2450             match = TRUE;
2451         }
2452     }
2453
2454     return (flags & ANYOF_INVERT) ? !match : match;
2455 }
2456
2457 STATIC bool
2458 reginclassutf8(regnode *f, U8 *p)
2459 {
2460     char flags = ARG1(f);
2461     bool match = FALSE;
2462     SV *sv = (SV*)PL_regdata->data[ARG2(f)];
2463
2464     if (swash_fetch(sv, p))
2465         match = TRUE;
2466     else if (flags & ANYOF_FOLD) {
2467         I32 cf;
2468         char tmpbuf[10];
2469         if (flags & ANYOF_LOCALE) {
2470             PL_reg_flags |= RF_tainted;
2471             uv_to_utf8(tmpbuf, toLOWER_LC_utf8(p));
2472         }
2473         else
2474             uv_to_utf8(tmpbuf, toLOWER_utf8(p));
2475         if (swash_fetch(sv, tmpbuf))
2476             match = TRUE;
2477     }
2478
2479     if (!match && (flags & ANYOF_ISA)) {
2480         PL_reg_flags |= RF_tainted;
2481
2482         if (((flags & ANYOF_ALNUML)  && isALNUM_LC_utf8(p))  ||
2483             ((flags & ANYOF_NALNUML) && !isALNUM_LC_utf8(p)) ||
2484             ((flags & ANYOF_SPACEL)  && isSPACE_LC_utf8(p))  ||
2485             ((flags & ANYOF_NSPACEL) && !isSPACE_LC_utf8(p)))
2486         {
2487             match = TRUE;
2488         }
2489     }
2490
2491     return (flags & ANYOF_INVERT) ? !match : match;
2492 }
2493
2494 STATIC char *
2495 reghop(unsigned char *s, I32 off)
2496 {
2497     if (off >= 0) {
2498         while (off-- && s < (U8*)PL_regeol)
2499             s += UTF8SKIP(s);
2500     }
2501     else {
2502         while (off++) {
2503             if (s > (U8*)PL_bostr) {
2504                 s--;
2505                 if (*s & 0x80) {
2506                     while (s > (U8*)PL_bostr && (*s & 0xc0) == 0x80)
2507                         s--;
2508                 }               /* XXX could check well-formedness here */
2509             }
2510         }
2511     }
2512     return s;
2513 }
2514
2515 STATIC char *
2516 reghopmaybe(unsigned char *s, I32 off)
2517 {
2518     if (off >= 0) {
2519         while (off-- && s < (U8*)PL_regeol)
2520             s += UTF8SKIP(s);
2521         if (off >= 0)
2522             return 0;
2523     }
2524     else {
2525         while (off++) {
2526             if (s > (U8*)PL_bostr) {
2527                 s--;
2528                 if (*s & 0x80) {
2529                     while (s > (U8*)PL_bostr && (*s & 0xc0) == 0x80)
2530                         s--;
2531                 }               /* XXX could check well-formedness here */
2532             }
2533             else
2534                 break;
2535         }
2536         if (off <= 0)
2537             return 0;
2538     }
2539     return s;
2540 }