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);
 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))) ) {
 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) && reginput >= regtill) {
 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 SANY:
 828             if (!nextchr && locinput >= regeol)
 829                 sayNO;
 830             nextchr = UCHARAT(++locinput);
 831             break;
 832         case ANY:
 833             if (!nextchr && locinput >= regeol || nextchr == '\n')
 834                 sayNO;
 835             nextchr = UCHARAT(++locinput);
 836             break;
 837         case EXACT:
 838             s = (char *) OPERAND(scan);
 839             ln = UCHARAT(s++);
 840             /* Inline the first character, for speed. */
 841             if (UCHARAT(s) != nextchr)
 842                 sayNO;
 843             if (regeol - locinput < ln)
 844                 sayNO;
 845             if (ln > 1 && memNE(s, locinput, ln))
 846                 sayNO;
 847             locinput += ln;
 848             nextchr = UCHARAT(locinput);
 849             break;
 850         case EXACTFL:
 851             reg_flags |= RF_tainted;
 852             /* FALL THROUGH */
 853         case EXACTF:
 854             s = (char *) OPERAND(scan);
 855             ln = UCHARAT(s++);
 856             /* Inline the first character, for speed. */
 857             if (UCHARAT(s) != nextchr &&
 858                 UCHARAT(s) != ((OP(scan) == EXACTF)
 859                                ? fold : fold_locale)[nextchr])
 860                 sayNO;
 861             if (regeol - locinput < ln)
 862                 sayNO;
 863             if (ln > 1 && (OP(scan) == EXACTF
 864                            ? ibcmp(s, locinput, ln)
 865                            : ibcmp_locale(s, locinput, ln)))
 866                 sayNO;
 867             locinput += ln;
 868             nextchr = UCHARAT(locinput);
 869             break;
 870         case ANYOF:
 871             s = (char *) OPERAND(scan);
 872             if (nextchr < 0)
 873                 nextchr = UCHARAT(locinput);
 874             if (!REGINCLASS(s, nextchr))
 875                 sayNO;
 876             if (!nextchr && locinput >= regeol)
 877                 sayNO;
 878             nextchr = UCHARAT(++locinput);
 879             break;
 880         case ALNUML:
 881             reg_flags |= RF_tainted;
 882             /* FALL THROUGH */
 883         case ALNUM:
 884             if (!nextchr)
 885                 sayNO;
 886             if (!(OP(scan) == ALNUM
 887                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
 888                 sayNO;
 889             nextchr = UCHARAT(++locinput);
 890             break;
 891         case NALNUML:
 892             reg_flags |= RF_tainted;
 893             /* FALL THROUGH */
 894         case NALNUM:
 895             if (!nextchr && locinput >= regeol)
 896                 sayNO;
 897             if (OP(scan) == NALNUM
 898                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
 899                 sayNO;
 900             nextchr = UCHARAT(++locinput);
 901             break;
 902         case BOUNDL:
 903         case NBOUNDL:
 904             reg_flags |= RF_tainted;
 905             /* FALL THROUGH */
 906         case BOUND:
 907         case NBOUND:
 908             /* was last char in word? */
 909             ln = (locinput != regbol) ? UCHARAT(locinput - 1) : regprev;
 910             if (OP(scan) == BOUND || OP(scan) == NBOUND) {
 911                 ln = isALNUM(ln);
 912                 n = isALNUM(nextchr);
 913             }
 914             else {
 915                 ln = isALNUM_LC(ln);
 916                 n = isALNUM_LC(nextchr);
 917             }
 918             if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL))
 919                 sayNO;
 920             break;
 921         case SPACEL:
 922             reg_flags |= RF_tainted;
 923             /* FALL THROUGH */
 924         case SPACE:
 925             if (!nextchr && locinput >= regeol)
 926                 sayNO;
 927             if (!(OP(scan) == SPACE
 928                   ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
 929                 sayNO;
 930             nextchr = UCHARAT(++locinput);
 931             break;
 932         case NSPACEL:
 933             reg_flags |= RF_tainted;
 934             /* FALL THROUGH */
 935         case NSPACE:
 936             if (!nextchr)
 937                 sayNO;
 938             if (OP(scan) == SPACE
 939                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
 940                 sayNO;
 941             nextchr = UCHARAT(++locinput);
 942             break;
 943         case DIGIT:
 944             if (!isDIGIT(nextchr))
 945                 sayNO;
 946             nextchr = UCHARAT(++locinput);
 947             break;
 948         case NDIGIT:
 949             if (!nextchr && locinput >= regeol)
 950                 sayNO;
 951             if (isDIGIT(nextchr))
 952                 sayNO;
 953             nextchr = UCHARAT(++locinput);
 954             break;
 955         case REFFL:
 956             reg_flags |= RF_tainted;
 957             /* FALL THROUGH */
 958         case REF:
 959         case REFF:
 960             n = ARG(scan);  /* which paren pair */
 961             s = regstartp[n];
 962             if (*reglastparen < n || !s)
 963                 sayNO;                  /* Do not match unless seen CLOSEn. */
 964             if (s == regendp[n])
 965                 break;
 966             /* Inline the first character, for speed. */
 967             if (UCHARAT(s) != nextchr &&
 968                 (OP(scan) == REF ||
 969                  (UCHARAT(s) != ((OP(scan) == REFF
 970                                   ? fold : fold_locale)[nextchr]))))
 971                 sayNO;
 972             ln = regendp[n] - s;
 973             if (locinput + ln > regeol)
 974                 sayNO;
 975             if (ln > 1 && (OP(scan) == REF
 976                            ? memNE(s, locinput, ln)
 977                            : (OP(scan) == REFF
 978                               ? ibcmp(s, locinput, ln)
 979                               : ibcmp_locale(s, locinput, ln))))
 980                 sayNO;
 981             locinput += ln;
 982             nextchr = UCHARAT(locinput);
 983             break;
 984
 985         case NOTHING:
 986         case TAIL:
 987             break;
 988         case BACK:
 989             break;
 990         case EVAL:
 991         {
 992             dSP;
 993             OP_4tree *oop = op;
 994             COP *ocurcop = curcop;
 995             SV **ocurpad = curpad;
 996             SV *ret;
 997
 998             n = ARG(scan);
 999             op = (OP_4tree*)regdata->data[n];
1000             DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%x\n", op) );
1001             curpad = AvARRAY((AV*)regdata->data[n + 1]);
1002
1003             CALLRUNOPS();                       /* Scalar context. */
1004             SPAGAIN;
1005             ret = POPs;
1006             PUTBACK;
1007
1008             if (logical) {
1009                 logical = 0;
1010                 sw = SvTRUE(ret);
1011             } else
1012                 sv_setsv(save_scalar(replgv), ret);
1013             op = oop;
1014             curpad = ocurpad;
1015             curcop = ocurcop;
1016             break;
1017         }
1018         case OPEN:
1019             n = ARG(scan);  /* which paren pair */
1020             reg_start_tmp[n] = locinput;
1021             if (n > regsize)
1022                 regsize = n;
1023             break;
1024         case CLOSE:
1025             n = ARG(scan);  /* which paren pair */
1026             regstartp[n] = reg_start_tmp[n];
1027             regendp[n] = locinput;
1028             if (n > *reglastparen)
1029                 *reglastparen = n;
1030             break;
1031         case GROUPP:
1032             n = ARG(scan);  /* which paren pair */
1033             sw = (*reglastparen >= n && regendp[n] != NULL);
1034             break;
1035         case IFTHEN:
1036             if (sw)
1037                 next = NEXTOPER(NEXTOPER(scan));
1038             else {
1039                 next = scan + ARG(scan);
1040                 if (OP(next) == IFTHEN) /* Fake one. */
1041                     next = NEXTOPER(NEXTOPER(next));
1042             }
1043             break;
1044         case LOGICAL:
1045             logical = 1;
1046             break;
1047         case CURLYX: {
1048                 CURCUR cc;
1049                 CHECKPOINT cp = savestack_ix;
1050
1051                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
1052                     next += ARG(next);
1053                 cc.oldcc = regcc;
1054                 regcc = &cc;
1055                 cc.parenfloor = *reglastparen;
1056                 cc.cur = -1;
1057                 cc.min = ARG1(scan);
1058                 cc.max  = ARG2(scan);
1059                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
1060                 cc.next = next;
1061                 cc.minmod = minmod;
1062                 cc.lastloc = 0;
1063                 reginput = locinput;
1064                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
1065                 regcpblow(cp);
1066                 regcc = cc.oldcc;
1067                 saySAME(n);
1068             }
1069             /* NOT REACHED */
1070         case WHILEM: {
1071                 /*
1072                  * This is really hard to understand, because after we match
1073                  * what we're trying to match, we must make sure the rest of
1074                  * the RE is going to match for sure, and to do that we have
1075                  * to go back UP the parse tree by recursing ever deeper.  And
1076                  * if it fails, we have to reset our parent's current state
1077                  * that we can try again after backing off.
1078                  */
1079
1080                 CHECKPOINT cp, lastcp;
1081                 CURCUR* cc = regcc;
1082                 char *lastloc = cc->lastloc; /* Detection of 0-len. */
1083
1084                 n = cc->cur + 1;        /* how many we know we matched */
1085                 reginput = locinput;
1086
1087                 DEBUG_r(
1088                     PerlIO_printf(Perl_debug_log,
1089                                   "%*s  %ld out of %ld..%ld  cc=%lx\n",
1090                                   REPORT_CODE_OFF+regindent*2, "",
1091                                   (long)n, (long)cc->min,
1092                                   (long)cc->max, (long)cc)
1093                     );
1094
1095                 /* If degenerate scan matches "", assume scan done. */
1096
1097                 if (locinput == cc->lastloc && n >= cc->min) {
1098                     regcc = cc->oldcc;
1099                     ln = regcc->cur;
1100                     DEBUG_r(
1101                         PerlIO_printf(Perl_debug_log, "%*s  empty match detected, try continuation...\n", REPORT_CODE_OFF+regindent*2, "")
1102                         );
1103                     if (regmatch(cc->next))
1104                         sayYES;
1105                     DEBUG_r(
1106                         PerlIO_printf(Perl_debug_log, "%*s  failed...\n", REPORT_CODE_OFF+regindent*2, "")
1107                         );
1108                     regcc->cur = ln;
1109                     regcc = cc;
1110                     sayNO;
1111                 }
1112
1113                 /* First just match a string of min scans. */
1114
1115                 if (n < cc->min) {
1116                     cc->cur = n;
1117                     cc->lastloc = locinput;
1118                     if (regmatch(cc->scan))
1119                         sayYES;
1120                     cc->cur = n - 1;
1121                     cc->lastloc = lastloc;
1122                     DEBUG_r(
1123                         PerlIO_printf(Perl_debug_log, "%*s  failed...\n", REPORT_CODE_OFF+regindent*2, "")
1124                         );
1125                     sayNO;
1126                 }
1127
1128                 /* Prefer next over scan for minimal matching. */
1129
1130                 if (cc->minmod) {
1131                     regcc = cc->oldcc;
1132                     ln = regcc->cur;
1133                     cp = regcppush(cc->parenfloor);
1134                     REGCP_SET;
1135                     if (regmatch(cc->next)) {
1136                         regcpblow(cp);
1137                         sayYES; /* All done. */
1138                     }
1139                     REGCP_UNWIND;
1140                     regcppop();
1141                     regcc->cur = ln;
1142                     regcc = cc;
1143
1144                     if (n >= cc->max) { /* Maximum greed exceeded? */
1145                         if (dowarn && n >= REG_INFTY
1146                             && !(reg_flags & RF_warned)) {
1147                             reg_flags |= RF_warned;
1148                             warn("count exceeded %d", REG_INFTY - 1);
1149                         }
1150                         sayNO;
1151                     }
1152
1153                     DEBUG_r(
1154                         PerlIO_printf(Perl_debug_log, "%*s  trying longer...\n", REPORT_CODE_OFF+regindent*2, "")
1155                         );
1156                     /* Try scanning more and see if it helps. */
1157                     reginput = locinput;
1158                     cc->cur = n;
1159                     cc->lastloc = locinput;
1160                     cp = regcppush(cc->parenfloor);
1161                     REGCP_SET;
1162                     if (regmatch(cc->scan)) {
1163                         regcpblow(cp);
1164                         sayYES;
1165                     }
1166                     DEBUG_r(
1167                         PerlIO_printf(Perl_debug_log, "%*s  failed...\n", REPORT_CODE_OFF+regindent*2, "")
1168                         );
1169                     REGCP_UNWIND;
1170                     regcppop();
1171                     cc->cur = n - 1;
1172                     cc->lastloc = lastloc;
1173                     sayNO;
1174                 }
1175
1176                 /* Prefer scan over next for maximal matching. */
1177
1178                 if (n < cc->max) {      /* More greed allowed? */
1179                     cp = regcppush(cc->parenfloor);
1180                     cc->cur = n;
1181                     cc->lastloc = locinput;
1182                     REGCP_SET;
1183                     if (regmatch(cc->scan)) {
1184                         regcpblow(cp);
1185                         sayYES;
1186                     }
1187                     REGCP_UNWIND;
1188                     regcppop();         /* Restore some previous $<digit>s? */
1189                     reginput = locinput;
1190                     DEBUG_r(
1191                         PerlIO_printf(Perl_debug_log, "%*s  failed, try continuation...\n", REPORT_CODE_OFF+regindent*2, "")
1192                         );
1193                 }
1194                 if (dowarn && n >= REG_INFTY && !(reg_flags & RF_warned)) {
1195                     reg_flags |= RF_warned;
1196                     warn("count exceeded %d", REG_INFTY - 1);
1197                 }
1198
1199                 /* Failed deeper matches of scan, so see if this one works. */
1200                 regcc = cc->oldcc;
1201                 ln = regcc->cur;
1202                 if (regmatch(cc->next))
1203                     sayYES;
1204                 DEBUG_r(
1205                     PerlIO_printf(Perl_debug_log, "%*s  failed...\n", REPORT_CODE_OFF+regindent*2, "")
1206                     );
1207                 regcc->cur = ln;
1208                 regcc = cc;
1209                 cc->cur = n - 1;
1210                 cc->lastloc = lastloc;
1211                 sayNO;
1212             }
1213             /* NOT REACHED */
1214         case BRANCHJ:
1215             next = scan + ARG(scan);
1216             if (next == scan)
1217                 next = NULL;
1218             inner = NEXTOPER(NEXTOPER(scan));
1219             goto do_branch;
1220         case BRANCH:
1221             inner = NEXTOPER(scan);
1222           do_branch:
1223             {
1224                 CHECKPOINT lastcp;
1225                 c1 = OP(scan);
1226                 if (OP(next) != c1)     /* No choice. */
1227                     next = inner;       /* Avoid recursion. */
1228                 else {
1229                     int lastparen = *reglastparen;
1230
1231                     REGCP_SET;
1232                     do {
1233                         reginput = locinput;
1234                         if (regmatch(inner))
1235                             sayYES;
1236                         REGCP_UNWIND;
1237                         for (n = *reglastparen; n > lastparen; n--)
1238                             regendp[n] = 0;
1239                         *reglastparen = n;
1240                         scan = next;
1241                         /*SUPPRESS 560*/
1242                         if (n = (c1 == BRANCH ? NEXT_OFF(next) : ARG(next)))
1243                             next += n;
1244                         else
1245                             next = NULL;
1246                         inner = NEXTOPER(scan);
1247                         if (c1 == BRANCHJ) {
1248                             inner = NEXTOPER(inner);
1249                         }
1250                     } while (scan != NULL && OP(scan) == c1);
1251                     sayNO;
1252                     /* NOTREACHED */
1253                 }
1254             }
1255             break;
1256         case MINMOD:
1257             minmod = 1;
1258             break;
1259         case CURLYM:
1260         {
1261             I32 l = 0;
1262             CHECKPOINT lastcp;
1263
1264             /* We suppose that the next guy does not need
1265                backtracking: in particular, it is of constant length,
1266                and has no parenths to influence future backrefs. */
1267             ln = ARG1(scan);  /* min to match */
1268             n  = ARG2(scan);  /* max to match */
1269             paren = scan->flags;
1270             if (paren) {
1271                 if (paren > regsize)
1272                     regsize = paren;
1273                 if (paren > *reglastparen)
1274                     *reglastparen = paren;
1275             }
1276             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
1277             if (paren)
1278                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
1279             reginput = locinput;
1280             if (minmod) {
1281                 minmod = 0;
1282                 if (ln && regrepeat_hard(scan, ln, &l) < ln)
1283                     sayNO;
1284                 if (ln && l == 0 && n >= ln
1285                     /* In fact, this is tricky.  If paren, then the
1286                        fact that we did/didnot match may influence
1287                        future execution. */
1288                     && !(paren && ln == 0))
1289                     ln = n;
1290                 locinput = reginput;
1291                 if (regkind[(U8)OP(next)] == EXACT) {
1292                     c1 = UCHARAT(OPERAND(next) + 1);
1293                     if (OP(next) == EXACTF)
1294                         c2 = fold[c1];
1295                     else if (OP(next) == EXACTFL)
1296                         c2 = fold_locale[c1];
1297                     else
1298                         c2 = c1;
1299                 } else
1300                     c1 = c2 = -1000;
1301                 REGCP_SET;
1302                 /* This may be improved if l == 0.  */
1303                 while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */
1304                     /* If it could work, try it. */
1305                     if (c1 == -1000 ||
1306                         UCHARAT(reginput) == c1 ||
1307                         UCHARAT(reginput) == c2)
1308                     {
1309                         if (paren) {
1310                             if (n) {
1311                                 regstartp[paren] = reginput - l;
1312                                 regendp[paren] = reginput;
1313                             } else
1314                                 regendp[paren] = NULL;
1315                         }
1316                         if (regmatch(next))
1317                             sayYES;
1318                         REGCP_UNWIND;
1319                     }
1320                     /* Couldn't or didn't -- move forward. */
1321                     reginput = locinput;
1322                     if (regrepeat_hard(scan, 1, &l)) {
1323                         ln++;
1324                         locinput = reginput;
1325                     }
1326                     else
1327                         sayNO;
1328                 }
1329             } else {
1330                 n = regrepeat_hard(scan, n, &l);
1331                 if (n != 0 && l == 0
1332                     /* In fact, this is tricky.  If paren, then the
1333                        fact that we did/didnot match may influence
1334                        future execution. */
1335                     && !(paren && ln == 0))
1336                     ln = n;
1337                 locinput = reginput;
1338                 DEBUG_r(
1339                     PerlIO_printf(Perl_debug_log, "%*s  matched %ld times, len=%ld...\n", REPORT_CODE_OFF+regindent*2, "", n, l)
1340                     );
1341                 if (n >= ln) {
1342                     if (regkind[(U8)OP(next)] == EXACT) {
1343                         c1 = UCHARAT(OPERAND(next) + 1);
1344                         if (OP(next) == EXACTF)
1345                             c2 = fold[c1];
1346                         else if (OP(next) == EXACTFL)
1347                             c2 = fold_locale[c1];
1348                         else
1349                             c2 = c1;
1350                     } else
1351                         c1 = c2 = -1000;
1352                 }
1353                 REGCP_SET;
1354                 while (n >= ln) {
1355                     /* If it could work, try it. */
1356                     if (c1 == -1000 ||
1357                         UCHARAT(reginput) == c1 ||
1358                         UCHARAT(reginput) == c2)
1359                         {
1360                             DEBUG_r(
1361                                 PerlIO_printf(Perl_debug_log, "%*s  trying tail with n=%ld...\n", REPORT_CODE_OFF+regindent*2, "", n)
1362                                 );
1363                             if (paren) {
1364                                 if (n) {
1365                                     regstartp[paren] = reginput - l;
1366                                     regendp[paren] = reginput;
1367                                 } else
1368                                     regendp[paren] = NULL;
1369                             }
1370                             if (regmatch(next))
1371                                 sayYES;
1372                             REGCP_UNWIND;
1373                         }
1374                     /* Couldn't or didn't -- back up. */
1375                     n--;
1376                     locinput -= l;
1377                     reginput = locinput;
1378                 }
1379             }
1380             sayNO;
1381             break;
1382         }
1383         case CURLYN:
1384             paren = scan->flags;        /* Which paren to set */
1385             if (paren > regsize)
1386                 regsize = paren;
1387             if (paren > *reglastparen)
1388                 *reglastparen = paren;
1389             ln = ARG1(scan);  /* min to match */
1390             n  = ARG2(scan);  /* max to match */
1391             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
1392             goto repeat;
1393         case CURLY:
1394             paren = 0;
1395             ln = ARG1(scan);  /* min to match */
1396             n  = ARG2(scan);  /* max to match */
1397             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
1398             goto repeat;
1399         case STAR:
1400             ln = 0;
1401             n = REG_INFTY;
1402             scan = NEXTOPER(scan);
1403             paren = 0;
1404             goto repeat;
1405         case PLUS:
1406             ln = 1;
1407             n = REG_INFTY;
1408             scan = NEXTOPER(scan);
1409             paren = 0;
1410           repeat:
1411             /*
1412             * Lookahead to avoid useless match attempts
1413             * when we know what character comes next.
1414             */
1415             if (regkind[(U8)OP(next)] == EXACT) {
1416                 c1 = UCHARAT(OPERAND(next) + 1);
1417                 if (OP(next) == EXACTF)
1418                     c2 = fold[c1];
1419                 else if (OP(next) == EXACTFL)
1420                     c2 = fold_locale[c1];
1421                 else
1422                     c2 = c1;
1423             }
1424             else
1425                 c1 = c2 = -1000;
1426             reginput = locinput;
1427             if (minmod) {
1428                 CHECKPOINT lastcp;
1429                 minmod = 0;
1430                 if (ln && regrepeat(scan, ln) < ln)
1431                     sayNO;
1432                 REGCP_SET;
1433                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
1434                     /* If it could work, try it. */
1435                     if (c1 == -1000 ||
1436                         UCHARAT(reginput) == c1 ||
1437                         UCHARAT(reginput) == c2)
1438                     {
1439                         if (paren) {
1440                             if (n) {
1441                                 regstartp[paren] = reginput - 1;
1442                                 regendp[paren] = reginput;
1443                             } else
1444                                 regendp[paren] = NULL;
1445                         }
1446                         if (regmatch(next))
1447                             sayYES;
1448                         REGCP_UNWIND;
1449                     }
1450                     /* Couldn't or didn't -- move forward. */
1451                     reginput = locinput + ln;
1452                     if (regrepeat(scan, 1)) {
1453                         ln++;
1454                         reginput = locinput + ln;
1455                     } else
1456                         sayNO;
1457                 }
1458             }
1459             else {
1460                 CHECKPOINT lastcp;
1461                 n = regrepeat(scan, n);
1462                 if (ln < n && regkind[(U8)OP(next)] == EOL &&
1463                     (!multiline  || OP(next) == SEOL))
1464                     ln = n;                     /* why back off? */
1465                 REGCP_SET;
1466                 if (paren) {
1467                     while (n >= ln) {
1468                         /* If it could work, try it. */
1469                         if (c1 == -1000 ||
1470                             UCHARAT(reginput) == c1 ||
1471                             UCHARAT(reginput) == c2)
1472                             {
1473                                 if (paren && n) {
1474                                     if (n) {
1475                                         regstartp[paren] = reginput - 1;
1476                                         regendp[paren] = reginput;
1477                                     } else
1478                                         regendp[paren] = NULL;
1479                                 }
1480                                 if (regmatch(next))
1481                                     sayYES;
1482                                 REGCP_UNWIND;
1483                             }
1484                         /* Couldn't or didn't -- back up. */
1485                         n--;
1486                         reginput = locinput + n;
1487                     }
1488                 } else {
1489                     while (n >= ln) {
1490                         /* If it could work, try it. */
1491                         if (c1 == -1000 ||
1492                             UCHARAT(reginput) == c1 ||
1493                             UCHARAT(reginput) == c2)
1494                             {
1495                                 if (regmatch(next))
1496                                     sayYES;
1497                                 REGCP_UNWIND;
1498                             }
1499                         /* Couldn't or didn't -- back up. */
1500                         n--;
1501                         reginput = locinput + n;
1502                     }
1503                 }
1504             }
1505             sayNO;
1506             break;
1507         case SUCCEED:
1508         case END:
1509             reginput = locinput;        /* put where regtry can find it */
1510             sayYES;                     /* Success! */
1511         case SUSPEND:
1512             n = 1;
1513             goto do_ifmatch;
1514         case UNLESSM:
1515             n = 0;
1516             if (locinput < bostr + scan->flags)
1517                 goto say_yes;
1518             goto do_ifmatch;
1519         case IFMATCH:
1520             n = 1;
1521             if (locinput < bostr + scan->flags)
1522                 goto say_no;
1523           do_ifmatch:
1524             reginput = locinput - scan->flags;
1525             inner = NEXTOPER(NEXTOPER(scan));
1526             if (regmatch(inner) != n) {
1527               say_no:
1528                 if (logical) {
1529                     logical = 0;
1530                     sw = 0;
1531                     goto do_longjump;
1532                 } else
1533                     sayNO;
1534             }
1535           say_yes:
1536             if (logical) {
1537                 logical = 0;
1538                 sw = 1;
1539             }
1540             if (OP(scan) == SUSPEND) {
1541                 locinput = reginput;
1542                 nextchr = UCHARAT(locinput);
1543             }
1544             /* FALL THROUGH. */
1545         case LONGJMP:
1546           do_longjump:
1547             next = scan + ARG(scan);
1548             if (next == scan)
1549                 next = NULL;
1550             break;
1551         default:
1552             PerlIO_printf(PerlIO_stderr(), "%lx %d\n",
1553                           (unsigned long)scan, OP(scan));
1554             FAIL("regexp memory corruption");
1555         }
1556         scan = next;
1557     }
1558
1559     /*
1560     * We get here only if there's trouble -- normally "case END" is
1561     * the terminating point.
1562     */
1563     FAIL("corrupted regexp pointers");
1564     /*NOTREACHED*/
1565     sayNO;
1566
1567 yes:
1568 #ifdef DEBUGGING
1569     regindent--;
1570 #endif
1571     return 1;
1572
1573 no:
1574 #ifdef DEBUGGING
1575     regindent--;
1576 #endif
1577     return 0;
1578 }
1579
1580 /*
1581  - regrepeat - repeatedly match something simple, report how many
1582  */
1583 /*
1584  * [This routine now assumes that it will only match on things of length 1.
1585  * That was true before, but now we assume scan - reginput is the count,
1586  * rather than incrementing count on every character.]
1587  */
1588 STATIC I32
1589 regrepeat(regnode *p, I32 max)
1590 {
1591     register char *scan;
1592     register char *opnd;
1593     register I32 c;
1594     register char *loceol = regeol;
1595
1596     scan = reginput;
1597     if (max != REG_INFTY && max < loceol - scan)
1598       loceol = scan + max;
1599     opnd = (char *) OPERAND(p);
1600     switch (OP(p)) {
1601     case ANY:
1602         while (scan < loceol && *scan != '\n')
1603             scan++;
1604         break;
1605     case SANY:
1606         scan = loceol;
1607         break;
1608     case EXACT:         /* length of string is 1 */
1609         c = UCHARAT(++opnd);
1610         while (scan < loceol && UCHARAT(scan) == c)
1611             scan++;
1612         break;
1613     case EXACTF:        /* length of string is 1 */
1614         c = UCHARAT(++opnd);
1615         while (scan < loceol &&
1616                (UCHARAT(scan) == c || UCHARAT(scan) == fold[c]))
1617             scan++;
1618         break;
1619     case EXACTFL:       /* length of string is 1 */
1620         reg_flags |= RF_tainted;
1621         c = UCHARAT(++opnd);
1622         while (scan < loceol &&
1623                (UCHARAT(scan) == c || UCHARAT(scan) == fold_locale[c]))
1624             scan++;
1625         break;
1626     case ANYOF:
1627         while (scan < loceol && REGINCLASS(opnd, *scan))
1628             scan++;
1629         break;
1630     case ALNUM:
1631         while (scan < loceol && isALNUM(*scan))
1632             scan++;
1633         break;
1634     case ALNUML:
1635         reg_flags |= RF_tainted;
1636         while (scan < loceol && isALNUM_LC(*scan))
1637             scan++;
1638         break;
1639     case NALNUM:
1640         while (scan < loceol && !isALNUM(*scan))
1641             scan++;
1642         break;
1643     case NALNUML:
1644         reg_flags |= RF_tainted;
1645         while (scan < loceol && !isALNUM_LC(*scan))
1646             scan++;
1647         break;
1648     case SPACE:
1649         while (scan < loceol && isSPACE(*scan))
1650             scan++;
1651         break;
1652     case SPACEL:
1653         reg_flags |= RF_tainted;
1654         while (scan < loceol && isSPACE_LC(*scan))
1655             scan++;
1656         break;
1657     case NSPACE:
1658         while (scan < loceol && !isSPACE(*scan))
1659             scan++;
1660         break;
1661     case NSPACEL:
1662         reg_flags |= RF_tainted;
1663         while (scan < loceol && !isSPACE_LC(*scan))
1664             scan++;
1665         break;
1666     case DIGIT:
1667         while (scan < loceol && isDIGIT(*scan))
1668             scan++;
1669         break;
1670     case NDIGIT:
1671         while (scan < loceol && !isDIGIT(*scan))
1672             scan++;
1673         break;
1674     default:            /* Called on something of 0 width. */
1675         break;          /* So match right here or not at all. */
1676     }
1677
1678     c = scan - reginput;
1679     reginput = scan;
1680
1681     DEBUG_r(
1682         {
1683                 SV *prop = sv_newmortal();
1684
1685                 regprop(prop, p);
1686                 PerlIO_printf(Perl_debug_log,
1687                               "%*s  %s can match %ld times out of %ld...\n",
1688                               REPORT_CODE_OFF+1, "", SvPVX(prop),c,max);
1689         });
1690
1691     return(c);
1692 }
1693
1694 /*
1695  - regrepeat_hard - repeatedly match something, report total lenth and length
1696  *
1697  * The repeater is supposed to have constant length.
1698  */
1699
1700 STATIC I32
1701 regrepeat_hard(regnode *p, I32 max, I32 *lp)
1702 {
1703     register char *scan;
1704     register char *start;
1705     register char *loceol = regeol;
1706     I32 l = -1;
1707
1708     start = reginput;
1709     while (reginput < loceol && (scan = reginput, regmatch(p))) {
1710         if (l == -1) {
1711             *lp = l = reginput - start;
1712             if (max != REG_INFTY && l*max < loceol - scan)
1713                 loceol = scan + l*max;
1714             if (l == 0) {
1715                 return max;
1716             }
1717         }
1718     }
1719     if (reginput < loceol)
1720         reginput = scan;
1721     else
1722         scan = reginput;
1723
1724     return (scan - start)/l;
1725 }
1726
1727 /*
1728  - regclass - determine if a character falls into a character class
1729  */
1730
1731 STATIC bool
1732 reginclass(register char *p, register I32 c)
1733 {
1734     char flags = *p;
1735     bool match = FALSE;
1736
1737     c &= 0xFF;
1738     if (ANYOF_TEST(p, c))
1739         match = TRUE;
1740     else if (flags & ANYOF_FOLD) {
1741         I32 cf;
1742         if (flags & ANYOF_LOCALE) {
1743             reg_flags |= RF_tainted;
1744             cf = fold_locale[c];
1745         }
1746         else
1747             cf = fold[c];
1748         if (ANYOF_TEST(p, cf))
1749             match = TRUE;
1750     }
1751
1752     if (!match && (flags & ANYOF_ISA)) {
1753         reg_flags |= RF_tainted;
1754
1755         if (((flags & ANYOF_ALNUML)  && isALNUM_LC(c))  ||
1756             ((flags & ANYOF_NALNUML) && !isALNUM_LC(c)) ||
1757             ((flags & ANYOF_SPACEL)  && isSPACE_LC(c))  ||
1758             ((flags & ANYOF_NSPACEL) && !isSPACE_LC(c)))
1759         {
1760             match = TRUE;
1761         }
1762     }
1763
1764     return (flags & ANYOF_INVERT) ? !match : match;
1765 }
1766
1767
1768