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