projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Locale-related pod patches, take 2
[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;
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':
bbce6d69 790 ret = regnode((regflags & PMf_LOCALE) ? ALNUML : ALNUM);
a0d0e21e 791 *flagp |= HASWIDTH|SIMPLE;
792 nextchar();
793 break;
794 case 'W':
bbce6d69 795 ret = regnode((regflags & PMf_LOCALE) ? NALNUML : NALNUM);
a0d0e21e 796 *flagp |= HASWIDTH|SIMPLE;
797 nextchar();
798 break;
799 case 'b':
bbce6d69 800 ret = regnode((regflags & PMf_LOCALE) ? BOUNDL : BOUND);
a0d0e21e 801 *flagp |= SIMPLE;
802 nextchar();
803 break;
804 case 'B':
bbce6d69 805 ret = regnode((regflags & PMf_LOCALE) ? NBOUNDL : NBOUND);
a0d0e21e 806 *flagp |= SIMPLE;
807 nextchar();
808 break;
809 case 's':
bbce6d69 810 ret = regnode((regflags & PMf_LOCALE) ? SPACEL : SPACE);
a0d0e21e 811 *flagp |= HASWIDTH|SIMPLE;
812 nextchar();
813 break;
814 case 'S':
bbce6d69 815 ret = regnode((regflags & PMf_LOCALE) ? NSPACEL : NSPACE);
a0d0e21e 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))
a687059c 851 regparse++;
a0d0e21e 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;
4633a7c4 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
a0d0e21e 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:
bbce6d69 884 ret = regnode((regflags & PMf_FOLD)
885 ? ((regflags & PMf_LOCALE) ? EXACTFL : EXACTF)
886 : EXACT);
a0d0e21e 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++;
a687059c 920 break;
a0d0e21e 921 case 'r':
922 ender = '\r';
923 p++;
a687059c 924 break;
a0d0e21e 925 case 't':
926 ender = '\t';
927 p++;
a687059c 928 break;
a0d0e21e 929 case 'f':
930 ender = '\f';
931 p++;
a687059c 932 break;
a0d0e21e 933 case 'e':
934 ender = '\033';
935 p++;
a687059c 936 break;
a0d0e21e 937 case 'a':
938 ender = '\007';
939 p++;
a687059c 940 break;
a0d0e21e 941 case 'x':
942 ender = scan_hex(++p, 2, &numlen);
943 p += numlen;
a687059c 944 break;
a0d0e21e 945 case 'c':
946 p++;
bbce6d69 947 ender = UCHARAT(p++);
948 ender = toCTRL(ender);
a687059c 949 break;
a0d0e21e 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;
a687059c 960 }
961 break;
a0d0e21e 962 case '\0':
963 if (p >= regxend)
a687059c 964 FAIL("trailing \\ in regexp");
965 /* FALL THROUGH */
a0d0e21e 966 default:
967 ender = *p++;
968 break;
969 }
970 break;
4633a7c4 971 case '#':
972 if (regflags & PMf_EXTENDED) {
973 while (p < regxend && *p != '\n') p++;
974 }
975 /* FALL THROUGH */
a0d0e21e 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 */
a687059c 983 default:
a0d0e21e 984 ender = *p++;
985 break;
a687059c 986 }
a0d0e21e 987 if (ISMULT2(p)) { /* Back off on ?+*. */
988 if (len)
989 p = oldp;
990 else {
991 len++;
992 regc(ender);
993 }
994 break;
a687059c 995 }
a0d0e21e 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');
a687059c 1010 }
a0d0e21e 1011 break;
1012 }
a687059c 1013
a0d0e21e 1014 return(ret);
a687059c 1015}
1016
1017static void
bbce6d69 1018regset(opnd, c)
1019char *opnd;
79072805 1020register I32 c;
a687059c 1021{
bbce6d69 1022 if (opnd == &regdummy)
1023 return;
1024 c &= 0xFF;
1025 opnd[1 + (c >> 3)] |= (1 << (c & 7));
a687059c 1026}
1027
1028static char *
1029regclass()
1030{
bbce6d69 1031 register char *opnd;
a0d0e21e 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);
bbce6d69 1040 opnd = regcode;
1041 for (class = 0; class < 33; class++)
1042 regc(0);
a0d0e21e 1043 if (*regparse == '^') { /* Complement of range. */
1044 regnaughty++;
1045 regparse++;
bbce6d69 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;
a0d0e21e 1054 }
a0d0e21e 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':
bbce6d69 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 }
a0d0e21e 1073 lastclass = 1234;
1074 continue;
1075 case 'W':
bbce6d69 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 }
a0d0e21e 1085 lastclass = 1234;
1086 continue;
1087 case 's':
bbce6d69 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 }
a0d0e21e 1097 lastclass = 1234;
1098 continue;
1099 case 'S':
bbce6d69 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 }
a0d0e21e 1109 lastclass = 1234;
1110 continue;
1111 case 'd':
1112 for (class = '0'; class <= '9'; class++)
bbce6d69 1113 regset(opnd, class);
a0d0e21e 1114 lastclass = 1234;
1115 continue;
1116 case 'D':
1117 for (class = 0; class < '0'; class++)
bbce6d69 1118 regset(opnd, class);
a0d0e21e 1119 for (class = '9' + 1; class < 256; class++)
bbce6d69 1120 regset(opnd, class);
a0d0e21e 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':
bbce6d69 1149 class = UCHARAT(regparse++);
1150 class = toCTRL(class);
a0d0e21e 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] != ']') {
a687059c 1168 regparse++;
a0d0e21e 1169 range = 1;
1170 continue; /* do it next time */
1171 }
a687059c 1172 }
bbce6d69 1173 for ( ; lastclass <= class; lastclass++)
1174 regset(opnd, lastclass);
a0d0e21e 1175 lastclass = class;
1176 }
1177 if (*regparse != ']')
1178 FAIL("unmatched [] in regexp");
1179 nextchar();
1180 return ret;
1181}
1182
1183static char*
1184nextchar()
1185{
1186 char* retval = regparse++;
1187
4633a7c4 1188 for (;;) {
1189 if (*regparse == '(' && regparse[1] == '?' &&
1190 regparse[2] == '#') {
1191 while (*regparse && *regparse != ')')
748a9306 1192 regparse++;
4633a7c4 1193 regparse++;
1194 continue;
1195 }
1196 if (regflags & PMf_EXTENDED) {
1197 if (isSPACE(*regparse)) {
748a9306 1198 regparse++;
1199 continue;
1200 }
1201 else if (*regparse == '#') {
1202 while (*regparse && *regparse != '\n')
1203 regparse++;
1204 regparse++;
1205 continue;
1206 }
748a9306 1207 }
4633a7c4 1208 return retval;
a0d0e21e 1209 }
a687059c 1210}
1211
1212/*
a0d0e21e 1213- regnode - emit a node
1214*/
1215#ifdef CAN_PROTOTYPE
1216static char * /* Location. */
1217regnode(char op)
1218#else
a687059c 1219static char * /* Location. */
1220regnode(op)
1221char op;
a0d0e21e 1222#endif
a687059c 1223{
a0d0e21e 1224 register char *ret;
1225 register char *ptr;
a687059c 1226
a0d0e21e 1227 ret = regcode;
1228 if (ret == &regdummy) {
a687059c 1229#ifdef REGALIGN
a0d0e21e 1230 if (!(regsize & 1))
1231 regsize++;
a687059c 1232#endif
a0d0e21e 1233 regsize += 3;
1234 return(ret);
1235 }
a687059c 1236
1237#ifdef REGALIGN
1238#ifndef lint
a0d0e21e 1239 if (!((long)ret & 1))
1240 *ret++ = 127;
a687059c 1241#endif
1242#endif
a0d0e21e 1243 ptr = ret;
1244 *ptr++ = op;
1245 *ptr++ = '\0'; /* Null "next" pointer. */
1246 *ptr++ = '\0';
1247 regcode = ptr;
a687059c 1248
a0d0e21e 1249 return(ret);
a687059c 1250}
1251
1252/*
a0d0e21e 1253- reganode - emit a node with an argument
1254*/
1255#ifdef CAN_PROTOTYPE
1256static char * /* Location. */
1257reganode(char op, unsigned short arg)
1258#else
fe14fcc3 1259static char * /* Location. */
1260reganode(op, arg)
1261char op;
1262unsigned short arg;
a0d0e21e 1263#endif
fe14fcc3 1264{
a0d0e21e 1265 register char *ret;
1266 register char *ptr;
fe14fcc3 1267
a0d0e21e 1268 ret = regcode;
1269 if (ret == &regdummy) {
fe14fcc3 1270#ifdef REGALIGN
a0d0e21e 1271 if (!(regsize & 1))
1272 regsize++;
fe14fcc3 1273#endif
a0d0e21e 1274 regsize += 5;
1275 return(ret);
1276 }
fe14fcc3 1277
1278#ifdef REGALIGN
1279#ifndef lint
a0d0e21e 1280 if (!((long)ret & 1))
1281 *ret++ = 127;
fe14fcc3 1282#endif
1283#endif
a0d0e21e 1284 ptr = ret;
1285 *ptr++ = op;
1286 *ptr++ = '\0'; /* Null "next" pointer. */
1287 *ptr++ = '\0';
fe14fcc3 1288#ifdef REGALIGN
a0d0e21e 1289 *(unsigned short *)(ret+3) = arg;
fe14fcc3 1290#else
a0d0e21e 1291 ret[3] = arg >> 8; ret[4] = arg & 0377;
fe14fcc3 1292#endif
a0d0e21e 1293 ptr += 2;
1294 regcode = ptr;
fe14fcc3 1295
a0d0e21e 1296 return(ret);
fe14fcc3 1297}
1298
1299/*
a0d0e21e 1300- regc - emit (if appropriate) a byte of code
1301*/
1302#ifdef CAN_PROTOTYPE
1303static void
1304regc(char b)
1305#else
a687059c 1306static void
1307regc(b)
1308char b;
a0d0e21e 1309#endif
a687059c 1310{
a0d0e21e 1311 if (regcode != &regdummy)
1312 *regcode++ = b;
1313 else
1314 regsize++;
a687059c 1315}
1316
1317/*
a0d0e21e 1318- reginsert - insert an operator in front of already-emitted operand
1319*
1320* Means relocating the operand.
1321*/
1322#ifdef CAN_PROTOTYPE
1323static void
1324reginsert(char op, char *opnd)
1325#else
a687059c 1326static void
1327reginsert(op, opnd)
1328char op;
1329char *opnd;
a0d0e21e 1330#endif
a687059c 1331{
a0d0e21e 1332 register char *src;
1333 register char *dst;
1334 register char *place;
1335 register int offset = (regkind[(U8)op] == CURLY ? 4 : 0);
a687059c 1336
a0d0e21e 1337 if (regcode == &regdummy) {
a687059c 1338#ifdef REGALIGN
a0d0e21e 1339 regsize += 4 + offset;
a687059c 1340#else
a0d0e21e 1341 regsize += 3 + offset;
a687059c 1342#endif
a0d0e21e 1343 return;
1344 }
a687059c 1345
a0d0e21e 1346 src = regcode;
a687059c 1347#ifdef REGALIGN
a0d0e21e 1348 regcode += 4 + offset;
a687059c 1349#else
a0d0e21e 1350 regcode += 3 + offset;
a687059c 1351#endif
a0d0e21e 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)
a687059c 1361 *place++ = '\0';
2b69d0c2 1362#ifdef REGALIGN
a0d0e21e 1363 *place++ = '\177';
2b69d0c2 1364#endif
a687059c 1365}
1366
1367/*
a0d0e21e 1368- regtail - set the next-pointer at the end of a node chain
1369*/
a687059c 1370static void
1371regtail(p, val)
1372char *p;
1373char *val;
1374{
a0d0e21e 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 }
a687059c 1390
1391#ifdef REGALIGN
a0d0e21e 1392 offset = val - scan;
a687059c 1393#ifndef lint
a0d0e21e 1394 *(short*)(scan+1) = offset;
a687059c 1395#else
a0d0e21e 1396 offset = offset;
a687059c 1397#endif
1398#else
a0d0e21e 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;
a687059c 1405#endif
1406}
1407
1408/*
a0d0e21e 1409- regoptail - regtail on operand of first argument; nop if operandless
1410*/
a687059c 1411static void
1412regoptail(p, val)
1413char *p;
1414char *val;
1415{
a0d0e21e 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);
a687059c 1420}
1421
1422/*
1423 - regcurly - a little FSA that accepts {\d+,?\d*}
1424 */
79072805 1425STATIC I32
a687059c 1426regcurly(s)
1427register char *s;
1428{
1429 if (*s++ != '{')
1430 return FALSE;
f0fcb552 1431 if (!isDIGIT(*s))
a687059c 1432 return FALSE;
f0fcb552 1433 while (isDIGIT(*s))
a687059c 1434 s++;
1435 if (*s == ',')
1436 s++;
f0fcb552 1437 while (isDIGIT(*s))
a687059c 1438 s++;
1439 if (*s != '}')
1440 return FALSE;
1441 return TRUE;
1442}
1443
1444#ifdef DEBUGGING
1445
1446/*
fd181c75 1447 - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
a687059c 1448 */
1449void
1450regdump(r)
1451regexp *r;
1452{
a0d0e21e 1453 register char *s;
bbce6d69 1454 register char op = EXACT; /* Arbitrary non-END op. */
a0d0e21e 1455 register char *next;
a687059c 1456
1457
a0d0e21e 1458 s = r->program + 1;
1459 while (op != END) { /* While that wasn't END last time... */
a687059c 1460#ifdef REGALIGN
a0d0e21e 1461 if (!((long)s & 1))
1462 s++;
a687059c 1463#endif
a0d0e21e 1464 op = OP(s);
760ac839 1465 PerlIO_printf(Perl_debug_log, "%2d%s", s-r->program, regprop(s)); /* Where, what. */
a0d0e21e 1466 next = regnext(s);
1467 s += regarglen[(U8)op];
1468 if (next == NULL) /* Next ptr. */
760ac839 1469 PerlIO_printf(Perl_debug_log, "(0)");
a0d0e21e 1470 else
760ac839 1471 PerlIO_printf(Perl_debug_log, "(%d)", (s-r->program)+(next-s));
a0d0e21e 1472 s += 3;
1473 if (op == ANYOF) {
bbce6d69 1474 s += 33;
a687059c 1475 }
bbce6d69 1476 if (regkind[(U8)op] == EXACT) {
a0d0e21e 1477 /* Literal string, where present. */
1478 s++;
760ac839 1479 (void)PerlIO_putc(Perl_debug_log, ' ');
1480 (void)PerlIO_putc(Perl_debug_log, '<');
a0d0e21e 1481 while (*s != '\0') {
760ac839 1482 (void)PerlIO_putc(Perl_debug_log,*s);
a0d0e21e 1483 s++;
1484 }
760ac839 1485 (void)PerlIO_putc(Perl_debug_log, '>');
a0d0e21e 1486 s++;
1487 }
760ac839 1488 (void)PerlIO_putc(Perl_debug_log, '\n');
a0d0e21e 1489 }
1490
1491 /* Header fields of interest. */
1492 if (r->regstart)
760ac839 1493 PerlIO_printf(Perl_debug_log, "start `%s' ", SvPVX(r->regstart));
a0d0e21e 1494 if (r->regstclass)
760ac839 1495 PerlIO_printf(Perl_debug_log, "stclass `%s' ", regprop(r->regstclass));
a0d0e21e 1496 if (r->reganch & ROPT_ANCH)
760ac839 1497 PerlIO_printf(Perl_debug_log, "anchored ");
a0d0e21e 1498 if (r->reganch & ROPT_SKIP)
760ac839 1499 PerlIO_printf(Perl_debug_log, "plus ");
a0d0e21e 1500 if (r->reganch & ROPT_IMPLICIT)
760ac839 1501 PerlIO_printf(Perl_debug_log, "implicit ");
a0d0e21e 1502 if (r->regmust != NULL)
760ac839 1503 PerlIO_printf(Perl_debug_log, "must have \"%s\" back %ld ", SvPVX(r->regmust),
a0d0e21e 1504 (long) r->regback);
760ac839 1505 PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen);
1506 PerlIO_printf(Perl_debug_log, "\n");
a687059c 1507}
1508
1509/*
a0d0e21e 1510- regprop - printable representation of opcode
1511*/
a687059c 1512char *
1513regprop(op)
1514char *op;
1515{
a0d0e21e 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;
bbce6d69 1551 case EXACT:
1552 p = "EXACT";
1553 break;
1554 case EXACTF:
1555 p = "EXACTF";
1556 break;
1557 case EXACTFL:
1558 p = "EXACTFL";
a0d0e21e 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;
a0d0e21e 1569 case BOUND:
1570 p = "BOUND";
1571 break;
bbce6d69 1572 case BOUNDL:
1573 p = "BOUNDL";
1574 break;
a0d0e21e 1575 case NBOUND:
1576 p = "NBOUND";
1577 break;
bbce6d69 1578 case NBOUNDL:
1579 p = "NBOUNDL";
a0d0e21e 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;
bbce6d69 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;
a0d0e21e 1655 default:
1656 FAIL("corrupted regexp opcode");
1657 }
1658 if (p != NULL)
1659 (void) strcat(buf, p);
1660 return(buf);
a687059c 1661}
1662#endif /* DEBUGGING */
1663
2b69d0c2 1664void
e50aee73 1665pregfree(r)
a687059c 1666struct regexp *r;
1667{
a0d0e21e 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);
a687059c 1689}
Unnamed repository; edit this file to name it for gitweb.