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