regexec.c

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