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