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