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