regexec.c

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