/* regcomp.c
*/
/*
* "A fair jaw-cracker dwarf-language must be." --Samwise Gamgee
*/
/* NOTE: this is derived from Henry Spencer's regexp code, and should not
* confused with the original package (see point 3 below). Thanks, Henry!
*/
/* Additional note: this code is very heavily munged from Henry's version
* in places. In some spots I've traded clarity for efficiency, so don't
* blame Henry for some of the lack of readability.
*/
/* The names of the functions have been changed from regcomp and
* regexec to pregcomp and pregexec in order to avoid conflicts
* with the POSIX routines of the same names.
*/
/*SUPPRESS 112*/
/*
* pregcomp and pregexec -- regsub and regerror are not used in perl
*
* Copyright (c) 1986 by University of Toronto.
* Written by Henry Spencer. Not derived from licensed software.
*
* Permission is granted to anyone to use this software for any
* purpose on any computer system, and to redistribute it freely,
* subject to the following restrictions:
*
* 1. The author is not responsible for the consequences of use of
* this software, no matter how awful, even if they arise
* from defects in it.
*
* 2. The origin of this software must not be misrepresented, either
* by explicit claim or by omission.
*
* 3. Altered versions must be plainly marked as such, and must not
* be misrepresented as being the original software.
*
*
**** Alterations to Henry's code are...
****
**** Copyright (c) 1991-1997, Larry Wall
****
**** You may distribute under the terms of either the GNU General Public
**** License or the Artistic License, as specified in the README file.
*
* Beware that some of this code is subtly aware of the way operator
* precedence is structured in regular expressions. Serious changes in
* regular-expression syntax might require a total rethink.
*/
#include "EXTERN.h"
#include "perl.h"
#include "INTERN.h"
#include "regcomp.h"
#ifdef MSDOS
# if defined(BUGGY_MSC6)
/* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
# pragma optimize("a",off)
/* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
# pragma optimize("w",on )
# endif /* BUGGY_MSC6 */
#endif /* MSDOS */
#ifndef STATIC
#define STATIC static
#endif
#define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?')
#define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
((*s) == '{' && regcurly(s)))
#ifdef atarist
#define PERL_META "^$.[()|?+*\\"
#else
#define META "^$.[()|?+*\\"
#endif
#ifdef SPSTART
#undef SPSTART /* dratted cpp namespace... */
#endif
/*
* Flags to be passed up and down.
*/
#define WORST 0 /* Worst case. */
#define HASWIDTH 0x1 /* Known never to match null string. */
#define SIMPLE 0x2 /* Simple enough to be STAR/PLUS operand. */
#define SPSTART 0x4 /* Starts with * or +. */
#define TRYAGAIN 0x8 /* Weeded out a declaration. */
/*
* Forward declarations for pregcomp()'s friends.
*/
static char *reg _((I32, I32 *));
static char *reganode _((char, unsigned short));
static char *regatom _((I32 *));
static char *regbranch _((I32 *));
static void regc _((char));
static char *regclass _((void));
STATIC I32 regcurly _((char *));
static char *regnode _((char));
static char *regpiece _((I32 *));
static void reginsert _((char, char *));
static void regoptail _((char *, char *));
static void regset _((char *, I32));
static void regtail _((char *, char *));
static char* regwhite _((char *, char *));
static char* nextchar _((void));
/*
- pregcomp - compile a regular expression into internal code
*
* We can't allocate space until we know how big the compiled form will be,
* but we can't compile it (and thus know how big it is) until we've got a
* place to put the code. So we cheat: we compile it twice, once with code
* generation turned off and size counting turned on, and once "for real".
* This also means that we don't allocate space until we are sure that the
* thing really will compile successfully, and we never have to move the
* code and thus invalidate pointers into it. (Note that it has to be in
* one piece because free() must be able to free it all.) [NB: not true in perl]
*
* Beware that the optimization-preparation code in here knows about some
* of the structure of the compiled regexp. [I'll say.]
*/
regexp *
pregcomp(exp,xend,pm)
char* exp;
char* xend;
PMOP* pm;
{
register regexp *r;
register char *scan;
register SV *longish;
SV *longest;
register I32 len;
register char *first;
I32 flags;
I32 backish;
I32 backest;
I32 curback;
I32 minlen = 0;
I32 sawplus = 0;
I32 sawopen = 0;
#define MAX_REPEAT_DEPTH 12
struct {
char *opcode;
I32 count;
} repeat_stack[MAX_REPEAT_DEPTH];
I32 repeat_depth = 0;
I32 repeat_count = 1; /* We start unmultiplied. */
if (exp == NULL)
croak("NULL regexp argument");
regprecomp = savepvn(exp, xend - exp);
regflags = pm->op_pmflags;
regsawback = 0;
/* First pass: determine size, legality. */
regparse = exp;
regxend = xend;
regnaughty = 0;
regnpar = 1;
regsize = 0L;
regcode = ®dummy;
regc((char)MAGIC);
if (reg(0, &flags) == NULL) {
Safefree(regprecomp);
regprecomp = Nullch;
return(NULL);
}
/* Small enough for pointer-storage convention? */
if (regsize >= 32767L) /* Probably could be 65535L. */
FAIL("regexp too big");
/* Allocate space and initialize. */
Newc(1001, r, sizeof(regexp) + (unsigned)regsize, char, regexp);
if (r == NULL)
FAIL("regexp out of space");
r->prelen = xend - exp;
r->precomp = regprecomp;
r->subbeg = r->subbase = NULL;
/* Second pass: emit code. */
regparse = exp;
regxend = xend;
regnaughty = 0;
regnpar = 1;
regcode = r->program;
regc((char)MAGIC);
if (reg(0, &flags) == NULL)
return(NULL);
/* Dig out information for optimizations. */
pm->op_pmflags = regflags;
r->regstart = Nullsv; /* Worst-case defaults. */
r->reganch = 0;
r->regmust = Nullsv;
r->regback = -1;
r->regstclass = Nullch;
r->naughty = regnaughty >= 10; /* Probably an expensive pattern. */
scan = r->program+1; /* First BRANCH. */
if (OP(regnext(scan)) == END) {/* Only one top-level choice. */
scan = NEXTOPER(scan);
first = scan;
while ((OP(first) == OPEN && (sawopen = 1)) ||
(OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
(OP(first) == PLUS) ||
(OP(first) == MINMOD) ||
(regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) {
if (OP(first) == PLUS)
sawplus = 1;
else
first += regarglen[(U8)OP(first)];
first = NEXTOPER(first);
}
/* Starting-point info. */
again:
if (OP(first) == EXACT) {
r->regstart = newSVpv(OPERAND(first)+1,*OPERAND(first));
if (SvCUR(r->regstart) > !sawstudy)
fbm_compile(r->regstart);
(void)SvUPGRADE(r->regstart, SVt_PVBM);
}
else if (strchr(simple+2,OP(first)))
r->regstclass = first;
else if (regkind[(U8)OP(first)] == BOUND ||
regkind[(U8)OP(first)] == NBOUND)
r->regstclass = first;
else if (regkind[(U8)OP(first)] == BOL) {
r->reganch |= ROPT_ANCH_BOL;
first = NEXTOPER(first);
goto again;
}
else if (OP(first) == GPOS) {
r->reganch |= ROPT_ANCH_GPOS;
first = NEXTOPER(first);
goto again;
}
else if ((OP(first) == STAR &&
regkind[(U8)OP(NEXTOPER(first))] == ANY) &&
!(r->reganch & ROPT_ANCH) )
{
/* turn .* into ^.* with an implied $*=1 */
r->reganch |= ROPT_ANCH_BOL | ROPT_IMPLICIT;
first = NEXTOPER(first);
goto again;
}
if (sawplus && (!sawopen || !regsawback))
r->reganch |= ROPT_SKIP; /* x+ must match 1st of run */
DEBUG_r(PerlIO_printf(Perl_debug_log, "first %d next %d offset %ld\n",
OP(first), OP(NEXTOPER(first)), (long)(first - scan)));
/*
* If there's something expensive in the r.e., find the
* longest literal string that must appear and make it the
* regmust. Resolve ties in favor of later strings, since
* the regstart check works with the beginning of the r.e.
* and avoiding duplication strengthens checking. Not a
* strong reason, but sufficient in the absence of others.
* [Now we resolve ties in favor of the earlier string if
* it happens that curback has been invalidated, since the
* earlier string may buy us something the later one won't.]
*/
longish = newSVpv("",0);
longest = newSVpv("",0);
len = 0;
minlen = 0;
curback = 0;
backish = 0;
backest = 0;
while (OP(scan) != END) {
if (OP(scan) == BRANCH) {
if (OP(regnext(scan)) == BRANCH) {
curback = -30000;
while (OP(scan) == BRANCH)
scan = regnext(scan);
}
else /* single branch is ok */
scan = NEXTOPER(scan);
continue;
}
if (OP(scan) == UNLESSM) {
curback = -30000;
scan = regnext(scan);
continue;
}
if (OP(scan) == EXACT) {
char *t;
first = scan;
while ((t = regnext(scan)) && OP(t) == CLOSE)
scan = t;
minlen += *OPERAND(first) * repeat_count;
if (curback - backish == len) {
sv_catpvn(longish, OPERAND(first)+1,
*OPERAND(first));
len += *OPERAND(first);
curback += *OPERAND(first);
first = regnext(scan);
}
else if (*OPERAND(first) >= len + (curback >= 0)) {
len = *OPERAND(first);
sv_setpvn(longish, OPERAND(first)+1,len);
backish = curback;
curback += len;
first = regnext(scan);
}
else
curback += *OPERAND(first);
}
else if (strchr(varies,OP(scan))) {
int tcount;
char *next;
if (repeat_depth < MAX_REPEAT_DEPTH
&& ((OP(scan) == PLUS
&& (tcount = 1)
&& (next = NEXTOPER(scan)))
|| (regkind[(U8)OP(scan)] == CURLY
&& (tcount = ARG1(scan))
&& (next = NEXTOPER(scan)+4))))
{
/* We treat (abc)+ as (abc)(abc)*. */
/* Mark the place to return back. */
repeat_stack[repeat_depth].opcode = regnext(scan);
repeat_stack[repeat_depth].count = repeat_count;
repeat_depth++;
repeat_count *= tcount;
/* Go deeper: */
scan = next;
continue;
}
else {
curback = -30000;
len = 0;
if (SvCUR(longish) > SvCUR(longest)) {
sv_setsv(longest,longish);
backest = backish;
}
sv_setpvn(longish,"",0);
}
}
else if (strchr(simple,OP(scan))) {
curback++;
minlen += repeat_count;
len = 0;
if (SvCUR(longish) > SvCUR(longest)) {
sv_setsv(longest,longish);
backest = backish;
}
sv_setpvn(longish,"",0);
}
scan = regnext(scan);
if (!scan) { /* Go up PLUS or CURLY. */
if (!repeat_depth--)
croak("panic: re scan");
scan = repeat_stack[repeat_depth].opcode;
repeat_count = repeat_stack[repeat_depth].count;
/* Need to submit the longest string found: */
curback = -30000;
len = 0;
if (SvCUR(longish) > SvCUR(longest)) {
sv_setsv(longest,longish);
backest = backish;
}
sv_setpvn(longish,"",0);
}
}
/* Prefer earlier on tie, unless we can tail match latter */
if (SvCUR(longish) + (first && regkind[(U8)OP(first)] == EOL)
> SvCUR(longest))
{
sv_setsv(longest,longish);
backest = backish;
}
else
sv_setpvn(longish,"",0);
if (SvCUR(longest)
&& (!r->regstart
|| !fbm_instr((unsigned char*) SvPVX(r->regstart),
(unsigned char *) (SvPVX(r->regstart)
+ SvCUR(r->regstart)),
longest)))
{
r->regmust = longest;
if (backest < 0)
backest = -1;
r->regback = backest;
if (SvCUR(longest) > !(sawstudy ||
(first && regkind[(U8)OP(first)] == EOL)))
fbm_compile(r->regmust);
(void)SvUPGRADE(r->regmust, SVt_PVBM);
BmUSEFUL(r->regmust) = 100;
if (first && regkind[(U8)OP(first)] == EOL && SvCUR(longish))
SvTAIL_on(r->regmust);
}
else {
SvREFCNT_dec(longest);
longest = Nullsv;
}
SvREFCNT_dec(longish);
}
r->nparens = regnpar - 1;
r->minlen = minlen;
Newz(1002, r->startp, regnpar, char*);
Newz(1002, r->endp, regnpar, char*);
DEBUG_r(regdump(r));
return(r);
}
/*
- reg - regular expression, i.e. main body or parenthesized thing
*
* Caller must absorb opening parenthesis.
*
* Combining parenthesis handling with the base level of regular expression
* is a trifle forced, but the need to tie the tails of the branches to what
* follows makes it hard to avoid.
*/
static char *
reg(paren, flagp)
I32 paren; /* Parenthesized? */
I32 *flagp;
{
register char *ret;
register char *br;
register char *ender = 0;
register I32 parno = 0;
I32 flags;
*flagp = HASWIDTH; /* Tentatively. */
/* Make an OPEN node, if parenthesized. */
if (paren) {
if (*regparse == '?') {
regparse++;
paren = *regparse++;
ret = NULL;
switch (paren) {
case ':':
case '=':
case '!':
break;
case '$':
case '@':
croak("Sequence (?%c...) not implemented", (int)paren);
break;
case '#':
while (*regparse && *regparse != ')')
regparse++;
if (*regparse != ')')
croak("Sequence (?#... not terminated");
nextchar();
*flagp = TRYAGAIN;
return NULL;
case 0:
croak("Sequence (? incomplete");
break;
default:
--regparse;
while (*regparse && strchr("iogcmsx", *regparse))
pmflag(®flags, *regparse++);
if (*regparse != ')')
croak("Sequence (?%c...) not recognized", *regparse);
nextchar();
*flagp = TRYAGAIN;
return NULL;
}
}
else {
parno = regnpar;
regnpar++;
ret = reganode(OPEN, parno);
}
} else
ret = NULL;
/* Pick up the branches, linking them together. */
br = regbranch(&flags);
if (br == NULL)
return(NULL);
if (ret != NULL)
regtail(ret, br); /* OPEN -> first. */
else
ret = br;
if (!(flags&HASWIDTH))
*flagp &= ~HASWIDTH;
*flagp |= flags&SPSTART;
while (*regparse == '|') {
nextchar();
br = regbranch(&flags);
if (br == NULL)
return(NULL);
regtail(ret, br); /* BRANCH -> BRANCH. */
if (!(flags&HASWIDTH))
*flagp &= ~HASWIDTH;
*flagp |= flags&SPSTART;
}
/* Make a closing node, and hook it on the end. */
switch (paren) {
case ':':
ender = regnode(NOTHING);
break;
case 1:
ender = reganode(CLOSE, parno);
break;
case '=':
case '!':
ender = regnode(SUCCEED);
*flagp &= ~HASWIDTH;
break;
case 0:
ender = regnode(END);
break;
}
regtail(ret, ender);
/* Hook the tails of the branches to the closing node. */
for (br = ret; br != NULL; br = regnext(br))
regoptail(br, ender);
if (paren == '=') {
reginsert(IFMATCH,ret);
regtail(ret, regnode(NOTHING));
}
else if (paren == '!') {
reginsert(UNLESSM,ret);
regtail(ret, regnode(NOTHING));
}
/* Check for proper termination. */
if (paren && (regparse >= regxend || *nextchar() != ')')) {
FAIL("unmatched () in regexp");
} else if (!paren && regparse < regxend) {
if (*regparse == ')') {
FAIL("unmatched () in regexp");
} else
FAIL("junk on end of regexp"); /* "Can't happen". */
/* NOTREACHED */
}
return(ret);
}
/*
- regbranch - one alternative of an | operator
*
* Implements the concatenation operator.
*/
static char *
regbranch(flagp)
I32 *flagp;
{
register char *ret;
register char *chain;
register char *latest;
I32 flags = 0;
*flagp = WORST; /* Tentatively. */
ret = regnode(BRANCH);
chain = NULL;
regparse--;
nextchar();
while (regparse < regxend && *regparse != '|' && *regparse != ')') {
flags &= ~TRYAGAIN;
latest = regpiece(&flags);
if (latest == NULL) {
if (flags & TRYAGAIN)
continue;
return(NULL);
}
*flagp |= flags&HASWIDTH;
if (chain == NULL) /* First piece. */
*flagp |= flags&SPSTART;
else {
regnaughty++;
regtail(chain, latest);
}
chain = latest;
}
if (chain == NULL) /* Loop ran zero times. */
(void) regnode(NOTHING);
return(ret);
}
/*
- regpiece - something followed by possible [*+?]
*
* Note that the branching code sequences used for ? and the general cases
* of * and + are somewhat optimized: they use the same NOTHING node as
* both the endmarker for their branch list and the body of the last branch.
* It might seem that this node could be dispensed with entirely, but the
* endmarker role is not redundant.
*/
static char *
regpiece(flagp)
I32 *flagp;
{
register char *ret;
register char op;
register char *next;
I32 flags;
char *origparse = regparse;
char *maxpos;
I32 min;
I32 max = 32767;
ret = regatom(&flags);
if (ret == NULL) {
if (flags & TRYAGAIN)
*flagp |= TRYAGAIN;
return(NULL);
}
op = *regparse;
if (op == '(' && regparse[1] == '?' && regparse[2] == '#') {
while (op && op != ')')
op = *++regparse;
if (op) {
nextchar();
op = *regparse;
}
}
if (op == '{' && regcurly(regparse)) {
next = regparse + 1;
maxpos = Nullch;
while (isDIGIT(*next) || *next == ',') {
if (*next == ',') {
if (maxpos)
break;
else
maxpos = next;
}
next++;
}
if (*next == '}') { /* got one */
if (!maxpos)
maxpos = next;
regparse++;
min = atoi(regparse);
if (*maxpos == ',')
maxpos++;
else
maxpos = regparse;
max = atoi(maxpos);
if (!max && *maxpos != '0')
max = 32767; /* meaning "infinity" */
regparse = next;
nextchar();
do_curly:
if ((flags&SIMPLE)) {
regnaughty += 2 + regnaughty / 2;
reginsert(CURLY, ret);
}
else {
regnaughty += 4 + regnaughty; /* compound interest */
regtail(ret, regnode(WHILEM));
reginsert(CURLYX,ret);
regtail(ret, regnode(NOTHING));
}
if (min > 0)
*flagp = (WORST|HASWIDTH);
if (max && max < min)
croak("Can't do {n,m} with n > m");
if (regcode != ®dummy) {
#ifdef REGALIGN
*(unsigned short *)(ret+3) = min;
*(unsigned short *)(ret+5) = max;
#else
ret[3] = min >> 8; ret[4] = min & 0377;
ret[5] = max >> 8; ret[6] = max & 0377;
#endif
}
goto nest_check;
}
}
if (!ISMULT1(op)) {
*flagp = flags;
return(ret);
}
if (!(flags&HASWIDTH) && op != '?')
FAIL("regexp *+ operand could be empty"); /* else may core dump */
nextchar();
*flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);
if (op == '*' && (flags&SIMPLE)) {
reginsert(STAR, ret);
regnaughty += 4;
}
else if (op == '*') {
min = 0;
goto do_curly;
} else if (op == '+' && (flags&SIMPLE)) {
reginsert(PLUS, ret);
regnaughty += 3;
}
else if (op == '+') {
min = 1;
goto do_curly;
} else if (op == '?') {
min = 0; max = 1;
goto do_curly;
}
nest_check:
if (dowarn && regcode != ®dummy && !(flags&HASWIDTH) && max > 10000) {
warn("%.*s matches null string many times",
regparse - origparse, origparse);
}
if (*regparse == '?') {
nextchar();
reginsert(MINMOD, ret);
#ifdef REGALIGN
regtail(ret, ret + 4);
#else
regtail(ret, ret + 3);
#endif
}
if (ISMULT2(regparse))
FAIL("nested *?+ in regexp");
return(ret);
}
/*
- regatom - the lowest level
*
* Optimization: gobbles an entire sequence of ordinary characters so that
* it can turn them into a single node, which is smaller to store and
* faster to run. Backslashed characters are exceptions, each becoming a
* separate node; the code is simpler that way and it's not worth fixing.
*
* [Yes, it is worth fixing, some scripts can run twice the speed.]
*/
static char *
regatom(flagp)
I32 *flagp;
{
register char *ret = 0;
I32 flags;
*flagp = WORST; /* Tentatively. */
tryagain:
switch (*regparse) {
case '^':
nextchar();
if (regflags & PMf_MULTILINE)
ret = regnode(MBOL);
else if (regflags & PMf_SINGLELINE)
ret = regnode(SBOL);
else
ret = regnode(BOL);
break;
case '$':
nextchar();
if (regflags & PMf_MULTILINE)
ret = regnode(MEOL);
else if (regflags & PMf_SINGLELINE)
ret = regnode(SEOL);
else
ret = regnode(EOL);
break;
case '.':
nextchar();
if (regflags & PMf_SINGLELINE)
ret = regnode(SANY);
else
ret = regnode(ANY);
regnaughty++;
*flagp |= HASWIDTH|SIMPLE;
break;
case '[':
regparse++;
ret = regclass();
*flagp |= HASWIDTH|SIMPLE;
break;
case '(':
nextchar();
ret = reg(1, &flags);
if (ret == NULL) {
if (flags & TRYAGAIN)
goto tryagain;
return(NULL);
}
*flagp |= flags&(HASWIDTH|SPSTART);
break;
case '|':
case ')':
if (flags & TRYAGAIN) {
*flagp |= TRYAGAIN;
return NULL;
}
croak("internal urp in regexp at /%s/", regparse);
/* Supposed to be caught earlier. */
break;
case '{':
if (!regcurly(regparse)) {
regparse++;
goto defchar;
}
/* FALL THROUGH */
case '?':
case '+':
case '*':
FAIL("?+*{} follows nothing in regexp");
break;
case '\\':
switch (*++regparse) {
case 'A':
ret = regnode(SBOL);
*flagp |= SIMPLE;
nextchar();
break;
case 'G':
ret = regnode(GPOS);
*flagp |= SIMPLE;
nextchar();
break;
case 'Z':
ret = regnode(SEOL);
*flagp |= SIMPLE;
nextchar();
break;
case 'w':
ret = regnode((regflags & PMf_LOCALE) ? ALNUML : ALNUM);
*flagp |= HASWIDTH|SIMPLE;
nextchar();
break;
case 'W':
ret = regnode((regflags & PMf_LOCALE) ? NALNUML : NALNUM);
*flagp |= HASWIDTH|SIMPLE;
nextchar();
break;
case 'b':
ret = regnode((regflags & PMf_LOCALE) ? BOUNDL : BOUND);
*flagp |= SIMPLE;
nextchar();
break;
case 'B':
ret = regnode((regflags & PMf_LOCALE) ? NBOUNDL : NBOUND);
*flagp |= SIMPLE;
nextchar();
break;
case 's':
ret = regnode((regflags & PMf_LOCALE) ? SPACEL : SPACE);
*flagp |= HASWIDTH|SIMPLE;
nextchar();
break;
case 'S':
ret = regnode((regflags & PMf_LOCALE) ? NSPACEL : NSPACE);
*flagp |= HASWIDTH|SIMPLE;
nextchar();
break;
case 'd':
ret = regnode(DIGIT);
*flagp |= HASWIDTH|SIMPLE;
nextchar();
break;
case 'D':
ret = regnode(NDIGIT);
*flagp |= HASWIDTH|SIMPLE;
nextchar();
break;
case 'n':
case 'r':
case 't':
case 'f':
case 'e':
case 'a':
case 'x':
case 'c':
case '0':
goto defchar;
case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
{
I32 num = atoi(regparse);
if (num > 9 && num >= regnpar)
goto defchar;
else {
regsawback = 1;
ret = reganode((regflags & PMf_FOLD)
? ((regflags & PMf_LOCALE) ? REFFL : REFF)
: REF, num);
*flagp |= HASWIDTH;
while (isDIGIT(*regparse))
regparse++;
regparse--;
nextchar();
}
}
break;
case '\0':
if (regparse >= regxend)
FAIL("trailing \\ in regexp");
/* FALL THROUGH */
default:
goto defchar;
}
break;
case '#':
if (regflags & PMf_EXTENDED) {
while (regparse < regxend && *regparse != '\n') regparse++;
if (regparse < regxend)
goto tryagain;
}
/* FALL THROUGH */
default: {
register I32 len;
register char ender;
register char *p;
char *oldp;
I32 numlen;
regparse++;
defchar:
ret = regnode((regflags & PMf_FOLD)
? ((regflags & PMf_LOCALE) ? EXACTFL : EXACTF)
: EXACT);
regc(0); /* save spot for len */
for (len = 0, p = regparse - 1;
len < 127 && p < regxend;
len++)
{
oldp = p;
if (regflags & PMf_EXTENDED)
p = regwhite(p, regxend);
switch (*p) {
case '^':
case '$':
case '.':
case '[':
case '(':
case ')':
case '|':
goto loopdone;
case '\\':
switch (*++p) {
case 'A':
case 'G':
case 'Z':
case 'w':
case 'W':
case 'b':
case 'B':
case 's':
case 'S':
case 'd':
case 'D':
--p;
goto loopdone;
case 'n':
ender = '\n';
p++;
break;
case 'r':
ender = '\r';
p++;
break;
case 't':
ender = '\t';
p++;
break;
case 'f':
ender = '\f';
p++;
break;
case 'e':
ender = '\033';
p++;
break;
case 'a':
ender = '\007';
p++;
break;
case 'x':
ender = scan_hex(++p, 2, &numlen);
p += numlen;
break;
case 'c':
p++;
ender = UCHARAT(p++);
ender = toCTRL(ender);
break;
case '0': case '1': case '2': case '3':case '4':
case '5': case '6': case '7': case '8':case '9':
if (*p == '0' ||
(isDIGIT(p[1]) && atoi(p) >= regnpar) ) {
ender = scan_oct(p, 3, &numlen);
p += numlen;
}
else {
--p;
goto loopdone;
}
break;
case '\0':
if (p >= regxend)
FAIL("trailing \\ in regexp");
/* FALL THROUGH */
default:
ender = *p++;
break;
}
break;
default:
ender = *p++;
break;
}
if (regflags & PMf_EXTENDED)
p = regwhite(p, regxend);
if (ISMULT2(p)) { /* Back off on ?+*. */
if (len)
p = oldp;
else {
len++;
regc(ender);
}
break;
}
regc(ender);
}
loopdone:
regparse = p - 1;
nextchar();
if (len < 0)
FAIL("internal disaster in regexp");
if (len > 0)
*flagp |= HASWIDTH;
if (len == 1)
*flagp |= SIMPLE;
if (regcode != ®dummy)
*OPERAND(ret) = len;
regc('\0');
}
break;
}
return(ret);
}
static char *
regwhite(p, e)
char *p;
char *e;
{
while (p < e) {
if (isSPACE(*p))
++p;
else if (*p == '#') {
do {
p++;
} while (p < e && *p != '\n');
}
else
break;
}
return p;
}
static void
regset(opnd, c)
char *opnd;
register I32 c;
{
if (opnd == ®dummy)
return;
c &= 0xFF;
opnd[1 + (c >> 3)] |= (1 << (c & 7));
}
static char *
regclass()
{
register char *opnd;
register I32 class;
register I32 lastclass = 1234;
register I32 range = 0;
register char *ret;
register I32 def;
I32 numlen;
ret = regnode(ANYOF);
opnd = regcode;
for (class = 0; class < 33; class++)
regc(0);
if (*regparse == '^') { /* Complement of range. */
regnaughty++;
regparse++;
if (opnd != ®dummy)
*opnd |= ANYOF_INVERT;
}
if (opnd != ®dummy) {
if (regflags & PMf_FOLD)
*opnd |= ANYOF_FOLD;
if (regflags & PMf_LOCALE)
*opnd |= ANYOF_LOCALE;
}
if (*regparse == ']' || *regparse == '-')
goto skipcond; /* allow 1st char to be ] or - */
while (regparse < regxend && *regparse != ']') {
skipcond:
class = UCHARAT(regparse++);
if (class == '\\') {
class = UCHARAT(regparse++);
switch (class) {
case 'w':
if (regflags & PMf_LOCALE) {
if (opnd != ®dummy)
*opnd |= ANYOF_ALNUML;
}
else {
for (class = 0; class < 256; class++)
if (isALNUM(class))
regset(opnd, class);
}
lastclass = 1234;
continue;
case 'W':
if (regflags & PMf_LOCALE) {
if (opnd != ®dummy)
*opnd |= ANYOF_NALNUML;
}
else {
for (class = 0; class < 256; class++)
if (!isALNUM(class))
regset(opnd, class);
}
lastclass = 1234;
continue;
case 's':
if (regflags & PMf_LOCALE) {
if (opnd != ®dummy)
*opnd |= ANYOF_SPACEL;
}
else {
for (class = 0; class < 256; class++)
if (isSPACE(class))
regset(opnd, class);
}
lastclass = 1234;
continue;
case 'S':
if (regflags & PMf_LOCALE) {
if (opnd != ®dummy)
*opnd |= ANYOF_NSPACEL;
}
else {
for (class = 0; class < 256; class++)
if (!isSPACE(class))
regset(opnd, class);
}
lastclass = 1234;
continue;
case 'd':
for (class = '0'; class <= '9'; class++)
regset(opnd, class);
lastclass = 1234;
continue;
case 'D':
for (class = 0; class < '0'; class++)
regset(opnd, class);
for (class = '9' + 1; class < 256; class++)
regset(opnd, class);
lastclass = 1234;
continue;
case 'n':
class = '\n';
break;
case 'r':
class = '\r';
break;
case 't':
class = '\t';
break;
case 'f':
class = '\f';
break;
case 'b':
class = '\b';
break;
case 'e':
class = '\033';
break;
case 'a':
class = '\007';
break;
case 'x':
class = scan_hex(regparse, 2, &numlen);
regparse += numlen;
break;
case 'c':
class = UCHARAT(regparse++);
class = toCTRL(class);
break;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
class = scan_oct(--regparse, 3, &numlen);
regparse += numlen;
break;
}
}
if (range) {
if (lastclass > class)
FAIL("invalid [] range in regexp");
range = 0;
}
else {
lastclass = class;
if (*regparse == '-' && regparse+1 < regxend &&
regparse[1] != ']') {
regparse++;
range = 1;
continue; /* do it next time */
}
}
for ( ; lastclass <= class; lastclass++)
regset(opnd, lastclass);
lastclass = class;
}
if (*regparse != ']')
FAIL("unmatched [] in regexp");
nextchar();
return ret;
}
static char*
nextchar()
{
char* retval = regparse++;
for (;;) {
if (*regparse == '(' && regparse[1] == '?' &&
regparse[2] == '#') {
while (*regparse && *regparse != ')')
regparse++;
regparse++;
continue;
}
if (regflags & PMf_EXTENDED) {
if (isSPACE(*regparse)) {
regparse++;
continue;
}
else if (*regparse == '#') {
while (*regparse && *regparse != '\n')
regparse++;
regparse++;
continue;
}
}
return retval;
}
}
/*
- regnode - emit a node
*/
#ifdef CAN_PROTOTYPE
static char * /* Location. */
regnode(char op)
#else
static char * /* Location. */
regnode(op)
char op;
#endif
{
register char *ret;
register char *ptr;
ret = regcode;
if (ret == ®dummy) {
#ifdef REGALIGN
if (!(regsize & 1))
regsize++;
#endif
regsize += 3;
return(ret);
}
#ifdef REGALIGN
#ifndef lint
if (!((long)ret & 1))
*ret++ = 127;
#endif
#endif
ptr = ret;
*ptr++ = op;
*ptr++ = '\0'; /* Null "next" pointer. */
*ptr++ = '\0';
regcode = ptr;
return(ret);
}
/*
- reganode - emit a node with an argument
*/
#ifdef CAN_PROTOTYPE
static char * /* Location. */
reganode(char op, unsigned short arg)
#else
static char * /* Location. */
reganode(op, arg)
char op;
unsigned short arg;
#endif
{
register char *ret;
register char *ptr;
ret = regcode;
if (ret == ®dummy) {
#ifdef REGALIGN
if (!(regsize & 1))
regsize++;
#endif
regsize += 5;
return(ret);
}
#ifdef REGALIGN
#ifndef lint
if (!((long)ret & 1))
*ret++ = 127;
#endif
#endif
ptr = ret;
*ptr++ = op;
*ptr++ = '\0'; /* Null "next" pointer. */
*ptr++ = '\0';
#ifdef REGALIGN
*(unsigned short *)(ret+3) = arg;
#else
ret[3] = arg >> 8; ret[4] = arg & 0377;
#endif
ptr += 2;
regcode = ptr;
return(ret);
}
/*
- regc - emit (if appropriate) a byte of code
*/
#ifdef CAN_PROTOTYPE
static void
regc(char b)
#else
static void
regc(b)
char b;
#endif
{
if (regcode != ®dummy)
*regcode++ = b;
else
regsize++;
}
/*
- reginsert - insert an operator in front of already-emitted operand
*
* Means relocating the operand.
*/
#ifdef CAN_PROTOTYPE
static void
reginsert(char op, char *opnd)
#else
static void
reginsert(op, opnd)
char op;
char *opnd;
#endif
{
register char *src;
register char *dst;
register char *place;
register int offset = (regkind[(U8)op] == CURLY ? 4 : 0);
if (regcode == ®dummy) {
#ifdef REGALIGN
regsize += 4 + offset;
#else
regsize += 3 + offset;
#endif
return;
}
src = regcode;
#ifdef REGALIGN
regcode += 4 + offset;
#else
regcode += 3 + offset;
#endif
dst = regcode;
while (src > opnd)
*--dst = *--src;
place = opnd; /* Op node, where operand used to be. */
*place++ = op;
*place++ = '\0';
*place++ = '\0';
while (offset-- > 0)
*place++ = '\0';
#ifdef REGALIGN
*place++ = '\177';
#endif
}
/*
- regtail - set the next-pointer at the end of a node chain
*/
static void
regtail(p, val)
char *p;
char *val;
{
register char *scan;
register char *temp;
register I32 offset;
if (p == ®dummy)
return;
/* Find last node. */
scan = p;
for (;;) {
temp = regnext(scan);
if (temp == NULL)
break;
scan = temp;
}
#ifdef REGALIGN
offset = val - scan;
#ifndef lint
*(short*)(scan+1) = offset;
#else
offset = offset;
#endif
#else
if (OP(scan) == BACK)
offset = scan - val;
else
offset = val - scan;
*(scan+1) = (offset>>8)&0377;
*(scan+2) = offset&0377;
#endif
}
/*
- regoptail - regtail on operand of first argument; nop if operandless
*/
static void
regoptail(p, val)
char *p;
char *val;
{
/* "Operandless" and "op != BRANCH" are synonymous in practice. */
if (p == NULL || p == ®dummy || regkind[(U8)OP(p)] != BRANCH)
return;
regtail(NEXTOPER(p), val);
}
/*
- regcurly - a little FSA that accepts {\d+,?\d*}
*/
STATIC I32
regcurly(s)
register char *s;
{
if (*s++ != '{')
return FALSE;
if (!isDIGIT(*s))
return FALSE;
while (isDIGIT(*s))
s++;
if (*s == ',')
s++;
while (isDIGIT(*s))
s++;
if (*s != '}')
return FALSE;
return TRUE;
}
#ifdef DEBUGGING
/*
- regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
*/
void
regdump(r)
regexp *r;
{
register char *s;
register char op = EXACT; /* Arbitrary non-END op. */
register char *next;
SV *sv = sv_newmortal();
s = r->program + 1;
while (op != END) { /* While that wasn't END last time... */
#ifdef REGALIGN
if (!((long)s & 1))
s++;
#endif
op = OP(s);
/* where, what */
regprop(sv, s);
PerlIO_printf(Perl_debug_log, "%2ld%s", (long)(s - r->program), SvPVX(sv));
next = regnext(s);
s += regarglen[(U8)op];
if (next == NULL) /* Next ptr. */
PerlIO_printf(Perl_debug_log, "(0)");
else
PerlIO_printf(Perl_debug_log, "(%ld)", (long)(s-r->program)+(next-s));
s += 3;
if (op == ANYOF) {
s += 33;
}
if (regkind[(U8)op] == EXACT) {
/* Literal string, where present. */
s++;
(void)PerlIO_putc(Perl_debug_log, ' ');
(void)PerlIO_putc(Perl_debug_log, '<');
while (*s != '\0') {
(void)PerlIO_putc(Perl_debug_log,*s);
s++;
}
(void)PerlIO_putc(Perl_debug_log, '>');
s++;
}
(void)PerlIO_putc(Perl_debug_log, '\n');
}
/* Header fields of interest. */
if (r->regstart)
PerlIO_printf(Perl_debug_log, "start `%s' ", SvPVX(r->regstart));
if (r->regstclass) {
regprop(sv, r->regstclass);
PerlIO_printf(Perl_debug_log, "stclass `%s' ", SvPVX(sv));
}
if (r->reganch & ROPT_ANCH) {
PerlIO_printf(Perl_debug_log, "anchored");
if (r->reganch & ROPT_ANCH_BOL)
PerlIO_printf(Perl_debug_log, "(BOL)");
if (r->reganch & ROPT_ANCH_GPOS)
PerlIO_printf(Perl_debug_log, "(GPOS)");
PerlIO_putc(Perl_debug_log, ' ');
}
if (r->reganch & ROPT_SKIP)
PerlIO_printf(Perl_debug_log, "plus ");
if (r->reganch & ROPT_IMPLICIT)
PerlIO_printf(Perl_debug_log, "implicit ");
if (r->regmust != NULL)
PerlIO_printf(Perl_debug_log, "must have \"%s\" back %ld ", SvPVX(r->regmust),
(long) r->regback);
PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen);
PerlIO_printf(Perl_debug_log, "\n");
}
/*
- regprop - printable representation of opcode
*/
void
regprop(sv, op)
SV *sv;
char *op;
{
register char *p = 0;
sv_setpv(sv, ":");
switch (OP(op)) {
case BOL:
p = "BOL";
break;
case MBOL:
p = "MBOL";
break;
case SBOL:
p = "SBOL";
break;
case EOL:
p = "EOL";
break;
case MEOL:
p = "MEOL";
break;
case SEOL:
p = "SEOL";
break;
case ANY:
p = "ANY";
break;
case SANY:
p = "SANY";
break;
case ANYOF:
p = "ANYOF";
break;
case BRANCH:
p = "BRANCH";
break;
case EXACT:
p = "EXACT";
break;
case EXACTF:
p = "EXACTF";
break;
case EXACTFL:
p = "EXACTFL";
break;
case NOTHING:
p = "NOTHING";
break;
case BACK:
p = "BACK";
break;
case END:
p = "END";
break;
case BOUND:
p = "BOUND";
break;
case BOUNDL:
p = "BOUNDL";
break;
case NBOUND:
p = "NBOUND";
break;
case NBOUNDL:
p = "NBOUNDL";
break;
case CURLY:
sv_catpvf(sv, "CURLY {%d,%d}", ARG1(op), ARG2(op));
break;
case CURLYX:
sv_catpvf(sv, "CURLYX {%d,%d}", ARG1(op), ARG2(op));
break;
case REF:
sv_catpvf(sv, "REF%d", ARG1(op));
break;
case REFF:
sv_catpvf(sv, "REFF%d", ARG1(op));
break;
case REFFL:
sv_catpvf(sv, "REFFL%d", ARG1(op));
break;
case OPEN:
sv_catpvf(sv, "OPEN%d", ARG1(op));
break;
case CLOSE:
sv_catpvf(sv, "CLOSE%d", ARG1(op));
p = NULL;
break;
case STAR:
p = "STAR";
break;
case PLUS:
p = "PLUS";
break;
case MINMOD:
p = "MINMOD";
break;
case GPOS:
p = "GPOS";
break;
case UNLESSM:
p = "UNLESSM";
break;
case IFMATCH:
p = "IFMATCH";
break;
case SUCCEED:
p = "SUCCEED";
break;
case WHILEM:
p = "WHILEM";
break;
case DIGIT:
p = "DIGIT";
break;
case NDIGIT:
p = "NDIGIT";
break;
case ALNUM:
p = "ALNUM";
break;
case NALNUM:
p = "NALNUM";
break;
case SPACE:
p = "SPACE";
break;
case NSPACE:
p = "NSPACE";
break;
case ALNUML:
p = "ALNUML";
break;
case NALNUML:
p = "NALNUML";
break;
case SPACEL:
p = "SPACEL";
break;
case NSPACEL:
p = "NSPACEL";
break;
default:
FAIL("corrupted regexp opcode");
}
if (p)
sv_catpv(sv, p);
}
#endif /* DEBUGGING */
void
pregfree(r)
struct regexp *r;
{
if (!r)
return;
if (r->precomp) {
Safefree(r->precomp);
r->precomp = Nullch;
}
if (r->subbase) {
Safefree(r->subbase);
r->subbase = Nullch;
}
if (r->regmust) {
SvREFCNT_dec(r->regmust);
r->regmust = Nullsv;
}
if (r->regstart) {
SvREFCNT_dec(r->regstart);
r->regstart = Nullsv;
}
Safefree(r->startp);
Safefree(r->endp);
Safefree(r);
}