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