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 /*SUPPRESS 112*/
  23 /*
  24  * pregcomp and pregexec -- regsub and regerror are not used in perl
  25  *
  26  *      Copyright (c) 1986 by University of Toronto.
  27  *      Written by Henry Spencer.  Not derived from licensed software.
  28  *
  29  *      Permission is granted to anyone to use this software for any
  30  *      purpose on any computer system, and to redistribute it freely,
  31  *      subject to the following restrictions:
  32  *
  33  *      1. The author is not responsible for the consequences of use of
  34  *              this software, no matter how awful, even if they arise
  35  *              from defects in it.
  36  *
  37  *      2. The origin of this software must not be misrepresented, either
  38  *              by explicit claim or by omission.
  39  *
  40  *      3. Altered versions must be plainly marked as such, and must not
  41  *              be misrepresented as being the original software.
  42  *
  43  ****    Alterations to Henry's code are...
  44  ****
  45  ****    Copyright (c) 1991-1997, Larry Wall
  46  ****
  47  ****    You may distribute under the terms of either the GNU General Public
  48  ****    License or the Artistic License, as specified in the README file.
  49  *
  50  * Beware that some of this code is subtly aware of the way operator
  51  * precedence is structured in regular expressions.  Serious changes in
  52  * regular-expression syntax might require a total rethink.
  53  */
  54 #include "EXTERN.h"
  55 #include "perl.h"
  56 #include "regcomp.h"
  57
  58 #define RF_tainted      1               /* tainted information used? */
  59 #define RF_warned       2               /* warned about big count? */
  60 #define RF_evaled       4               /* Did an EVAL with setting? */
  61
  62 #define RS_init         1               /* eval environment created */
  63 #define RS_set          2               /* replsv value is set */
  64
  65 #ifndef STATIC
  66 #define STATIC  static
  67 #endif
  68
  69 #ifndef PERL_OBJECT
  70 typedef I32 CHECKPOINT;
  71
  72 /*
  73  * Forwards.
  74  */
  75
  76 static I32 regmatch _((regnode *prog));
  77 static I32 regrepeat _((regnode *p, I32 max));
  78 static I32 regrepeat_hard _((regnode *p, I32 max, I32 *lp));
  79 static I32 regtry _((regexp *prog, char *startpos));
  80
  81 static bool reginclass _((char *p, I32 c));
  82 static CHECKPOINT regcppush _((I32 parenfloor));
  83 static char * regcppop _((void));
  84 #endif
  85 #define REGINCLASS(p,c)  (*(p) ? reginclass(p,c) : ANYOF_TEST(p,c))
  86
  87 STATIC CHECKPOINT
  88 regcppush(I32 parenfloor)
  89 {
  90     dTHR;
  91     int retval = savestack_ix;
  92     int i = (regsize - parenfloor) * 4;
  93     int p;
  94
  95     SSCHECK(i + 5);
  96     for (p = regsize; p > parenfloor; p--) {
  97         SSPUSHPTR(regendp[p]);
  98         SSPUSHPTR(regstartp[p]);
  99         SSPUSHPTR(reg_start_tmp[p]);
 100         SSPUSHINT(p);
 101     }
 102     SSPUSHINT(regsize);
 103     SSPUSHINT(*reglastparen);
 104     SSPUSHPTR(reginput);
 105     SSPUSHINT(i + 3);
 106     SSPUSHINT(SAVEt_REGCONTEXT);
 107     return retval;
 108 }
 109
 110 /* These are needed since we do not localize EVAL nodes: */
 111 #  define REGCP_SET  DEBUG_r(PerlIO_printf(Perl_debug_log, "  Setting an EVAL scope, savestack=%i\n", savestack_ix)); lastcp = savestack_ix
 112 #  define REGCP_UNWIND  DEBUG_r(lastcp != savestack_ix ? PerlIO_printf(Perl_debug_log,"  Clearing an EVAL scope, savestack=%i..%i\n", lastcp, savestack_ix) : 0); regcpblow(lastcp)
 113
 114 STATIC char *
 115 regcppop(void)
 116 {
 117     dTHR;
 118     I32 i = SSPOPINT;
 119     U32 paren = 0;
 120     char *input;
 121     char *tmps;
 122     assert(i == SAVEt_REGCONTEXT);
 123     i = SSPOPINT;
 124     input = (char *) SSPOPPTR;
 125     *reglastparen = SSPOPINT;
 126     regsize = SSPOPINT;
 127     for (i -= 3; i > 0; i -= 4) {
 128         paren = (U32)SSPOPINT;
 129         reg_start_tmp[paren] = (char *) SSPOPPTR;
 130         regstartp[paren] = (char *) SSPOPPTR;
 131         tmps = (char*)SSPOPPTR;
 132         if (paren <= *reglastparen)
 133             regendp[paren] = tmps;
 134         DEBUG_r(
 135             PerlIO_printf(Perl_debug_log, "     restoring \\%d to %d(%d)..%d%s\n",
 136                           paren, regstartp[paren] - regbol,
 137                           reg_start_tmp[paren] - regbol,
 138                           regendp[paren] - regbol,
 139                           (paren > *reglastparen ? "(no)" : ""));
 140         );
 141     }
 142     DEBUG_r(
 143         if (*reglastparen + 1 <= regnpar) {
 144             PerlIO_printf(Perl_debug_log, "     restoring \\%d..\\%d to undef\n",
 145                           *reglastparen + 1, regnpar);
 146         }
 147     );
 148     for (paren = *reglastparen + 1; paren <= regnpar; paren++) {
 149         if (paren > regsize)
 150             regstartp[paren] = Nullch;
 151         regendp[paren] = Nullch;
 152     }
 153     return input;
 154 }
 155
 156 #define regcpblow(cp) LEAVE_SCOPE(cp)
 157
 158 /*
 159  * pregexec and friends
 160  */
 161
 162 /*
 163  - pregexec - match a regexp against a string
 164  */
 165 I32
 166 pregexec(register regexp *prog, char *stringarg, register char *strend, char *strbeg, I32 minend, SV *screamer, U32 nosave)
 167 /* strend: pointer to null at end of string */
 168 /* strbeg: real beginning of string */
 169 /* minend: end of match must be >=minend after stringarg. */
 170 /* nosave: For optimizations. */
 171 {
 172     return
 173         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
 174                       nosave ? 0 : REXEC_COPY_STR);
 175 }
 176
 177 /*
 178  - regexec_flags - match a regexp against a string
 179  */
 180 I32
 181 regexec_flags(register regexp *prog, char *stringarg, register char *strend, char *strbeg, I32 minend, SV *screamer, void *data, U32 flags)
 182 /* strend: pointer to null at end of string */
 183 /* strbeg: real beginning of string */
 184 /* minend: end of match must be >=minend after stringarg. */
 185 /* data: May be used for some additional optimizations. */
 186 /* nosave: For optimizations. */
 187 {
 188     register char *s;
 189     register regnode *c;
 190     register char *startpos = stringarg;
 191     register I32 tmp;
 192     I32 minlen;         /* must match at least this many chars */
 193     I32 dontbother = 0; /* how many characters not to try at end */
 194     CURCUR cc;
 195     I32 start_shift = 0;                /* Offset of the start to find
 196                                          constant substr. */
 197     I32 end_shift = 0;                  /* Same for the end. */
 198     I32 scream_pos = -1;                /* Internal iterator of scream. */
 199     char *scream_olds;
 200     SV* oreplsv = GvSV(replgv);
 201
 202     cc.cur = 0;
 203     cc.oldcc = 0;
 204     regcc = &cc;
 205
 206     regprecomp = prog->precomp;         /* Needed for error messages. */
 207 #ifdef DEBUGGING
 208     regnarrate = debug & 512;
 209     regprogram = prog->program;
 210 #endif
 211
 212     /* Be paranoid... */
 213     if (prog == NULL || startpos == NULL) {
 214         croak("NULL regexp parameter");
 215         return 0;
 216     }
 217
 218     minlen = prog->minlen;
 219     if (strend - startpos < minlen) goto phooey;
 220
 221     if (startpos == strbeg)     /* is ^ valid at stringarg? */
 222         regprev = '\n';
 223     else {
 224         regprev = stringarg[-1];
 225         if (!multiline && regprev == '\n')
 226             regprev = '\0';             /* force ^ to NOT match */
 227     }
 228
 229     /* Check validity of program. */
 230     if (UCHARAT(prog->program) != MAGIC) {
 231         FAIL("corrupted regexp program");
 232     }
 233
 234     regnpar = prog->nparens;
 235     reg_flags = 0;
 236     reg_eval_set = 0;
 237
 238     /* If there is a "must appear" string, look for it. */
 239     s = startpos;
 240     if (!(flags & REXEC_CHECKED)
 241         && prog->check_substr != Nullsv &&
 242         !(prog->reganch & ROPT_ANCH_GPOS) &&
 243         (!(prog->reganch & (ROPT_ANCH_BOL | ROPT_ANCH_MBOL))
 244          || (multiline && prog->check_substr == prog->anchored_substr)) )
 245     {
 246         start_shift = prog->check_offset_min;
 247         /* Should be nonnegative! */
 248         end_shift = minlen - start_shift - SvCUR(prog->check_substr);
 249         if (screamer) {
 250             if (screamfirst[BmRARE(prog->check_substr)] >= 0)
 251                     s = screaminstr(screamer, prog->check_substr,
 252                                     start_shift + (stringarg - strbeg),
 253                                     end_shift, &scream_pos, 0);
 254             else
 255                     s = Nullch;
 256             scream_olds = s;
 257         }
 258         else
 259             s = fbm_instr((unsigned char*)s + start_shift,
 260                           (unsigned char*)strend - end_shift,
 261                 prog->check_substr, 0);
 262         if (!s) {
 263             ++BmUSEFUL(prog->check_substr);     /* hooray */
 264             goto phooey;        /* not present */
 265         } else if ((s - stringarg) > prog->check_offset_max) {
 266             ++BmUSEFUL(prog->check_substr);     /* hooray/2 */
 267             s -= prog->check_offset_max;
 268         } else if (!prog->naughty
 269                    && --BmUSEFUL(prog->check_substr) < 0
 270                    && prog->check_substr == prog->float_substr) { /* boo */
 271             SvREFCNT_dec(prog->check_substr);
 272             prog->check_substr = Nullsv;        /* disable */
 273             prog->float_substr = Nullsv;        /* clear */
 274             s = startpos;
 275         } else s = startpos;
 276     }
 277
 278     /* Mark beginning of line for ^ and lookbehind. */
 279     regbol = startpos;
 280     bostr  = strbeg;
 281
 282     /* Mark end of line for $ (and such) */
 283     regeol = strend;
 284
 285     /* see how far we have to get to not match where we matched before */
 286     regtill = startpos+minend;
 287
 288     DEBUG_r(
 289         PerlIO_printf(Perl_debug_log,
 290                       "Matching `%.60s%s' against `%.*s%s'\n",
 291                       prog->precomp,
 292                       (strlen(prog->precomp) > 60 ? "..." : ""),
 293                       (strend - startpos > 60 ? 60 : strend - startpos),
 294                       startpos,
 295                       (strend - startpos > 60 ? "..." : ""))
 296         );
 297
 298     /* Simplest case:  anchored match need be tried only once. */
 299     /*  [unless only anchor is BOL and multiline is set] */
 300     if (prog->reganch & ROPT_ANCH) {
 301         if (regtry(prog, startpos))
 302             goto got_it;
 303         else if (!(prog->reganch & ROPT_ANCH_GPOS) &&
 304                  (multiline || (prog->reganch & ROPT_IMPLICIT)
 305                   || (prog->reganch & ROPT_ANCH_MBOL)))
 306         {
 307             if (minlen)
 308                 dontbother = minlen - 1;
 309             strend -= dontbother;
 310             /* for multiline we only have to try after newlines */
 311             if (s > startpos)
 312                 s--;
 313             while (s < strend) {
 314                 if (*s++ == '\n') {
 315                     if (s < strend && regtry(prog, s))
 316                         goto got_it;
 317                 }
 318             }
 319         }
 320         goto phooey;
 321     }
 322
 323     /* Messy cases:  unanchored match. */
 324     if (prog->anchored_substr && prog->reganch & ROPT_SKIP) {
 325         /* we have /x+whatever/ */
 326         /* it must be a one character string */
 327         char ch = SvPVX(prog->anchored_substr)[0];
 328         while (s < strend) {
 329             if (*s == ch) {
 330                 if (regtry(prog, s)) goto got_it;
 331                 s++;
 332                 while (s < strend && *s == ch)
 333                     s++;
 334             }
 335             s++;
 336         }
 337     }
 338     /*SUPPRESS 560*/
 339     else if (prog->anchored_substr != Nullsv
 340              || (prog->float_substr != Nullsv
 341                  && prog->float_max_offset < strend - s)) {
 342         SV *must = prog->anchored_substr
 343             ? prog->anchored_substr : prog->float_substr;
 344         I32 back_max =
 345             prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset;
 346         I32 back_min =
 347             prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset;
 348         I32 delta = back_max - back_min;
 349         char *last = strend - SvCUR(must) - back_min; /* Cannot start after this */
 350         char *last1 = s - 1;            /* Last position checked before */
 351
 352         /* XXXX check_substr already used to find `s', can optimize if
 353            check_substr==must. */
 354         scream_pos = -1;
 355         dontbother = end_shift;
 356         strend -= dontbother;
 357         while ( (s <= last) &&
 358                 (screamer
 359                  ? (s = screaminstr(screamer, must, s + back_min - strbeg,
 360                                     end_shift, &scream_pos, 0))
 361                  : (s = fbm_instr((unsigned char*)s + back_min,
 362                                   (unsigned char*)strend, must, 0))) ) {
 363             if (s - back_max > last1) {
 364                 last1 = s - back_min;
 365                 s = s - back_max;
 366             } else {
 367                 char *t = last1 + 1;
 368
 369                 last1 = s - back_min;
 370                 s = t;
 371             }
 372             while (s <= last1) {
 373                 if (regtry(prog, s))
 374                     goto got_it;
 375                 s++;
 376             }
 377         }
 378         goto phooey;
 379     } else if (c = prog->regstclass) {
 380         I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
 381         char *Class;
 382
 383         if (minlen)
 384             dontbother = minlen - 1;
 385         strend -= dontbother;   /* don't bother with what can't match */
 386         tmp = 1;
 387         /* We know what class it must start with. */
 388         switch (OP(c)) {
 389         case ANYOF:
 390             Class = (char *) OPERAND(c);
 391             while (s < strend) {
 392                 if (REGINCLASS(Class, *s)) {
 393                     if (tmp && regtry(prog, s))
 394                         goto got_it;
 395                     else
 396                         tmp = doevery;
 397                 }
 398                 else
 399                     tmp = 1;
 400                 s++;
 401             }
 402             break;
 403         case BOUNDL:
 404             reg_flags |= RF_tainted;
 405             /* FALL THROUGH */
 406         case BOUND:
 407             if (minlen)
 408                 dontbother++,strend--;
 409             tmp = (s != startpos) ? UCHARAT(s - 1) : regprev;
 410             tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
 411             while (s < strend) {
 412                 if (tmp == !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
 413                     tmp = !tmp;
 414                     if (regtry(prog, s))
 415                         goto got_it;
 416                 }
 417                 s++;
 418             }
 419             if ((minlen || tmp) && regtry(prog,s))
 420                 goto got_it;
 421             break;
 422         case NBOUNDL:
 423             reg_flags |= RF_tainted;
 424             /* FALL THROUGH */
 425         case NBOUND:
 426             if (minlen)
 427                 dontbother++,strend--;
 428             tmp = (s != startpos) ? UCHARAT(s - 1) : regprev;
 429             tmp = ((OP(c) == NBOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
 430             while (s < strend) {
 431                 if (tmp == !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
 432                     tmp = !tmp;
 433                 else if (regtry(prog, s))
 434                     goto got_it;
 435                 s++;
 436             }
 437             if ((minlen || !tmp) && regtry(prog,s))
 438                 goto got_it;
 439             break;
 440         case ALNUM:
 441             while (s < strend) {
 442                 if (isALNUM(*s)) {
 443                     if (tmp && regtry(prog, s))
 444                         goto got_it;
 445                     else
 446                         tmp = doevery;
 447                 }
 448                 else
 449                     tmp = 1;
 450                 s++;
 451             }
 452             break;
 453         case ALNUML:
 454             reg_flags |= RF_tainted;
 455             while (s < strend) {
 456                 if (isALNUM_LC(*s)) {
 457                     if (tmp && regtry(prog, s))
 458                         goto got_it;
 459                     else
 460                         tmp = doevery;
 461                 }
 462                 else
 463                     tmp = 1;
 464                 s++;
 465             }
 466             break;
 467         case NALNUM:
 468             while (s < strend) {
 469                 if (!isALNUM(*s)) {
 470                     if (tmp && regtry(prog, s))
 471                         goto got_it;
 472                     else
 473                         tmp = doevery;
 474                 }
 475                 else
 476                     tmp = 1;
 477                 s++;
 478             }
 479             break;
 480         case NALNUML:
 481             reg_flags |= RF_tainted;
 482             while (s < strend) {
 483                 if (!isALNUM_LC(*s)) {
 484                     if (tmp && regtry(prog, s))
 485                         goto got_it;
 486                     else
 487                         tmp = doevery;
 488                 }
 489                 else
 490                     tmp = 1;
 491                 s++;
 492             }
 493             break;
 494         case SPACE:
 495             while (s < strend) {
 496                 if (isSPACE(*s)) {
 497                     if (tmp && regtry(prog, s))
 498                         goto got_it;
 499                     else
 500                         tmp = doevery;
 501                 }
 502                 else
 503                     tmp = 1;
 504                 s++;
 505             }
 506             break;
 507         case SPACEL:
 508             reg_flags |= RF_tainted;
 509             while (s < strend) {
 510                 if (isSPACE_LC(*s)) {
 511                     if (tmp && regtry(prog, s))
 512                         goto got_it;
 513                     else
 514                         tmp = doevery;
 515                 }
 516                 else
 517                     tmp = 1;
 518                 s++;
 519             }
 520             break;
 521         case NSPACE:
 522             while (s < strend) {
 523                 if (!isSPACE(*s)) {
 524                     if (tmp && regtry(prog, s))
 525                         goto got_it;
 526                     else
 527                         tmp = doevery;
 528                 }
 529                 else
 530                     tmp = 1;
 531                 s++;
 532             }
 533             break;
 534         case NSPACEL:
 535             reg_flags |= RF_tainted;
 536             while (s < strend) {
 537                 if (!isSPACE_LC(*s)) {
 538                     if (tmp && regtry(prog, s))
 539                         goto got_it;
 540                     else
 541                         tmp = doevery;
 542                 }
 543                 else
 544                     tmp = 1;
 545                 s++;
 546             }
 547             break;
 548         case DIGIT:
 549             while (s < strend) {
 550                 if (isDIGIT(*s)) {
 551                     if (tmp && regtry(prog, s))
 552                         goto got_it;
 553                     else
 554                         tmp = doevery;
 555                 }
 556                 else
 557                     tmp = 1;
 558                 s++;
 559             }
 560             break;
 561         case NDIGIT:
 562             while (s < strend) {
 563                 if (!isDIGIT(*s)) {
 564                     if (tmp && regtry(prog, s))
 565                         goto got_it;
 566                     else
 567                         tmp = doevery;
 568                 }
 569                 else
 570                     tmp = 1;
 571                 s++;
 572             }
 573             break;
 574         }
 575     }
 576     else {
 577         dontbother = 0;
 578         if (prog->float_substr != Nullsv) {     /* Trim the end. */
 579             char *last;
 580             I32 oldpos = scream_pos;
 581
 582             if (screamer) {
 583                 last = screaminstr(screamer, prog->float_substr, s - strbeg,
 584                                    end_shift, &scream_pos, 1); /* last one */
 585                 if (!last) {
 586                     last = scream_olds; /* Only one occurence. */
 587                 }
 588             } else {
 589                 STRLEN len;
 590                 char *little = SvPV(prog->float_substr, len);
 591                 last = rninstr(s, strend, little, little + len);
 592             }
 593             if (last == NULL) goto phooey; /* Should not happen! */
 594             dontbother = strend - last - 1;
 595         }
 596         if (minlen && (dontbother < minlen))
 597             dontbother = minlen - 1;
 598         strend -= dontbother;
 599         /* We don't know much -- general case. */
 600         do {
 601             if (regtry(prog, s))
 602                 goto got_it;
 603         } while (s++ < strend);
 604     }
 605
 606     /* Failure. */
 607     goto phooey;
 608
 609 got_it:
 610     strend += dontbother;       /* uncheat */
 611     prog->subbeg = strbeg;
 612     prog->subend = strend;
 613     RX_MATCH_TAINTED_set(prog, reg_flags & RF_tainted);
 614
 615     /* make sure $`, $&, $', and $digit will work later */
 616     if (strbeg != prog->subbase) {      /* second+ //g match.  */
 617         if (!(flags & REXEC_COPY_STR)) {
 618             if (prog->subbase) {
 619                 Safefree(prog->subbase);
 620                 prog->subbase = Nullch;
 621             }
 622         }
 623         else {
 624             I32 i = strend - startpos + (stringarg - strbeg);
 625             s = savepvn(strbeg, i);
 626             Safefree(prog->subbase);
 627             prog->subbase = s;
 628             prog->subbeg = prog->subbase;
 629             prog->subend = prog->subbase + i;
 630             s = prog->subbase + (stringarg - strbeg);
 631             for (i = 0; i <= prog->nparens; i++) {
 632                 if (prog->endp[i]) {
 633                     prog->startp[i] = s + (prog->startp[i] - startpos);
 634                     prog->endp[i] = s + (prog->endp[i] - startpos);
 635                 }
 636             }
 637         }
 638     }
 639     /* Preserve the current value of $^R */
 640     if (oreplsv != GvSV(replgv)) {
 641         sv_setsv(oreplsv, GvSV(replgv));/* So that when GvSV(replgv) is
 642                                            restored, the value remains
 643                                            the same. */
 644     }
 645     return 1;
 646
 647 phooey:
 648     return 0;
 649 }
 650
 651 /*
 652  - regtry - try match at specific point
 653  */
 654 STATIC I32                      /* 0 failure, 1 success */
 655 regtry(regexp *prog, char *startpos)
 656 {
 657     dTHR;
 658     register I32 i;
 659     register char **sp;
 660     register char **ep;
 661     CHECKPOINT lastcp;
 662
 663     if ((prog->reganch & ROPT_EVAL_SEEN) && !reg_eval_set) {
 664         reg_eval_set = RS_init;
 665         DEBUG_r(DEBUG_s(
 666             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %i\n", stack_sp - stack_base);
 667             ));
 668         SAVEINT(cxstack[cxstack_ix].blk_oldsp);
 669         cxstack[cxstack_ix].blk_oldsp = stack_sp - stack_base;
 670         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
 671         SAVETMPS;
 672         /* Apparently this is not needed, judging by wantarray. */
 673         /* SAVEINT(cxstack[cxstack_ix].blk_gimme);
 674            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
 675     }
 676     reginput = startpos;
 677     regstartp = prog->startp;
 678     regendp = prog->endp;
 679     reglastparen = &prog->lastparen;
 680     prog->lastparen = 0;
 681     regsize = 0;
 682     if (reg_start_tmpl <= prog->nparens) {
 683         reg_start_tmpl = prog->nparens*3/2 + 3;
 684         if(reg_start_tmp)
 685             Renew(reg_start_tmp, reg_start_tmpl, char*);
 686         else
 687             New(22,reg_start_tmp, reg_start_tmpl, char*);
 688     }
 689
 690     sp = prog->startp;
 691     ep = prog->endp;
 692     regdata = prog->data;
 693     if (prog->nparens) {
 694         for (i = prog->nparens; i >= 0; i--) {
 695             *sp++ = NULL;
 696             *ep++ = NULL;
 697         }
 698     }
 699     REGCP_SET;
 700     if (regmatch(prog->program + 1)) {
 701         prog->startp[0] = startpos;
 702         prog->endp[0] = reginput;
 703         return 1;
 704     }
 705     REGCP_UNWIND;
 706     return 0;
 707 }
 708
 709 /*
 710  - regmatch - main matching routine
 711  *
 712  * Conceptually the strategy is simple:  check to see whether the current
 713  * node matches, call self recursively to see whether the rest matches,
 714  * and then act accordingly.  In practice we make some effort to avoid
 715  * recursion, in particular by going through "ordinary" nodes (that don't
 716  * need to know whether the rest of the match failed) by a loop instead of
 717  * by recursion.
 718  */
 719 /* [lwall] I've hoisted the register declarations to the outer block in order to
 720  * maybe save a little bit of pushing and popping on the stack.  It also takes
 721  * advantage of machines that use a register save mask on subroutine entry.
 722  */
 723 STATIC I32                      /* 0 failure, 1 success */
 724 regmatch(regnode *prog)
 725 {
 726     dTHR;
 727     register regnode *scan;     /* Current node. */
 728     regnode *next;              /* Next node. */
 729     regnode *inner;             /* Next node in internal branch. */
 730     register I32 nextchr; /* renamed nextchr - nextchar colides with function of same name */
 731     register I32 n;             /* no or next */
 732     register I32 ln;            /* len or last */
 733     register char *s;           /* operand or save */
 734     register char *locinput = reginput;
 735     register I32 c1, c2, paren; /* case fold search, parenth */
 736     int minmod = 0, sw = 0, logical = 0;
 737 #ifdef DEBUGGING
 738     regindent++;
 739 #endif
 740
 741     nextchr = UCHARAT(locinput);
 742     scan = prog;
 743     while (scan != NULL) {
 744 #define sayNO_L (logical ? (logical = 0, sw = 0, goto cont) : sayNO)
 745 #ifdef DEBUGGING
 746 #  define sayYES goto yes
 747 #  define sayNO goto no
 748 #  define saySAME(x) if (x) goto yes; else goto no
 749 #  define REPORT_CODE_OFF 24
 750 #else
 751 #  define sayYES return 1
 752 #  define sayNO return 0
 753 #  define saySAME(x) return x
 754 #endif
 755         DEBUG_r( {
 756             SV *prop = sv_newmortal();
 757             int docolor = *colors[0];
 758             int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
 759             int l = (regeol - locinput > taill ? taill : regeol - locinput);
 760             int pref_len = (locinput - bostr > (5 + taill) - l
 761                             ? (5 + taill) - l : locinput - bostr);
 762
 763             if (l + pref_len < (5 + taill) && l < regeol - locinput)
 764                 l = ( regeol - locinput > (5 + taill) - pref_len
 765                       ? (5 + taill) - pref_len : regeol - locinput);
 766             regprop(prop, scan);
 767             PerlIO_printf(Perl_debug_log,
 768                           "%4i <%s%.*s%s%s%s%.*s%s>%*s|%*s%2d%s\n",
 769                           locinput - bostr,
 770                           colors[2], pref_len, locinput - pref_len, colors[3],
 771                           (docolor ? "" : "> <"),
 772                           colors[0], l, locinput, colors[1],
 773                           15 - l - pref_len + 1,
 774                           "",
 775                           regindent*2, "", scan - regprogram,
 776                           SvPVX(prop));
 777         } );
 778
 779         next = scan + NEXT_OFF(scan);
 780         if (next == scan)
 781             next = NULL;
 782
 783         switch (OP(scan)) {
 784         case BOL:
 785             if (locinput == regbol
 786                 ? regprev == '\n'
 787                 : (multiline &&
 788                    (nextchr || locinput < regeol) && locinput[-1] == '\n') )
 789             {
 790                 /* regtill = regbol; */
 791                 break;
 792             }
 793             sayNO;
 794         case MBOL:
 795             if (locinput == regbol
 796                 ? regprev == '\n'
 797                 : ((nextchr || locinput < regeol) && locinput[-1] == '\n') )
 798             {
 799                 break;
 800             }
 801             sayNO;
 802         case SBOL:
 803             if (locinput == regbol && regprev == '\n')
 804                 break;
 805             sayNO;
 806         case GPOS:
 807             if (locinput == regbol)
 808                 break;
 809             sayNO;
 810         case EOL:
 811             if (multiline)
 812                 goto meol;
 813             else
 814                 goto seol;
 815         case MEOL:
 816           meol:
 817             if ((nextchr || locinput < regeol) && nextchr != '\n')
 818                 sayNO;
 819             break;
 820         case SEOL:
 821           seol:
 822             if ((nextchr || locinput < regeol) && nextchr != '\n')
 823                 sayNO;
 824             if (regeol - locinput > 1)
 825                 sayNO;
 826             break;
 827         case EOS:
 828             if (regeol != locinput)
 829                 sayNO;
 830             break;
 831         case SANY:
 832             if (!nextchr && locinput >= regeol)
 833                 sayNO;
 834             nextchr = UCHARAT(++locinput);
 835             break;
 836         case ANY:
 837             if (!nextchr && locinput >= regeol || nextchr == '\n')
 838                 sayNO;
 839             nextchr = UCHARAT(++locinput);
 840             break;
 841         case EXACT:
 842             s = (char *) OPERAND(scan);
 843             ln = UCHARAT(s++);
 844             /* Inline the first character, for speed. */
 845             if (UCHARAT(s) != nextchr)
 846                 sayNO;
 847             if (regeol - locinput < ln)
 848                 sayNO;
 849             if (ln > 1 && memNE(s, locinput, ln))
 850                 sayNO;
 851             locinput += ln;
 852             nextchr = UCHARAT(locinput);
 853             break;
 854         case EXACTFL:
 855             reg_flags |= RF_tainted;
 856             /* FALL THROUGH */
 857         case EXACTF:
 858             s = (char *) OPERAND(scan);
 859             ln = UCHARAT(s++);
 860             /* Inline the first character, for speed. */
 861             if (UCHARAT(s) != nextchr &&
 862                 UCHARAT(s) != ((OP(scan) == EXACTF)
 863                                ? fold : fold_locale)[nextchr])
 864                 sayNO;
 865             if (regeol - locinput < ln)
 866                 sayNO;
 867             if (ln > 1 && (OP(scan) == EXACTF
 868                            ? ibcmp(s, locinput, ln)
 869                            : ibcmp_locale(s, locinput, ln)))
 870                 sayNO;
 871             locinput += ln;
 872             nextchr = UCHARAT(locinput);
 873             break;
 874         case ANYOF:
 875             s = (char *) OPERAND(scan);
 876             if (nextchr < 0)
 877                 nextchr = UCHARAT(locinput);
 878             if (!REGINCLASS(s, nextchr))
 879                 sayNO;
 880             if (!nextchr && locinput >= regeol)
 881                 sayNO;
 882             nextchr = UCHARAT(++locinput);
 883             break;
 884         case ALNUML:
 885             reg_flags |= RF_tainted;
 886             /* FALL THROUGH */
 887         case ALNUM:
 888             if (!nextchr)
 889                 sayNO;
 890             if (!(OP(scan) == ALNUM
 891                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
 892                 sayNO;
 893             nextchr = UCHARAT(++locinput);
 894             break;
 895         case NALNUML:
 896             reg_flags |= RF_tainted;
 897             /* FALL THROUGH */
 898         case NALNUM:
 899             if (!nextchr && locinput >= regeol)
 900                 sayNO;
 901             if (OP(scan) == NALNUM
 902                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
 903                 sayNO;
 904             nextchr = UCHARAT(++locinput);
 905             break;
 906         case BOUNDL:
 907         case NBOUNDL:
 908             reg_flags |= RF_tainted;
 909             /* FALL THROUGH */
 910         case BOUND:
 911         case NBOUND:
 912             /* was last char in word? */
 913             ln = (locinput != regbol) ? UCHARAT(locinput - 1) : regprev;
 914             if (OP(scan) == BOUND || OP(scan) == NBOUND) {
 915                 ln = isALNUM(ln);
 916                 n = isALNUM(nextchr);
 917             }
 918             else {
 919                 ln = isALNUM_LC(ln);
 920                 n = isALNUM_LC(nextchr);
 921             }
 922             if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL))
 923                 sayNO;
 924             break;
 925         case SPACEL:
 926             reg_flags |= RF_tainted;
 927             /* FALL THROUGH */
 928         case SPACE:
 929             if (!nextchr && locinput >= regeol)
 930                 sayNO;
 931             if (!(OP(scan) == SPACE
 932                   ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
 933                 sayNO;
 934             nextchr = UCHARAT(++locinput);
 935             break;
 936         case NSPACEL:
 937             reg_flags |= RF_tainted;
 938             /* FALL THROUGH */
 939         case NSPACE:
 940             if (!nextchr)
 941                 sayNO;
 942             if (OP(scan) == SPACE
 943                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
 944                 sayNO;
 945             nextchr = UCHARAT(++locinput);
 946             break;
 947         case DIGIT:
 948             if (!isDIGIT(nextchr))
 949                 sayNO;
 950             nextchr = UCHARAT(++locinput);
 951             break;
 952         case NDIGIT:
 953             if (!nextchr && locinput >= regeol)
 954                 sayNO;
 955             if (isDIGIT(nextchr))
 956                 sayNO;
 957             nextchr = UCHARAT(++locinput);
 958             break;
 959         case REFFL:
 960             reg_flags |= RF_tainted;
 961             /* FALL THROUGH */
 962         case REF:
 963         case REFF:
 964             n = ARG(scan);  /* which paren pair */
 965             s = regstartp[n];
 966             if (*reglastparen < n || !s)
 967                 sayNO;                  /* Do not match unless seen CLOSEn. */
 968             if (s == regendp[n])
 969                 break;
 970             /* Inline the first character, for speed. */
 971             if (UCHARAT(s) != nextchr &&
 972                 (OP(scan) == REF ||
 973                  (UCHARAT(s) != ((OP(scan) == REFF
 974                                   ? fold : fold_locale)[nextchr]))))
 975                 sayNO;
 976             ln = regendp[n] - s;
 977             if (locinput + ln > regeol)
 978                 sayNO;
 979             if (ln > 1 && (OP(scan) == REF
 980                            ? memNE(s, locinput, ln)
 981                            : (OP(scan) == REFF
 982                               ? ibcmp(s, locinput, ln)
 983                               : ibcmp_locale(s, locinput, ln))))
 984                 sayNO;
 985             locinput += ln;
 986             nextchr = UCHARAT(locinput);
 987             break;
 988
 989         case NOTHING:
 990         case TAIL:
 991             break;
 992         case BACK:
 993             break;
 994         case EVAL:
 995         {
 996             dSP;
 997             OP_4tree *oop = op;
 998             COP *ocurcop = curcop;
 999             SV **ocurpad = curpad;
1000             SV *ret;
1001
1002             n = ARG(scan);
1003             op = (OP_4tree*)regdata->data[n];
1004             DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%x\n", op) );
1005             curpad = AvARRAY((AV*)regdata->data[n + 1]);
1006
1007             CALLRUNOPS();                       /* Scalar context. */
1008             SPAGAIN;
1009             ret = POPs;
1010             PUTBACK;
1011
1012             if (logical) {
1013                 logical = 0;
1014                 sw = SvTRUE(ret);
1015             } else
1016                 sv_setsv(save_scalar(replgv), ret);
1017             op = oop;
1018             curpad = ocurpad;
1019             curcop = ocurcop;
1020             break;
1021         }
1022         case OPEN:
1023             n = ARG(scan);  /* which paren pair */
1024             reg_start_tmp[n] = locinput;
1025             if (n > regsize)
1026                 regsize = n;
1027             break;
1028         case CLOSE:
1029             n = ARG(scan);  /* which paren pair */
1030             regstartp[n] = reg_start_tmp[n];
1031             regendp[n] = locinput;
1032             if (n > *reglastparen)
1033                 *reglastparen = n;
1034             break;
1035         case GROUPP:
1036             n = ARG(scan);  /* which paren pair */
1037             sw = (*reglastparen >= n && regendp[n] != NULL);
1038             break;
1039         case IFTHEN:
1040             if (sw)
1041                 next = NEXTOPER(NEXTOPER(scan));
1042             else {
1043                 next = scan + ARG(scan);
1044                 if (OP(next) == IFTHEN) /* Fake one. */
1045                     next = NEXTOPER(NEXTOPER(next));
1046             }
1047             break;
1048         case LOGICAL:
1049             logical = 1;
1050             break;
1051         case CURLYX: {
1052                 CURCUR cc;
1053                 CHECKPOINT cp = savestack_ix;
1054
1055                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
1056                     next += ARG(next);
1057                 cc.oldcc = regcc;
1058                 regcc = &cc;
1059                 cc.parenfloor = *reglastparen;
1060                 cc.cur = -1;
1061                 cc.min = ARG1(scan);
1062                 cc.max  = ARG2(scan);
1063                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
1064                 cc.next = next;
1065                 cc.minmod = minmod;
1066                 cc.lastloc = 0;
1067                 reginput = locinput;
1068                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
1069                 regcpblow(cp);
1070                 regcc = cc.oldcc;
1071                 saySAME(n);
1072             }
1073             /* NOT REACHED */
1074         case WHILEM: {
1075                 /*
1076                  * This is really hard to understand, because after we match
1077                  * what we're trying to match, we must make sure the rest of
1078                  * the RE is going to match for sure, and to do that we have
1079                  * to go back UP the parse tree by recursing ever deeper.  And
1080                  * if it fails, we have to reset our parent's current state
1081                  * that we can try again after backing off.
1082                  */
1083
1084                 CHECKPOINT cp, lastcp;
1085                 CURCUR* cc = regcc;
1086                 char *lastloc = cc->lastloc; /* Detection of 0-len. */
1087
1088                 n = cc->cur + 1;        /* how many we know we matched */
1089                 reginput = locinput;
1090
1091                 DEBUG_r(
1092                     PerlIO_printf(Perl_debug_log,
1093                                   "%*s  %ld out of %ld..%ld  cc=%lx\n",
1094                                   REPORT_CODE_OFF+regindent*2, "",
1095                                   (long)n, (long)cc->min,
1096                                   (long)cc->max, (long)cc)
1097                     );
1098
1099                 /* If degenerate scan matches "", assume scan done. */
1100
1101                 if (locinput == cc->lastloc && n >= cc->min) {
1102                     regcc = cc->oldcc;
1103                     ln = regcc->cur;
1104                     DEBUG_r(
1105                         PerlIO_printf(Perl_debug_log, "%*s  empty match detected, try continuation...\n", REPORT_CODE_OFF+regindent*2, "")
1106                         );
1107                     if (regmatch(cc->next))
1108                         sayYES;
1109                     DEBUG_r(
1110                         PerlIO_printf(Perl_debug_log, "%*s  failed...\n", REPORT_CODE_OFF+regindent*2, "")
1111                         );
1112                     regcc->cur = ln;
1113                     regcc = cc;
1114                     sayNO;
1115                 }
1116
1117                 /* First just match a string of min scans. */
1118
1119                 if (n < cc->min) {
1120                     cc->cur = n;
1121                     cc->lastloc = locinput;
1122                     if (regmatch(cc->scan))
1123                         sayYES;
1124                     cc->cur = n - 1;
1125                     cc->lastloc = lastloc;
1126                     DEBUG_r(
1127                         PerlIO_printf(Perl_debug_log, "%*s  failed...\n", REPORT_CODE_OFF+regindent*2, "")
1128                         );
1129                     sayNO;
1130                 }
1131
1132                 /* Prefer next over scan for minimal matching. */
1133
1134                 if (cc->minmod) {
1135                     regcc = cc->oldcc;
1136                     ln = regcc->cur;
1137                     cp = regcppush(cc->parenfloor);
1138                     REGCP_SET;
1139                     if (regmatch(cc->next)) {
1140                         regcpblow(cp);
1141                         sayYES; /* All done. */
1142                     }
1143                     REGCP_UNWIND;
1144                     regcppop();
1145                     regcc->cur = ln;
1146                     regcc = cc;
1147
1148                     if (n >= cc->max) { /* Maximum greed exceeded? */
1149                         if (dowarn && n >= REG_INFTY
1150                             && !(reg_flags & RF_warned)) {
1151                             reg_flags |= RF_warned;
1152                             warn("count exceeded %d", REG_INFTY - 1);
1153                         }
1154                         sayNO;
1155                     }
1156
1157                     DEBUG_r(
1158                         PerlIO_printf(Perl_debug_log, "%*s  trying longer...\n", REPORT_CODE_OFF+regindent*2, "")
1159                         );
1160                     /* Try scanning more and see if it helps. */
1161                     reginput = locinput;
1162                     cc->cur = n;
1163                     cc->lastloc = locinput;
1164                     cp = regcppush(cc->parenfloor);
1165                     REGCP_SET;
1166                     if (regmatch(cc->scan)) {
1167                         regcpblow(cp);
1168                         sayYES;
1169                     }
1170                     DEBUG_r(
1171                         PerlIO_printf(Perl_debug_log, "%*s  failed...\n", REPORT_CODE_OFF+regindent*2, "")
1172                         );
1173                     REGCP_UNWIND;
1174                     regcppop();
1175                     cc->cur = n - 1;
1176                     cc->lastloc = lastloc;
1177                     sayNO;
1178                 }
1179
1180                 /* Prefer scan over next for maximal matching. */
1181
1182                 if (n < cc->max) {      /* More greed allowed? */
1183                     cp = regcppush(cc->parenfloor);
1184                     cc->cur = n;
1185                     cc->lastloc = locinput;
1186                     REGCP_SET;
1187                     if (regmatch(cc->scan)) {
1188                         regcpblow(cp);
1189                         sayYES;
1190                     }
1191                     REGCP_UNWIND;
1192                     regcppop();         /* Restore some previous $<digit>s? */
1193                     reginput = locinput;
1194                     DEBUG_r(
1195                         PerlIO_printf(Perl_debug_log, "%*s  failed, try continuation...\n", REPORT_CODE_OFF+regindent*2, "")
1196                         );
1197                 }
1198                 if (dowarn && n >= REG_INFTY && !(reg_flags & RF_warned)) {
1199                     reg_flags |= RF_warned;
1200                     warn("count exceeded %d", REG_INFTY - 1);
1201                 }
1202
1203                 /* Failed deeper matches of scan, so see if this one works. */
1204                 regcc = cc->oldcc;
1205                 ln = regcc->cur;
1206                 if (regmatch(cc->next))
1207                     sayYES;
1208                 DEBUG_r(
1209                     PerlIO_printf(Perl_debug_log, "%*s  failed...\n", REPORT_CODE_OFF+regindent*2, "")
1210                     );
1211                 regcc->cur = ln;
1212                 regcc = cc;
1213                 cc->cur = n - 1;
1214                 cc->lastloc = lastloc;
1215                 sayNO;
1216             }
1217             /* NOT REACHED */
1218         case BRANCHJ:
1219             next = scan + ARG(scan);
1220             if (next == scan)
1221                 next = NULL;
1222             inner = NEXTOPER(NEXTOPER(scan));
1223             goto do_branch;
1224         case BRANCH:
1225             inner = NEXTOPER(scan);
1226           do_branch:
1227             {
1228                 CHECKPOINT lastcp;
1229                 c1 = OP(scan);
1230                 if (OP(next) != c1)     /* No choice. */
1231                     next = inner;       /* Avoid recursion. */
1232                 else {
1233                     int lastparen = *reglastparen;
1234
1235                     REGCP_SET;
1236                     do {
1237                         reginput = locinput;
1238                         if (regmatch(inner))
1239                             sayYES;
1240                         REGCP_UNWIND;
1241                         for (n = *reglastparen; n > lastparen; n--)
1242                             regendp[n] = 0;
1243                         *reglastparen = n;
1244                         scan = next;
1245                         /*SUPPRESS 560*/
1246                         if (n = (c1 == BRANCH ? NEXT_OFF(next) : ARG(next)))
1247                             next += n;
1248                         else
1249                             next = NULL;
1250                         inner = NEXTOPER(scan);
1251                         if (c1 == BRANCHJ) {
1252                             inner = NEXTOPER(inner);
1253                         }
1254                     } while (scan != NULL && OP(scan) == c1);
1255                     sayNO;
1256                     /* NOTREACHED */
1257                 }
1258             }
1259             break;
1260         case MINMOD:
1261             minmod = 1;
1262             break;
1263         case CURLYM:
1264         {
1265             I32 l = 0;
1266             CHECKPOINT lastcp;
1267
1268             /* We suppose that the next guy does not need
1269                backtracking: in particular, it is of constant length,
1270                and has no parenths to influence future backrefs. */
1271             ln = ARG1(scan);  /* min to match */
1272             n  = ARG2(scan);  /* max to match */
1273             paren = scan->flags;
1274             if (paren) {
1275                 if (paren > regsize)
1276                     regsize = paren;
1277                 if (paren > *reglastparen)
1278                     *reglastparen = paren;
1279             }
1280             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
1281             if (paren)
1282                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
1283             reginput = locinput;
1284             if (minmod) {
1285                 minmod = 0;
1286                 if (ln && regrepeat_hard(scan, ln, &l) < ln)
1287                     sayNO;
1288                 if (ln && l == 0 && n >= ln
1289                     /* In fact, this is tricky.  If paren, then the
1290                        fact that we did/didnot match may influence
1291                        future execution. */
1292                     && !(paren && ln == 0))
1293                     ln = n;
1294                 locinput = reginput;
1295                 if (regkind[(U8)OP(next)] == EXACT) {
1296                     c1 = UCHARAT(OPERAND(next) + 1);
1297                     if (OP(next) == EXACTF)
1298                         c2 = fold[c1];
1299                     else if (OP(next) == EXACTFL)
1300                         c2 = fold_locale[c1];
1301                     else
1302                         c2 = c1;
1303                 } else
1304                     c1 = c2 = -1000;
1305                 REGCP_SET;
1306                 /* This may be improved if l == 0.  */
1307                 while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */
1308                     /* If it could work, try it. */
1309                     if (c1 == -1000 ||
1310                         UCHARAT(reginput) == c1 ||
1311                         UCHARAT(reginput) == c2)
1312                     {
1313                         if (paren) {
1314                             if (n) {
1315                                 regstartp[paren] = reginput - l;
1316                                 regendp[paren] = reginput;
1317                             } else
1318                                 regendp[paren] = NULL;
1319                         }
1320                         if (regmatch(next))
1321                             sayYES;
1322                         REGCP_UNWIND;
1323                     }
1324                     /* Couldn't or didn't -- move forward. */
1325                     reginput = locinput;
1326                     if (regrepeat_hard(scan, 1, &l)) {
1327                         ln++;
1328                         locinput = reginput;
1329                     }
1330                     else
1331                         sayNO;
1332                 }
1333             } else {
1334                 n = regrepeat_hard(scan, n, &l);
1335                 if (n != 0 && l == 0
1336                     /* In fact, this is tricky.  If paren, then the
1337                        fact that we did/didnot match may influence
1338                        future execution. */
1339                     && !(paren && ln == 0))
1340                     ln = n;
1341                 locinput = reginput;
1342                 DEBUG_r(
1343                     PerlIO_printf(Perl_debug_log, "%*s  matched %ld times, len=%ld...\n", REPORT_CODE_OFF+regindent*2, "", n, l)
1344                     );
1345                 if (n >= ln) {
1346                     if (regkind[(U8)OP(next)] == EXACT) {
1347                         c1 = UCHARAT(OPERAND(next) + 1);
1348                         if (OP(next) == EXACTF)
1349                             c2 = fold[c1];
1350                         else if (OP(next) == EXACTFL)
1351                             c2 = fold_locale[c1];
1352                         else
1353                             c2 = c1;
1354                     } else
1355                         c1 = c2 = -1000;
1356                 }
1357                 REGCP_SET;
1358                 while (n >= ln) {
1359                     /* If it could work, try it. */
1360                     if (c1 == -1000 ||
1361                         UCHARAT(reginput) == c1 ||
1362                         UCHARAT(reginput) == c2)
1363                         {
1364                             DEBUG_r(
1365                                 PerlIO_printf(Perl_debug_log, "%*s  trying tail with n=%ld...\n", REPORT_CODE_OFF+regindent*2, "", n)
1366                                 );
1367                             if (paren) {
1368                                 if (n) {
1369                                     regstartp[paren] = reginput - l;
1370                                     regendp[paren] = reginput;
1371                                 } else
1372                                     regendp[paren] = NULL;
1373                             }
1374                             if (regmatch(next))
1375                                 sayYES;
1376                             REGCP_UNWIND;
1377                         }
1378                     /* Couldn't or didn't -- back up. */
1379                     n--;
1380                     locinput -= l;
1381                     reginput = locinput;
1382                 }
1383             }
1384             sayNO;
1385             break;
1386         }
1387         case CURLYN:
1388             paren = scan->flags;        /* Which paren to set */
1389             if (paren > regsize)
1390                 regsize = paren;
1391             if (paren > *reglastparen)
1392                 *reglastparen = paren;
1393             ln = ARG1(scan);  /* min to match */
1394             n  = ARG2(scan);  /* max to match */
1395             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
1396             goto repeat;
1397         case CURLY:
1398             paren = 0;
1399             ln = ARG1(scan);  /* min to match */
1400             n  = ARG2(scan);  /* max to match */
1401             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
1402             goto repeat;
1403         case STAR:
1404             ln = 0;
1405             n = REG_INFTY;
1406             scan = NEXTOPER(scan);
1407             paren = 0;
1408             goto repeat;
1409         case PLUS:
1410             ln = 1;
1411             n = REG_INFTY;
1412             scan = NEXTOPER(scan);
1413             paren = 0;
1414           repeat:
1415             /*
1416             * Lookahead to avoid useless match attempts
1417             * when we know what character comes next.
1418             */
1419             if (regkind[(U8)OP(next)] == EXACT) {
1420                 c1 = UCHARAT(OPERAND(next) + 1);
1421                 if (OP(next) == EXACTF)
1422                     c2 = fold[c1];
1423                 else if (OP(next) == EXACTFL)
1424                     c2 = fold_locale[c1];
1425                 else
1426                     c2 = c1;
1427             }
1428             else
1429                 c1 = c2 = -1000;
1430             reginput = locinput;
1431             if (minmod) {
1432                 CHECKPOINT lastcp;
1433                 minmod = 0;
1434                 if (ln && regrepeat(scan, ln) < ln)
1435                     sayNO;
1436                 REGCP_SET;
1437                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
1438                     /* If it could work, try it. */
1439                     if (c1 == -1000 ||
1440                         UCHARAT(reginput) == c1 ||
1441                         UCHARAT(reginput) == c2)
1442                     {
1443                         if (paren) {
1444                             if (n) {
1445                                 regstartp[paren] = reginput - 1;
1446                                 regendp[paren] = reginput;
1447                             } else
1448                                 regendp[paren] = NULL;
1449                         }
1450                         if (regmatch(next))
1451                             sayYES;
1452                         REGCP_UNWIND;
1453                     }
1454                     /* Couldn't or didn't -- move forward. */
1455                     reginput = locinput + ln;
1456                     if (regrepeat(scan, 1)) {
1457                         ln++;
1458                         reginput = locinput + ln;
1459                     } else
1460                         sayNO;
1461                 }
1462             }
1463             else {
1464                 CHECKPOINT lastcp;
1465                 n = regrepeat(scan, n);
1466                 if (ln < n && regkind[(U8)OP(next)] == EOL &&
1467                     (!multiline  || OP(next) == SEOL))
1468                     ln = n;                     /* why back off? */
1469                 REGCP_SET;
1470                 if (paren) {
1471                     while (n >= ln) {
1472                         /* If it could work, try it. */
1473                         if (c1 == -1000 ||
1474                             UCHARAT(reginput) == c1 ||
1475                             UCHARAT(reginput) == c2)
1476                             {
1477                                 if (paren && n) {
1478                                     if (n) {
1479                                         regstartp[paren] = reginput - 1;
1480                                         regendp[paren] = reginput;
1481                                     } else
1482                                         regendp[paren] = NULL;
1483                                 }
1484                                 if (regmatch(next))
1485                                     sayYES;
1486                                 REGCP_UNWIND;
1487                             }
1488                         /* Couldn't or didn't -- back up. */
1489                         n--;
1490                         reginput = locinput + n;
1491                     }
1492                 } else {
1493                     while (n >= ln) {
1494                         /* If it could work, try it. */
1495                         if (c1 == -1000 ||
1496                             UCHARAT(reginput) == c1 ||
1497                             UCHARAT(reginput) == c2)
1498                             {
1499                                 if (regmatch(next))
1500                                     sayYES;
1501                                 REGCP_UNWIND;
1502                             }
1503                         /* Couldn't or didn't -- back up. */
1504                         n--;
1505                         reginput = locinput + n;
1506                     }
1507                 }
1508             }
1509             sayNO;
1510             break;
1511         case END:
1512             if (locinput < regtill)
1513                 sayNO;                  /* Cannot match: too short. */
1514             /* Fall through */
1515         case SUCCEED:
1516             reginput = locinput;        /* put where regtry can find it */
1517             sayYES;                     /* Success! */
1518         case SUSPEND:
1519             n = 1;
1520             goto do_ifmatch;
1521         case UNLESSM:
1522             n = 0;
1523             if (locinput < bostr + scan->flags)
1524                 goto say_yes;
1525             goto do_ifmatch;
1526         case IFMATCH:
1527             n = 1;
1528             if (locinput < bostr + scan->flags)
1529                 goto say_no;
1530           do_ifmatch:
1531             reginput = locinput - scan->flags;
1532             inner = NEXTOPER(NEXTOPER(scan));
1533             if (regmatch(inner) != n) {
1534               say_no:
1535                 if (logical) {
1536                     logical = 0;
1537                     sw = 0;
1538                     goto do_longjump;
1539                 } else
1540                     sayNO;
1541             }
1542           say_yes:
1543             if (logical) {
1544                 logical = 0;
1545                 sw = 1;
1546             }
1547             if (OP(scan) == SUSPEND) {
1548                 locinput = reginput;
1549                 nextchr = UCHARAT(locinput);
1550             }
1551             /* FALL THROUGH. */
1552         case LONGJMP:
1553           do_longjump:
1554             next = scan + ARG(scan);
1555             if (next == scan)
1556                 next = NULL;
1557             break;
1558         default:
1559             PerlIO_printf(PerlIO_stderr(), "%lx %d\n",
1560                           (unsigned long)scan, OP(scan));
1561             FAIL("regexp memory corruption");
1562         }
1563         scan = next;
1564     }
1565
1566     /*
1567     * We get here only if there's trouble -- normally "case END" is
1568     * the terminating point.
1569     */
1570     FAIL("corrupted regexp pointers");
1571     /*NOTREACHED*/
1572     sayNO;
1573
1574 yes:
1575 #ifdef DEBUGGING
1576     regindent--;
1577 #endif
1578     return 1;
1579
1580 no:
1581 #ifdef DEBUGGING
1582     regindent--;
1583 #endif
1584     return 0;
1585 }
1586
1587 /*
1588  - regrepeat - repeatedly match something simple, report how many
1589  */
1590 /*
1591  * [This routine now assumes that it will only match on things of length 1.
1592  * That was true before, but now we assume scan - reginput is the count,
1593  * rather than incrementing count on every character.]
1594  */
1595 STATIC I32
1596 regrepeat(regnode *p, I32 max)
1597 {
1598     register char *scan;
1599     register char *opnd;
1600     register I32 c;
1601     register char *loceol = regeol;
1602
1603     scan = reginput;
1604     if (max != REG_INFTY && max < loceol - scan)
1605       loceol = scan + max;
1606     opnd = (char *) OPERAND(p);
1607     switch (OP(p)) {
1608     case ANY:
1609         while (scan < loceol && *scan != '\n')
1610             scan++;
1611         break;
1612     case SANY:
1613         scan = loceol;
1614         break;
1615     case EXACT:         /* length of string is 1 */
1616         c = UCHARAT(++opnd);
1617         while (scan < loceol && UCHARAT(scan) == c)
1618             scan++;
1619         break;
1620     case EXACTF:        /* length of string is 1 */
1621         c = UCHARAT(++opnd);
1622         while (scan < loceol &&
1623                (UCHARAT(scan) == c || UCHARAT(scan) == fold[c]))
1624             scan++;
1625         break;
1626     case EXACTFL:       /* length of string is 1 */
1627         reg_flags |= RF_tainted;
1628         c = UCHARAT(++opnd);
1629         while (scan < loceol &&
1630                (UCHARAT(scan) == c || UCHARAT(scan) == fold_locale[c]))
1631             scan++;
1632         break;
1633     case ANYOF:
1634         while (scan < loceol && REGINCLASS(opnd, *scan))
1635             scan++;
1636         break;
1637     case ALNUM:
1638         while (scan < loceol && isALNUM(*scan))
1639             scan++;
1640         break;
1641     case ALNUML:
1642         reg_flags |= RF_tainted;
1643         while (scan < loceol && isALNUM_LC(*scan))
1644             scan++;
1645         break;
1646     case NALNUM:
1647         while (scan < loceol && !isALNUM(*scan))
1648             scan++;
1649         break;
1650     case NALNUML:
1651         reg_flags |= RF_tainted;
1652         while (scan < loceol && !isALNUM_LC(*scan))
1653             scan++;
1654         break;
1655     case SPACE:
1656         while (scan < loceol && isSPACE(*scan))
1657             scan++;
1658         break;
1659     case SPACEL:
1660         reg_flags |= RF_tainted;
1661         while (scan < loceol && isSPACE_LC(*scan))
1662             scan++;
1663         break;
1664     case NSPACE:
1665         while (scan < loceol && !isSPACE(*scan))
1666             scan++;
1667         break;
1668     case NSPACEL:
1669         reg_flags |= RF_tainted;
1670         while (scan < loceol && !isSPACE_LC(*scan))
1671             scan++;
1672         break;
1673     case DIGIT:
1674         while (scan < loceol && isDIGIT(*scan))
1675             scan++;
1676         break;
1677     case NDIGIT:
1678         while (scan < loceol && !isDIGIT(*scan))
1679             scan++;
1680         break;
1681     default:            /* Called on something of 0 width. */
1682         break;          /* So match right here or not at all. */
1683     }
1684
1685     c = scan - reginput;
1686     reginput = scan;
1687
1688     DEBUG_r(
1689         {
1690                 SV *prop = sv_newmortal();
1691
1692                 regprop(prop, p);
1693                 PerlIO_printf(Perl_debug_log,
1694                               "%*s  %s can match %ld times out of %ld...\n",
1695                               REPORT_CODE_OFF+1, "", SvPVX(prop),c,max);
1696         });
1697
1698     return(c);
1699 }
1700
1701 /*
1702  - regrepeat_hard - repeatedly match something, report total lenth and length
1703  *
1704  * The repeater is supposed to have constant length.
1705  */
1706
1707 STATIC I32
1708 regrepeat_hard(regnode *p, I32 max, I32 *lp)
1709 {
1710     register char *scan;
1711     register char *start;
1712     register char *loceol = regeol;
1713     I32 l = -1;
1714
1715     start = reginput;
1716     while (reginput < loceol && (scan = reginput, regmatch(p))) {
1717         if (l == -1) {
1718             *lp = l = reginput - start;
1719             if (max != REG_INFTY && l*max < loceol - scan)
1720                 loceol = scan + l*max;
1721             if (l == 0) {
1722                 return max;
1723             }
1724         }
1725     }
1726     if (reginput < loceol)
1727         reginput = scan;
1728     else
1729         scan = reginput;
1730
1731     return (scan - start)/l;
1732 }
1733
1734 /*
1735  - regclass - determine if a character falls into a character class
1736  */
1737
1738 STATIC bool
1739 reginclass(register char *p, register I32 c)
1740 {
1741     char flags = *p;
1742     bool match = FALSE;
1743
1744     c &= 0xFF;
1745     if (ANYOF_TEST(p, c))
1746         match = TRUE;
1747     else if (flags & ANYOF_FOLD) {
1748         I32 cf;
1749         if (flags & ANYOF_LOCALE) {
1750             reg_flags |= RF_tainted;
1751             cf = fold_locale[c];
1752         }
1753         else
1754             cf = fold[c];
1755         if (ANYOF_TEST(p, cf))
1756             match = TRUE;
1757     }
1758
1759     if (!match && (flags & ANYOF_ISA)) {
1760         reg_flags |= RF_tainted;
1761
1762         if (((flags & ANYOF_ALNUML)  && isALNUM_LC(c))  ||
1763             ((flags & ANYOF_NALNUML) && !isALNUM_LC(c)) ||
1764             ((flags & ANYOF_SPACEL)  && isSPACE_LC(c))  ||
1765             ((flags & ANYOF_NSPACEL) && !isSPACE_LC(c)))
1766         {
1767             match = TRUE;
1768         }
1769     }
1770
1771     return (flags & ANYOF_INVERT) ? !match : match;
1772 }
1773
1774
1775