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