projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
[inseparable changes from patch from perl5.003_22 to perl5.003_23]
[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) {
774d564b 231 r->reganch |= ROPT_ANCH_BOL;
a0d0e21e 232 first = NEXTOPER(first);
774d564b 233 goto again;
234 }
235 else if (OP(first) == GPOS) {
236 r->reganch |= ROPT_ANCH_GPOS;
237 first = NEXTOPER(first);
238 goto again;
a0d0e21e 239 }
240 else if ((OP(first) == STAR &&
241 regkind[(U8)OP(NEXTOPER(first))] == ANY) &&
242 !(r->reganch & ROPT_ANCH) )
243 {
244 /* turn .* into ^.* with an implied $*=1 */
774d564b 245 r->reganch |= ROPT_ANCH_BOL | ROPT_IMPLICIT;
a0d0e21e 246 first = NEXTOPER(first);
774d564b 247 goto again;
a0d0e21e 248 }
249 if (sawplus && (!sawopen || !regsawback))
250 r->reganch |= ROPT_SKIP; /* x+ must match 1st of run */
251
760ac839 252 DEBUG_r(PerlIO_printf(Perl_debug_log, "first %d next %d offset %d\n",
a0d0e21e 253 OP(first), OP(NEXTOPER(first)), first - scan));
254 /*
255 * If there's something expensive in the r.e., find the
256 * longest literal string that must appear and make it the
257 * regmust. Resolve ties in favor of later strings, since
258 * the regstart check works with the beginning of the r.e.
259 * and avoiding duplication strengthens checking. Not a
260 * strong reason, but sufficient in the absence of others.
261 * [Now we resolve ties in favor of the earlier string if
262 * it happens that curback has been invalidated, since the
263 * earlier string may buy us something the later one won't.]
264 */
265 longish = newSVpv("",0);
266 longest = newSVpv("",0);
267 len = 0;
268 minlen = 0;
269 curback = 0;
270 backish = 0;
271 backest = 0;
272 while (OP(scan) != END) {
273 if (OP(scan) == BRANCH) {
274 if (OP(regnext(scan)) == BRANCH) {
275 curback = -30000;
276 while (OP(scan) == BRANCH)
277 scan = regnext(scan);
00bf170e 278 }
a0d0e21e 279 else /* single branch is ok */
280 scan = NEXTOPER(scan);
748a9306 281 continue;
a0d0e21e 282 }
283 if (OP(scan) == UNLESSM) {
284 curback = -30000;
285 scan = regnext(scan);
748a9306 286 continue;
a0d0e21e 287 }
bbce6d69 288 if (OP(scan) == EXACT) {
a0d0e21e 289 char *t;
a687059c 290
a0d0e21e 291 first = scan;
292 while (OP(t = regnext(scan)) == CLOSE)
293 scan = t;
294 minlen += *OPERAND(first);
295 if (curback - backish == len) {
296 sv_catpvn(longish, OPERAND(first)+1,
297 *OPERAND(first));
298 len += *OPERAND(first);
299 curback += *OPERAND(first);
300 first = regnext(scan);
2b69d0c2 301 }
a0d0e21e 302 else if (*OPERAND(first) >= len + (curback >= 0)) {
303 len = *OPERAND(first);
304 sv_setpvn(longish, OPERAND(first)+1,len);
305 backish = curback;
306 curback += len;
307 first = regnext(scan);
9ef589d8 308 }
a0d0e21e 309 else
310 curback += *OPERAND(first);
311 }
312 else if (strchr(varies,OP(scan))) {
313 curback = -30000;
a687059c 314 len = 0;
a0d0e21e 315 if (SvCUR(longish) > SvCUR(longest)) {
79072805 316 sv_setsv(longest,longish);
34de22dd 317 backest = backish;
318 }
a0d0e21e 319 sv_setpvn(longish,"",0);
320 if (OP(scan) == PLUS && strchr(simple,OP(NEXTOPER(scan))))
321 minlen++;
322 else if (regkind[(U8)OP(scan)] == CURLY &&
323 strchr(simple,OP(NEXTOPER(scan)+4)))
324 minlen += ARG1(scan);
325 }
326 else if (strchr(simple,OP(scan))) {
327 curback++;
328 minlen++;
329 len = 0;
330 if (SvCUR(longish) > SvCUR(longest)) {
331 sv_setsv(longest,longish);
332 backest = backish;
fe14fcc3 333 }
a0d0e21e 334 sv_setpvn(longish,"",0);
335 }
336 scan = regnext(scan);
a687059c 337 }
338
a0d0e21e 339 /* Prefer earlier on tie, unless we can tail match latter */
340
bbce6d69 341 if (SvCUR(longish) + (regkind[(U8)OP(first)] == EOL)
342 > SvCUR(longest))
a0d0e21e 343 {
344 sv_setsv(longest,longish);
345 backest = backish;
346 }
347 else
348 sv_setpvn(longish,"",0);
349 if (SvCUR(longest)
bbce6d69 350 && (!r->regstart
351 || !fbm_instr((unsigned char*) SvPVX(r->regstart),
352 (unsigned char *) (SvPVX(r->regstart)
353 + SvCUR(r->regstart)),
354 longest)))
a0d0e21e 355 {
356 r->regmust = longest;
357 if (backest < 0)
358 backest = -1;
359 r->regback = backest;
bbce6d69 360 if (SvCUR(longest) > !(sawstudy || regkind[(U8)OP(first)] == EOL))
361 fbm_compile(r->regmust);
a0d0e21e 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
a0d0e21e 374 r->nparens = regnpar - 1;
375 r->minlen = minlen;
376 Newz(1002, r->startp, regnpar, char*);
377 Newz(1002, r->endp, regnpar, char*);
378 DEBUG_r(regdump(r));
379 return(r);
a687059c 380}
381
382/*
383 - reg - regular expression, i.e. main body or parenthesized thing
384 *
385 * Caller must absorb opening parenthesis.
386 *
387 * Combining parenthesis handling with the base level of regular expression
388 * is a trifle forced, but the need to tie the tails of the branches to what
389 * follows makes it hard to avoid.
390 */
391static char *
392reg(paren, flagp)
79072805 393I32 paren; /* Parenthesized? */
394I32 *flagp;
a687059c 395{
a0d0e21e 396 register char *ret;
397 register char *br;
398 register char *ender = 0;
399 register I32 parno = 0;
400 I32 flags;
401
402 *flagp = HASWIDTH; /* Tentatively. */
403
404 /* Make an OPEN node, if parenthesized. */
405 if (paren) {
406 if (*regparse == '?') {
407 regparse++;
748a9306 408 paren = *regparse++;
a0d0e21e 409 ret = NULL;
410 switch (paren) {
411 case ':':
412 case '=':
413 case '!':
414 break;
415 case '$':
416 case '@':
417 croak("Sequence (?%c...) not implemented", paren);
418 break;
419 case '#':
420 while (*regparse && *regparse != ')')
421 regparse++;
422 if (*regparse != ')')
748a9306 423 croak("Sequence (?#... not terminated");
a0d0e21e 424 nextchar();
425 *flagp = TRYAGAIN;
426 return NULL;
427 default:
428 --regparse;
429 while (*regparse && strchr("iogmsx", *regparse))
430 pmflag(&regflags, *regparse++);
431 if (*regparse != ')')
432 croak("Sequence (?%c...) not recognized", *regparse);
433 nextchar();
434 *flagp = TRYAGAIN;
435 return NULL;
436 }
437 }
438 else {
439 parno = regnpar;
440 regnpar++;
441 ret = reganode(OPEN, parno);
442 }
443 } else
444 ret = NULL;
445
446 /* Pick up the branches, linking them together. */
447 br = regbranch(&flags);
448 if (br == NULL)
449 return(NULL);
450 if (ret != NULL)
451 regtail(ret, br); /* OPEN -> first. */
452 else
453 ret = br;
454 if (!(flags&HASWIDTH))
455 *flagp &= ~HASWIDTH;
456 *flagp |= flags&SPSTART;
457 while (*regparse == '|') {
458 nextchar();
a687059c 459 br = regbranch(&flags);
460 if (br == NULL)
a0d0e21e 461 return(NULL);
462 regtail(ret, br); /* BRANCH -> BRANCH. */
a687059c 463 if (!(flags&HASWIDTH))
a0d0e21e 464 *flagp &= ~HASWIDTH;
a687059c 465 *flagp |= flags&SPSTART;
a0d0e21e 466 }
467
468 /* Make a closing node, and hook it on the end. */
469 switch (paren) {
470 case ':':
471 ender = regnode(NOTHING);
472 break;
473 case 1:
474 ender = reganode(CLOSE, parno);
475 break;
476 case '=':
477 case '!':
478 ender = regnode(SUCCEED);
479 *flagp &= ~HASWIDTH;
480 break;
481 case 0:
482 ender = regnode(END);
483 break;
484 }
485 regtail(ret, ender);
486
487 /* Hook the tails of the branches to the closing node. */
488 for (br = ret; br != NULL; br = regnext(br))
489 regoptail(br, ender);
490
491 if (paren == '=') {
492 reginsert(IFMATCH,ret);
493 regtail(ret, regnode(NOTHING));
494 }
495 else if (paren == '!') {
496 reginsert(UNLESSM,ret);
497 regtail(ret, regnode(NOTHING));
498 }
499
500 /* Check for proper termination. */
4633a7c4 501 if (paren && (regparse >= regxend || *nextchar() != ')')) {
a0d0e21e 502 FAIL("unmatched () in regexp");
503 } else if (!paren && regparse < regxend) {
504 if (*regparse == ')') {
505 FAIL("unmatched () in regexp");
506 } else
507 FAIL("junk on end of regexp"); /* "Can't happen". */
508 /* NOTREACHED */
509 }
a687059c 510
a0d0e21e 511 return(ret);
a687059c 512}
513
514/*
515 - regbranch - one alternative of an | operator
516 *
517 * Implements the concatenation operator.
518 */
519static char *
520regbranch(flagp)
79072805 521I32 *flagp;
a687059c 522{
a0d0e21e 523 register char *ret;
524 register char *chain;
525 register char *latest;
526 I32 flags = 0;
527
528 *flagp = WORST; /* Tentatively. */
529
530 ret = regnode(BRANCH);
531 chain = NULL;
532 regparse--;
533 nextchar();
534 while (regparse < regxend && *regparse != '|' && *regparse != ')') {
535 flags &= ~TRYAGAIN;
536 latest = regpiece(&flags);
537 if (latest == NULL) {
538 if (flags & TRYAGAIN)
539 continue;
540 return(NULL);
541 }
542 *flagp |= flags&HASWIDTH;
543 if (chain == NULL) /* First piece. */
544 *flagp |= flags&SPSTART;
545 else {
546 regnaughty++;
547 regtail(chain, latest);
a687059c 548 }
a0d0e21e 549 chain = latest;
550 }
551 if (chain == NULL) /* Loop ran zero times. */
552 (void) regnode(NOTHING);
a687059c 553
a0d0e21e 554 return(ret);
a687059c 555}
556
557/*
558 - regpiece - something followed by possible [*+?]
559 *
560 * Note that the branching code sequences used for ? and the general cases
561 * of * and + are somewhat optimized: they use the same NOTHING node as
562 * both the endmarker for their branch list and the body of the last branch.
563 * It might seem that this node could be dispensed with entirely, but the
564 * endmarker role is not redundant.
565 */
566static char *
567regpiece(flagp)
79072805 568I32 *flagp;
a687059c 569{
a0d0e21e 570 register char *ret;
571 register char op;
572 register char *next;
573 I32 flags;
574 char *origparse = regparse;
575 char *maxpos;
576 I32 min;
577 I32 max = 32767;
578
579 ret = regatom(&flags);
580 if (ret == NULL) {
581 if (flags & TRYAGAIN)
582 *flagp |= TRYAGAIN;
583 return(NULL);
584 }
585
586 op = *regparse;
587 if (op == '(' && regparse[1] == '?' && regparse[2] == '#') {
588 while (op && op != ')')
589 op = *++regparse;
590 if (op) {
591 nextchar();
592 op = *regparse;
593 }
594 }
595
596 if (op == '{' && regcurly(regparse)) {
597 next = regparse + 1;
598 maxpos = Nullch;
599 while (isDIGIT(*next) || *next == ',') {
600 if (*next == ',') {
601 if (maxpos)
602 break;
603 else
604 maxpos = next;
a687059c 605 }
a0d0e21e 606 next++;
607 }
608 if (*next == '}') { /* got one */
609 if (!maxpos)
610 maxpos = next;
611 regparse++;
612 min = atoi(regparse);
613 if (*maxpos == ',')
614 maxpos++;
615 else
616 maxpos = regparse;
617 max = atoi(maxpos);
618 if (!max && *maxpos != '0')
619 max = 32767; /* meaning "infinity" */
620 regparse = next;
621 nextchar();
622
623 do_curly:
624 if ((flags&SIMPLE)) {
625 regnaughty += 2 + regnaughty / 2;
626 reginsert(CURLY, ret);
627 }
628 else {
629 regnaughty += 4 + regnaughty; /* compound interest */
630 regtail(ret, regnode(WHILEM));
631 reginsert(CURLYX,ret);
632 regtail(ret, regnode(NOTHING));
633 }
634
635 if (min > 0)
636 *flagp = (WORST|HASWIDTH);
637 if (max && max < min)
638 croak("Can't do {n,m} with n > m");
639 if (regcode != &regdummy) {
00bf170e 640#ifdef REGALIGN
a0d0e21e 641 *(unsigned short *)(ret+3) = min;
642 *(unsigned short *)(ret+5) = max;
00bf170e 643#else
a0d0e21e 644 ret[3] = min >> 8; ret[4] = min & 0377;
645 ret[5] = max >> 8; ret[6] = max & 0377;
00bf170e 646#endif
a687059c 647 }
a687059c 648
a0d0e21e 649 goto nest_check;
a687059c 650 }
a0d0e21e 651 }
a687059c 652
a0d0e21e 653 if (!ISMULT1(op)) {
654 *flagp = flags;
a687059c 655 return(ret);
a0d0e21e 656 }
657 nextchar();
658
659 *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);
660
661 if (op == '*' && (flags&SIMPLE)) {
662 reginsert(STAR, ret);
663 regnaughty += 4;
664 }
665 else if (op == '*') {
666 min = 0;
667 goto do_curly;
668 } else if (op == '+' && (flags&SIMPLE)) {
669 reginsert(PLUS, ret);
670 regnaughty += 3;
671 }
672 else if (op == '+') {
673 min = 1;
674 goto do_curly;
675 } else if (op == '?') {
676 min = 0; max = 1;
677 goto do_curly;
678 }
679 nest_check:
680 if (dowarn && regcode != &regdummy && !(flags&HASWIDTH) && max > 10000) {
681 warn("%.*s matches null string many times",
682 regparse - origparse, origparse);
683 }
684
685 if (*regparse == '?') {
686 nextchar();
687 reginsert(MINMOD, ret);
688#ifdef REGALIGN
689 regtail(ret, ret + 4);
690#else
691 regtail(ret, ret + 3);
692#endif
693 }
694 if (ISMULT2(regparse))
695 FAIL("nested *?+ in regexp");
696
697 return(ret);
a687059c 698}
699
700/*
701 - regatom - the lowest level
702 *
703 * Optimization: gobbles an entire sequence of ordinary characters so that
704 * it can turn them into a single node, which is smaller to store and
705 * faster to run. Backslashed characters are exceptions, each becoming a
706 * separate node; the code is simpler that way and it's not worth fixing.
707 *
708 * [Yes, it is worth fixing, some scripts can run twice the speed.]
709 */
710static char *
711regatom(flagp)
79072805 712I32 *flagp;
a687059c 713{
a0d0e21e 714 register char *ret = 0;
715 I32 flags;
716
717 *flagp = WORST; /* Tentatively. */
718
719tryagain:
720 switch (*regparse) {
721 case '^':
722 nextchar();
723 if (regflags & PMf_MULTILINE)
724 ret = regnode(MBOL);
725 else if (regflags & PMf_SINGLELINE)
726 ret = regnode(SBOL);
727 else
728 ret = regnode(BOL);
729 break;
730 case '$':
731 nextchar();
732 if (regflags & PMf_MULTILINE)
733 ret = regnode(MEOL);
734 else if (regflags & PMf_SINGLELINE)
735 ret = regnode(SEOL);
736 else
737 ret = regnode(EOL);
738 break;
739 case '.':
740 nextchar();
741 if (regflags & PMf_SINGLELINE)
742 ret = regnode(SANY);
743 else
744 ret = regnode(ANY);
745 regnaughty++;
746 *flagp |= HASWIDTH|SIMPLE;
747 break;
748 case '[':
749 regparse++;
750 ret = regclass();
751 *flagp |= HASWIDTH|SIMPLE;
752 break;
753 case '(':
754 nextchar();
755 ret = reg(1, &flags);
756 if (ret == NULL) {
757 if (flags & TRYAGAIN)
758 goto tryagain;
759 return(NULL);
760 }
761 *flagp |= flags&(HASWIDTH|SPSTART);
762 break;
763 case '|':
764 case ')':
765 if (flags & TRYAGAIN) {
766 *flagp |= TRYAGAIN;
767 return NULL;
768 }
769 croak("internal urp in regexp at /%s/", regparse);
770 /* Supposed to be caught earlier. */
771 break;
85afd4ae 772 case '{':
773 if (!regcurly(regparse)) {
774 regparse++;
775 goto defchar;
776 }
777 /* FALL THROUGH */
a0d0e21e 778 case '?':
779 case '+':
780 case '*':
3115e423 781 FAIL("?+*{} follows nothing in regexp");
a0d0e21e 782 break;
783 case '\\':
784 switch (*++regparse) {
785 case 'A':
786 ret = regnode(SBOL);
787 *flagp |= SIMPLE;
788 nextchar();
789 break;
790 case 'G':
774d564b 791 ret = regnode(GPOS);
a0d0e21e 792 *flagp |= SIMPLE;
793 nextchar();
794 break;
795 case 'Z':
796 ret = regnode(SEOL);
797 *flagp |= SIMPLE;
798 nextchar();
799 break;
800 case 'w':
bbce6d69 801 ret = regnode((regflags & PMf_LOCALE) ? ALNUML : ALNUM);
a0d0e21e 802 *flagp |= HASWIDTH|SIMPLE;
803 nextchar();
804 break;
805 case 'W':
bbce6d69 806 ret = regnode((regflags & PMf_LOCALE) ? NALNUML : NALNUM);
a0d0e21e 807 *flagp |= HASWIDTH|SIMPLE;
808 nextchar();
809 break;
810 case 'b':
bbce6d69 811 ret = regnode((regflags & PMf_LOCALE) ? BOUNDL : BOUND);
a0d0e21e 812 *flagp |= SIMPLE;
813 nextchar();
814 break;
815 case 'B':
bbce6d69 816 ret = regnode((regflags & PMf_LOCALE) ? NBOUNDL : NBOUND);
a0d0e21e 817 *flagp |= SIMPLE;
818 nextchar();
819 break;
820 case 's':
bbce6d69 821 ret = regnode((regflags & PMf_LOCALE) ? SPACEL : SPACE);
a0d0e21e 822 *flagp |= HASWIDTH|SIMPLE;
823 nextchar();
824 break;
825 case 'S':
bbce6d69 826 ret = regnode((regflags & PMf_LOCALE) ? NSPACEL : NSPACE);
a0d0e21e 827 *flagp |= HASWIDTH|SIMPLE;
828 nextchar();
829 break;
830 case 'd':
831 ret = regnode(DIGIT);
832 *flagp |= HASWIDTH|SIMPLE;
833 nextchar();
834 break;
835 case 'D':
836 ret = regnode(NDIGIT);
837 *flagp |= HASWIDTH|SIMPLE;
838 nextchar();
839 break;
840 case 'n':
841 case 'r':
842 case 't':
843 case 'f':
844 case 'e':
845 case 'a':
846 case 'x':
847 case 'c':
848 case '0':
849 goto defchar;
850 case '1': case '2': case '3': case '4':
851 case '5': case '6': case '7': case '8': case '9':
852 {
853 I32 num = atoi(regparse);
854
855 if (num > 9 && num >= regnpar)
856 goto defchar;
857 else {
858 regsawback = 1;
859 ret = reganode(REF, num);
860 *flagp |= HASWIDTH;
861 while (isDIGIT(*regparse))
a687059c 862 regparse++;
a0d0e21e 863 regparse--;
864 nextchar();
865 }
866 }
867 break;
868 case '\0':
869 if (regparse >= regxend)
870 FAIL("trailing \\ in regexp");
871 /* FALL THROUGH */
872 default:
873 goto defchar;
874 }
875 break;
4633a7c4 876
877 case '#':
878 if (regflags & PMf_EXTENDED) {
879 while (regparse < regxend && *regparse != '\n') regparse++;
880 if (regparse < regxend)
881 goto tryagain;
882 }
883 /* FALL THROUGH */
884
a0d0e21e 885 default: {
886 register I32 len;
887 register char ender;
888 register char *p;
889 char *oldp;
890 I32 numlen;
891
892 regparse++;
893
894 defchar:
bbce6d69 895 ret = regnode((regflags & PMf_FOLD)
896 ? ((regflags & PMf_LOCALE) ? EXACTFL : EXACTF)
897 : EXACT);
a0d0e21e 898 regc(0); /* save spot for len */
899 for (len = 0, p = regparse - 1;
900 len < 127 && p < regxend;
901 len++)
902 {
903 oldp = p;
904 switch (*p) {
905 case '^':
906 case '$':
907 case '.':
908 case '[':
909 case '(':
910 case ')':
911 case '|':
912 goto loopdone;
913 case '\\':
914 switch (*++p) {
915 case 'A':
916 case 'G':
917 case 'Z':
918 case 'w':
919 case 'W':
920 case 'b':
921 case 'B':
922 case 's':
923 case 'S':
924 case 'd':
925 case 'D':
926 --p;
927 goto loopdone;
928 case 'n':
929 ender = '\n';
930 p++;
a687059c 931 break;
a0d0e21e 932 case 'r':
933 ender = '\r';
934 p++;
a687059c 935 break;
a0d0e21e 936 case 't':
937 ender = '\t';
938 p++;
a687059c 939 break;
a0d0e21e 940 case 'f':
941 ender = '\f';
942 p++;
a687059c 943 break;
a0d0e21e 944 case 'e':
945 ender = '\033';
946 p++;
a687059c 947 break;
a0d0e21e 948 case 'a':
949 ender = '\007';
950 p++;
a687059c 951 break;
a0d0e21e 952 case 'x':
953 ender = scan_hex(++p, 2, &numlen);
954 p += numlen;
a687059c 955 break;
a0d0e21e 956 case 'c':
957 p++;
bbce6d69 958 ender = UCHARAT(p++);
959 ender = toCTRL(ender);
a687059c 960 break;
a0d0e21e 961 case '0': case '1': case '2': case '3':case '4':
962 case '5': case '6': case '7': case '8':case '9':
963 if (*p == '0' ||
964 (isDIGIT(p[1]) && atoi(p) >= regnpar) ) {
965 ender = scan_oct(p, 3, &numlen);
966 p += numlen;
967 }
968 else {
969 --p;
970 goto loopdone;
a687059c 971 }
972 break;
a0d0e21e 973 case '\0':
974 if (p >= regxend)
a687059c 975 FAIL("trailing \\ in regexp");
976 /* FALL THROUGH */
a0d0e21e 977 default:
978 ender = *p++;
979 break;
980 }
981 break;
4633a7c4 982 case '#':
983 if (regflags & PMf_EXTENDED) {
984 while (p < regxend && *p != '\n') p++;
985 }
986 /* FALL THROUGH */
a0d0e21e 987 case ' ': case '\t': case '\n': case '\r': case '\f': case '\v':
988 if (regflags & PMf_EXTENDED) {
989 p++;
990 len--;
991 continue;
992 }
993 /* FALL THROUGH */
a687059c 994 default:
a0d0e21e 995 ender = *p++;
996 break;
a687059c 997 }
a0d0e21e 998 if (ISMULT2(p)) { /* Back off on ?+*. */
999 if (len)
1000 p = oldp;
1001 else {
1002 len++;
1003 regc(ender);
1004 }
1005 break;
a687059c 1006 }
a0d0e21e 1007 regc(ender);
1008 }
1009 loopdone:
1010 regparse = p - 1;
1011 nextchar();
1012 if (len < 0)
1013 FAIL("internal disaster in regexp");
1014 if (len > 0)
1015 *flagp |= HASWIDTH;
1016 if (len == 1)
1017 *flagp |= SIMPLE;
1018 if (regcode != &regdummy)
1019 *OPERAND(ret) = len;
1020 regc('\0');
a687059c 1021 }
a0d0e21e 1022 break;
1023 }
a687059c 1024
a0d0e21e 1025 return(ret);
a687059c 1026}
1027
1028static void
bbce6d69 1029regset(opnd, c)
1030char *opnd;
79072805 1031register I32 c;
a687059c 1032{
bbce6d69 1033 if (opnd == &regdummy)
1034 return;
1035 c &= 0xFF;
1036 opnd[1 + (c >> 3)] |= (1 << (c & 7));
a687059c 1037}
1038
1039static char *
1040regclass()
1041{
bbce6d69 1042 register char *opnd;
a0d0e21e 1043 register I32 class;
1044 register I32 lastclass = 1234;
1045 register I32 range = 0;
1046 register char *ret;
1047 register I32 def;
1048 I32 numlen;
1049
1050 ret = regnode(ANYOF);
bbce6d69 1051 opnd = regcode;
1052 for (class = 0; class < 33; class++)
1053 regc(0);
a0d0e21e 1054 if (*regparse == '^') { /* Complement of range. */
1055 regnaughty++;
1056 regparse++;
bbce6d69 1057 if (opnd != &regdummy)
1058 *opnd |= ANYOF_INVERT;
1059 }
1060 if (opnd != &regdummy) {
1061 if (regflags & PMf_FOLD)
1062 *opnd |= ANYOF_FOLD;
1063 if (regflags & PMf_LOCALE)
1064 *opnd |= ANYOF_LOCALE;
a0d0e21e 1065 }
a0d0e21e 1066 if (*regparse == ']' || *regparse == '-')
1067 goto skipcond; /* allow 1st char to be ] or - */
1068 while (regparse < regxend && *regparse != ']') {
1069 skipcond:
1070 class = UCHARAT(regparse++);
1071 if (class == '\\') {
1072 class = UCHARAT(regparse++);
1073 switch (class) {
1074 case 'w':
bbce6d69 1075 if (regflags & PMf_LOCALE) {
1076 if (opnd != &regdummy)
1077 *opnd |= ANYOF_ALNUML;
1078 }
1079 else {
1080 for (class = 0; class < 256; class++)
1081 if (isALNUM(class))
1082 regset(opnd, class);
1083 }
a0d0e21e 1084 lastclass = 1234;
1085 continue;
1086 case 'W':
bbce6d69 1087 if (regflags & PMf_LOCALE) {
1088 if (opnd != &regdummy)
1089 *opnd |= ANYOF_NALNUML;
1090 }
1091 else {
1092 for (class = 0; class < 256; class++)
1093 if (!isALNUM(class))
1094 regset(opnd, class);
1095 }
a0d0e21e 1096 lastclass = 1234;
1097 continue;
1098 case 's':
bbce6d69 1099 if (regflags & PMf_LOCALE) {
1100 if (opnd != &regdummy)
1101 *opnd |= ANYOF_SPACEL;
1102 }
1103 else {
1104 for (class = 0; class < 256; class++)
1105 if (isSPACE(class))
1106 regset(opnd, class);
1107 }
a0d0e21e 1108 lastclass = 1234;
1109 continue;
1110 case 'S':
bbce6d69 1111 if (regflags & PMf_LOCALE) {
1112 if (opnd != &regdummy)
1113 *opnd |= ANYOF_NSPACEL;
1114 }
1115 else {
1116 for (class = 0; class < 256; class++)
1117 if (!isSPACE(class))
1118 regset(opnd, class);
1119 }
a0d0e21e 1120 lastclass = 1234;
1121 continue;
1122 case 'd':
1123 for (class = '0'; class <= '9'; class++)
bbce6d69 1124 regset(opnd, class);
a0d0e21e 1125 lastclass = 1234;
1126 continue;
1127 case 'D':
1128 for (class = 0; class < '0'; class++)
bbce6d69 1129 regset(opnd, class);
a0d0e21e 1130 for (class = '9' + 1; class < 256; class++)
bbce6d69 1131 regset(opnd, class);
a0d0e21e 1132 lastclass = 1234;
1133 continue;
1134 case 'n':
1135 class = '\n';
1136 break;
1137 case 'r':
1138 class = '\r';
1139 break;
1140 case 't':
1141 class = '\t';
1142 break;
1143 case 'f':
1144 class = '\f';
1145 break;
1146 case 'b':
1147 class = '\b';
1148 break;
1149 case 'e':
1150 class = '\033';
1151 break;
1152 case 'a':
1153 class = '\007';
1154 break;
1155 case 'x':
1156 class = scan_hex(regparse, 2, &numlen);
1157 regparse += numlen;
1158 break;
1159 case 'c':
bbce6d69 1160 class = UCHARAT(regparse++);
1161 class = toCTRL(class);
a0d0e21e 1162 break;
1163 case '0': case '1': case '2': case '3': case '4':
1164 case '5': case '6': case '7': case '8': case '9':
1165 class = scan_oct(--regparse, 3, &numlen);
1166 regparse += numlen;
1167 break;
1168 }
1169 }
1170 if (range) {
1171 if (lastclass > class)
1172 FAIL("invalid [] range in regexp");
1173 range = 0;
1174 }
1175 else {
1176 lastclass = class;
1177 if (*regparse == '-' && regparse+1 < regxend &&
1178 regparse[1] != ']') {
a687059c 1179 regparse++;
a0d0e21e 1180 range = 1;
1181 continue; /* do it next time */
1182 }
a687059c 1183 }
bbce6d69 1184 for ( ; lastclass <= class; lastclass++)
1185 regset(opnd, lastclass);
a0d0e21e 1186 lastclass = class;
1187 }
1188 if (*regparse != ']')
1189 FAIL("unmatched [] in regexp");
1190 nextchar();
1191 return ret;
1192}
1193
1194static char*
1195nextchar()
1196{
1197 char* retval = regparse++;
1198
4633a7c4 1199 for (;;) {
1200 if (*regparse == '(' && regparse[1] == '?' &&
1201 regparse[2] == '#') {
1202 while (*regparse && *regparse != ')')
748a9306 1203 regparse++;
4633a7c4 1204 regparse++;
1205 continue;
1206 }
1207 if (regflags & PMf_EXTENDED) {
1208 if (isSPACE(*regparse)) {
748a9306 1209 regparse++;
1210 continue;
1211 }
1212 else if (*regparse == '#') {
1213 while (*regparse && *regparse != '\n')
1214 regparse++;
1215 regparse++;
1216 continue;
1217 }
748a9306 1218 }
4633a7c4 1219 return retval;
a0d0e21e 1220 }
a687059c 1221}
1222
1223/*
a0d0e21e 1224- regnode - emit a node
1225*/
1226#ifdef CAN_PROTOTYPE
1227static char * /* Location. */
1228regnode(char op)
1229#else
a687059c 1230static char * /* Location. */
1231regnode(op)
1232char op;
a0d0e21e 1233#endif
a687059c 1234{
a0d0e21e 1235 register char *ret;
1236 register char *ptr;
a687059c 1237
a0d0e21e 1238 ret = regcode;
1239 if (ret == &regdummy) {
a687059c 1240#ifdef REGALIGN
a0d0e21e 1241 if (!(regsize & 1))
1242 regsize++;
a687059c 1243#endif
a0d0e21e 1244 regsize += 3;
1245 return(ret);
1246 }
a687059c 1247
1248#ifdef REGALIGN
1249#ifndef lint
a0d0e21e 1250 if (!((long)ret & 1))
1251 *ret++ = 127;
a687059c 1252#endif
1253#endif
a0d0e21e 1254 ptr = ret;
1255 *ptr++ = op;
1256 *ptr++ = '\0'; /* Null "next" pointer. */
1257 *ptr++ = '\0';
1258 regcode = ptr;
a687059c 1259
a0d0e21e 1260 return(ret);
a687059c 1261}
1262
1263/*
a0d0e21e 1264- reganode - emit a node with an argument
1265*/
1266#ifdef CAN_PROTOTYPE
1267static char * /* Location. */
1268reganode(char op, unsigned short arg)
1269#else
fe14fcc3 1270static char * /* Location. */
1271reganode(op, arg)
1272char op;
1273unsigned short arg;
a0d0e21e 1274#endif
fe14fcc3 1275{
a0d0e21e 1276 register char *ret;
1277 register char *ptr;
fe14fcc3 1278
a0d0e21e 1279 ret = regcode;
1280 if (ret == &regdummy) {
fe14fcc3 1281#ifdef REGALIGN
a0d0e21e 1282 if (!(regsize & 1))
1283 regsize++;
fe14fcc3 1284#endif
a0d0e21e 1285 regsize += 5;
1286 return(ret);
1287 }
fe14fcc3 1288
1289#ifdef REGALIGN
1290#ifndef lint
a0d0e21e 1291 if (!((long)ret & 1))
1292 *ret++ = 127;
fe14fcc3 1293#endif
1294#endif
a0d0e21e 1295 ptr = ret;
1296 *ptr++ = op;
1297 *ptr++ = '\0'; /* Null "next" pointer. */
1298 *ptr++ = '\0';
fe14fcc3 1299#ifdef REGALIGN
a0d0e21e 1300 *(unsigned short *)(ret+3) = arg;
fe14fcc3 1301#else
a0d0e21e 1302 ret[3] = arg >> 8; ret[4] = arg & 0377;
fe14fcc3 1303#endif
a0d0e21e 1304 ptr += 2;
1305 regcode = ptr;
fe14fcc3 1306
a0d0e21e 1307 return(ret);
fe14fcc3 1308}
1309
1310/*
a0d0e21e 1311- regc - emit (if appropriate) a byte of code
1312*/
1313#ifdef CAN_PROTOTYPE
1314static void
1315regc(char b)
1316#else
a687059c 1317static void
1318regc(b)
1319char b;
a0d0e21e 1320#endif
a687059c 1321{
a0d0e21e 1322 if (regcode != &regdummy)
1323 *regcode++ = b;
1324 else
1325 regsize++;
a687059c 1326}
1327
1328/*
a0d0e21e 1329- reginsert - insert an operator in front of already-emitted operand
1330*
1331* Means relocating the operand.
1332*/
1333#ifdef CAN_PROTOTYPE
1334static void
1335reginsert(char op, char *opnd)
1336#else
a687059c 1337static void
1338reginsert(op, opnd)
1339char op;
1340char *opnd;
a0d0e21e 1341#endif
a687059c 1342{
a0d0e21e 1343 register char *src;
1344 register char *dst;
1345 register char *place;
1346 register int offset = (regkind[(U8)op] == CURLY ? 4 : 0);
a687059c 1347
a0d0e21e 1348 if (regcode == &regdummy) {
a687059c 1349#ifdef REGALIGN
a0d0e21e 1350 regsize += 4 + offset;
a687059c 1351#else
a0d0e21e 1352 regsize += 3 + offset;
a687059c 1353#endif
a0d0e21e 1354 return;
1355 }
a687059c 1356
a0d0e21e 1357 src = regcode;
a687059c 1358#ifdef REGALIGN
a0d0e21e 1359 regcode += 4 + offset;
a687059c 1360#else
a0d0e21e 1361 regcode += 3 + offset;
a687059c 1362#endif
a0d0e21e 1363 dst = regcode;
1364 while (src > opnd)
1365 *--dst = *--src;
1366
1367 place = opnd; /* Op node, where operand used to be. */
1368 *place++ = op;
1369 *place++ = '\0';
1370 *place++ = '\0';
1371 while (offset-- > 0)
a687059c 1372 *place++ = '\0';
2b69d0c2 1373#ifdef REGALIGN
a0d0e21e 1374 *place++ = '\177';
2b69d0c2 1375#endif
a687059c 1376}
1377
1378/*
a0d0e21e 1379- regtail - set the next-pointer at the end of a node chain
1380*/
a687059c 1381static void
1382regtail(p, val)
1383char *p;
1384char *val;
1385{
a0d0e21e 1386 register char *scan;
1387 register char *temp;
1388 register I32 offset;
1389
1390 if (p == &regdummy)
1391 return;
1392
1393 /* Find last node. */
1394 scan = p;
1395 for (;;) {
1396 temp = regnext(scan);
1397 if (temp == NULL)
1398 break;
1399 scan = temp;
1400 }
a687059c 1401
1402#ifdef REGALIGN
a0d0e21e 1403 offset = val - scan;
a687059c 1404#ifndef lint
a0d0e21e 1405 *(short*)(scan+1) = offset;
a687059c 1406#else
a0d0e21e 1407 offset = offset;
a687059c 1408#endif
1409#else
a0d0e21e 1410 if (OP(scan) == BACK)
1411 offset = scan - val;
1412 else
1413 offset = val - scan;
1414 *(scan+1) = (offset>>8)&0377;
1415 *(scan+2) = offset&0377;
a687059c 1416#endif
1417}
1418
1419/*
a0d0e21e 1420- regoptail - regtail on operand of first argument; nop if operandless
1421*/
a687059c 1422static void
1423regoptail(p, val)
1424char *p;
1425char *val;
1426{
a0d0e21e 1427 /* "Operandless" and "op != BRANCH" are synonymous in practice. */
1428 if (p == NULL || p == &regdummy || regkind[(U8)OP(p)] != BRANCH)
1429 return;
1430 regtail(NEXTOPER(p), val);
a687059c 1431}
1432
1433/*
1434 - regcurly - a little FSA that accepts {\d+,?\d*}
1435 */
79072805 1436STATIC I32
a687059c 1437regcurly(s)
1438register char *s;
1439{
1440 if (*s++ != '{')
1441 return FALSE;
f0fcb552 1442 if (!isDIGIT(*s))
a687059c 1443 return FALSE;
f0fcb552 1444 while (isDIGIT(*s))
a687059c 1445 s++;
1446 if (*s == ',')
1447 s++;
f0fcb552 1448 while (isDIGIT(*s))
a687059c 1449 s++;
1450 if (*s != '}')
1451 return FALSE;
1452 return TRUE;
1453}
1454
1455#ifdef DEBUGGING
1456
1457/*
fd181c75 1458 - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
a687059c 1459 */
1460void
1461regdump(r)
1462regexp *r;
1463{
a0d0e21e 1464 register char *s;
bbce6d69 1465 register char op = EXACT; /* Arbitrary non-END op. */
a0d0e21e 1466 register char *next;
a687059c 1467
1468
a0d0e21e 1469 s = r->program + 1;
1470 while (op != END) { /* While that wasn't END last time... */
a687059c 1471#ifdef REGALIGN
a0d0e21e 1472 if (!((long)s & 1))
1473 s++;
a687059c 1474#endif
a0d0e21e 1475 op = OP(s);
760ac839 1476 PerlIO_printf(Perl_debug_log, "%2d%s", s-r->program, regprop(s)); /* Where, what. */
a0d0e21e 1477 next = regnext(s);
1478 s += regarglen[(U8)op];
1479 if (next == NULL) /* Next ptr. */
760ac839 1480 PerlIO_printf(Perl_debug_log, "(0)");
a0d0e21e 1481 else
760ac839 1482 PerlIO_printf(Perl_debug_log, "(%d)", (s-r->program)+(next-s));
a0d0e21e 1483 s += 3;
1484 if (op == ANYOF) {
bbce6d69 1485 s += 33;
a687059c 1486 }
bbce6d69 1487 if (regkind[(U8)op] == EXACT) {
a0d0e21e 1488 /* Literal string, where present. */
1489 s++;
760ac839 1490 (void)PerlIO_putc(Perl_debug_log, ' ');
1491 (void)PerlIO_putc(Perl_debug_log, '<');
a0d0e21e 1492 while (*s != '\0') {
760ac839 1493 (void)PerlIO_putc(Perl_debug_log,*s);
a0d0e21e 1494 s++;
1495 }
760ac839 1496 (void)PerlIO_putc(Perl_debug_log, '>');
a0d0e21e 1497 s++;
1498 }
760ac839 1499 (void)PerlIO_putc(Perl_debug_log, '\n');
a0d0e21e 1500 }
1501
1502 /* Header fields of interest. */
1503 if (r->regstart)
760ac839 1504 PerlIO_printf(Perl_debug_log, "start `%s' ", SvPVX(r->regstart));
a0d0e21e 1505 if (r->regstclass)
760ac839 1506 PerlIO_printf(Perl_debug_log, "stclass `%s' ", regprop(r->regstclass));
774d564b 1507 if (r->reganch & ROPT_ANCH) {
1508 PerlIO_printf(Perl_debug_log, "anchored");
1509 if (r->reganch & ROPT_ANCH_BOL)
1510 PerlIO_printf(Perl_debug_log, "(BOL)");
1511 if (r->reganch & ROPT_ANCH_GPOS)
1512 PerlIO_printf(Perl_debug_log, "(GPOS)");
1513 PerlIO_putc(Perl_debug_log, ' ');
1514 }
a0d0e21e 1515 if (r->reganch & ROPT_SKIP)
760ac839 1516 PerlIO_printf(Perl_debug_log, "plus ");
a0d0e21e 1517 if (r->reganch & ROPT_IMPLICIT)
760ac839 1518 PerlIO_printf(Perl_debug_log, "implicit ");
a0d0e21e 1519 if (r->regmust != NULL)
760ac839 1520 PerlIO_printf(Perl_debug_log, "must have \"%s\" back %ld ", SvPVX(r->regmust),
a0d0e21e 1521 (long) r->regback);
760ac839 1522 PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen);
1523 PerlIO_printf(Perl_debug_log, "\n");
a687059c 1524}
1525
1526/*
a0d0e21e 1527- regprop - printable representation of opcode
1528*/
a687059c 1529char *
1530regprop(op)
1531char *op;
1532{
a0d0e21e 1533 register char *p = 0;
1534
1535 (void) strcpy(buf, ":");
1536
1537 switch (OP(op)) {
1538 case BOL:
1539 p = "BOL";
1540 break;
1541 case MBOL:
1542 p = "MBOL";
1543 break;
1544 case SBOL:
1545 p = "SBOL";
1546 break;
1547 case EOL:
1548 p = "EOL";
1549 break;
1550 case MEOL:
1551 p = "MEOL";
1552 break;
1553 case SEOL:
1554 p = "SEOL";
1555 break;
1556 case ANY:
1557 p = "ANY";
1558 break;
1559 case SANY:
1560 p = "SANY";
1561 break;
1562 case ANYOF:
1563 p = "ANYOF";
1564 break;
1565 case BRANCH:
1566 p = "BRANCH";
1567 break;
bbce6d69 1568 case EXACT:
1569 p = "EXACT";
1570 break;
1571 case EXACTF:
1572 p = "EXACTF";
1573 break;
1574 case EXACTFL:
1575 p = "EXACTFL";
a0d0e21e 1576 break;
1577 case NOTHING:
1578 p = "NOTHING";
1579 break;
1580 case BACK:
1581 p = "BACK";
1582 break;
1583 case END:
1584 p = "END";
1585 break;
a0d0e21e 1586 case BOUND:
1587 p = "BOUND";
1588 break;
bbce6d69 1589 case BOUNDL:
1590 p = "BOUNDL";
1591 break;
a0d0e21e 1592 case NBOUND:
1593 p = "NBOUND";
1594 break;
bbce6d69 1595 case NBOUNDL:
1596 p = "NBOUNDL";
a0d0e21e 1597 break;
1598 case CURLY:
1599 (void)sprintf(buf+strlen(buf), "CURLY {%d,%d}", ARG1(op),ARG2(op));
1600 p = NULL;
1601 break;
1602 case CURLYX:
1603 (void)sprintf(buf+strlen(buf), "CURLYX {%d,%d}", ARG1(op),ARG2(op));
1604 p = NULL;
1605 break;
1606 case REF:
1607 (void)sprintf(buf+strlen(buf), "REF%d", ARG1(op));
1608 p = NULL;
1609 break;
1610 case OPEN:
1611 (void)sprintf(buf+strlen(buf), "OPEN%d", ARG1(op));
1612 p = NULL;
1613 break;
1614 case CLOSE:
1615 (void)sprintf(buf+strlen(buf), "CLOSE%d", ARG1(op));
1616 p = NULL;
1617 break;
1618 case STAR:
1619 p = "STAR";
1620 break;
1621 case PLUS:
1622 p = "PLUS";
1623 break;
1624 case MINMOD:
1625 p = "MINMOD";
1626 break;
774d564b 1627 case GPOS:
1628 p = "GPOS";
a0d0e21e 1629 break;
1630 case UNLESSM:
1631 p = "UNLESSM";
1632 break;
1633 case IFMATCH:
1634 p = "IFMATCH";
1635 break;
1636 case SUCCEED:
1637 p = "SUCCEED";
1638 break;
1639 case WHILEM:
1640 p = "WHILEM";
1641 break;
bbce6d69 1642 case DIGIT:
1643 p = "DIGIT";
1644 break;
1645 case NDIGIT:
1646 p = "NDIGIT";
1647 break;
1648 case ALNUM:
1649 p = "ALNUM";
1650 break;
1651 case NALNUM:
1652 p = "NALNUM";
1653 break;
1654 case SPACE:
1655 p = "SPACE";
1656 break;
1657 case NSPACE:
1658 p = "NSPACE";
1659 break;
1660 case ALNUML:
1661 p = "ALNUML";
1662 break;
1663 case NALNUML:
1664 p = "NALNUML";
1665 break;
1666 case SPACEL:
1667 p = "SPACEL";
1668 break;
1669 case NSPACEL:
1670 p = "NSPACEL";
1671 break;
a0d0e21e 1672 default:
1673 FAIL("corrupted regexp opcode");
1674 }
1675 if (p != NULL)
1676 (void) strcat(buf, p);
1677 return(buf);
a687059c 1678}
1679#endif /* DEBUGGING */
1680
2b69d0c2 1681void
e50aee73 1682pregfree(r)
a687059c 1683struct regexp *r;
1684{
a0d0e21e 1685 if (!r)
1686 return;
1687 if (r->precomp) {
1688 Safefree(r->precomp);
1689 r->precomp = Nullch;
1690 }
1691 if (r->subbase) {
1692 Safefree(r->subbase);
1693 r->subbase = Nullch;
1694 }
1695 if (r->regmust) {
1696 SvREFCNT_dec(r->regmust);
1697 r->regmust = Nullsv;
1698 }
1699 if (r->regstart) {
1700 SvREFCNT_dec(r->regstart);
1701 r->regstart = Nullsv;
1702 }
1703 Safefree(r->startp);
1704 Safefree(r->endp);
1705 Safefree(r);
a687059c 1706}
Unnamed repository; edit this file to name it for gitweb.