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