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