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