projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Allow MakeMaker 5.34 to use libraries containing '+' in name
[p5sagit/p5-mst-13.2.git] / regcomp.c
CommitLineData
a0d0e21e 1/* regcomp.c
2 */
3
4/*
5 * "A fair jaw-cracker dwarf-language must be." --Samwise Gamgee
6 */
7
a687059c 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 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 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 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 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 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 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 77#ifdef atarist
78#define PERL_META "^$.[()|?+*\\"
79#else
a687059c 80#define META "^$.[()|?+*\\"
2b69d0c2 81#endif
a687059c 82
35c8bce7 83#ifdef SPSTART
84#undef SPSTART /* dratted cpp namespace... */
85#endif
a687059c 86/*
87 * Flags to be passed up and down.
88 */
a687059c 89#define WORST 0 /* Worst case. */
a0d0e21e 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 94
95/*
e50aee73 96 * Forward declarations for pregcomp()'s friends.
a687059c 97 */
a0d0e21e 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 *));
bbce6d69 110static void regset _((char *, I32));
a0d0e21e 111static void regtail _((char *, char *));
112static char* nextchar _((void));
a687059c 113
114/*
e50aee73 115 - pregcomp - compile a regular expression into internal code
a687059c 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 131char* exp;
132char* xend;
133PMOP* pm;
a687059c 134{
a0d0e21e 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
bbce6d69 152 regprecomp = savepvn(exp, xend - exp);
a0d0e21e 153 regflags = pm->op_pmflags;
bbce6d69 154 regsawback = 0;
155
156 /* First pass: determine size, legality. */
a0d0e21e 157 regparse = exp;
158 regxend = xend;
a0d0e21e 159 regnaughty = 0;
a0d0e21e 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
bbce6d69 174 /* Allocate space and initialize. */
a0d0e21e 175 Newc(1001, r, sizeof(regexp) + (unsigned)regsize, char, regexp);
176 if (r == NULL)
177 FAIL("regexp out of space");
bbce6d69 178 r->prelen = xend - exp;
a0d0e21e 179 r->precomp = regprecomp;
180 r->subbeg = r->subbase = NULL;
bbce6d69 181
182 /* Second pass: emit code. */
a0d0e21e 183 regparse = exp;
bbce6d69 184 regxend = xend;
185 regnaughty = 0;
a0d0e21e 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;
a0d0e21e 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 215 }
216
a0d0e21e 217 /* Starting-point info. */
218 again:
bbce6d69 219 if (OP(first) == EXACT) {
a0d0e21e 220 r->regstart = newSVpv(OPERAND(first)+1,*OPERAND(first));
bbce6d69 221 if (SvCUR(r->regstart) > !sawstudy)
222 fbm_compile(r->regstart);
223 (void)SvUPGRADE(r->regstart, SVt_PVBM);
a0d0e21e 224 }
225 else if (strchr(simple+2,OP(first)))
226 r->regstclass = first;
bbce6d69 227 else if (regkind[(U8)OP(first)] == BOUND ||
228 regkind[(U8)OP(first)] == NBOUND)
a0d0e21e 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
760ac839 247 DEBUG_r(PerlIO_printf(Perl_debug_log, "first %d next %d offset %d\n",
a0d0e21e 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 274 else /* single branch is ok */
275 scan = NEXTOPER(scan);
748a9306 276 continue;
a0d0e21e 277 }
278 if (OP(scan) == UNLESSM) {
279 curback = -30000;
280 scan = regnext(scan);
748a9306 281 continue;
a0d0e21e 282 }
bbce6d69 283 if (OP(scan) == EXACT) {
a0d0e21e 284 char *t;
a687059c 285
a0d0e21e 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 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 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 312 backest = backish;
313 }
a0d0e21e 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 329 sv_setpvn(longish,"",0);
330 }
331 scan = regnext(scan);
a687059c 332 }
333
a0d0e21e 334 /* Prefer earlier on tie, unless we can tail match latter */
335
bbce6d69 336 if (SvCUR(longish) + (regkind[(U8)OP(first)] == EOL)
337 > SvCUR(longest))
a0d0e21e 338 {
339 sv_setsv(longest,longish);
340 backest = backish;
341 }
342 else
343 sv_setpvn(longish,"",0);
344 if (SvCUR(longest)
bbce6d69 345 && (!r->regstart
346 || !fbm_instr((unsigned char*) SvPVX(r->regstart),
347 (unsigned char *) (SvPVX(r->regstart)
348 + SvCUR(r->regstart)),
349 longest)))
a0d0e21e 350 {
351 r->regmust = longest;
352 if (backest < 0)
353 backest = -1;
354 r->regback = backest;
bbce6d69 355 if (SvCUR(longest) > !(sawstudy || regkind[(U8)OP(first)] == EOL))
356 fbm_compile(r->regmust);
a0d0e21e 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
a0d0e21e 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);
a687059c 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 */
386static char *
387reg(paren, flagp)
79072805 388I32 paren; /* Parenthesized? */
389I32 *flagp;
a687059c 390{
a0d0e21e 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++;
748a9306 403 paren = *regparse++;
a0d0e21e 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 != ')')
748a9306 418 croak("Sequence (?#... not terminated");
a0d0e21e 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();
a687059c 454 br = regbranch(&flags);
455 if (br == NULL)
a0d0e21e 456 return(NULL);
457 regtail(ret, br); /* BRANCH -> BRANCH. */
a687059c 458 if (!(flags&HASWIDTH))
a0d0e21e 459 *flagp &= ~HASWIDTH;
a687059c 460 *flagp |= flags&SPSTART;
a0d0e21e 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. */
4633a7c4 496 if (paren && (regparse >= regxend || *nextchar() != ')')) {
a0d0e21e 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 }
a687059c 505
a0d0e21e 506 return(ret);
a687059c 507}
508
509/*
510 - regbranch - one alternative of an | operator
511 *
512 * Implements the concatenation operator.
513 */
514static char *
515regbranch(flagp)
79072805 516I32 *flagp;
a687059c 517{
a0d0e21e 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);
a687059c 543 }
a0d0e21e 544 chain = latest;
545 }
546 if (chain == NULL) /* Loop ran zero times. */
547 (void) regnode(NOTHING);
a687059c 548
a0d0e21e 549 return(ret);
a687059c 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 */
561static char *
562regpiece(flagp)
79072805 563I32 *flagp;
a687059c 564{
a0d0e21e 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;
a687059c 600 }
a0d0e21e 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) {
00bf170e 635#ifdef REGALIGN
a0d0e21e 636 *(unsigned short *)(ret+3) = min;
637 *(unsigned short *)(ret+5) = max;
00bf170e 638#else
a0d0e21e 639 ret[3] = min >> 8; ret[4] = min & 0377;
640 ret[5] = max >> 8; ret[6] = max & 0377;
00bf170e 641#endif
a687059c 642 }
a687059c 643
a0d0e21e 644 goto nest_check;
a687059c 645 }
a0d0e21e 646 }
a687059c 647
a0d0e21e 648 if (!ISMULT1(op)) {
649 *flagp = flags;
a687059c 650 return(ret);
a0d0e21e 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);
a687059c 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 */
705static char *
706regatom(flagp)
79072805 707I32 *flagp;
a687059c 708{
a0d0e21e 709 register char *ret = 0;
710 I32 flags;
711
712 *flagp = WORST; /* Tentatively. */
713
714tryagain:
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;
85afd4ae 767 case '{':
768 if (!regcurly(regparse)) {
769 regparse++;
770 goto defchar;
771 }
772 /* FALL THROUGH */
a0d0e21e 773 case '?':
774 case '+':
775 case '*':
3115e423 776 FAIL("?+*{} follows nothing in regexp");
a0d0e21e 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':
bbce6d69 796 ret = regnode((regflags & PMf_LOCALE) ? ALNUML : ALNUM);
a0d0e21e 797 *flagp |= HASWIDTH|SIMPLE;
798 nextchar();
799 break;
800 case 'W':
bbce6d69 801 ret = regnode((regflags & PMf_LOCALE) ? NALNUML : NALNUM);
a0d0e21e 802 *flagp |= HASWIDTH|SIMPLE;
803 nextchar();
804 break;
805 case 'b':
bbce6d69 806 ret = regnode((regflags & PMf_LOCALE) ? BOUNDL : BOUND);
a0d0e21e 807 *flagp |= SIMPLE;
808 nextchar();
809 break;
810 case 'B':
bbce6d69 811 ret = regnode((regflags & PMf_LOCALE) ? NBOUNDL : NBOUND);
a0d0e21e 812 *flagp |= SIMPLE;
813 nextchar();
814 break;
815 case 's':
bbce6d69 816 ret = regnode((regflags & PMf_LOCALE) ? SPACEL : SPACE);
a0d0e21e 817 *flagp |= HASWIDTH|SIMPLE;
818 nextchar();
819 break;
820 case 'S':
bbce6d69 821 ret = regnode((regflags & PMf_LOCALE) ? NSPACEL : NSPACE);
a0d0e21e 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 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;
4633a7c4 871
872 case '#':
873 if (regflags & PMf_EXTENDED) {
874 while (regparse < regxend && *regparse != '\n') regparse++;
875 if (regparse < regxend)
876 goto tryagain;
877 }
878 /* FALL THROUGH */
879
a0d0e21e 880 default: {
881 register I32 len;
882 register char ender;
883 register char *p;
884 char *oldp;
885 I32 numlen;
886
887 regparse++;
888
889 defchar:
bbce6d69 890 ret = regnode((regflags & PMf_FOLD)
891 ? ((regflags & PMf_LOCALE) ? EXACTFL : EXACTF)
892 : EXACT);
a0d0e21e 893 regc(0); /* save spot for len */
894 for (len = 0, p = regparse - 1;
895 len < 127 && p < regxend;
896 len++)
897 {
898 oldp = p;
899 switch (*p) {
900 case '^':
901 case '$':
902 case '.':
903 case '[':
904 case '(':
905 case ')':
906 case '|':
907 goto loopdone;
908 case '\\':
909 switch (*++p) {
910 case 'A':
911 case 'G':
912 case 'Z':
913 case 'w':
914 case 'W':
915 case 'b':
916 case 'B':
917 case 's':
918 case 'S':
919 case 'd':
920 case 'D':
921 --p;
922 goto loopdone;
923 case 'n':
924 ender = '\n';
925 p++;
a687059c 926 break;
a0d0e21e 927 case 'r':
928 ender = '\r';
929 p++;
a687059c 930 break;
a0d0e21e 931 case 't':
932 ender = '\t';
933 p++;
a687059c 934 break;
a0d0e21e 935 case 'f':
936 ender = '\f';
937 p++;
a687059c 938 break;
a0d0e21e 939 case 'e':
940 ender = '\033';
941 p++;
a687059c 942 break;
a0d0e21e 943 case 'a':
944 ender = '\007';
945 p++;
a687059c 946 break;
a0d0e21e 947 case 'x':
948 ender = scan_hex(++p, 2, &numlen);
949 p += numlen;
a687059c 950 break;
a0d0e21e 951 case 'c':
952 p++;
bbce6d69 953 ender = UCHARAT(p++);
954 ender = toCTRL(ender);
a687059c 955 break;
a0d0e21e 956 case '0': case '1': case '2': case '3':case '4':
957 case '5': case '6': case '7': case '8':case '9':
958 if (*p == '0' ||
959 (isDIGIT(p[1]) && atoi(p) >= regnpar) ) {
960 ender = scan_oct(p, 3, &numlen);
961 p += numlen;
962 }
963 else {
964 --p;
965 goto loopdone;
a687059c 966 }
967 break;
a0d0e21e 968 case '\0':
969 if (p >= regxend)
a687059c 970 FAIL("trailing \\ in regexp");
971 /* FALL THROUGH */
a0d0e21e 972 default:
973 ender = *p++;
974 break;
975 }
976 break;
4633a7c4 977 case '#':
978 if (regflags & PMf_EXTENDED) {
979 while (p < regxend && *p != '\n') p++;
980 }
981 /* FALL THROUGH */
a0d0e21e 982 case ' ': case '\t': case '\n': case '\r': case '\f': case '\v':
983 if (regflags & PMf_EXTENDED) {
984 p++;
985 len--;
986 continue;
987 }
988 /* FALL THROUGH */
a687059c 989 default:
a0d0e21e 990 ender = *p++;
991 break;
a687059c 992 }
a0d0e21e 993 if (ISMULT2(p)) { /* Back off on ?+*. */
994 if (len)
995 p = oldp;
996 else {
997 len++;
998 regc(ender);
999 }
1000 break;
a687059c 1001 }
a0d0e21e 1002 regc(ender);
1003 }
1004 loopdone:
1005 regparse = p - 1;
1006 nextchar();
1007 if (len < 0)
1008 FAIL("internal disaster in regexp");
1009 if (len > 0)
1010 *flagp |= HASWIDTH;
1011 if (len == 1)
1012 *flagp |= SIMPLE;
1013 if (regcode != &regdummy)
1014 *OPERAND(ret) = len;
1015 regc('\0');
a687059c 1016 }
a0d0e21e 1017 break;
1018 }
a687059c 1019
a0d0e21e 1020 return(ret);
a687059c 1021}
1022
1023static void
bbce6d69 1024regset(opnd, c)
1025char *opnd;
79072805 1026register I32 c;
a687059c 1027{
bbce6d69 1028 if (opnd == &regdummy)
1029 return;
1030 c &= 0xFF;
1031 opnd[1 + (c >> 3)] |= (1 << (c & 7));
a687059c 1032}
1033
1034static char *
1035regclass()
1036{
bbce6d69 1037 register char *opnd;
a0d0e21e 1038 register I32 class;
1039 register I32 lastclass = 1234;
1040 register I32 range = 0;
1041 register char *ret;
1042 register I32 def;
1043 I32 numlen;
1044
1045 ret = regnode(ANYOF);
bbce6d69 1046 opnd = regcode;
1047 for (class = 0; class < 33; class++)
1048 regc(0);
a0d0e21e 1049 if (*regparse == '^') { /* Complement of range. */
1050 regnaughty++;
1051 regparse++;
bbce6d69 1052 if (opnd != &regdummy)
1053 *opnd |= ANYOF_INVERT;
1054 }
1055 if (opnd != &regdummy) {
1056 if (regflags & PMf_FOLD)
1057 *opnd |= ANYOF_FOLD;
1058 if (regflags & PMf_LOCALE)
1059 *opnd |= ANYOF_LOCALE;
a0d0e21e 1060 }
a0d0e21e 1061 if (*regparse == ']' || *regparse == '-')
1062 goto skipcond; /* allow 1st char to be ] or - */
1063 while (regparse < regxend && *regparse != ']') {
1064 skipcond:
1065 class = UCHARAT(regparse++);
1066 if (class == '\\') {
1067 class = UCHARAT(regparse++);
1068 switch (class) {
1069 case 'w':
bbce6d69 1070 if (regflags & PMf_LOCALE) {
1071 if (opnd != &regdummy)
1072 *opnd |= ANYOF_ALNUML;
1073 }
1074 else {
1075 for (class = 0; class < 256; class++)
1076 if (isALNUM(class))
1077 regset(opnd, class);
1078 }
a0d0e21e 1079 lastclass = 1234;
1080 continue;
1081 case 'W':
bbce6d69 1082 if (regflags & PMf_LOCALE) {
1083 if (opnd != &regdummy)
1084 *opnd |= ANYOF_NALNUML;
1085 }
1086 else {
1087 for (class = 0; class < 256; class++)
1088 if (!isALNUM(class))
1089 regset(opnd, class);
1090 }
a0d0e21e 1091 lastclass = 1234;
1092 continue;
1093 case 's':
bbce6d69 1094 if (regflags & PMf_LOCALE) {
1095 if (opnd != &regdummy)
1096 *opnd |= ANYOF_SPACEL;
1097 }
1098 else {
1099 for (class = 0; class < 256; class++)
1100 if (isSPACE(class))
1101 regset(opnd, class);
1102 }
a0d0e21e 1103 lastclass = 1234;
1104 continue;
1105 case 'S':
bbce6d69 1106 if (regflags & PMf_LOCALE) {
1107 if (opnd != &regdummy)
1108 *opnd |= ANYOF_NSPACEL;
1109 }
1110 else {
1111 for (class = 0; class < 256; class++)
1112 if (!isSPACE(class))
1113 regset(opnd, class);
1114 }
a0d0e21e 1115 lastclass = 1234;
1116 continue;
1117 case 'd':
1118 for (class = '0'; class <= '9'; class++)
bbce6d69 1119 regset(opnd, class);
a0d0e21e 1120 lastclass = 1234;
1121 continue;
1122 case 'D':
1123 for (class = 0; class < '0'; class++)
bbce6d69 1124 regset(opnd, class);
a0d0e21e 1125 for (class = '9' + 1; class < 256; class++)
bbce6d69 1126 regset(opnd, class);
a0d0e21e 1127 lastclass = 1234;
1128 continue;
1129 case 'n':
1130 class = '\n';
1131 break;
1132 case 'r':
1133 class = '\r';
1134 break;
1135 case 't':
1136 class = '\t';
1137 break;
1138 case 'f':
1139 class = '\f';
1140 break;
1141 case 'b':
1142 class = '\b';
1143 break;
1144 case 'e':
1145 class = '\033';
1146 break;
1147 case 'a':
1148 class = '\007';
1149 break;
1150 case 'x':
1151 class = scan_hex(regparse, 2, &numlen);
1152 regparse += numlen;
1153 break;
1154 case 'c':
bbce6d69 1155 class = UCHARAT(regparse++);
1156 class = toCTRL(class);
a0d0e21e 1157 break;
1158 case '0': case '1': case '2': case '3': case '4':
1159 case '5': case '6': case '7': case '8': case '9':
1160 class = scan_oct(--regparse, 3, &numlen);
1161 regparse += numlen;
1162 break;
1163 }
1164 }
1165 if (range) {
1166 if (lastclass > class)
1167 FAIL("invalid [] range in regexp");
1168 range = 0;
1169 }
1170 else {
1171 lastclass = class;
1172 if (*regparse == '-' && regparse+1 < regxend &&
1173 regparse[1] != ']') {
a687059c 1174 regparse++;
a0d0e21e 1175 range = 1;
1176 continue; /* do it next time */
1177 }
a687059c 1178 }
bbce6d69 1179 for ( ; lastclass <= class; lastclass++)
1180 regset(opnd, lastclass);
a0d0e21e 1181 lastclass = class;
1182 }
1183 if (*regparse != ']')
1184 FAIL("unmatched [] in regexp");
1185 nextchar();
1186 return ret;
1187}
1188
1189static char*
1190nextchar()
1191{
1192 char* retval = regparse++;
1193
4633a7c4 1194 for (;;) {
1195 if (*regparse == '(' && regparse[1] == '?' &&
1196 regparse[2] == '#') {
1197 while (*regparse && *regparse != ')')
748a9306 1198 regparse++;
4633a7c4 1199 regparse++;
1200 continue;
1201 }
1202 if (regflags & PMf_EXTENDED) {
1203 if (isSPACE(*regparse)) {
748a9306 1204 regparse++;
1205 continue;
1206 }
1207 else if (*regparse == '#') {
1208 while (*regparse && *regparse != '\n')
1209 regparse++;
1210 regparse++;
1211 continue;
1212 }
748a9306 1213 }
4633a7c4 1214 return retval;
a0d0e21e 1215 }
a687059c 1216}
1217
1218/*
a0d0e21e 1219- regnode - emit a node
1220*/
1221#ifdef CAN_PROTOTYPE
1222static char * /* Location. */
1223regnode(char op)
1224#else
a687059c 1225static char * /* Location. */
1226regnode(op)
1227char op;
a0d0e21e 1228#endif
a687059c 1229{
a0d0e21e 1230 register char *ret;
1231 register char *ptr;
a687059c 1232
a0d0e21e 1233 ret = regcode;
1234 if (ret == &regdummy) {
a687059c 1235#ifdef REGALIGN
a0d0e21e 1236 if (!(regsize & 1))
1237 regsize++;
a687059c 1238#endif
a0d0e21e 1239 regsize += 3;
1240 return(ret);
1241 }
a687059c 1242
1243#ifdef REGALIGN
1244#ifndef lint
a0d0e21e 1245 if (!((long)ret & 1))
1246 *ret++ = 127;
a687059c 1247#endif
1248#endif
a0d0e21e 1249 ptr = ret;
1250 *ptr++ = op;
1251 *ptr++ = '\0'; /* Null "next" pointer. */
1252 *ptr++ = '\0';
1253 regcode = ptr;
a687059c 1254
a0d0e21e 1255 return(ret);
a687059c 1256}
1257
1258/*
a0d0e21e 1259- reganode - emit a node with an argument
1260*/
1261#ifdef CAN_PROTOTYPE
1262static char * /* Location. */
1263reganode(char op, unsigned short arg)
1264#else
fe14fcc3 1265static char * /* Location. */
1266reganode(op, arg)
1267char op;
1268unsigned short arg;
a0d0e21e 1269#endif
fe14fcc3 1270{
a0d0e21e 1271 register char *ret;
1272 register char *ptr;
fe14fcc3 1273
a0d0e21e 1274 ret = regcode;
1275 if (ret == &regdummy) {
fe14fcc3 1276#ifdef REGALIGN
a0d0e21e 1277 if (!(regsize & 1))
1278 regsize++;
fe14fcc3 1279#endif
a0d0e21e 1280 regsize += 5;
1281 return(ret);
1282 }
fe14fcc3 1283
1284#ifdef REGALIGN
1285#ifndef lint
a0d0e21e 1286 if (!((long)ret & 1))
1287 *ret++ = 127;
fe14fcc3 1288#endif
1289#endif
a0d0e21e 1290 ptr = ret;
1291 *ptr++ = op;
1292 *ptr++ = '\0'; /* Null "next" pointer. */
1293 *ptr++ = '\0';
fe14fcc3 1294#ifdef REGALIGN
a0d0e21e 1295 *(unsigned short *)(ret+3) = arg;
fe14fcc3 1296#else
a0d0e21e 1297 ret[3] = arg >> 8; ret[4] = arg & 0377;
fe14fcc3 1298#endif
a0d0e21e 1299 ptr += 2;
1300 regcode = ptr;
fe14fcc3 1301
a0d0e21e 1302 return(ret);
fe14fcc3 1303}
1304
1305/*
a0d0e21e 1306- regc - emit (if appropriate) a byte of code
1307*/
1308#ifdef CAN_PROTOTYPE
1309static void
1310regc(char b)
1311#else
a687059c 1312static void
1313regc(b)
1314char b;
a0d0e21e 1315#endif
a687059c 1316{
a0d0e21e 1317 if (regcode != &regdummy)
1318 *regcode++ = b;
1319 else
1320 regsize++;
a687059c 1321}
1322
1323/*
a0d0e21e 1324- reginsert - insert an operator in front of already-emitted operand
1325*
1326* Means relocating the operand.
1327*/
1328#ifdef CAN_PROTOTYPE
1329static void
1330reginsert(char op, char *opnd)
1331#else
a687059c 1332static void
1333reginsert(op, opnd)
1334char op;
1335char *opnd;
a0d0e21e 1336#endif
a687059c 1337{
a0d0e21e 1338 register char *src;
1339 register char *dst;
1340 register char *place;
1341 register int offset = (regkind[(U8)op] == CURLY ? 4 : 0);
a687059c 1342
a0d0e21e 1343 if (regcode == &regdummy) {
a687059c 1344#ifdef REGALIGN
a0d0e21e 1345 regsize += 4 + offset;
a687059c 1346#else
a0d0e21e 1347 regsize += 3 + offset;
a687059c 1348#endif
a0d0e21e 1349 return;
1350 }
a687059c 1351
a0d0e21e 1352 src = regcode;
a687059c 1353#ifdef REGALIGN
a0d0e21e 1354 regcode += 4 + offset;
a687059c 1355#else
a0d0e21e 1356 regcode += 3 + offset;
a687059c 1357#endif
a0d0e21e 1358 dst = regcode;
1359 while (src > opnd)
1360 *--dst = *--src;
1361
1362 place = opnd; /* Op node, where operand used to be. */
1363 *place++ = op;
1364 *place++ = '\0';
1365 *place++ = '\0';
1366 while (offset-- > 0)
a687059c 1367 *place++ = '\0';
2b69d0c2 1368#ifdef REGALIGN
a0d0e21e 1369 *place++ = '\177';
2b69d0c2 1370#endif
a687059c 1371}
1372
1373/*
a0d0e21e 1374- regtail - set the next-pointer at the end of a node chain
1375*/
a687059c 1376static void
1377regtail(p, val)
1378char *p;
1379char *val;
1380{
a0d0e21e 1381 register char *scan;
1382 register char *temp;
1383 register I32 offset;
1384
1385 if (p == &regdummy)
1386 return;
1387
1388 /* Find last node. */
1389 scan = p;
1390 for (;;) {
1391 temp = regnext(scan);
1392 if (temp == NULL)
1393 break;
1394 scan = temp;
1395 }
a687059c 1396
1397#ifdef REGALIGN
a0d0e21e 1398 offset = val - scan;
a687059c 1399#ifndef lint
a0d0e21e 1400 *(short*)(scan+1) = offset;
a687059c 1401#else
a0d0e21e 1402 offset = offset;
a687059c 1403#endif
1404#else
a0d0e21e 1405 if (OP(scan) == BACK)
1406 offset = scan - val;
1407 else
1408 offset = val - scan;
1409 *(scan+1) = (offset>>8)&0377;
1410 *(scan+2) = offset&0377;
a687059c 1411#endif
1412}
1413
1414/*
a0d0e21e 1415- regoptail - regtail on operand of first argument; nop if operandless
1416*/
a687059c 1417static void
1418regoptail(p, val)
1419char *p;
1420char *val;
1421{
a0d0e21e 1422 /* "Operandless" and "op != BRANCH" are synonymous in practice. */
1423 if (p == NULL || p == &regdummy || regkind[(U8)OP(p)] != BRANCH)
1424 return;
1425 regtail(NEXTOPER(p), val);
a687059c 1426}
1427
1428/*
1429 - regcurly - a little FSA that accepts {\d+,?\d*}
1430 */
79072805 1431STATIC I32
a687059c 1432regcurly(s)
1433register char *s;
1434{
1435 if (*s++ != '{')
1436 return FALSE;
f0fcb552 1437 if (!isDIGIT(*s))
a687059c 1438 return FALSE;
f0fcb552 1439 while (isDIGIT(*s))
a687059c 1440 s++;
1441 if (*s == ',')
1442 s++;
f0fcb552 1443 while (isDIGIT(*s))
a687059c 1444 s++;
1445 if (*s != '}')
1446 return FALSE;
1447 return TRUE;
1448}
1449
1450#ifdef DEBUGGING
1451
1452/*
fd181c75 1453 - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
a687059c 1454 */
1455void
1456regdump(r)
1457regexp *r;
1458{
a0d0e21e 1459 register char *s;
bbce6d69 1460 register char op = EXACT; /* Arbitrary non-END op. */
a0d0e21e 1461 register char *next;
a687059c 1462
1463
a0d0e21e 1464 s = r->program + 1;
1465 while (op != END) { /* While that wasn't END last time... */
a687059c 1466#ifdef REGALIGN
a0d0e21e 1467 if (!((long)s & 1))
1468 s++;
a687059c 1469#endif
a0d0e21e 1470 op = OP(s);
760ac839 1471 PerlIO_printf(Perl_debug_log, "%2d%s", s-r->program, regprop(s)); /* Where, what. */
a0d0e21e 1472 next = regnext(s);
1473 s += regarglen[(U8)op];
1474 if (next == NULL) /* Next ptr. */
760ac839 1475 PerlIO_printf(Perl_debug_log, "(0)");
a0d0e21e 1476 else
760ac839 1477 PerlIO_printf(Perl_debug_log, "(%d)", (s-r->program)+(next-s));
a0d0e21e 1478 s += 3;
1479 if (op == ANYOF) {
bbce6d69 1480 s += 33;
a687059c 1481 }
bbce6d69 1482 if (regkind[(U8)op] == EXACT) {
a0d0e21e 1483 /* Literal string, where present. */
1484 s++;
760ac839 1485 (void)PerlIO_putc(Perl_debug_log, ' ');
1486 (void)PerlIO_putc(Perl_debug_log, '<');
a0d0e21e 1487 while (*s != '\0') {
760ac839 1488 (void)PerlIO_putc(Perl_debug_log,*s);
a0d0e21e 1489 s++;
1490 }
760ac839 1491 (void)PerlIO_putc(Perl_debug_log, '>');
a0d0e21e 1492 s++;
1493 }
760ac839 1494 (void)PerlIO_putc(Perl_debug_log, '\n');
a0d0e21e 1495 }
1496
1497 /* Header fields of interest. */
1498 if (r->regstart)
760ac839 1499 PerlIO_printf(Perl_debug_log, "start `%s' ", SvPVX(r->regstart));
a0d0e21e 1500 if (r->regstclass)
760ac839 1501 PerlIO_printf(Perl_debug_log, "stclass `%s' ", regprop(r->regstclass));
a0d0e21e 1502 if (r->reganch & ROPT_ANCH)
760ac839 1503 PerlIO_printf(Perl_debug_log, "anchored ");
a0d0e21e 1504 if (r->reganch & ROPT_SKIP)
760ac839 1505 PerlIO_printf(Perl_debug_log, "plus ");
a0d0e21e 1506 if (r->reganch & ROPT_IMPLICIT)
760ac839 1507 PerlIO_printf(Perl_debug_log, "implicit ");
a0d0e21e 1508 if (r->regmust != NULL)
760ac839 1509 PerlIO_printf(Perl_debug_log, "must have \"%s\" back %ld ", SvPVX(r->regmust),
a0d0e21e 1510 (long) r->regback);
760ac839 1511 PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen);
1512 PerlIO_printf(Perl_debug_log, "\n");
a687059c 1513}
1514
1515/*
a0d0e21e 1516- regprop - printable representation of opcode
1517*/
a687059c 1518char *
1519regprop(op)
1520char *op;
1521{
a0d0e21e 1522 register char *p = 0;
1523
1524 (void) strcpy(buf, ":");
1525
1526 switch (OP(op)) {
1527 case BOL:
1528 p = "BOL";
1529 break;
1530 case MBOL:
1531 p = "MBOL";
1532 break;
1533 case SBOL:
1534 p = "SBOL";
1535 break;
1536 case EOL:
1537 p = "EOL";
1538 break;
1539 case MEOL:
1540 p = "MEOL";
1541 break;
1542 case SEOL:
1543 p = "SEOL";
1544 break;
1545 case ANY:
1546 p = "ANY";
1547 break;
1548 case SANY:
1549 p = "SANY";
1550 break;
1551 case ANYOF:
1552 p = "ANYOF";
1553 break;
1554 case BRANCH:
1555 p = "BRANCH";
1556 break;
bbce6d69 1557 case EXACT:
1558 p = "EXACT";
1559 break;
1560 case EXACTF:
1561 p = "EXACTF";
1562 break;
1563 case EXACTFL:
1564 p = "EXACTFL";
a0d0e21e 1565 break;
1566 case NOTHING:
1567 p = "NOTHING";
1568 break;
1569 case BACK:
1570 p = "BACK";
1571 break;
1572 case END:
1573 p = "END";
1574 break;
a0d0e21e 1575 case BOUND:
1576 p = "BOUND";
1577 break;
bbce6d69 1578 case BOUNDL:
1579 p = "BOUNDL";
1580 break;
a0d0e21e 1581 case NBOUND:
1582 p = "NBOUND";
1583 break;
bbce6d69 1584 case NBOUNDL:
1585 p = "NBOUNDL";
a0d0e21e 1586 break;
1587 case CURLY:
1588 (void)sprintf(buf+strlen(buf), "CURLY {%d,%d}", ARG1(op),ARG2(op));
1589 p = NULL;
1590 break;
1591 case CURLYX:
1592 (void)sprintf(buf+strlen(buf), "CURLYX {%d,%d}", ARG1(op),ARG2(op));
1593 p = NULL;
1594 break;
1595 case REF:
1596 (void)sprintf(buf+strlen(buf), "REF%d", ARG1(op));
1597 p = NULL;
1598 break;
1599 case OPEN:
1600 (void)sprintf(buf+strlen(buf), "OPEN%d", ARG1(op));
1601 p = NULL;
1602 break;
1603 case CLOSE:
1604 (void)sprintf(buf+strlen(buf), "CLOSE%d", ARG1(op));
1605 p = NULL;
1606 break;
1607 case STAR:
1608 p = "STAR";
1609 break;
1610 case PLUS:
1611 p = "PLUS";
1612 break;
1613 case MINMOD:
1614 p = "MINMOD";
1615 break;
1616 case GBOL:
1617 p = "GBOL";
1618 break;
1619 case UNLESSM:
1620 p = "UNLESSM";
1621 break;
1622 case IFMATCH:
1623 p = "IFMATCH";
1624 break;
1625 case SUCCEED:
1626 p = "SUCCEED";
1627 break;
1628 case WHILEM:
1629 p = "WHILEM";
1630 break;
bbce6d69 1631 case DIGIT:
1632 p = "DIGIT";
1633 break;
1634 case NDIGIT:
1635 p = "NDIGIT";
1636 break;
1637 case ALNUM:
1638 p = "ALNUM";
1639 break;
1640 case NALNUM:
1641 p = "NALNUM";
1642 break;
1643 case SPACE:
1644 p = "SPACE";
1645 break;
1646 case NSPACE:
1647 p = "NSPACE";
1648 break;
1649 case ALNUML:
1650 p = "ALNUML";
1651 break;
1652 case NALNUML:
1653 p = "NALNUML";
1654 break;
1655 case SPACEL:
1656 p = "SPACEL";
1657 break;
1658 case NSPACEL:
1659 p = "NSPACEL";
1660 break;
a0d0e21e 1661 default:
1662 FAIL("corrupted regexp opcode");
1663 }
1664 if (p != NULL)
1665 (void) strcat(buf, p);
1666 return(buf);
a687059c 1667}
1668#endif /* DEBUGGING */
1669
2b69d0c2 1670void
e50aee73 1671pregfree(r)
a687059c 1672struct regexp *r;
1673{
a0d0e21e 1674 if (!r)
1675 return;
1676 if (r->precomp) {
1677 Safefree(r->precomp);
1678 r->precomp = Nullch;
1679 }
1680 if (r->subbase) {
1681 Safefree(r->subbase);
1682 r->subbase = Nullch;
1683 }
1684 if (r->regmust) {
1685 SvREFCNT_dec(r->regmust);
1686 r->regmust = Nullsv;
1687 }
1688 if (r->regstart) {
1689 SvREFCNT_dec(r->regstart);
1690 r->regstart = Nullsv;
1691 }
1692 Safefree(r->startp);
1693 Safefree(r->endp);
1694 Safefree(r);
a687059c 1695}
Unnamed repository; edit this file to name it for gitweb.