regexec.c

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