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             default:
 475                 --regparse;
 476                 while (*regparse && strchr("iogcmsx", *regparse))
 477                     pmflag(&regflags, *regparse++);
 478                 if (*regparse != ')')
 479                     croak("Sequence (?%c...) not recognized", *regparse);
 480                 nextchar();
 481                 *flagp = TRYAGAIN;
 482                 return NULL;
 483             }
 484         }
 485         else {
 486             parno = regnpar;
 487             regnpar++;
 488             ret = reganode(OPEN, parno);
 489         }
 490     } else
 491         ret = NULL;
 492
 493     /* Pick up the branches, linking them together. */
 494     br = regbranch(&flags);
 495     if (br == NULL)
 496         return(NULL);
 497     if (ret != NULL)
 498         regtail(ret, br);       /* OPEN -> first. */
 499     else
 500         ret = br;
 501     if (!(flags&HASWIDTH))
 502         *flagp &= ~HASWIDTH;
 503     *flagp |= flags&SPSTART;
 504     while (*regparse == '|') {
 505         nextchar();
 506         br = regbranch(&flags);
 507         if (br == NULL)
 508             return(NULL);
 509         regtail(ret, br);       /* BRANCH -> BRANCH. */
 510         if (!(flags&HASWIDTH))
 511             *flagp &= ~HASWIDTH;
 512         *flagp |= flags&SPSTART;
 513     }
 514
 515     /* Make a closing node, and hook it on the end. */
 516     switch (paren) {
 517     case ':':
 518         ender = regnode(NOTHING);
 519         break;
 520     case 1:
 521         ender = reganode(CLOSE, parno);
 522         break;
 523     case '=':
 524     case '!':
 525         ender = regnode(SUCCEED);
 526         *flagp &= ~HASWIDTH;
 527         break;
 528     case 0:
 529         ender = regnode(END);
 530         break;
 531     }
 532     regtail(ret, ender);
 533
 534     /* Hook the tails of the branches to the closing node. */
 535     for (br = ret; br != NULL; br = regnext(br))
 536         regoptail(br, ender);
 537
 538     if (paren == '=') {
 539         reginsert(IFMATCH,ret);
 540         regtail(ret, regnode(NOTHING));
 541     }
 542     else if (paren == '!') {
 543         reginsert(UNLESSM,ret);
 544         regtail(ret, regnode(NOTHING));
 545     }
 546
 547     /* Check for proper termination. */
 548     if (paren && (regparse >= regxend || *nextchar() != ')')) {
 549         FAIL("unmatched () in regexp");
 550     } else if (!paren && regparse < regxend) {
 551         if (*regparse == ')') {
 552             FAIL("unmatched () in regexp");
 553         } else
 554             FAIL("junk on end of regexp");      /* "Can't happen". */
 555         /* NOTREACHED */
 556     }
 557
 558     return(ret);
 559 }
 560
 561 /*
 562  - regbranch - one alternative of an | operator
 563  *
 564  * Implements the concatenation operator.
 565  */
 566 static char *
 567 regbranch(flagp)
 568 I32 *flagp;
 569 {
 570     register char *ret;
 571     register char *chain;
 572     register char *latest;
 573     I32 flags = 0;
 574
 575     *flagp = WORST;             /* Tentatively. */
 576
 577     ret = regnode(BRANCH);
 578     chain = NULL;
 579     regparse--;
 580     nextchar();
 581     while (regparse < regxend && *regparse != '|' && *regparse != ')') {
 582         flags &= ~TRYAGAIN;
 583         latest = regpiece(&flags);
 584         if (latest == NULL) {
 585             if (flags & TRYAGAIN)
 586                 continue;
 587             return(NULL);
 588         }
 589         *flagp |= flags&HASWIDTH;
 590         if (chain == NULL)      /* First piece. */
 591             *flagp |= flags&SPSTART;
 592         else {
 593             regnaughty++;
 594             regtail(chain, latest);
 595         }
 596         chain = latest;
 597     }
 598     if (chain == NULL)  /* Loop ran zero times. */
 599         (void) regnode(NOTHING);
 600
 601     return(ret);
 602 }
 603
 604 /*
 605  - regpiece - something followed by possible [*+?]
 606  *
 607  * Note that the branching code sequences used for ? and the general cases
 608  * of * and + are somewhat optimized:  they use the same NOTHING node as
 609  * both the endmarker for their branch list and the body of the last branch.
 610  * It might seem that this node could be dispensed with entirely, but the
 611  * endmarker role is not redundant.
 612  */
 613 static char *
 614 regpiece(flagp)
 615 I32 *flagp;
 616 {
 617     register char *ret;
 618     register char op;
 619     register char *next;
 620     I32 flags;
 621     char *origparse = regparse;
 622     char *maxpos;
 623     I32 min;
 624     I32 max = 32767;
 625
 626     ret = regatom(&flags);
 627     if (ret == NULL) {
 628         if (flags & TRYAGAIN)
 629             *flagp |= TRYAGAIN;
 630         return(NULL);
 631     }
 632
 633     op = *regparse;
 634     if (op == '(' && regparse[1] == '?' && regparse[2] == '#') {
 635         while (op && op != ')')
 636             op = *++regparse;
 637         if (op) {
 638             nextchar();
 639             op = *regparse;
 640         }
 641     }
 642
 643     if (op == '{' && regcurly(regparse)) {
 644         next = regparse + 1;
 645         maxpos = Nullch;
 646         while (isDIGIT(*next) || *next == ',') {
 647             if (*next == ',') {
 648                 if (maxpos)
 649                     break;
 650                 else
 651                     maxpos = next;
 652             }
 653             next++;
 654         }
 655         if (*next == '}') {             /* got one */
 656             if (!maxpos)
 657                 maxpos = next;
 658             regparse++;
 659             min = atoi(regparse);
 660             if (*maxpos == ',')
 661                 maxpos++;
 662             else
 663                 maxpos = regparse;
 664             max = atoi(maxpos);
 665             if (!max && *maxpos != '0')
 666                 max = 32767;            /* meaning "infinity" */
 667             regparse = next;
 668             nextchar();
 669
 670         do_curly:
 671             if ((flags&SIMPLE)) {
 672                 regnaughty += 2 + regnaughty / 2;
 673                 reginsert(CURLY, ret);
 674             }
 675             else {
 676                 regnaughty += 4 + regnaughty;   /* compound interest */
 677                 regtail(ret, regnode(WHILEM));
 678                 reginsert(CURLYX,ret);
 679                 regtail(ret, regnode(NOTHING));
 680             }
 681
 682             if (min > 0)
 683                 *flagp = (WORST|HASWIDTH);
 684             if (max && max < min)
 685                 croak("Can't do {n,m} with n > m");
 686             if (regcode != &regdummy) {
 687 #ifdef REGALIGN
 688                 *(unsigned short *)(ret+3) = min;
 689                 *(unsigned short *)(ret+5) = max;
 690 #else
 691                 ret[3] = min >> 8; ret[4] = min & 0377;
 692                 ret[5] = max  >> 8; ret[6] = max  & 0377;
 693 #endif
 694             }
 695
 696             goto nest_check;
 697         }
 698     }
 699
 700     if (!ISMULT1(op)) {
 701         *flagp = flags;
 702         return(ret);
 703     }
 704
 705     if (!(flags&HASWIDTH) && op != '?')
 706       FAIL("regexp *+ operand could be empty");
 707
 708     nextchar();
 709
 710     *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);
 711
 712     if (op == '*' && (flags&SIMPLE)) {
 713         reginsert(STAR, ret);
 714         regnaughty += 4;
 715     }
 716     else if (op == '*') {
 717         min = 0;
 718         goto do_curly;
 719     } else if (op == '+' && (flags&SIMPLE)) {
 720         reginsert(PLUS, ret);
 721         regnaughty += 3;
 722     }
 723     else if (op == '+') {
 724         min = 1;
 725         goto do_curly;
 726     } else if (op == '?') {
 727         min = 0; max = 1;
 728         goto do_curly;
 729     }
 730   nest_check:
 731     if (dowarn && regcode != &regdummy && !(flags&HASWIDTH) && max > 10000) {
 732         warn("%.*s matches null string many times",
 733             regparse - origparse, origparse);
 734     }
 735
 736     if (*regparse == '?') {
 737         nextchar();
 738         reginsert(MINMOD, ret);
 739 #ifdef REGALIGN
 740         regtail(ret, ret + 4);
 741 #else
 742         regtail(ret, ret + 3);
 743 #endif
 744     }
 745     if (ISMULT2(regparse))
 746         FAIL("nested *?+ in regexp");
 747
 748     return(ret);
 749 }
 750
 751 /*
 752  - regatom - the lowest level
 753  *
 754  * Optimization:  gobbles an entire sequence of ordinary characters so that
 755  * it can turn them into a single node, which is smaller to store and
 756  * faster to run.  Backslashed characters are exceptions, each becoming a
 757  * separate node; the code is simpler that way and it's not worth fixing.
 758  *
 759  * [Yes, it is worth fixing, some scripts can run twice the speed.]
 760  */
 761 static char *
 762 regatom(flagp)
 763 I32 *flagp;
 764 {
 765     register char *ret = 0;
 766     I32 flags;
 767
 768     *flagp = WORST;             /* Tentatively. */
 769
 770 tryagain:
 771     switch (*regparse) {
 772     case '^':
 773         nextchar();
 774         if (regflags & PMf_MULTILINE)
 775             ret = regnode(MBOL);
 776         else if (regflags & PMf_SINGLELINE)
 777             ret = regnode(SBOL);
 778         else
 779             ret = regnode(BOL);
 780         break;
 781     case '$':
 782         nextchar();
 783         if (regflags & PMf_MULTILINE)
 784             ret = regnode(MEOL);
 785         else if (regflags & PMf_SINGLELINE)
 786             ret = regnode(SEOL);
 787         else
 788             ret = regnode(EOL);
 789         break;
 790     case '.':
 791         nextchar();
 792         if (regflags & PMf_SINGLELINE)
 793             ret = regnode(SANY);
 794         else
 795             ret = regnode(ANY);
 796         regnaughty++;
 797         *flagp |= HASWIDTH|SIMPLE;
 798         break;
 799     case '[':
 800         regparse++;
 801         ret = regclass();
 802         *flagp |= HASWIDTH|SIMPLE;
 803         break;
 804     case '(':
 805         nextchar();
 806         ret = reg(1, &flags);
 807         if (ret == NULL) {
 808                 if (flags & TRYAGAIN)
 809                     goto tryagain;
 810                 return(NULL);
 811         }
 812         *flagp |= flags&(HASWIDTH|SPSTART);
 813         break;
 814     case '|':
 815     case ')':
 816         if (flags & TRYAGAIN) {
 817             *flagp |= TRYAGAIN;
 818             return NULL;
 819         }
 820         croak("internal urp in regexp at /%s/", regparse);
 821                                 /* Supposed to be caught earlier. */
 822         break;
 823     case '{':
 824         if (!regcurly(regparse)) {
 825             regparse++;
 826             goto defchar;
 827         }
 828         /* FALL THROUGH */
 829     case '?':
 830     case '+':
 831     case '*':
 832         FAIL("?+*{} follows nothing in regexp");
 833         break;
 834     case '\\':
 835         switch (*++regparse) {
 836         case 'A':
 837             ret = regnode(SBOL);
 838             *flagp |= SIMPLE;
 839             nextchar();
 840             break;
 841         case 'G':
 842             ret = regnode(GPOS);
 843             *flagp |= SIMPLE;
 844             nextchar();
 845             break;
 846         case 'Z':
 847             ret = regnode(SEOL);
 848             *flagp |= SIMPLE;
 849             nextchar();
 850             break;
 851         case 'w':
 852             ret = regnode((regflags & PMf_LOCALE) ? ALNUML : ALNUM);
 853             *flagp |= HASWIDTH|SIMPLE;
 854             nextchar();
 855             break;
 856         case 'W':
 857             ret = regnode((regflags & PMf_LOCALE) ? NALNUML : NALNUM);
 858             *flagp |= HASWIDTH|SIMPLE;
 859             nextchar();
 860             break;
 861         case 'b':
 862             ret = regnode((regflags & PMf_LOCALE) ? BOUNDL : BOUND);
 863             *flagp |= SIMPLE;
 864             nextchar();
 865             break;
 866         case 'B':
 867             ret = regnode((regflags & PMf_LOCALE) ? NBOUNDL : NBOUND);
 868             *flagp |= SIMPLE;
 869             nextchar();
 870             break;
 871         case 's':
 872             ret = regnode((regflags & PMf_LOCALE) ? SPACEL : SPACE);
 873             *flagp |= HASWIDTH|SIMPLE;
 874             nextchar();
 875             break;
 876         case 'S':
 877             ret = regnode((regflags & PMf_LOCALE) ? NSPACEL : NSPACE);
 878             *flagp |= HASWIDTH|SIMPLE;
 879             nextchar();
 880             break;
 881         case 'd':
 882             ret = regnode(DIGIT);
 883             *flagp |= HASWIDTH|SIMPLE;
 884             nextchar();
 885             break;
 886         case 'D':
 887             ret = regnode(NDIGIT);
 888             *flagp |= HASWIDTH|SIMPLE;
 889             nextchar();
 890             break;
 891         case 'n':
 892         case 'r':
 893         case 't':
 894         case 'f':
 895         case 'e':
 896         case 'a':
 897         case 'x':
 898         case 'c':
 899         case '0':
 900             goto defchar;
 901         case '1': case '2': case '3': case '4':
 902         case '5': case '6': case '7': case '8': case '9':
 903             {
 904                 I32 num = atoi(regparse);
 905
 906                 if (num > 9 && num >= regnpar)
 907                     goto defchar;
 908                 else {
 909                     regsawback = 1;
 910                     ret = reganode((regflags & PMf_FOLD)
 911                                    ? ((regflags & PMf_LOCALE) ? REFFL : REFF)
 912                                    : REF, num);
 913                     *flagp |= HASWIDTH;
 914                     while (isDIGIT(*regparse))
 915                         regparse++;
 916                     regparse--;
 917                     nextchar();
 918                 }
 919             }
 920             break;
 921         case '\0':
 922             if (regparse >= regxend)
 923                 FAIL("trailing \\ in regexp");
 924             /* FALL THROUGH */
 925         default:
 926             goto defchar;
 927         }
 928         break;
 929
 930     case '#':
 931         if (regflags & PMf_EXTENDED) {
 932             while (regparse < regxend && *regparse != '\n') regparse++;
 933             if (regparse < regxend)
 934                 goto tryagain;
 935         }
 936         /* FALL THROUGH */
 937
 938     default: {
 939             register I32 len;
 940             register char ender;
 941             register char *p;
 942             char *oldp;
 943             I32 numlen;
 944
 945             regparse++;
 946
 947         defchar:
 948             ret = regnode((regflags & PMf_FOLD)
 949                           ? ((regflags & PMf_LOCALE) ? EXACTFL : EXACTF)
 950                           : EXACT);
 951             regc(0);            /* save spot for len */
 952             for (len = 0, p = regparse - 1;
 953               len < 127 && p < regxend;
 954               len++)
 955             {
 956                 oldp = p;
 957
 958                 if (regflags & PMf_EXTENDED)
 959                     p = regwhite(p, regxend);
 960                 switch (*p) {
 961                 case '^':
 962                 case '$':
 963                 case '.':
 964                 case '[':
 965                 case '(':
 966                 case ')':
 967                 case '|':
 968                     goto loopdone;
 969                 case '\\':
 970                     switch (*++p) {
 971                     case 'A':
 972                     case 'G':
 973                     case 'Z':
 974                     case 'w':
 975                     case 'W':
 976                     case 'b':
 977                     case 'B':
 978                     case 's':
 979                     case 'S':
 980                     case 'd':
 981                     case 'D':
 982                         --p;
 983                         goto loopdone;
 984                     case 'n':
 985                         ender = '\n';
 986                         p++;
 987                         break;
 988                     case 'r':
 989                         ender = '\r';
 990                         p++;
 991                         break;
 992                     case 't':
 993                         ender = '\t';
 994                         p++;
 995                         break;
 996                     case 'f':
 997                         ender = '\f';
 998                         p++;
 999                         break;
1000                     case 'e':
1001                         ender = '\033';
1002                         p++;
1003                         break;
1004                     case 'a':
1005                         ender = '\007';
1006                         p++;
1007                         break;
1008                     case 'x':
1009                         ender = scan_hex(++p, 2, &numlen);
1010                         p += numlen;
1011                         break;
1012                     case 'c':
1013                         p++;
1014                         ender = UCHARAT(p++);
1015                         ender = toCTRL(ender);
1016                         break;
1017                     case '0': case '1': case '2': case '3':case '4':
1018                     case '5': case '6': case '7': case '8':case '9':
1019                         if (*p == '0' ||
1020                           (isDIGIT(p[1]) && atoi(p) >= regnpar) ) {
1021                             ender = scan_oct(p, 3, &numlen);
1022                             p += numlen;
1023                         }
1024                         else {
1025                             --p;
1026                             goto loopdone;
1027                         }
1028                         break;
1029                     case '\0':
1030                         if (p >= regxend)
1031                             FAIL("trailing \\ in regexp");
1032                         /* FALL THROUGH */
1033                     default:
1034                         ender = *p++;
1035                         break;
1036                     }
1037                     break;
1038                 default:
1039                     ender = *p++;
1040                     break;
1041                 }
1042                 if (regflags & PMf_EXTENDED)
1043                     p = regwhite(p, regxend);
1044                 if (ISMULT2(p)) { /* Back off on ?+*. */
1045                     if (len)
1046                         p = oldp;
1047                     else {
1048                         len++;
1049                         regc(ender);
1050                     }
1051                     break;
1052                 }
1053                 regc(ender);
1054             }
1055         loopdone:
1056             regparse = p - 1;
1057             nextchar();
1058             if (len < 0)
1059                 FAIL("internal disaster in regexp");
1060             if (len > 0)
1061                 *flagp |= HASWIDTH;
1062             if (len == 1)
1063                 *flagp |= SIMPLE;
1064             if (regcode != &regdummy)
1065                 *OPERAND(ret) = len;
1066             regc('\0');
1067         }
1068         break;
1069     }
1070
1071     return(ret);
1072 }
1073
1074 static char *
1075 regwhite(p, e)
1076 char *p;
1077 char *e;
1078 {
1079     while (p < e) {
1080         if (isSPACE(*p))
1081             ++p;
1082         else if (*p == '#') {
1083             do {
1084                 p++;
1085             } while (p < e && *p != '\n');
1086         }
1087         else
1088             break;
1089     }
1090     return p;
1091 }
1092
1093 static void
1094 regset(opnd, c)
1095 char *opnd;
1096 register I32 c;
1097 {
1098     if (opnd == &regdummy)
1099         return;
1100     c &= 0xFF;
1101     opnd[1 + (c >> 3)] |= (1 << (c & 7));
1102 }
1103
1104 static char *
1105 regclass()
1106 {
1107     register char *opnd;
1108     register I32 class;
1109     register I32 lastclass = 1234;
1110     register I32 range = 0;
1111     register char *ret;
1112     register I32 def;
1113     I32 numlen;
1114
1115     ret = regnode(ANYOF);
1116     opnd = regcode;
1117     for (class = 0; class < 33; class++)
1118         regc(0);
1119     if (*regparse == '^') {     /* Complement of range. */
1120         regnaughty++;
1121         regparse++;
1122         if (opnd != &regdummy)
1123             *opnd |= ANYOF_INVERT;
1124     }
1125     if (opnd != &regdummy) {
1126         if (regflags & PMf_FOLD)
1127             *opnd |= ANYOF_FOLD;
1128         if (regflags & PMf_LOCALE)
1129             *opnd |= ANYOF_LOCALE;
1130     }
1131     if (*regparse == ']' || *regparse == '-')
1132         goto skipcond;          /* allow 1st char to be ] or - */
1133     while (regparse < regxend && *regparse != ']') {
1134        skipcond:
1135         class = UCHARAT(regparse++);
1136         if (class == '\\') {
1137             class = UCHARAT(regparse++);
1138             switch (class) {
1139             case 'w':
1140                 if (regflags & PMf_LOCALE) {
1141                     if (opnd != &regdummy)
1142                         *opnd |= ANYOF_ALNUML;
1143                 }
1144                 else {
1145                     for (class = 0; class < 256; class++)
1146                         if (isALNUM(class))
1147                             regset(opnd, class);
1148                 }
1149                 lastclass = 1234;
1150                 continue;
1151             case 'W':
1152                 if (regflags & PMf_LOCALE) {
1153                     if (opnd != &regdummy)
1154                         *opnd |= ANYOF_NALNUML;
1155                 }
1156                 else {
1157                     for (class = 0; class < 256; class++)
1158                         if (!isALNUM(class))
1159                             regset(opnd, class);
1160                 }
1161                 lastclass = 1234;
1162                 continue;
1163             case 's':
1164                 if (regflags & PMf_LOCALE) {
1165                     if (opnd != &regdummy)
1166                         *opnd |= ANYOF_SPACEL;
1167                 }
1168                 else {
1169                     for (class = 0; class < 256; class++)
1170                         if (isSPACE(class))
1171                             regset(opnd, class);
1172                 }
1173                 lastclass = 1234;
1174                 continue;
1175             case 'S':
1176                 if (regflags & PMf_LOCALE) {
1177                     if (opnd != &regdummy)
1178                         *opnd |= ANYOF_NSPACEL;
1179                 }
1180                 else {
1181                     for (class = 0; class < 256; class++)
1182                         if (!isSPACE(class))
1183                             regset(opnd, class);
1184                 }
1185                 lastclass = 1234;
1186                 continue;
1187             case 'd':
1188                 for (class = '0'; class <= '9'; class++)
1189                     regset(opnd, class);
1190                 lastclass = 1234;
1191                 continue;
1192             case 'D':
1193                 for (class = 0; class < '0'; class++)
1194                     regset(opnd, class);
1195                 for (class = '9' + 1; class < 256; class++)
1196                     regset(opnd, class);
1197                 lastclass = 1234;
1198                 continue;
1199             case 'n':
1200                 class = '\n';
1201                 break;
1202             case 'r':
1203                 class = '\r';
1204                 break;
1205             case 't':
1206                 class = '\t';
1207                 break;
1208             case 'f':
1209                 class = '\f';
1210                 break;
1211             case 'b':
1212                 class = '\b';
1213                 break;
1214             case 'e':
1215                 class = '\033';
1216                 break;
1217             case 'a':
1218                 class = '\007';
1219                 break;
1220             case 'x':
1221                 class = scan_hex(regparse, 2, &numlen);
1222                 regparse += numlen;
1223                 break;
1224             case 'c':
1225                 class = UCHARAT(regparse++);
1226                 class = toCTRL(class);
1227                 break;
1228             case '0': case '1': case '2': case '3': case '4':
1229             case '5': case '6': case '7': case '8': case '9':
1230                 class = scan_oct(--regparse, 3, &numlen);
1231                 regparse += numlen;
1232                 break;
1233             }
1234         }
1235         if (range) {
1236             if (lastclass > class)
1237                 FAIL("invalid [] range in regexp");
1238             range = 0;
1239         }
1240         else {
1241             lastclass = class;
1242             if (*regparse == '-' && regparse+1 < regxend &&
1243               regparse[1] != ']') {
1244                 regparse++;
1245                 range = 1;
1246                 continue;       /* do it next time */
1247             }
1248         }
1249         for ( ; lastclass <= class; lastclass++)
1250             regset(opnd, lastclass);
1251         lastclass = class;
1252     }
1253     if (*regparse != ']')
1254         FAIL("unmatched [] in regexp");
1255     nextchar();
1256     return ret;
1257 }
1258
1259 static char*
1260 nextchar()
1261 {
1262     char* retval = regparse++;
1263
1264     for (;;) {
1265         if (*regparse == '(' && regparse[1] == '?' &&
1266                 regparse[2] == '#') {
1267             while (*regparse && *regparse != ')')
1268                 regparse++;
1269             regparse++;
1270             continue;
1271         }
1272         if (regflags & PMf_EXTENDED) {
1273             if (isSPACE(*regparse)) {
1274                 regparse++;
1275                 continue;
1276             }
1277             else if (*regparse == '#') {
1278                 while (*regparse && *regparse != '\n')
1279                     regparse++;
1280                 regparse++;
1281                 continue;
1282             }
1283         }
1284         return retval;
1285     }
1286 }
1287
1288 /*
1289 - regnode - emit a node
1290 */
1291 #ifdef CAN_PROTOTYPE
1292 static char *                   /* Location. */
1293 regnode(char op)
1294 #else
1295 static char *                   /* Location. */
1296 regnode(op)
1297 char op;
1298 #endif
1299 {
1300     register char *ret;
1301     register char *ptr;
1302
1303     ret = regcode;
1304     if (ret == &regdummy) {
1305 #ifdef REGALIGN
1306         if (!(regsize & 1))
1307             regsize++;
1308 #endif
1309         regsize += 3;
1310         return(ret);
1311     }
1312
1313 #ifdef REGALIGN
1314 #ifndef lint
1315     if (!((long)ret & 1))
1316       *ret++ = 127;
1317 #endif
1318 #endif
1319     ptr = ret;
1320     *ptr++ = op;
1321     *ptr++ = '\0';              /* Null "next" pointer. */
1322     *ptr++ = '\0';
1323     regcode = ptr;
1324
1325     return(ret);
1326 }
1327
1328 /*
1329 - reganode - emit a node with an argument
1330 */
1331 #ifdef CAN_PROTOTYPE
1332 static char *                   /* Location. */
1333 reganode(char op, unsigned short arg)
1334 #else
1335 static char *                   /* Location. */
1336 reganode(op, arg)
1337 char op;
1338 unsigned short arg;
1339 #endif
1340 {
1341     register char *ret;
1342     register char *ptr;
1343
1344     ret = regcode;
1345     if (ret == &regdummy) {
1346 #ifdef REGALIGN
1347         if (!(regsize & 1))
1348             regsize++;
1349 #endif
1350         regsize += 5;
1351         return(ret);
1352     }
1353
1354 #ifdef REGALIGN
1355 #ifndef lint
1356     if (!((long)ret & 1))
1357       *ret++ = 127;
1358 #endif
1359 #endif
1360     ptr = ret;
1361     *ptr++ = op;
1362     *ptr++ = '\0';              /* Null "next" pointer. */
1363     *ptr++ = '\0';
1364 #ifdef REGALIGN
1365     *(unsigned short *)(ret+3) = arg;
1366 #else
1367     ret[3] = arg >> 8; ret[4] = arg & 0377;
1368 #endif
1369     ptr += 2;
1370     regcode = ptr;
1371
1372     return(ret);
1373 }
1374
1375 /*
1376 - regc - emit (if appropriate) a byte of code
1377 */
1378 #ifdef CAN_PROTOTYPE
1379 static void
1380 regc(char b)
1381 #else
1382 static void
1383 regc(b)
1384 char b;
1385 #endif
1386 {
1387     if (regcode != &regdummy)
1388         *regcode++ = b;
1389     else
1390         regsize++;
1391 }
1392
1393 /*
1394 - reginsert - insert an operator in front of already-emitted operand
1395 *
1396 * Means relocating the operand.
1397 */
1398 #ifdef CAN_PROTOTYPE
1399 static void
1400 reginsert(char op, char *opnd)
1401 #else
1402 static void
1403 reginsert(op, opnd)
1404 char op;
1405 char *opnd;
1406 #endif
1407 {
1408     register char *src;
1409     register char *dst;
1410     register char *place;
1411     register int offset = (regkind[(U8)op] == CURLY ? 4 : 0);
1412
1413     if (regcode == &regdummy) {
1414 #ifdef REGALIGN
1415         regsize += 4 + offset;
1416 #else
1417         regsize += 3 + offset;
1418 #endif
1419         return;
1420     }
1421
1422     src = regcode;
1423 #ifdef REGALIGN
1424     regcode += 4 + offset;
1425 #else
1426     regcode += 3 + offset;
1427 #endif
1428     dst = regcode;
1429     while (src > opnd)
1430         *--dst = *--src;
1431
1432     place = opnd;               /* Op node, where operand used to be. */
1433     *place++ = op;
1434     *place++ = '\0';
1435     *place++ = '\0';
1436     while (offset-- > 0)
1437         *place++ = '\0';
1438 #ifdef REGALIGN
1439     *place++ = '\177';
1440 #endif
1441 }
1442
1443 /*
1444 - regtail - set the next-pointer at the end of a node chain
1445 */
1446 static void
1447 regtail(p, val)
1448 char *p;
1449 char *val;
1450 {
1451     register char *scan;
1452     register char *temp;
1453     register I32 offset;
1454
1455     if (p == &regdummy)
1456         return;
1457
1458     /* Find last node. */
1459     scan = p;
1460     for (;;) {
1461         temp = regnext(scan);
1462         if (temp == NULL)
1463             break;
1464         scan = temp;
1465     }
1466
1467 #ifdef REGALIGN
1468     offset = val - scan;
1469 #ifndef lint
1470     *(short*)(scan+1) = offset;
1471 #else
1472     offset = offset;
1473 #endif
1474 #else
1475     if (OP(scan) == BACK)
1476         offset = scan - val;
1477     else
1478         offset = val - scan;
1479     *(scan+1) = (offset>>8)&0377;
1480     *(scan+2) = offset&0377;
1481 #endif
1482 }
1483
1484 /*
1485 - regoptail - regtail on operand of first argument; nop if operandless
1486 */
1487 static void
1488 regoptail(p, val)
1489 char *p;
1490 char *val;
1491 {
1492     /* "Operandless" and "op != BRANCH" are synonymous in practice. */
1493     if (p == NULL || p == &regdummy || regkind[(U8)OP(p)] != BRANCH)
1494         return;
1495     regtail(NEXTOPER(p), val);
1496 }
1497
1498 /*
1499  - regcurly - a little FSA that accepts {\d+,?\d*}
1500  */
1501 STATIC I32
1502 regcurly(s)
1503 register char *s;
1504 {
1505     if (*s++ != '{')
1506         return FALSE;
1507     if (!isDIGIT(*s))
1508         return FALSE;
1509     while (isDIGIT(*s))
1510         s++;
1511     if (*s == ',')
1512         s++;
1513     while (isDIGIT(*s))
1514         s++;
1515     if (*s != '}')
1516         return FALSE;
1517     return TRUE;
1518 }
1519
1520 #ifdef DEBUGGING
1521
1522 /*
1523  - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
1524  */
1525 void
1526 regdump(r)
1527 regexp *r;
1528 {
1529     register char *s;
1530     register char op = EXACT;   /* Arbitrary non-END op. */
1531     register char *next;
1532     SV *sv = sv_newmortal();
1533
1534     s = r->program + 1;
1535     while (op != END) { /* While that wasn't END last time... */
1536 #ifdef REGALIGN
1537         if (!((long)s & 1))
1538             s++;
1539 #endif
1540         op = OP(s);
1541         /* where, what */
1542         regprop(sv, s);
1543         PerlIO_printf(Perl_debug_log, "%2d%s", s - r->program, SvPVX(sv));
1544         next = regnext(s);
1545         s += regarglen[(U8)op];
1546         if (next == NULL)               /* Next ptr. */
1547             PerlIO_printf(Perl_debug_log, "(0)");
1548         else
1549             PerlIO_printf(Perl_debug_log, "(%d)", (s-r->program)+(next-s));
1550         s += 3;
1551         if (op == ANYOF) {
1552             s += 33;
1553         }
1554         if (regkind[(U8)op] == EXACT) {
1555             /* Literal string, where present. */
1556             s++;
1557             (void)PerlIO_putc(Perl_debug_log, ' ');
1558             (void)PerlIO_putc(Perl_debug_log, '<');
1559             while (*s != '\0') {
1560                 (void)PerlIO_putc(Perl_debug_log,*s);
1561                 s++;
1562             }
1563             (void)PerlIO_putc(Perl_debug_log, '>');
1564             s++;
1565         }
1566         (void)PerlIO_putc(Perl_debug_log, '\n');
1567     }
1568
1569     /* Header fields of interest. */
1570     if (r->regstart)
1571         PerlIO_printf(Perl_debug_log, "start `%s' ", SvPVX(r->regstart));
1572     if (r->regstclass) {
1573         regprop(sv, r->regstclass);
1574         PerlIO_printf(Perl_debug_log, "stclass `%s' ", SvPVX(sv));
1575     }
1576     if (r->reganch & ROPT_ANCH) {
1577         PerlIO_printf(Perl_debug_log, "anchored");
1578         if (r->reganch & ROPT_ANCH_BOL)
1579             PerlIO_printf(Perl_debug_log, "(BOL)");
1580         if (r->reganch & ROPT_ANCH_GPOS)
1581             PerlIO_printf(Perl_debug_log, "(GPOS)");
1582         PerlIO_putc(Perl_debug_log, ' ');
1583     }
1584     if (r->reganch & ROPT_SKIP)
1585         PerlIO_printf(Perl_debug_log, "plus ");
1586     if (r->reganch & ROPT_IMPLICIT)
1587         PerlIO_printf(Perl_debug_log, "implicit ");
1588     if (r->regmust != NULL)
1589         PerlIO_printf(Perl_debug_log, "must have \"%s\" back %ld ", SvPVX(r->regmust),
1590          (long) r->regback);
1591     PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen);
1592     PerlIO_printf(Perl_debug_log, "\n");
1593 }
1594
1595 /*
1596 - regprop - printable representation of opcode
1597 */
1598 void
1599 regprop(sv, o)
1600 SV *sv;
1601 char *o;
1602 {
1603     register char *p = 0;
1604
1605     sv_setpv(sv, ":");
1606     switch (OP(o)) {
1607     case BOL:
1608         p = "BOL";
1609         break;
1610     case MBOL:
1611         p = "MBOL";
1612         break;
1613     case SBOL:
1614         p = "SBOL";
1615         break;
1616     case EOL:
1617         p = "EOL";
1618         break;
1619     case MEOL:
1620         p = "MEOL";
1621         break;
1622     case SEOL:
1623         p = "SEOL";
1624         break;
1625     case ANY:
1626         p = "ANY";
1627         break;
1628     case SANY:
1629         p = "SANY";
1630         break;
1631     case ANYOF:
1632         p = "ANYOF";
1633         break;
1634     case BRANCH:
1635         p = "BRANCH";
1636         break;
1637     case EXACT:
1638         p = "EXACT";
1639         break;
1640     case EXACTF:
1641         p = "EXACTF";
1642         break;
1643     case EXACTFL:
1644         p = "EXACTFL";
1645         break;
1646     case NOTHING:
1647         p = "NOTHING";
1648         break;
1649     case BACK:
1650         p = "BACK";
1651         break;
1652     case END:
1653         p = "END";
1654         break;
1655     case BOUND:
1656         p = "BOUND";
1657         break;
1658     case BOUNDL:
1659         p = "BOUNDL";
1660         break;
1661     case NBOUND:
1662         p = "NBOUND";
1663         break;
1664     case NBOUNDL:
1665         p = "NBOUNDL";
1666         break;
1667     case CURLY:
1668         sv_catpvf(sv, "CURLY {%d,%d}", ARG1(o), ARG2(o));
1669         break;
1670     case CURLYX:
1671         sv_catpvf(sv, "CURLYX {%d,%d}", ARG1(o), ARG2(o));
1672         break;
1673     case REF:
1674         sv_catpvf(sv, "REF%d", ARG1(o));
1675         break;
1676     case REFF:
1677         sv_catpvf(sv, "REFF%d", ARG1(o));
1678         break;
1679     case REFFL:
1680         sv_catpvf(sv, "REFFL%d", ARG1(o));
1681         break;
1682     case OPEN:
1683         sv_catpvf(sv, "OPEN%d", ARG1(o));
1684         break;
1685     case CLOSE:
1686         sv_catpvf(sv, "CLOSE%d", ARG1(o));
1687         p = NULL;
1688         break;
1689     case STAR:
1690         p = "STAR";
1691         break;
1692     case PLUS:
1693         p = "PLUS";
1694         break;
1695     case MINMOD:
1696         p = "MINMOD";
1697         break;
1698     case GPOS:
1699         p = "GPOS";
1700         break;
1701     case UNLESSM:
1702         p = "UNLESSM";
1703         break;
1704     case IFMATCH:
1705         p = "IFMATCH";
1706         break;
1707     case SUCCEED:
1708         p = "SUCCEED";
1709         break;
1710     case WHILEM:
1711         p = "WHILEM";
1712         break;
1713     case DIGIT:
1714         p = "DIGIT";
1715         break;
1716     case NDIGIT:
1717         p = "NDIGIT";
1718         break;
1719     case ALNUM:
1720         p = "ALNUM";
1721         break;
1722     case NALNUM:
1723         p = "NALNUM";
1724         break;
1725     case SPACE:
1726         p = "SPACE";
1727         break;
1728     case NSPACE:
1729         p = "NSPACE";
1730         break;
1731     case ALNUML:
1732         p = "ALNUML";
1733         break;
1734     case NALNUML:
1735         p = "NALNUML";
1736         break;
1737     case SPACEL:
1738         p = "SPACEL";
1739         break;
1740     case NSPACEL:
1741         p = "NSPACEL";
1742         break;
1743     default:
1744         FAIL("corrupted regexp opcode");
1745     }
1746     if (p)
1747         sv_catpv(sv, p);
1748 }
1749 #endif /* DEBUGGING */
1750
1751 void
1752 pregfree(r)
1753 struct regexp *r;
1754 {
1755     if (!r)
1756         return;
1757     if (r->precomp) {
1758         Safefree(r->precomp);
1759         r->precomp = Nullch;
1760     }
1761     if (r->subbase) {
1762         Safefree(r->subbase);
1763         r->subbase = Nullch;
1764     }
1765     if (r->regmust) {
1766         SvREFCNT_dec(r->regmust);
1767         r->regmust = Nullsv;
1768     }
1769     if (r->regstart) {
1770         SvREFCNT_dec(r->regstart);
1771         r->regstart = Nullsv;
1772     }
1773     Safefree(r->startp);
1774     Safefree(r->endp);
1775     Safefree(r);
1776 }