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