regcomp.c

   1 /*    regcomp.c
   2  */
   3
   4 /*
   5  * "A fair jaw-cracker dwarf-language must be."  --Samwise Gamgee
   6  */
   7
   8 /* NOTE: this is derived from Henry Spencer's regexp code, and should not
   9  * confused with the original package (see point 3 below).  Thanks, Henry!
  10  */
  11
  12 /* Additional note: this code is very heavily munged from Henry's version
  13  * in places.  In some spots I've traded clarity for efficiency, so don't
  14  * blame Henry for some of the lack of readability.
  15  */
  16
  17 /* The names of the functions have been changed from regcomp and
  18  * regexec to  pregcomp and pregexec in order to avoid conflicts
  19  * with the POSIX routines of the same names.
  20 */
  21
  22 /*SUPPRESS 112*/
  23 /*
  24  * pregcomp and pregexec -- regsub and regerror are not used in perl
  25  *
  26  *      Copyright (c) 1986 by University of Toronto.
  27  *      Written by Henry Spencer.  Not derived from licensed software.
  28  *
  29  *      Permission is granted to anyone to use this software for any
  30  *      purpose on any computer system, and to redistribute it freely,
  31  *      subject to the following restrictions:
  32  *
  33  *      1. The author is not responsible for the consequences of use of
  34  *              this software, no matter how awful, even if they arise
  35  *              from defects in it.
  36  *
  37  *      2. The origin of this software must not be misrepresented, either
  38  *              by explicit claim or by omission.
  39  *
  40  *      3. Altered versions must be plainly marked as such, and must not
  41  *              be misrepresented as being the original software.
  42  *
  43  *
  44  ****    Alterations to Henry's code are...
  45  ****
  46  ****    Copyright (c) 1991-1994, Larry Wall
  47  ****
  48  ****    You may distribute under the terms of either the GNU General Public
  49  ****    License or the Artistic License, as specified in the README file.
  50
  51  *
  52  * Beware that some of this code is subtly aware of the way operator
  53  * precedence is structured in regular expressions.  Serious changes in
  54  * regular-expression syntax might require a total rethink.
  55  */
  56 #include "EXTERN.h"
  57 #include "perl.h"
  58 #include "INTERN.h"
  59 #include "regcomp.h"
  60
  61 #ifdef MSDOS
  62 # if defined(BUGGY_MSC6)
  63  /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
  64  # pragma optimize("a",off)
  65  /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
  66  # pragma optimize("w",on )
  67 # endif /* BUGGY_MSC6 */
  68 #endif /* MSDOS */
  69
  70 #ifndef STATIC
  71 #define STATIC  static
  72 #endif
  73
  74 #define ISMULT1(c)      ((c) == '*' || (c) == '+' || (c) == '?')
  75 #define ISMULT2(s)      ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
  76         ((*s) == '{' && regcurly(s)))
  77 #ifdef atarist
  78 #define PERL_META       "^$.[()|?+*\\"
  79 #else
  80 #define META    "^$.[()|?+*\\"
  81 #endif
  82
  83 #ifdef SPSTART
  84 #undef SPSTART          /* dratted cpp namespace... */
  85 #endif
  86 /*
  87  * Flags to be passed up and down.
  88  */
  89 #define WORST           0       /* Worst case. */
  90 #define HASWIDTH        0x1     /* Known never to match null string. */
  91 #define SIMPLE          0x2     /* Simple enough to be STAR/PLUS operand. */
  92 #define SPSTART         0x4     /* Starts with * or +. */
  93 #define TRYAGAIN        0x8     /* Weeded out a declaration. */
  94
  95 /*
  96  * Forward declarations for pregcomp()'s friends.
  97  */
  98
  99 static char *reg _((I32, I32 *));
 100 static char *reganode _((char, unsigned short));
 101 static char *regatom _((I32 *));
 102 static char *regbranch _((I32 *));
 103 static void regc _((char));
 104 static char *regclass _((void));
 105 STATIC I32 regcurly _((char *));
 106 static char *regnode _((char));
 107 static char *regpiece _((I32 *));
 108 static void reginsert _((char, char *));
 109 static void regoptail _((char *, char *));
 110 static void regset _((char *, I32, I32));
 111 static void regtail _((char *, char *));
 112 static char* nextchar _((void));
 113
 114 /*
 115  - pregcomp - compile a regular expression into internal code
 116  *
 117  * We can't allocate space until we know how big the compiled form will be,
 118  * but we can't compile it (and thus know how big it is) until we've got a
 119  * place to put the code.  So we cheat:  we compile it twice, once with code
 120  * generation turned off and size counting turned on, and once "for real".
 121  * This also means that we don't allocate space until we are sure that the
 122  * thing really will compile successfully, and we never have to move the
 123  * code and thus invalidate pointers into it.  (Note that it has to be in
 124  * one piece because free() must be able to free it all.) [NB: not true in perl]
 125  *
 126  * Beware that the optimization-preparation code in here knows about some
 127  * of the structure of the compiled regexp.  [I'll say.]
 128  */
 129 regexp *
 130 pregcomp(exp,xend,pm)
 131 char* exp;
 132 char* xend;
 133 PMOP* pm;
 134 {
 135     I32 fold = pm->op_pmflags & PMf_FOLD;
 136     register regexp *r;
 137     register char *scan;
 138     register SV *longish;
 139     SV *longest;
 140     register I32 len;
 141     register char *first;
 142     I32 flags;
 143     I32 backish;
 144     I32 backest;
 145     I32 curback;
 146     I32 minlen = 0;
 147     I32 sawplus = 0;
 148     I32 sawopen = 0;
 149
 150     if (exp == NULL)
 151         croak("NULL regexp argument");
 152
 153     /* First pass: determine size, legality. */
 154     regflags = pm->op_pmflags;
 155     regparse = exp;
 156     regxend = xend;
 157     regprecomp = savepvn(exp,xend-exp);
 158     regnaughty = 0;
 159     regsawback = 0;
 160     regnpar = 1;
 161     regsize = 0L;
 162     regcode = &regdummy;
 163     regc((char)MAGIC);
 164     if (reg(0, &flags) == NULL) {
 165         Safefree(regprecomp);
 166         regprecomp = Nullch;
 167         return(NULL);
 168     }
 169
 170     /* Small enough for pointer-storage convention? */
 171     if (regsize >= 32767L)              /* Probably could be 65535L. */
 172         FAIL("regexp too big");
 173
 174     /* Allocate space. */
 175     Newc(1001, r, sizeof(regexp) + (unsigned)regsize, char, regexp);
 176     if (r == NULL)
 177         FAIL("regexp out of space");
 178
 179     /* Second pass: emit code. */
 180     r->prelen = xend-exp;
 181     r->precomp = regprecomp;
 182     r->subbeg = r->subbase = NULL;
 183     regnaughty = 0;
 184     regparse = exp;
 185     regnpar = 1;
 186     regcode = r->program;
 187     regc((char)MAGIC);
 188     if (reg(0, &flags) == NULL)
 189         return(NULL);
 190
 191     /* Dig out information for optimizations. */
 192     pm->op_pmflags = regflags;
 193     fold = pm->op_pmflags & PMf_FOLD;
 194     r->regstart = Nullsv;       /* Worst-case defaults. */
 195     r->reganch = 0;
 196     r->regmust = Nullsv;
 197     r->regback = -1;
 198     r->regstclass = Nullch;
 199     r->naughty = regnaughty >= 10;      /* Probably an expensive pattern. */
 200     scan = r->program+1;                        /* First BRANCH. */
 201     if (OP(regnext(scan)) == END) {/* Only one top-level choice. */
 202         scan = NEXTOPER(scan);
 203
 204         first = scan;
 205         while ((OP(first) == OPEN && (sawopen = 1)) ||
 206             (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
 207             (OP(first) == PLUS) ||
 208             (OP(first) == MINMOD) ||
 209             (regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) {
 210                 if (OP(first) == PLUS)
 211                     sawplus = 1;
 212                 else
 213                     first += regarglen[(U8)OP(first)];
 214                 first = NEXTOPER(first);
 215         }
 216
 217         /* Starting-point info. */
 218       again:
 219         if (OP(first) == EXACTLY) {
 220             r->regstart = newSVpv(OPERAND(first)+1,*OPERAND(first));
 221             if (SvCUR(r->regstart) > !(sawstudy|fold))
 222                 fbm_compile(r->regstart,fold);
 223             else
 224                 sv_upgrade(r->regstart, SVt_PVBM);
 225         }
 226         else if (strchr(simple+2,OP(first)))
 227             r->regstclass = first;
 228         else if (OP(first) == BOUND || OP(first) == NBOUND)
 229             r->regstclass = first;
 230         else if (regkind[(U8)OP(first)] == BOL) {
 231             r->reganch = ROPT_ANCH;
 232             first = NEXTOPER(first);
 233                 goto again;
 234         }
 235         else if ((OP(first) == STAR &&
 236             regkind[(U8)OP(NEXTOPER(first))] == ANY) &&
 237             !(r->reganch & ROPT_ANCH) )
 238         {
 239             /* turn .* into ^.* with an implied $*=1 */
 240             r->reganch = ROPT_ANCH | ROPT_IMPLICIT;
 241             first = NEXTOPER(first);
 242                 goto again;
 243         }
 244         if (sawplus && (!sawopen || !regsawback))
 245             r->reganch |= ROPT_SKIP;    /* x+ must match 1st of run */
 246
 247         DEBUG_r(fprintf(stderr,"first %d next %d offset %d\n",
 248            OP(first), OP(NEXTOPER(first)), first - scan));
 249         /*
 250         * If there's something expensive in the r.e., find the
 251         * longest literal string that must appear and make it the
 252         * regmust.  Resolve ties in favor of later strings, since
 253         * the regstart check works with the beginning of the r.e.
 254         * and avoiding duplication strengthens checking.  Not a
 255         * strong reason, but sufficient in the absence of others.
 256         * [Now we resolve ties in favor of the earlier string if
 257         * it happens that curback has been invalidated, since the
 258         * earlier string may buy us something the later one won't.]
 259         */
 260         longish = newSVpv("",0);
 261         longest = newSVpv("",0);
 262         len = 0;
 263         minlen = 0;
 264         curback = 0;
 265         backish = 0;
 266         backest = 0;
 267         while (OP(scan) != END) {
 268             if (OP(scan) == BRANCH) {
 269                 if (OP(regnext(scan)) == BRANCH) {
 270                     curback = -30000;
 271                     while (OP(scan) == BRANCH)
 272                         scan = regnext(scan);
 273                 }
 274                 else    /* single branch is ok */
 275                     scan = NEXTOPER(scan);
 276                 continue;
 277             }
 278             if (OP(scan) == UNLESSM) {
 279                 curback = -30000;
 280                 scan = regnext(scan);
 281                 continue;
 282             }
 283             if (OP(scan) == EXACTLY) {
 284                 char *t;
 285
 286                 first = scan;
 287                 while (OP(t = regnext(scan)) == CLOSE)
 288                     scan = t;
 289                 minlen += *OPERAND(first);
 290                 if (curback - backish == len) {
 291                     sv_catpvn(longish, OPERAND(first)+1,
 292                         *OPERAND(first));
 293                     len += *OPERAND(first);
 294                     curback += *OPERAND(first);
 295                     first = regnext(scan);
 296                 }
 297                 else if (*OPERAND(first) >= len + (curback >= 0)) {
 298                     len = *OPERAND(first);
 299                     sv_setpvn(longish, OPERAND(first)+1,len);
 300                     backish = curback;
 301                     curback += len;
 302                     first = regnext(scan);
 303                 }
 304                 else
 305                     curback += *OPERAND(first);
 306             }
 307             else if (strchr(varies,OP(scan))) {
 308                 curback = -30000;
 309                 len = 0;
 310                 if (SvCUR(longish) > SvCUR(longest)) {
 311                     sv_setsv(longest,longish);
 312                     backest = backish;
 313                 }
 314                 sv_setpvn(longish,"",0);
 315                 if (OP(scan) == PLUS && strchr(simple,OP(NEXTOPER(scan))))
 316                     minlen++;
 317                 else if (regkind[(U8)OP(scan)] == CURLY &&
 318                   strchr(simple,OP(NEXTOPER(scan)+4)))
 319                     minlen += ARG1(scan);
 320             }
 321             else if (strchr(simple,OP(scan))) {
 322                 curback++;
 323                 minlen++;
 324                 len = 0;
 325                 if (SvCUR(longish) > SvCUR(longest)) {
 326                     sv_setsv(longest,longish);
 327                     backest = backish;
 328                 }
 329                 sv_setpvn(longish,"",0);
 330             }
 331             scan = regnext(scan);
 332         }
 333
 334         /* Prefer earlier on tie, unless we can tail match latter */
 335
 336         if (SvCUR(longish) + (regkind[(U8)OP(first)] == EOL) >
 337                 SvCUR(longest))
 338         {
 339             sv_setsv(longest,longish);
 340             backest = backish;
 341         }
 342         else
 343             sv_setpvn(longish,"",0);
 344         if (SvCUR(longest)
 345             &&
 346             (!r->regstart
 347              ||
 348              !fbm_instr((unsigned char*) SvPVX(r->regstart),
 349                   (unsigned char *) SvPVX(r->regstart)
 350                     + SvCUR(r->regstart),
 351                   longest)
 352             )
 353            )
 354         {
 355             r->regmust = longest;
 356             if (backest < 0)
 357                 backest = -1;
 358             r->regback = backest;
 359             if (SvCUR(longest) > !(sawstudy || fold ||
 360                         regkind[(U8)OP(first)]==EOL))
 361                 fbm_compile(r->regmust,fold);
 362             (void)SvUPGRADE(r->regmust, SVt_PVBM);
 363             BmUSEFUL(r->regmust) = 100;
 364             if (regkind[(U8)OP(first)] == EOL && SvCUR(longish))
 365                 SvTAIL_on(r->regmust);
 366         }
 367         else {
 368             SvREFCNT_dec(longest);
 369             longest = Nullsv;
 370         }
 371         SvREFCNT_dec(longish);
 372     }
 373
 374     r->do_folding = fold;
 375     r->nparens = regnpar - 1;
 376     r->minlen = minlen;
 377     Newz(1002, r->startp, regnpar, char*);
 378     Newz(1002, r->endp, regnpar, char*);
 379     DEBUG_r(regdump(r));
 380     return(r);
 381 }
 382
 383 /*
 384  - reg - regular expression, i.e. main body or parenthesized thing
 385  *
 386  * Caller must absorb opening parenthesis.
 387  *
 388  * Combining parenthesis handling with the base level of regular expression
 389  * is a trifle forced, but the need to tie the tails of the branches to what
 390  * follows makes it hard to avoid.
 391  */
 392 static char *
 393 reg(paren, flagp)
 394 I32 paren;                      /* Parenthesized? */
 395 I32 *flagp;
 396 {
 397     register char *ret;
 398     register char *br;
 399     register char *ender = 0;
 400     register I32 parno = 0;
 401     I32 flags;
 402
 403     *flagp = HASWIDTH;  /* Tentatively. */
 404
 405     /* Make an OPEN node, if parenthesized. */
 406     if (paren) {
 407         if (*regparse == '?') {
 408             regparse++;
 409             paren = *regparse++;
 410             ret = NULL;
 411             switch (paren) {
 412             case ':':
 413             case '=':
 414             case '!':
 415                 break;
 416             case '$':
 417             case '@':
 418                 croak("Sequence (?%c...) not implemented", paren);
 419                 break;
 420             case '#':
 421                 while (*regparse && *regparse != ')')
 422                     regparse++;
 423                 if (*regparse != ')')
 424                     croak("Sequence (?#... not terminated");
 425                 nextchar();
 426                 *flagp = TRYAGAIN;
 427                 return NULL;
 428             default:
 429                 --regparse;
 430                 while (*regparse && strchr("iogmsx", *regparse))
 431                     pmflag(&regflags, *regparse++);
 432                 if (*regparse != ')')
 433                     croak("Sequence (?%c...) not recognized", *regparse);
 434                 nextchar();
 435                 *flagp = TRYAGAIN;
 436                 return NULL;
 437             }
 438         }
 439         else {
 440             parno = regnpar;
 441             regnpar++;
 442             ret = reganode(OPEN, parno);
 443         }
 444     } else
 445         ret = NULL;
 446
 447     /* Pick up the branches, linking them together. */
 448     br = regbranch(&flags);
 449     if (br == NULL)
 450         return(NULL);
 451     if (ret != NULL)
 452         regtail(ret, br);       /* OPEN -> first. */
 453     else
 454         ret = br;
 455     if (!(flags&HASWIDTH))
 456         *flagp &= ~HASWIDTH;
 457     *flagp |= flags&SPSTART;
 458     while (*regparse == '|') {
 459         nextchar();
 460         br = regbranch(&flags);
 461         if (br == NULL)
 462             return(NULL);
 463         regtail(ret, br);       /* BRANCH -> BRANCH. */
 464         if (!(flags&HASWIDTH))
 465             *flagp &= ~HASWIDTH;
 466         *flagp |= flags&SPSTART;
 467     }
 468
 469     /* Make a closing node, and hook it on the end. */
 470     switch (paren) {
 471     case ':':
 472         ender = regnode(NOTHING);
 473         break;
 474     case 1:
 475         ender = reganode(CLOSE, parno);
 476         break;
 477     case '=':
 478     case '!':
 479         ender = regnode(SUCCEED);
 480         *flagp &= ~HASWIDTH;
 481         break;
 482     case 0:
 483         ender = regnode(END);
 484         break;
 485     }
 486     regtail(ret, ender);
 487
 488     /* Hook the tails of the branches to the closing node. */
 489     for (br = ret; br != NULL; br = regnext(br))
 490         regoptail(br, ender);
 491
 492     if (paren == '=') {
 493         reginsert(IFMATCH,ret);
 494         regtail(ret, regnode(NOTHING));
 495     }
 496     else if (paren == '!') {
 497         reginsert(UNLESSM,ret);
 498         regtail(ret, regnode(NOTHING));
 499     }
 500
 501     /* Check for proper termination. */
 502     if (paren && *nextchar() != ')') {
 503         FAIL("unmatched () in regexp");
 504     } else if (!paren && regparse < regxend) {
 505         if (*regparse == ')') {
 506             FAIL("unmatched () in regexp");
 507         } else
 508             FAIL("junk on end of regexp");      /* "Can't happen". */
 509         /* NOTREACHED */
 510     }
 511
 512     return(ret);
 513 }
 514
 515 /*
 516  - regbranch - one alternative of an | operator
 517  *
 518  * Implements the concatenation operator.
 519  */
 520 static char *
 521 regbranch(flagp)
 522 I32 *flagp;
 523 {
 524     register char *ret;
 525     register char *chain;
 526     register char *latest;
 527     I32 flags = 0;
 528
 529     *flagp = WORST;             /* Tentatively. */
 530
 531     ret = regnode(BRANCH);
 532     chain = NULL;
 533     regparse--;
 534     nextchar();
 535     while (regparse < regxend && *regparse != '|' && *regparse != ')') {
 536         flags &= ~TRYAGAIN;
 537         latest = regpiece(&flags);
 538         if (latest == NULL) {
 539             if (flags & TRYAGAIN)
 540                 continue;
 541             return(NULL);
 542         }
 543         *flagp |= flags&HASWIDTH;
 544         if (chain == NULL)      /* First piece. */
 545             *flagp |= flags&SPSTART;
 546         else {
 547             regnaughty++;
 548             regtail(chain, latest);
 549         }
 550         chain = latest;
 551     }
 552     if (chain == NULL)  /* Loop ran zero times. */
 553         (void) regnode(NOTHING);
 554
 555     return(ret);
 556 }
 557
 558 /*
 559  - regpiece - something followed by possible [*+?]
 560  *
 561  * Note that the branching code sequences used for ? and the general cases
 562  * of * and + are somewhat optimized:  they use the same NOTHING node as
 563  * both the endmarker for their branch list and the body of the last branch.
 564  * It might seem that this node could be dispensed with entirely, but the
 565  * endmarker role is not redundant.
 566  */
 567 static char *
 568 regpiece(flagp)
 569 I32 *flagp;
 570 {
 571     register char *ret;
 572     register char op;
 573     register char *next;
 574     I32 flags;
 575     char *origparse = regparse;
 576     char *maxpos;
 577     I32 min;
 578     I32 max = 32767;
 579
 580     ret = regatom(&flags);
 581     if (ret == NULL) {
 582         if (flags & TRYAGAIN)
 583             *flagp |= TRYAGAIN;
 584         return(NULL);
 585     }
 586
 587     op = *regparse;
 588     if (op == '(' && regparse[1] == '?' && regparse[2] == '#') {
 589         while (op && op != ')')
 590             op = *++regparse;
 591         if (op) {
 592             nextchar();
 593             op = *regparse;
 594         }
 595     }
 596
 597     if (op == '{' && regcurly(regparse)) {
 598         next = regparse + 1;
 599         maxpos = Nullch;
 600         while (isDIGIT(*next) || *next == ',') {
 601             if (*next == ',') {
 602                 if (maxpos)
 603                     break;
 604                 else
 605                     maxpos = next;
 606             }
 607             next++;
 608         }
 609         if (*next == '}') {             /* got one */
 610             if (!maxpos)
 611                 maxpos = next;
 612             regparse++;
 613             min = atoi(regparse);
 614             if (*maxpos == ',')
 615                 maxpos++;
 616             else
 617                 maxpos = regparse;
 618             max = atoi(maxpos);
 619             if (!max && *maxpos != '0')
 620                 max = 32767;            /* meaning "infinity" */
 621             regparse = next;
 622             nextchar();
 623
 624         do_curly:
 625             if ((flags&SIMPLE)) {
 626                 regnaughty += 2 + regnaughty / 2;
 627                 reginsert(CURLY, ret);
 628             }
 629             else {
 630                 regnaughty += 4 + regnaughty;   /* compound interest */
 631                 regtail(ret, regnode(WHILEM));
 632                 reginsert(CURLYX,ret);
 633                 regtail(ret, regnode(NOTHING));
 634             }
 635
 636             if (min > 0)
 637                 *flagp = (WORST|HASWIDTH);
 638             if (max && max < min)
 639                 croak("Can't do {n,m} with n > m");
 640             if (regcode != &regdummy) {
 641 #ifdef REGALIGN
 642                 *(unsigned short *)(ret+3) = min;
 643                 *(unsigned short *)(ret+5) = max;
 644 #else
 645                 ret[3] = min >> 8; ret[4] = min & 0377;
 646                 ret[5] = max  >> 8; ret[6] = max  & 0377;
 647 #endif
 648             }
 649
 650             goto nest_check;
 651         }
 652     }
 653
 654     if (!ISMULT1(op)) {
 655         *flagp = flags;
 656         return(ret);
 657     }
 658     nextchar();
 659
 660     *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);
 661
 662     if (op == '*' && (flags&SIMPLE)) {
 663         reginsert(STAR, ret);
 664         regnaughty += 4;
 665     }
 666     else if (op == '*') {
 667         min = 0;
 668         goto do_curly;
 669     } else if (op == '+' && (flags&SIMPLE)) {
 670         reginsert(PLUS, ret);
 671         regnaughty += 3;
 672     }
 673     else if (op == '+') {
 674         min = 1;
 675         goto do_curly;
 676     } else if (op == '?') {
 677         min = 0; max = 1;
 678         goto do_curly;
 679     }
 680   nest_check:
 681     if (dowarn && regcode != &regdummy && !(flags&HASWIDTH) && max > 10000) {
 682         warn("%.*s matches null string many times",
 683             regparse - origparse, origparse);
 684     }
 685
 686     if (*regparse == '?') {
 687         nextchar();
 688         reginsert(MINMOD, ret);
 689 #ifdef REGALIGN
 690         regtail(ret, ret + 4);
 691 #else
 692         regtail(ret, ret + 3);
 693 #endif
 694     }
 695     if (ISMULT2(regparse))
 696         FAIL("nested *?+ in regexp");
 697
 698     return(ret);
 699 }
 700
 701 /*
 702  - regatom - the lowest level
 703  *
 704  * Optimization:  gobbles an entire sequence of ordinary characters so that
 705  * it can turn them into a single node, which is smaller to store and
 706  * faster to run.  Backslashed characters are exceptions, each becoming a
 707  * separate node; the code is simpler that way and it's not worth fixing.
 708  *
 709  * [Yes, it is worth fixing, some scripts can run twice the speed.]
 710  */
 711 static char *
 712 regatom(flagp)
 713 I32 *flagp;
 714 {
 715     register char *ret = 0;
 716     I32 flags;
 717
 718     *flagp = WORST;             /* Tentatively. */
 719
 720 tryagain:
 721     switch (*regparse) {
 722     case '^':
 723         nextchar();
 724         if (regflags & PMf_MULTILINE)
 725             ret = regnode(MBOL);
 726         else if (regflags & PMf_SINGLELINE)
 727             ret = regnode(SBOL);
 728         else
 729             ret = regnode(BOL);
 730         break;
 731     case '$':
 732         nextchar();
 733         if (regflags & PMf_MULTILINE)
 734             ret = regnode(MEOL);
 735         else if (regflags & PMf_SINGLELINE)
 736             ret = regnode(SEOL);
 737         else
 738             ret = regnode(EOL);
 739         break;
 740     case '.':
 741         nextchar();
 742         if (regflags & PMf_SINGLELINE)
 743             ret = regnode(SANY);
 744         else
 745             ret = regnode(ANY);
 746         regnaughty++;
 747         *flagp |= HASWIDTH|SIMPLE;
 748         break;
 749     case '[':
 750         regparse++;
 751         ret = regclass();
 752         *flagp |= HASWIDTH|SIMPLE;
 753         break;
 754     case '(':
 755         nextchar();
 756         ret = reg(1, &flags);
 757         if (ret == NULL) {
 758                 if (flags & TRYAGAIN)
 759                     goto tryagain;
 760                 return(NULL);
 761         }
 762         *flagp |= flags&(HASWIDTH|SPSTART);
 763         break;
 764     case '|':
 765     case ')':
 766         if (flags & TRYAGAIN) {
 767             *flagp |= TRYAGAIN;
 768             return NULL;
 769         }
 770         croak("internal urp in regexp at /%s/", regparse);
 771                                 /* Supposed to be caught earlier. */
 772         break;
 773     case '?':
 774     case '+':
 775     case '*':
 776         FAIL("?+* follows nothing in regexp");
 777         break;
 778     case '\\':
 779         switch (*++regparse) {
 780         case 'A':
 781             ret = regnode(SBOL);
 782             *flagp |= SIMPLE;
 783             nextchar();
 784             break;
 785         case 'G':
 786             ret = regnode(GBOL);
 787             *flagp |= SIMPLE;
 788             nextchar();
 789             break;
 790         case 'Z':
 791             ret = regnode(SEOL);
 792             *flagp |= SIMPLE;
 793             nextchar();
 794             break;
 795         case 'w':
 796             ret = regnode(ALNUM);
 797             *flagp |= HASWIDTH|SIMPLE;
 798             nextchar();
 799             break;
 800         case 'W':
 801             ret = regnode(NALNUM);
 802             *flagp |= HASWIDTH|SIMPLE;
 803             nextchar();
 804             break;
 805         case 'b':
 806             ret = regnode(BOUND);
 807             *flagp |= SIMPLE;
 808             nextchar();
 809             break;
 810         case 'B':
 811             ret = regnode(NBOUND);
 812             *flagp |= SIMPLE;
 813             nextchar();
 814             break;
 815         case 's':
 816             ret = regnode(SPACE);
 817             *flagp |= HASWIDTH|SIMPLE;
 818             nextchar();
 819             break;
 820         case 'S':
 821             ret = regnode(NSPACE);
 822             *flagp |= HASWIDTH|SIMPLE;
 823             nextchar();
 824             break;
 825         case 'd':
 826             ret = regnode(DIGIT);
 827             *flagp |= HASWIDTH|SIMPLE;
 828             nextchar();
 829             break;
 830         case 'D':
 831             ret = regnode(NDIGIT);
 832             *flagp |= HASWIDTH|SIMPLE;
 833             nextchar();
 834             break;
 835         case 'n':
 836         case 'r':
 837         case 't':
 838         case 'f':
 839         case 'e':
 840         case 'a':
 841         case 'x':
 842         case 'c':
 843         case '0':
 844             goto defchar;
 845         case '1': case '2': case '3': case '4':
 846         case '5': case '6': case '7': case '8': case '9':
 847             {
 848                 I32 num = atoi(regparse);
 849
 850                 if (num > 9 && num >= regnpar)
 851                     goto defchar;
 852                 else {
 853                     regsawback = 1;
 854                     ret = reganode(REF, num);
 855                     *flagp |= HASWIDTH;
 856                     while (isDIGIT(*regparse))
 857                         regparse++;
 858                     regparse--;
 859                     nextchar();
 860                 }
 861             }
 862             break;
 863         case '\0':
 864             if (regparse >= regxend)
 865                 FAIL("trailing \\ in regexp");
 866             /* FALL THROUGH */
 867         default:
 868             goto defchar;
 869         }
 870         break;
 871     default: {
 872             register I32 len;
 873             register char ender;
 874             register char *p;
 875             char *oldp;
 876             I32 numlen;
 877
 878             regparse++;
 879
 880         defchar:
 881             ret = regnode(EXACTLY);
 882             regc(0);            /* save spot for len */
 883             for (len = 0, p = regparse - 1;
 884               len < 127 && p < regxend;
 885               len++)
 886             {
 887                 oldp = p;
 888                 switch (*p) {
 889                 case '^':
 890                 case '$':
 891                 case '.':
 892                 case '[':
 893                 case '(':
 894                 case ')':
 895                 case '|':
 896                     goto loopdone;
 897                 case '\\':
 898                     switch (*++p) {
 899                     case 'A':
 900                     case 'G':
 901                     case 'Z':
 902                     case 'w':
 903                     case 'W':
 904                     case 'b':
 905                     case 'B':
 906                     case 's':
 907                     case 'S':
 908                     case 'd':
 909                     case 'D':
 910                         --p;
 911                         goto loopdone;
 912                     case 'n':
 913                         ender = '\n';
 914                         p++;
 915                         break;
 916                     case 'r':
 917                         ender = '\r';
 918                         p++;
 919                         break;
 920                     case 't':
 921                         ender = '\t';
 922                         p++;
 923                         break;
 924                     case 'f':
 925                         ender = '\f';
 926                         p++;
 927                         break;
 928                     case 'e':
 929                         ender = '\033';
 930                         p++;
 931                         break;
 932                     case 'a':
 933                         ender = '\007';
 934                         p++;
 935                         break;
 936                     case 'x':
 937                         ender = scan_hex(++p, 2, &numlen);
 938                         p += numlen;
 939                         break;
 940                     case 'c':
 941                         p++;
 942                         ender = *p++;
 943                         if (isLOWER(ender))
 944                             ender = toUPPER(ender);
 945                         ender ^= 64;
 946                         break;
 947                     case '0': case '1': case '2': case '3':case '4':
 948                     case '5': case '6': case '7': case '8':case '9':
 949                         if (*p == '0' ||
 950                           (isDIGIT(p[1]) && atoi(p) >= regnpar) ) {
 951                             ender = scan_oct(p, 3, &numlen);
 952                             p += numlen;
 953                         }
 954                         else {
 955                             --p;
 956                             goto loopdone;
 957                         }
 958                         break;
 959                     case '\0':
 960                         if (p >= regxend)
 961                             FAIL("trailing \\ in regexp");
 962                         /* FALL THROUGH */
 963                     default:
 964                         ender = *p++;
 965                         break;
 966                     }
 967                     break;
 968                 case ' ': case '\t': case '\n': case '\r': case '\f': case '\v':
 969                     if (regflags & PMf_EXTENDED) {
 970                         p++;
 971                         len--;
 972                         continue;
 973                     }
 974                     /* FALL THROUGH */
 975                 default:
 976                     ender = *p++;
 977                     break;
 978                 }
 979                 if (regflags & PMf_FOLD && isUPPER(ender))
 980                     ender = toLOWER(ender);
 981                 if (ISMULT2(p)) { /* Back off on ?+*. */
 982                     if (len)
 983                         p = oldp;
 984                     else {
 985                         len++;
 986                         regc(ender);
 987                     }
 988                     break;
 989                 }
 990                 regc(ender);
 991             }
 992         loopdone:
 993             regparse = p - 1;
 994             nextchar();
 995             if (len < 0)
 996                 FAIL("internal disaster in regexp");
 997             if (len > 0)
 998                 *flagp |= HASWIDTH;
 999             if (len == 1)
1000                 *flagp |= SIMPLE;
1001             if (regcode != &regdummy)
1002                 *OPERAND(ret) = len;
1003             regc('\0');
1004         }
1005         break;
1006     }
1007
1008     return(ret);
1009 }
1010
1011 static void
1012 regset(bits,def,c)
1013 char *bits;
1014 I32 def;
1015 register I32 c;
1016 {
1017     if (regcode == &regdummy)
1018       return;
1019     c &= 255;
1020     if (def)
1021         bits[c >> 3] &= ~(1 << (c & 7));
1022     else
1023         bits[c >> 3] |=  (1 << (c & 7));
1024 }
1025
1026 static char *
1027 regclass()
1028 {
1029     register char *bits;
1030     register I32 class;
1031     register I32 lastclass = 1234;
1032     register I32 range = 0;
1033     register char *ret;
1034     register I32 def;
1035     I32 numlen;
1036
1037     ret = regnode(ANYOF);
1038     if (*regparse == '^') {     /* Complement of range. */
1039         regnaughty++;
1040         regparse++;
1041         def = 0;
1042     } else {
1043         def = 255;
1044     }
1045     bits = regcode;
1046     for (class = 0; class < 32; class++)
1047       regc(def);
1048     if (*regparse == ']' || *regparse == '-')
1049         goto skipcond;          /* allow 1st char to be ] or - */
1050     while (regparse < regxend && *regparse != ']') {
1051        skipcond:
1052         class = UCHARAT(regparse++);
1053         if (class == '\\') {
1054             class = UCHARAT(regparse++);
1055             switch (class) {
1056             case 'w':
1057                 for (class = 0; class < 256; class++)
1058                   if (isALNUM(class))
1059                     regset(bits,def,class);
1060                 lastclass = 1234;
1061                 continue;
1062             case 'W':
1063                 for (class = 0; class < 256; class++)
1064                   if (!isALNUM(class))
1065                     regset(bits,def,class);
1066                 lastclass = 1234;
1067                 continue;
1068             case 's':
1069                 for (class = 0; class < 256; class++)
1070                   if (isSPACE(class))
1071                     regset(bits,def,class);
1072                 lastclass = 1234;
1073                 continue;
1074             case 'S':
1075                 for (class = 0; class < 256; class++)
1076                   if (!isSPACE(class))
1077                     regset(bits,def,class);
1078                 lastclass = 1234;
1079                 continue;
1080             case 'd':
1081                 for (class = '0'; class <= '9'; class++)
1082                     regset(bits,def,class);
1083                 lastclass = 1234;
1084                 continue;
1085             case 'D':
1086                 for (class = 0; class < '0'; class++)
1087                     regset(bits,def,class);
1088                 for (class = '9' + 1; class < 256; class++)
1089                     regset(bits,def,class);
1090                 lastclass = 1234;
1091                 continue;
1092             case 'n':
1093                 class = '\n';
1094                 break;
1095             case 'r':
1096                 class = '\r';
1097                 break;
1098             case 't':
1099                 class = '\t';
1100                 break;
1101             case 'f':
1102                 class = '\f';
1103                 break;
1104             case 'b':
1105                 class = '\b';
1106                 break;
1107             case 'e':
1108                 class = '\033';
1109                 break;
1110             case 'a':
1111                 class = '\007';
1112                 break;
1113             case 'x':
1114                 class = scan_hex(regparse, 2, &numlen);
1115                 regparse += numlen;
1116                 break;
1117             case 'c':
1118                 class = *regparse++;
1119                 if (isLOWER(class))
1120                   class = toUPPER(class);
1121                 class ^= 64;
1122                 break;
1123             case '0': case '1': case '2': case '3': case '4':
1124             case '5': case '6': case '7': case '8': case '9':
1125                 class = scan_oct(--regparse, 3, &numlen);
1126                 regparse += numlen;
1127                 break;
1128             }
1129         }
1130         if (range) {
1131             if (lastclass > class)
1132                 FAIL("invalid [] range in regexp");
1133             range = 0;
1134         }
1135         else {
1136             lastclass = class;
1137             if (*regparse == '-' && regparse+1 < regxend &&
1138               regparse[1] != ']') {
1139                 regparse++;
1140                 range = 1;
1141                 continue;       /* do it next time */
1142             }
1143         }
1144         for ( ; lastclass <= class; lastclass++) {
1145             regset(bits,def,lastclass);
1146             if (regflags & PMf_FOLD && isUPPER(lastclass))
1147                 regset(bits,def,toLOWER(lastclass));
1148         }
1149         lastclass = class;
1150     }
1151     if (*regparse != ']')
1152         FAIL("unmatched [] in regexp");
1153     nextchar();
1154     return ret;
1155 }
1156
1157 static char*
1158 nextchar()
1159 {
1160     char* retval = regparse++;
1161
1162     if (regflags & PMf_EXTENDED) {
1163         for (;;) {
1164             if (isSPACE(*regparse)) {
1165                 regparse++;
1166                 continue;
1167             }
1168             else if (*regparse == '(' && regparse[1] == '?' &&
1169                     regparse[2] == '#') {
1170                 while (*regparse && *regparse != ')')
1171                     regparse++;
1172                 regparse++;
1173                 continue;
1174             }
1175             else if (*regparse == '#') {
1176                 while (*regparse && *regparse != '\n')
1177                     regparse++;
1178                 regparse++;
1179                 continue;
1180             }
1181             break;
1182         }
1183     }
1184     return retval;
1185 }
1186
1187 /*
1188 - regnode - emit a node
1189 */
1190 #ifdef CAN_PROTOTYPE
1191 static char *                   /* Location. */
1192 regnode(char op)
1193 #else
1194 static char *                   /* Location. */
1195 regnode(op)
1196 char op;
1197 #endif
1198 {
1199     register char *ret;
1200     register char *ptr;
1201
1202     ret = regcode;
1203     if (ret == &regdummy) {
1204 #ifdef REGALIGN
1205         if (!(regsize & 1))
1206             regsize++;
1207 #endif
1208         regsize += 3;
1209         return(ret);
1210     }
1211
1212 #ifdef REGALIGN
1213 #ifndef lint
1214     if (!((long)ret & 1))
1215       *ret++ = 127;
1216 #endif
1217 #endif
1218     ptr = ret;
1219     *ptr++ = op;
1220     *ptr++ = '\0';              /* Null "next" pointer. */
1221     *ptr++ = '\0';
1222     regcode = ptr;
1223
1224     return(ret);
1225 }
1226
1227 /*
1228 - reganode - emit a node with an argument
1229 */
1230 #ifdef CAN_PROTOTYPE
1231 static char *                   /* Location. */
1232 reganode(char op, unsigned short arg)
1233 #else
1234 static char *                   /* Location. */
1235 reganode(op, arg)
1236 char op;
1237 unsigned short arg;
1238 #endif
1239 {
1240     register char *ret;
1241     register char *ptr;
1242
1243     ret = regcode;
1244     if (ret == &regdummy) {
1245 #ifdef REGALIGN
1246         if (!(regsize & 1))
1247             regsize++;
1248 #endif
1249         regsize += 5;
1250         return(ret);
1251     }
1252
1253 #ifdef REGALIGN
1254 #ifndef lint
1255     if (!((long)ret & 1))
1256       *ret++ = 127;
1257 #endif
1258 #endif
1259     ptr = ret;
1260     *ptr++ = op;
1261     *ptr++ = '\0';              /* Null "next" pointer. */
1262     *ptr++ = '\0';
1263 #ifdef REGALIGN
1264     *(unsigned short *)(ret+3) = arg;
1265 #else
1266     ret[3] = arg >> 8; ret[4] = arg & 0377;
1267 #endif
1268     ptr += 2;
1269     regcode = ptr;
1270
1271     return(ret);
1272 }
1273
1274 /*
1275 - regc - emit (if appropriate) a byte of code
1276 */
1277 #ifdef CAN_PROTOTYPE
1278 static void
1279 regc(char b)
1280 #else
1281 static void
1282 regc(b)
1283 char b;
1284 #endif
1285 {
1286     if (regcode != &regdummy)
1287         *regcode++ = b;
1288     else
1289         regsize++;
1290 }
1291
1292 /*
1293 - reginsert - insert an operator in front of already-emitted operand
1294 *
1295 * Means relocating the operand.
1296 */
1297 #ifdef CAN_PROTOTYPE
1298 static void
1299 reginsert(char op, char *opnd)
1300 #else
1301 static void
1302 reginsert(op, opnd)
1303 char op;
1304 char *opnd;
1305 #endif
1306 {
1307     register char *src;
1308     register char *dst;
1309     register char *place;
1310     register int offset = (regkind[(U8)op] == CURLY ? 4 : 0);
1311
1312     if (regcode == &regdummy) {
1313 #ifdef REGALIGN
1314         regsize += 4 + offset;
1315 #else
1316         regsize += 3 + offset;
1317 #endif
1318         return;
1319     }
1320
1321     src = regcode;
1322 #ifdef REGALIGN
1323     regcode += 4 + offset;
1324 #else
1325     regcode += 3 + offset;
1326 #endif
1327     dst = regcode;
1328     while (src > opnd)
1329         *--dst = *--src;
1330
1331     place = opnd;               /* Op node, where operand used to be. */
1332     *place++ = op;
1333     *place++ = '\0';
1334     *place++ = '\0';
1335     while (offset-- > 0)
1336         *place++ = '\0';
1337 #ifdef REGALIGN
1338     *place++ = '\177';
1339 #endif
1340 }
1341
1342 /*
1343 - regtail - set the next-pointer at the end of a node chain
1344 */
1345 static void
1346 regtail(p, val)
1347 char *p;
1348 char *val;
1349 {
1350     register char *scan;
1351     register char *temp;
1352     register I32 offset;
1353
1354     if (p == &regdummy)
1355         return;
1356
1357     /* Find last node. */
1358     scan = p;
1359     for (;;) {
1360         temp = regnext(scan);
1361         if (temp == NULL)
1362             break;
1363         scan = temp;
1364     }
1365
1366 #ifdef REGALIGN
1367     offset = val - scan;
1368 #ifndef lint
1369     *(short*)(scan+1) = offset;
1370 #else
1371     offset = offset;
1372 #endif
1373 #else
1374     if (OP(scan) == BACK)
1375         offset = scan - val;
1376     else
1377         offset = val - scan;
1378     *(scan+1) = (offset>>8)&0377;
1379     *(scan+2) = offset&0377;
1380 #endif
1381 }
1382
1383 /*
1384 - regoptail - regtail on operand of first argument; nop if operandless
1385 */
1386 static void
1387 regoptail(p, val)
1388 char *p;
1389 char *val;
1390 {
1391     /* "Operandless" and "op != BRANCH" are synonymous in practice. */
1392     if (p == NULL || p == &regdummy || regkind[(U8)OP(p)] != BRANCH)
1393         return;
1394     regtail(NEXTOPER(p), val);
1395 }
1396
1397 /*
1398  - regcurly - a little FSA that accepts {\d+,?\d*}
1399  */
1400 STATIC I32
1401 regcurly(s)
1402 register char *s;
1403 {
1404     if (*s++ != '{')
1405         return FALSE;
1406     if (!isDIGIT(*s))
1407         return FALSE;
1408     while (isDIGIT(*s))
1409         s++;
1410     if (*s == ',')
1411         s++;
1412     while (isDIGIT(*s))
1413         s++;
1414     if (*s != '}')
1415         return FALSE;
1416     return TRUE;
1417 }
1418
1419 #ifdef DEBUGGING
1420
1421 /*
1422  - regdump - dump a regexp onto stderr in vaguely comprehensible form
1423  */
1424 void
1425 regdump(r)
1426 regexp *r;
1427 {
1428     register char *s;
1429     register char op = EXACTLY; /* Arbitrary non-END op. */
1430     register char *next;
1431
1432
1433     s = r->program + 1;
1434     while (op != END) { /* While that wasn't END last time... */
1435 #ifdef REGALIGN
1436         if (!((long)s & 1))
1437             s++;
1438 #endif
1439         op = OP(s);
1440         fprintf(stderr,"%2d%s", s-r->program, regprop(s));      /* Where, what. */
1441         next = regnext(s);
1442         s += regarglen[(U8)op];
1443         if (next == NULL)               /* Next ptr. */
1444             fprintf(stderr,"(0)");
1445         else
1446             fprintf(stderr,"(%d)", (s-r->program)+(next-s));
1447         s += 3;
1448         if (op == ANYOF) {
1449             s += 32;
1450         }
1451         if (op == EXACTLY) {
1452             /* Literal string, where present. */
1453             s++;
1454             (void)putc(' ', stderr);
1455             (void)putc('<', stderr);
1456             while (*s != '\0') {
1457                 (void)putc(*s, stderr);
1458                 s++;
1459             }
1460             (void)putc('>', stderr);
1461             s++;
1462         }
1463         (void)putc('\n', stderr);
1464     }
1465
1466     /* Header fields of interest. */
1467     if (r->regstart)
1468         fprintf(stderr,"start `%s' ", SvPVX(r->regstart));
1469     if (r->regstclass)
1470         fprintf(stderr,"stclass `%s' ", regprop(r->regstclass));
1471     if (r->reganch & ROPT_ANCH)
1472         fprintf(stderr,"anchored ");
1473     if (r->reganch & ROPT_SKIP)
1474         fprintf(stderr,"plus ");
1475     if (r->reganch & ROPT_IMPLICIT)
1476         fprintf(stderr,"implicit ");
1477     if (r->regmust != NULL)
1478         fprintf(stderr,"must have \"%s\" back %ld ", SvPVX(r->regmust),
1479          (long) r->regback);
1480     fprintf(stderr, "minlen %ld ", (long) r->minlen);
1481     fprintf(stderr,"\n");
1482 }
1483
1484 /*
1485 - regprop - printable representation of opcode
1486 */
1487 char *
1488 regprop(op)
1489 char *op;
1490 {
1491     register char *p = 0;
1492
1493     (void) strcpy(buf, ":");
1494
1495     switch (OP(op)) {
1496     case BOL:
1497         p = "BOL";
1498         break;
1499     case MBOL:
1500         p = "MBOL";
1501         break;
1502     case SBOL:
1503         p = "SBOL";
1504         break;
1505     case EOL:
1506         p = "EOL";
1507         break;
1508     case MEOL:
1509         p = "MEOL";
1510         break;
1511     case SEOL:
1512         p = "SEOL";
1513         break;
1514     case ANY:
1515         p = "ANY";
1516         break;
1517     case SANY:
1518         p = "SANY";
1519         break;
1520     case ANYOF:
1521         p = "ANYOF";
1522         break;
1523     case BRANCH:
1524         p = "BRANCH";
1525         break;
1526     case EXACTLY:
1527         p = "EXACTLY";
1528         break;
1529     case NOTHING:
1530         p = "NOTHING";
1531         break;
1532     case BACK:
1533         p = "BACK";
1534         break;
1535     case END:
1536         p = "END";
1537         break;
1538     case ALNUM:
1539         p = "ALNUM";
1540         break;
1541     case NALNUM:
1542         p = "NALNUM";
1543         break;
1544     case BOUND:
1545         p = "BOUND";
1546         break;
1547     case NBOUND:
1548         p = "NBOUND";
1549         break;
1550     case SPACE:
1551         p = "SPACE";
1552         break;
1553     case NSPACE:
1554         p = "NSPACE";
1555         break;
1556     case DIGIT:
1557         p = "DIGIT";
1558         break;
1559     case NDIGIT:
1560         p = "NDIGIT";
1561         break;
1562     case CURLY:
1563         (void)sprintf(buf+strlen(buf), "CURLY {%d,%d}", ARG1(op),ARG2(op));
1564         p = NULL;
1565         break;
1566     case CURLYX:
1567         (void)sprintf(buf+strlen(buf), "CURLYX {%d,%d}", ARG1(op),ARG2(op));
1568         p = NULL;
1569         break;
1570     case REF:
1571         (void)sprintf(buf+strlen(buf), "REF%d", ARG1(op));
1572         p = NULL;
1573         break;
1574     case OPEN:
1575         (void)sprintf(buf+strlen(buf), "OPEN%d", ARG1(op));
1576         p = NULL;
1577         break;
1578     case CLOSE:
1579         (void)sprintf(buf+strlen(buf), "CLOSE%d", ARG1(op));
1580         p = NULL;
1581         break;
1582     case STAR:
1583         p = "STAR";
1584         break;
1585     case PLUS:
1586         p = "PLUS";
1587         break;
1588     case MINMOD:
1589         p = "MINMOD";
1590         break;
1591     case GBOL:
1592         p = "GBOL";
1593         break;
1594     case UNLESSM:
1595         p = "UNLESSM";
1596         break;
1597     case IFMATCH:
1598         p = "IFMATCH";
1599         break;
1600     case SUCCEED:
1601         p = "SUCCEED";
1602         break;
1603     case WHILEM:
1604         p = "WHILEM";
1605         break;
1606     default:
1607         FAIL("corrupted regexp opcode");
1608     }
1609     if (p != NULL)
1610         (void) strcat(buf, p);
1611     return(buf);
1612 }
1613 #endif /* DEBUGGING */
1614
1615 void
1616 pregfree(r)
1617 struct regexp *r;
1618 {
1619     if (!r)
1620         return;
1621     if (r->precomp) {
1622         Safefree(r->precomp);
1623         r->precomp = Nullch;
1624     }
1625     if (r->subbase) {
1626         Safefree(r->subbase);
1627         r->subbase = Nullch;
1628     }
1629     if (r->regmust) {
1630         SvREFCNT_dec(r->regmust);
1631         r->regmust = Nullsv;
1632     }
1633     if (r->regstart) {
1634         SvREFCNT_dec(r->regstart);
1635         r->regstart = Nullsv;
1636     }
1637     Safefree(r->startp);
1638     Safefree(r->endp);
1639     Safefree(r);
1640 }