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