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