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