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