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