5 * "A fair jaw-cracker dwarf-language must be." --Samwise Gamgee
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!
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.
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.
24 * pregcomp and pregexec -- regsub and regerror are not used in perl
26 * Copyright (c) 1986 by University of Toronto.
27 * Written by Henry Spencer. Not derived from licensed software.
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:
33 * 1. The author is not responsible for the consequences of use of
34 * this software, no matter how awful, even if they arise
37 * 2. The origin of this software must not be misrepresented, either
38 * by explicit claim or by omission.
40 * 3. Altered versions must be plainly marked as such, and must not
41 * be misrepresented as being the original software.
44 **** Alterations to Henry's code are...
46 **** Copyright (c) 1991-1997, Larry Wall
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.
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.
63 #endif /* USE_THREADS */
66 # if defined(BUGGY_MSC6)
67 /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
68 # pragma optimize("a",off)
69 /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
70 # pragma optimize("w",on )
71 # endif /* BUGGY_MSC6 */
78 #define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?')
79 #define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
80 ((*s) == '{' && regcurly(s)))
82 #define PERL_META "^$.[()|?+*\\"
84 #define META "^$.[()|?+*\\"
88 #undef SPSTART /* dratted cpp namespace... */
91 * Flags to be passed up and down.
93 #define WORST 0 /* Worst case. */
94 #define HASWIDTH 0x1 /* Known never to match null string. */
95 #define SIMPLE 0x2 /* Simple enough to be STAR/PLUS operand. */
96 #define SPSTART 0x4 /* Starts with * or +. */
97 #define TRYAGAIN 0x8 /* Weeded out a declaration. */
100 * Forward declarations for pregcomp()'s friends.
103 static char *reg _((I32, I32 *));
104 static char *reganode _((char, unsigned short));
105 static char *regatom _((I32 *));
106 static char *regbranch _((I32 *));
107 static void regc _((char));
108 static char *regclass _((void));
109 STATIC I32 regcurly _((char *));
110 static char *regnode _((char));
111 static char *regpiece _((I32 *));
112 static void reginsert _((char, char *));
113 static void regoptail _((char *, char *));
114 static void regset _((char *, I32));
115 static void regtail _((char *, char *));
116 static char* regwhite _((char *, char *));
117 static char* nextchar _((void));
120 - pregcomp - compile a regular expression into internal code
122 * We can't allocate space until we know how big the compiled form will be,
123 * but we can't compile it (and thus know how big it is) until we've got a
124 * place to put the code. So we cheat: we compile it twice, once with code
125 * generation turned off and size counting turned on, and once "for real".
126 * This also means that we don't allocate space until we are sure that the
127 * thing really will compile successfully, and we never have to move the
128 * code and thus invalidate pointers into it. (Note that it has to be in
129 * one piece because free() must be able to free it all.) [NB: not true in perl]
131 * Beware that the optimization-preparation code in here knows about some
132 * of the structure of the compiled regexp. [I'll say.]
135 pregcomp(char *exp, char *xend, PMOP *pm)
139 register SV *longish;
142 register char *first;
150 #define MAX_REPEAT_DEPTH 12
154 } repeat_stack[MAX_REPEAT_DEPTH];
155 I32 repeat_depth = 0;
156 I32 repeat_count = 1; /* We start unmultiplied. */
159 croak("NULL regexp argument");
161 regprecomp = savepvn(exp, xend - exp);
162 regflags = pm->op_pmflags;
165 /* First pass: determine size, legality. */
173 if (reg(0, &flags) == NULL) {
174 Safefree(regprecomp);
179 /* Small enough for pointer-storage convention? */
180 if (regsize >= 32767L) /* Probably could be 65535L. */
181 FAIL("regexp too big");
183 /* Allocate space and initialize. */
184 Newc(1001, r, sizeof(regexp) + (unsigned)regsize, char, regexp);
186 FAIL("regexp out of space");
187 r->prelen = xend - exp;
188 r->precomp = regprecomp;
189 r->subbeg = r->subbase = NULL;
191 /* Second pass: emit code. */
196 regcode = r->program;
198 if (reg(0, &flags) == NULL)
201 /* Dig out information for optimizations. */
202 pm->op_pmflags = regflags;
203 r->regstart = Nullsv; /* Worst-case defaults. */
207 r->regstclass = Nullch;
208 r->naughty = regnaughty >= 10; /* Probably an expensive pattern. */
209 scan = r->program+1; /* First BRANCH. */
210 if (OP(regnext(scan)) == END) {/* Only one top-level choice. */
211 scan = NEXTOPER(scan);
214 while ((OP(first) == OPEN && (sawopen = 1)) ||
215 (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
216 (OP(first) == PLUS) ||
217 (OP(first) == MINMOD) ||
218 (regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) {
219 if (OP(first) == PLUS)
222 first += regarglen[(U8)OP(first)];
223 first = NEXTOPER(first);
226 /* Starting-point info. */
228 if (OP(first) == EXACT) {
229 r->regstart = newSVpv(OPERAND(first)+1,*OPERAND(first));
230 if (SvCUR(r->regstart) > !sawstudy)
231 fbm_compile(r->regstart);
232 (void)SvUPGRADE(r->regstart, SVt_PVBM);
234 else if (strchr(simple+2,OP(first)))
235 r->regstclass = first;
236 else if (regkind[(U8)OP(first)] == BOUND ||
237 regkind[(U8)OP(first)] == NBOUND)
238 r->regstclass = first;
239 else if (regkind[(U8)OP(first)] == BOL) {
240 r->reganch |= ROPT_ANCH_BOL;
241 first = NEXTOPER(first);
244 else if (OP(first) == GPOS) {
245 r->reganch |= ROPT_ANCH_GPOS;
246 first = NEXTOPER(first);
249 else if ((OP(first) == STAR &&
250 regkind[(U8)OP(NEXTOPER(first))] == ANY) &&
251 !(r->reganch & ROPT_ANCH) )
253 /* turn .* into ^.* with an implied $*=1 */
254 r->reganch |= ROPT_ANCH_BOL | ROPT_IMPLICIT;
255 first = NEXTOPER(first);
258 if (sawplus && (!sawopen || !regsawback))
259 r->reganch |= ROPT_SKIP; /* x+ must match 1st of run */
261 DEBUG_r(PerlIO_printf(Perl_debug_log, "first %d next %d offset %ld\n",
262 OP(first), OP(NEXTOPER(first)), (long)(first - scan)));
264 * If there's something expensive in the r.e., find the
265 * longest literal string that must appear and make it the
266 * regmust. Resolve ties in favor of later strings, since
267 * the regstart check works with the beginning of the r.e.
268 * and avoiding duplication strengthens checking. Not a
269 * strong reason, but sufficient in the absence of others.
270 * [Now we resolve ties in favor of the earlier string if
271 * it happens that curback has been invalidated, since the
272 * earlier string may buy us something the later one won't.]
274 longish = newSVpv("",0);
275 longest = newSVpv("",0);
281 while (OP(scan) != END) {
282 if (OP(scan) == BRANCH) {
283 if (OP(regnext(scan)) == BRANCH) {
285 while (OP(scan) == BRANCH)
286 scan = regnext(scan);
288 else /* single branch is ok */
289 scan = NEXTOPER(scan);
292 if (OP(scan) == UNLESSM) {
294 scan = regnext(scan);
297 if (OP(scan) == EXACT) {
301 while ((t = regnext(scan)) && OP(t) == CLOSE)
303 minlen += *OPERAND(first) * repeat_count;
304 if (curback - backish == len) {
305 sv_catpvn(longish, OPERAND(first)+1,
307 len += *OPERAND(first);
308 curback += *OPERAND(first);
309 first = regnext(scan);
311 else if (*OPERAND(first) >= len + (curback >= 0)) {
312 len = *OPERAND(first);
313 sv_setpvn(longish, OPERAND(first)+1,len);
316 first = regnext(scan);
319 curback += *OPERAND(first);
321 else if (strchr(varies,OP(scan))) {
325 if (repeat_depth < MAX_REPEAT_DEPTH
326 && ((OP(scan) == PLUS
328 && (next = NEXTOPER(scan)))
329 || (regkind[(U8)OP(scan)] == CURLY
330 && (tcount = ARG1(scan))
331 && (next = NEXTOPER(scan)+4))))
333 /* We treat (abc)+ as (abc)(abc)*. */
335 /* Mark the place to return back. */
336 repeat_stack[repeat_depth].opcode = regnext(scan);
337 repeat_stack[repeat_depth].count = repeat_count;
339 repeat_count *= tcount;
348 if (SvCUR(longish) > SvCUR(longest)) {
349 sv_setsv(longest,longish);
352 sv_setpvn(longish,"",0);
355 else if (strchr(simple,OP(scan))) {
357 minlen += repeat_count;
359 if (SvCUR(longish) > SvCUR(longest)) {
360 sv_setsv(longest,longish);
363 sv_setpvn(longish,"",0);
365 scan = regnext(scan);
366 if (!scan) { /* Go up PLUS or CURLY. */
368 croak("panic: re scan");
369 scan = repeat_stack[repeat_depth].opcode;
370 repeat_count = repeat_stack[repeat_depth].count;
371 /* Need to submit the longest string found: */
374 if (SvCUR(longish) > SvCUR(longest)) {
375 sv_setsv(longest,longish);
378 sv_setpvn(longish,"",0);
382 /* Prefer earlier on tie, unless we can tail match latter */
384 if (SvCUR(longish) + (first && regkind[(U8)OP(first)] == EOL)
387 sv_setsv(longest,longish);
391 sv_setpvn(longish,"",0);
394 || !fbm_instr((unsigned char*) SvPVX(r->regstart),
395 (unsigned char *) (SvPVX(r->regstart)
396 + SvCUR(r->regstart)),
399 r->regmust = longest;
402 r->regback = backest;
403 if (SvCUR(longest) > !(sawstudy ||
404 (first && regkind[(U8)OP(first)] == EOL)))
405 fbm_compile(r->regmust);
406 (void)SvUPGRADE(r->regmust, SVt_PVBM);
407 BmUSEFUL(r->regmust) = 100;
408 if (first && regkind[(U8)OP(first)] == EOL && SvCUR(longish))
409 SvTAIL_on(r->regmust);
412 SvREFCNT_dec(longest);
415 SvREFCNT_dec(longish);
418 r->nparens = regnpar - 1;
420 Newz(1002, r->startp, regnpar, char*);
421 Newz(1002, r->endp, regnpar, char*);
427 - reg - regular expression, i.e. main body or parenthesized thing
429 * Caller must absorb opening parenthesis.
431 * Combining parenthesis handling with the base level of regular expression
432 * is a trifle forced, but the need to tie the tails of the branches to what
433 * follows makes it hard to avoid.
436 reg(I32 paren, I32 *flagp)
442 register char *ender = 0;
443 register I32 parno = 0;
446 *flagp = HASWIDTH; /* Tentatively. */
448 /* Make an OPEN node, if parenthesized. */
450 if (*regparse == '?') {
461 croak("Sequence (?%c...) not implemented", (int)paren);
464 while (*regparse && *regparse != ')')
466 if (*regparse != ')')
467 croak("Sequence (?#... not terminated");
472 croak("Sequence (? incomplete");
476 while (*regparse && strchr("iogcmsx", *regparse))
477 pmflag(®flags, *regparse++);
478 if (*regparse != ')')
479 croak("Sequence (?%c...) not recognized", *regparse);
488 ret = reganode(OPEN, parno);
493 /* Pick up the branches, linking them together. */
494 br = regbranch(&flags);
498 regtail(ret, br); /* OPEN -> first. */
501 if (!(flags&HASWIDTH))
503 *flagp |= flags&SPSTART;
504 while (*regparse == '|') {
506 br = regbranch(&flags);
509 regtail(ret, br); /* BRANCH -> BRANCH. */
510 if (!(flags&HASWIDTH))
512 *flagp |= flags&SPSTART;
515 /* Make a closing node, and hook it on the end. */
518 ender = regnode(NOTHING);
521 ender = reganode(CLOSE, parno);
525 ender = regnode(SUCCEED);
529 ender = regnode(END);
534 /* Hook the tails of the branches to the closing node. */
535 for (br = ret; br != NULL; br = regnext(br))
536 regoptail(br, ender);
539 reginsert(IFMATCH,ret);
540 regtail(ret, regnode(NOTHING));
542 else if (paren == '!') {
543 reginsert(UNLESSM,ret);
544 regtail(ret, regnode(NOTHING));
547 /* Check for proper termination. */
548 if (paren && (regparse >= regxend || *nextchar() != ')')) {
549 FAIL("unmatched () in regexp");
550 } else if (!paren && regparse < regxend) {
551 if (*regparse == ')') {
552 FAIL("unmatched () in regexp");
554 FAIL("junk on end of regexp"); /* "Can't happen". */
562 - regbranch - one alternative of an | operator
564 * Implements the concatenation operator.
567 regbranch(I32 *flagp)
570 register char *chain;
571 register char *latest;
574 *flagp = WORST; /* Tentatively. */
576 ret = regnode(BRANCH);
580 while (regparse < regxend && *regparse != '|' && *regparse != ')') {
582 latest = regpiece(&flags);
583 if (latest == NULL) {
584 if (flags & TRYAGAIN)
588 *flagp |= flags&HASWIDTH;
589 if (chain == NULL) /* First piece. */
590 *flagp |= flags&SPSTART;
593 regtail(chain, latest);
597 if (chain == NULL) /* Loop ran zero times. */
598 (void) regnode(NOTHING);
604 - regpiece - something followed by possible [*+?]
606 * Note that the branching code sequences used for ? and the general cases
607 * of * and + are somewhat optimized: they use the same NOTHING node as
608 * both the endmarker for their branch list and the body of the last branch.
609 * It might seem that this node could be dispensed with entirely, but the
610 * endmarker role is not redundant.
619 char *origparse = regparse;
624 ret = regatom(&flags);
626 if (flags & TRYAGAIN)
632 if (op == '(' && regparse[1] == '?' && regparse[2] == '#') {
633 while (op && op != ')')
641 if (op == '{' && regcurly(regparse)) {
644 while (isDIGIT(*next) || *next == ',') {
653 if (*next == '}') { /* got one */
657 min = atoi(regparse);
663 if (!max && *maxpos != '0')
664 max = 32767; /* meaning "infinity" */
669 if ((flags&SIMPLE)) {
670 regnaughty += 2 + regnaughty / 2;
671 reginsert(CURLY, ret);
674 regnaughty += 4 + regnaughty; /* compound interest */
675 regtail(ret, regnode(WHILEM));
676 reginsert(CURLYX,ret);
677 regtail(ret, regnode(NOTHING));
681 *flagp = (WORST|HASWIDTH);
682 if (max && max < min)
683 croak("Can't do {n,m} with n > m");
684 if (regcode != ®dummy) {
686 *(unsigned short *)(ret+3) = min;
687 *(unsigned short *)(ret+5) = max;
689 ret[3] = min >> 8; ret[4] = min & 0377;
690 ret[5] = max >> 8; ret[6] = max & 0377;
703 if (!(flags&HASWIDTH) && op != '?')
704 FAIL("regexp *+ operand could be empty"); /* else may core dump */
708 *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);
710 if (op == '*' && (flags&SIMPLE)) {
711 reginsert(STAR, ret);
714 else if (op == '*') {
717 } else if (op == '+' && (flags&SIMPLE)) {
718 reginsert(PLUS, ret);
721 else if (op == '+') {
724 } else if (op == '?') {
729 if (dowarn && regcode != ®dummy && !(flags&HASWIDTH) && max > 10000) {
730 warn("%.*s matches null string many times",
731 regparse - origparse, origparse);
734 if (*regparse == '?') {
736 reginsert(MINMOD, ret);
738 regtail(ret, ret + 4);
740 regtail(ret, ret + 3);
743 if (ISMULT2(regparse))
744 FAIL("nested *?+ in regexp");
750 - regatom - the lowest level
752 * Optimization: gobbles an entire sequence of ordinary characters so that
753 * it can turn them into a single node, which is smaller to store and
754 * faster to run. Backslashed characters are exceptions, each becoming a
755 * separate node; the code is simpler that way and it's not worth fixing.
757 * [Yes, it is worth fixing, some scripts can run twice the speed.]
762 register char *ret = 0;
765 *flagp = WORST; /* Tentatively. */
771 if (regflags & PMf_MULTILINE)
773 else if (regflags & PMf_SINGLELINE)
780 if (regflags & PMf_MULTILINE)
782 else if (regflags & PMf_SINGLELINE)
789 if (regflags & PMf_SINGLELINE)
794 *flagp |= HASWIDTH|SIMPLE;
799 *flagp |= HASWIDTH|SIMPLE;
803 ret = reg(1, &flags);
805 if (flags & TRYAGAIN)
809 *flagp |= flags&(HASWIDTH|SPSTART);
813 if (flags & TRYAGAIN) {
817 croak("internal urp in regexp at /%s/", regparse);
818 /* Supposed to be caught earlier. */
821 if (!regcurly(regparse)) {
829 FAIL("?+*{} follows nothing in regexp");
832 switch (*++regparse) {
849 ret = regnode((regflags & PMf_LOCALE) ? ALNUML : ALNUM);
850 *flagp |= HASWIDTH|SIMPLE;
854 ret = regnode((regflags & PMf_LOCALE) ? NALNUML : NALNUM);
855 *flagp |= HASWIDTH|SIMPLE;
859 ret = regnode((regflags & PMf_LOCALE) ? BOUNDL : BOUND);
864 ret = regnode((regflags & PMf_LOCALE) ? NBOUNDL : NBOUND);
869 ret = regnode((regflags & PMf_LOCALE) ? SPACEL : SPACE);
870 *flagp |= HASWIDTH|SIMPLE;
874 ret = regnode((regflags & PMf_LOCALE) ? NSPACEL : NSPACE);
875 *flagp |= HASWIDTH|SIMPLE;
879 ret = regnode(DIGIT);
880 *flagp |= HASWIDTH|SIMPLE;
884 ret = regnode(NDIGIT);
885 *flagp |= HASWIDTH|SIMPLE;
898 case '1': case '2': case '3': case '4':
899 case '5': case '6': case '7': case '8': case '9':
901 I32 num = atoi(regparse);
903 if (num > 9 && num >= regnpar)
907 ret = reganode((regflags & PMf_FOLD)
908 ? ((regflags & PMf_LOCALE) ? REFFL : REFF)
911 while (isDIGIT(*regparse))
919 if (regparse >= regxend)
920 FAIL("trailing \\ in regexp");
928 if (regflags & PMf_EXTENDED) {
929 while (regparse < regxend && *regparse != '\n') regparse++;
930 if (regparse < regxend)
945 ret = regnode((regflags & PMf_FOLD)
946 ? ((regflags & PMf_LOCALE) ? EXACTFL : EXACTF)
948 regc(0); /* save spot for len */
949 for (len = 0, p = regparse - 1;
950 len < 127 && p < regxend;
955 if (regflags & PMf_EXTENDED)
956 p = regwhite(p, regxend);
1006 ender = scan_hex(++p, 2, &numlen);
1011 ender = UCHARAT(p++);
1012 ender = toCTRL(ender);
1014 case '0': case '1': case '2': case '3':case '4':
1015 case '5': case '6': case '7': case '8':case '9':
1017 (isDIGIT(p[1]) && atoi(p) >= regnpar) ) {
1018 ender = scan_oct(p, 3, &numlen);
1028 FAIL("trailing \\ in regexp");
1039 if (regflags & PMf_EXTENDED)
1040 p = regwhite(p, regxend);
1041 if (ISMULT2(p)) { /* Back off on ?+*. */
1056 FAIL("internal disaster in regexp");
1061 if (regcode != ®dummy)
1062 *OPERAND(ret) = len;
1072 regwhite(char *p, char *e)
1077 else if (*p == '#') {
1080 } while (p < e && *p != '\n');
1089 regset(char *opnd, register I32 c)
1091 if (opnd == ®dummy)
1094 opnd[1 + (c >> 3)] |= (1 << (c & 7));
1100 register char *opnd;
1102 register I32 lastclass = 1234;
1103 register I32 range = 0;
1108 ret = regnode(ANYOF);
1110 for (Class = 0; Class < 33; Class++)
1112 if (*regparse == '^') { /* Complement of range. */
1115 if (opnd != ®dummy)
1116 *opnd |= ANYOF_INVERT;
1118 if (opnd != ®dummy) {
1119 if (regflags & PMf_FOLD)
1120 *opnd |= ANYOF_FOLD;
1121 if (regflags & PMf_LOCALE)
1122 *opnd |= ANYOF_LOCALE;
1124 if (*regparse == ']' || *regparse == '-')
1125 goto skipcond; /* allow 1st char to be ] or - */
1126 while (regparse < regxend && *regparse != ']') {
1128 Class = UCHARAT(regparse++);
1129 if (Class == '\\') {
1130 Class = UCHARAT(regparse++);
1133 if (regflags & PMf_LOCALE) {
1134 if (opnd != ®dummy)
1135 *opnd |= ANYOF_ALNUML;
1138 for (Class = 0; Class < 256; Class++)
1140 regset(opnd, Class);
1145 if (regflags & PMf_LOCALE) {
1146 if (opnd != ®dummy)
1147 *opnd |= ANYOF_NALNUML;
1150 for (Class = 0; Class < 256; Class++)
1151 if (!isALNUM(Class))
1152 regset(opnd, Class);
1157 if (regflags & PMf_LOCALE) {
1158 if (opnd != ®dummy)
1159 *opnd |= ANYOF_SPACEL;
1162 for (Class = 0; Class < 256; Class++)
1164 regset(opnd, Class);
1169 if (regflags & PMf_LOCALE) {
1170 if (opnd != ®dummy)
1171 *opnd |= ANYOF_NSPACEL;
1174 for (Class = 0; Class < 256; Class++)
1175 if (!isSPACE(Class))
1176 regset(opnd, Class);
1181 for (Class = '0'; Class <= '9'; Class++)
1182 regset(opnd, Class);
1186 for (Class = 0; Class < '0'; Class++)
1187 regset(opnd, Class);
1188 for (Class = '9' + 1; Class < 256; Class++)
1189 regset(opnd, Class);
1214 Class = scan_hex(regparse, 2, &numlen);
1218 Class = UCHARAT(regparse++);
1219 Class = toCTRL(Class);
1221 case '0': case '1': case '2': case '3': case '4':
1222 case '5': case '6': case '7': case '8': case '9':
1223 Class = scan_oct(--regparse, 3, &numlen);
1229 if (lastclass > Class)
1230 FAIL("invalid [] range in regexp");
1235 if (*regparse == '-' && regparse+1 < regxend &&
1236 regparse[1] != ']') {
1239 continue; /* do it next time */
1242 for ( ; lastclass <= Class; lastclass++)
1243 regset(opnd, lastclass);
1246 if (*regparse != ']')
1247 FAIL("unmatched [] in regexp");
1255 char* retval = regparse++;
1258 if (*regparse == '(' && regparse[1] == '?' &&
1259 regparse[2] == '#') {
1260 while (*regparse && *regparse != ')')
1265 if (regflags & PMf_EXTENDED) {
1266 if (isSPACE(*regparse)) {
1270 else if (*regparse == '#') {
1271 while (*regparse && *regparse != '\n')
1282 - regnode - emit a node
1284 #ifdef CAN_PROTOTYPE
1285 static char * /* Location. */
1288 static char * /* Location. */
1297 if (ret == ®dummy) {
1308 if (!((long)ret & 1))
1314 *ptr++ = '\0'; /* Null "next" pointer. */
1322 - reganode - emit a node with an argument
1324 #ifdef CAN_PROTOTYPE
1325 static char * /* Location. */
1326 reganode(char op, unsigned short arg)
1328 static char * /* Location. */
1338 if (ret == ®dummy) {
1349 if (!((long)ret & 1))
1355 *ptr++ = '\0'; /* Null "next" pointer. */
1358 *(unsigned short *)(ret+3) = arg;
1360 ret[3] = arg >> 8; ret[4] = arg & 0377;
1369 - regc - emit (if appropriate) a byte of code
1371 #ifdef CAN_PROTOTYPE
1380 if (regcode != ®dummy)
1387 - reginsert - insert an operator in front of already-emitted operand
1389 * Means relocating the operand.
1391 #ifdef CAN_PROTOTYPE
1393 reginsert(char op, char *opnd)
1403 register char *place;
1404 register int offset = (regkind[(U8)op] == CURLY ? 4 : 0);
1406 if (regcode == ®dummy) {
1408 regsize += 4 + offset;
1410 regsize += 3 + offset;
1417 regcode += 4 + offset;
1419 regcode += 3 + offset;
1425 place = opnd; /* Op node, where operand used to be. */
1429 while (offset-- > 0)
1437 - regtail - set the next-pointer at the end of a node chain
1440 regtail(char *p, char *val)
1442 register char *scan;
1443 register char *temp;
1444 register I32 offset;
1449 /* Find last node. */
1452 temp = regnext(scan);
1459 offset = val - scan;
1461 *(short*)(scan+1) = offset;
1466 if (OP(scan) == BACK)
1467 offset = scan - val;
1469 offset = val - scan;
1470 *(scan+1) = (offset>>8)&0377;
1471 *(scan+2) = offset&0377;
1476 - regoptail - regtail on operand of first argument; nop if operandless
1479 regoptail(char *p, char *val)
1481 /* "Operandless" and "op != BRANCH" are synonymous in practice. */
1482 if (p == NULL || p == ®dummy || regkind[(U8)OP(p)] != BRANCH)
1484 regtail(NEXTOPER(p), val);
1488 - regcurly - a little FSA that accepts {\d+,?\d*}
1491 regcurly(register char *s)
1511 - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
1517 register char op = EXACT; /* Arbitrary non-END op. */
1518 register char *next;
1519 SV *sv = sv_newmortal();
1522 while (op != END) { /* While that wasn't END last time... */
1530 PerlIO_printf(Perl_debug_log, "%2ld%s", (long)(s - r->program), SvPVX(sv));
1532 s += regarglen[(U8)op];
1533 if (next == NULL) /* Next ptr. */
1534 PerlIO_printf(Perl_debug_log, "(0)");
1536 PerlIO_printf(Perl_debug_log, "(%ld)", (long)(s-r->program)+(next-s));
1541 if (regkind[(U8)op] == EXACT) {
1542 /* Literal string, where present. */
1544 (void)PerlIO_putc(Perl_debug_log, ' ');
1545 (void)PerlIO_putc(Perl_debug_log, '<');
1546 while (*s != '\0') {
1547 (void)PerlIO_putc(Perl_debug_log,*s);
1550 (void)PerlIO_putc(Perl_debug_log, '>');
1553 (void)PerlIO_putc(Perl_debug_log, '\n');
1556 /* Header fields of interest. */
1558 PerlIO_printf(Perl_debug_log, "start `%s' ", SvPVX(r->regstart));
1559 if (r->regstclass) {
1560 regprop(sv, r->regstclass);
1561 PerlIO_printf(Perl_debug_log, "stclass `%s' ", SvPVX(sv));
1563 if (r->reganch & ROPT_ANCH) {
1564 PerlIO_printf(Perl_debug_log, "anchored");
1565 if (r->reganch & ROPT_ANCH_BOL)
1566 PerlIO_printf(Perl_debug_log, "(BOL)");
1567 if (r->reganch & ROPT_ANCH_GPOS)
1568 PerlIO_printf(Perl_debug_log, "(GPOS)");
1569 PerlIO_putc(Perl_debug_log, ' ');
1571 if (r->reganch & ROPT_SKIP)
1572 PerlIO_printf(Perl_debug_log, "plus ");
1573 if (r->reganch & ROPT_IMPLICIT)
1574 PerlIO_printf(Perl_debug_log, "implicit ");
1575 if (r->regmust != NULL)
1576 PerlIO_printf(Perl_debug_log, "must have \"%s\" back %ld ", SvPVX(r->regmust),
1578 PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen);
1579 PerlIO_printf(Perl_debug_log, "\n");
1583 - regprop - printable representation of opcode
1586 regprop(SV *sv, char *o)
1588 register char *p = 0;
1653 sv_catpvf(sv, "CURLY {%d,%d}", ARG1(o), ARG2(o));
1656 sv_catpvf(sv, "CURLYX {%d,%d}", ARG1(o), ARG2(o));
1659 sv_catpvf(sv, "REF%d", ARG1(o));
1662 sv_catpvf(sv, "REFF%d", ARG1(o));
1665 sv_catpvf(sv, "REFFL%d", ARG1(o));
1668 sv_catpvf(sv, "OPEN%d", ARG1(o));
1671 sv_catpvf(sv, "CLOSE%d", ARG1(o));
1729 FAIL("corrupted regexp opcode");
1734 #endif /* DEBUGGING */
1737 pregfree(struct regexp *r)
1742 Safefree(r->precomp);
1743 r->precomp = Nullch;
1746 Safefree(r->subbase);
1747 r->subbase = Nullch;
1750 SvREFCNT_dec(r->regmust);
1751 r->regmust = Nullsv;
1754 SvREFCNT_dec(r->regstart);
1755 r->regstart = Nullsv;
1757 Safefree(r->startp);