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