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