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-1994, 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.
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 */
74 #define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?')
75 #define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
76 ((*s) == '{' && regcurly(s)))
78 #define PERL_META "^$.[()|?+*\\"
80 #define META "^$.[()|?+*\\"
84 #undef SPSTART /* dratted cpp namespace... */
87 * Flags to be passed up and down.
89 #define WORST 0 /* Worst case. */
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. */
96 * Forward declarations for pregcomp()'s friends.
99 static char *reg _((I32, I32 *));
100 static char *reganode _((char, unsigned short));
101 static char *regatom _((I32 *));
102 static char *regbranch _((I32 *));
103 static void regc _((char));
104 static char *regclass _((void));
105 STATIC I32 regcurly _((char *));
106 static char *regnode _((char));
107 static char *regpiece _((I32 *));
108 static void reginsert _((char, char *));
109 static void regoptail _((char *, char *));
110 static void regset _((char *, I32));
111 static void regtail _((char *, char *));
112 static char* nextchar _((void));
115 - pregcomp - compile a regular expression into internal code
117 * We can't allocate space until we know how big the compiled form will be,
118 * but we can't compile it (and thus know how big it is) until we've got a
119 * place to put the code. So we cheat: we compile it twice, once with code
120 * generation turned off and size counting turned on, and once "for real".
121 * This also means that we don't allocate space until we are sure that the
122 * thing really will compile successfully, and we never have to move the
123 * code and thus invalidate pointers into it. (Note that it has to be in
124 * one piece because free() must be able to free it all.) [NB: not true in perl]
126 * Beware that the optimization-preparation code in here knows about some
127 * of the structure of the compiled regexp. [I'll say.]
130 pregcomp(exp,xend,pm)
137 register SV *longish;
140 register char *first;
150 croak("NULL regexp argument");
152 regprecomp = savepvn(exp, xend - exp);
153 regflags = pm->op_pmflags;
156 /* First pass: determine size, legality. */
164 if (reg(0, &flags) == NULL) {
165 Safefree(regprecomp);
170 /* Small enough for pointer-storage convention? */
171 if (regsize >= 32767L) /* Probably could be 65535L. */
172 FAIL("regexp too big");
174 /* Allocate space and initialize. */
175 Newc(1001, r, sizeof(regexp) + (unsigned)regsize, char, regexp);
177 FAIL("regexp out of space");
178 r->prelen = xend - exp;
179 r->precomp = regprecomp;
180 r->subbeg = r->subbase = NULL;
182 /* Second pass: emit code. */
187 regcode = r->program;
189 if (reg(0, &flags) == NULL)
192 /* Dig out information for optimizations. */
193 pm->op_pmflags = regflags;
194 r->regstart = Nullsv; /* Worst-case defaults. */
198 r->regstclass = Nullch;
199 r->naughty = regnaughty >= 10; /* Probably an expensive pattern. */
200 scan = r->program+1; /* First BRANCH. */
201 if (OP(regnext(scan)) == END) {/* Only one top-level choice. */
202 scan = NEXTOPER(scan);
205 while ((OP(first) == OPEN && (sawopen = 1)) ||
206 (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
207 (OP(first) == PLUS) ||
208 (OP(first) == MINMOD) ||
209 (regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) {
210 if (OP(first) == PLUS)
213 first += regarglen[(U8)OP(first)];
214 first = NEXTOPER(first);
217 /* Starting-point info. */
219 if (OP(first) == EXACT) {
220 r->regstart = newSVpv(OPERAND(first)+1,*OPERAND(first));
221 if (SvCUR(r->regstart) > !sawstudy)
222 fbm_compile(r->regstart);
223 (void)SvUPGRADE(r->regstart, SVt_PVBM);
225 else if (strchr(simple+2,OP(first)))
226 r->regstclass = first;
227 else if (regkind[(U8)OP(first)] == BOUND ||
228 regkind[(U8)OP(first)] == NBOUND)
229 r->regstclass = first;
230 else if (regkind[(U8)OP(first)] == BOL) {
231 r->reganch |= ROPT_ANCH_BOL;
232 first = NEXTOPER(first);
235 else if (OP(first) == GPOS) {
236 r->reganch |= ROPT_ANCH_GPOS;
237 first = NEXTOPER(first);
240 else if ((OP(first) == STAR &&
241 regkind[(U8)OP(NEXTOPER(first))] == ANY) &&
242 !(r->reganch & ROPT_ANCH) )
244 /* turn .* into ^.* with an implied $*=1 */
245 r->reganch |= ROPT_ANCH_BOL | ROPT_IMPLICIT;
246 first = NEXTOPER(first);
249 if (sawplus && (!sawopen || !regsawback))
250 r->reganch |= ROPT_SKIP; /* x+ must match 1st of run */
252 DEBUG_r(PerlIO_printf(Perl_debug_log, "first %d next %d offset %d\n",
253 OP(first), OP(NEXTOPER(first)), first - scan));
255 * If there's something expensive in the r.e., find the
256 * longest literal string that must appear and make it the
257 * regmust. Resolve ties in favor of later strings, since
258 * the regstart check works with the beginning of the r.e.
259 * and avoiding duplication strengthens checking. Not a
260 * strong reason, but sufficient in the absence of others.
261 * [Now we resolve ties in favor of the earlier string if
262 * it happens that curback has been invalidated, since the
263 * earlier string may buy us something the later one won't.]
265 longish = newSVpv("",0);
266 longest = newSVpv("",0);
272 while (OP(scan) != END) {
273 if (OP(scan) == BRANCH) {
274 if (OP(regnext(scan)) == BRANCH) {
276 while (OP(scan) == BRANCH)
277 scan = regnext(scan);
279 else /* single branch is ok */
280 scan = NEXTOPER(scan);
283 if (OP(scan) == UNLESSM) {
285 scan = regnext(scan);
288 if (OP(scan) == EXACT) {
292 while (OP(t = regnext(scan)) == CLOSE)
294 minlen += *OPERAND(first);
295 if (curback - backish == len) {
296 sv_catpvn(longish, OPERAND(first)+1,
298 len += *OPERAND(first);
299 curback += *OPERAND(first);
300 first = regnext(scan);
302 else if (*OPERAND(first) >= len + (curback >= 0)) {
303 len = *OPERAND(first);
304 sv_setpvn(longish, OPERAND(first)+1,len);
307 first = regnext(scan);
310 curback += *OPERAND(first);
312 else if (strchr(varies,OP(scan))) {
315 if (SvCUR(longish) > SvCUR(longest)) {
316 sv_setsv(longest,longish);
319 sv_setpvn(longish,"",0);
320 if (OP(scan) == PLUS && strchr(simple,OP(NEXTOPER(scan))))
322 else if (regkind[(U8)OP(scan)] == CURLY &&
323 strchr(simple,OP(NEXTOPER(scan)+4)))
324 minlen += ARG1(scan);
326 else if (strchr(simple,OP(scan))) {
330 if (SvCUR(longish) > SvCUR(longest)) {
331 sv_setsv(longest,longish);
334 sv_setpvn(longish,"",0);
336 scan = regnext(scan);
339 /* Prefer earlier on tie, unless we can tail match latter */
341 if (SvCUR(longish) + (regkind[(U8)OP(first)] == EOL)
344 sv_setsv(longest,longish);
348 sv_setpvn(longish,"",0);
351 || !fbm_instr((unsigned char*) SvPVX(r->regstart),
352 (unsigned char *) (SvPVX(r->regstart)
353 + SvCUR(r->regstart)),
356 r->regmust = longest;
359 r->regback = backest;
360 if (SvCUR(longest) > !(sawstudy || regkind[(U8)OP(first)] == EOL))
361 fbm_compile(r->regmust);
362 (void)SvUPGRADE(r->regmust, SVt_PVBM);
363 BmUSEFUL(r->regmust) = 100;
364 if (regkind[(U8)OP(first)] == EOL && SvCUR(longish))
365 SvTAIL_on(r->regmust);
368 SvREFCNT_dec(longest);
371 SvREFCNT_dec(longish);
374 r->nparens = regnpar - 1;
376 Newz(1002, r->startp, regnpar, char*);
377 Newz(1002, r->endp, regnpar, char*);
383 - reg - regular expression, i.e. main body or parenthesized thing
385 * Caller must absorb opening parenthesis.
387 * Combining parenthesis handling with the base level of regular expression
388 * is a trifle forced, but the need to tie the tails of the branches to what
389 * follows makes it hard to avoid.
393 I32 paren; /* Parenthesized? */
398 register char *ender = 0;
399 register I32 parno = 0;
402 *flagp = HASWIDTH; /* Tentatively. */
404 /* Make an OPEN node, if parenthesized. */
406 if (*regparse == '?') {
417 croak("Sequence (?%c...) not implemented", paren);
420 while (*regparse && *regparse != ')')
422 if (*regparse != ')')
423 croak("Sequence (?#... not terminated");
429 while (*regparse && strchr("iogmsx", *regparse))
430 pmflag(®flags, *regparse++);
431 if (*regparse != ')')
432 croak("Sequence (?%c...) not recognized", *regparse);
441 ret = reganode(OPEN, parno);
446 /* Pick up the branches, linking them together. */
447 br = regbranch(&flags);
451 regtail(ret, br); /* OPEN -> first. */
454 if (!(flags&HASWIDTH))
456 *flagp |= flags&SPSTART;
457 while (*regparse == '|') {
459 br = regbranch(&flags);
462 regtail(ret, br); /* BRANCH -> BRANCH. */
463 if (!(flags&HASWIDTH))
465 *flagp |= flags&SPSTART;
468 /* Make a closing node, and hook it on the end. */
471 ender = regnode(NOTHING);
474 ender = reganode(CLOSE, parno);
478 ender = regnode(SUCCEED);
482 ender = regnode(END);
487 /* Hook the tails of the branches to the closing node. */
488 for (br = ret; br != NULL; br = regnext(br))
489 regoptail(br, ender);
492 reginsert(IFMATCH,ret);
493 regtail(ret, regnode(NOTHING));
495 else if (paren == '!') {
496 reginsert(UNLESSM,ret);
497 regtail(ret, regnode(NOTHING));
500 /* Check for proper termination. */
501 if (paren && (regparse >= regxend || *nextchar() != ')')) {
502 FAIL("unmatched () in regexp");
503 } else if (!paren && regparse < regxend) {
504 if (*regparse == ')') {
505 FAIL("unmatched () in regexp");
507 FAIL("junk on end of regexp"); /* "Can't happen". */
515 - regbranch - one alternative of an | operator
517 * Implements the concatenation operator.
524 register char *chain;
525 register char *latest;
528 *flagp = WORST; /* Tentatively. */
530 ret = regnode(BRANCH);
534 while (regparse < regxend && *regparse != '|' && *regparse != ')') {
536 latest = regpiece(&flags);
537 if (latest == NULL) {
538 if (flags & TRYAGAIN)
542 *flagp |= flags&HASWIDTH;
543 if (chain == NULL) /* First piece. */
544 *flagp |= flags&SPSTART;
547 regtail(chain, latest);
551 if (chain == NULL) /* Loop ran zero times. */
552 (void) regnode(NOTHING);
558 - regpiece - something followed by possible [*+?]
560 * Note that the branching code sequences used for ? and the general cases
561 * of * and + are somewhat optimized: they use the same NOTHING node as
562 * both the endmarker for their branch list and the body of the last branch.
563 * It might seem that this node could be dispensed with entirely, but the
564 * endmarker role is not redundant.
574 char *origparse = regparse;
579 ret = regatom(&flags);
581 if (flags & TRYAGAIN)
587 if (op == '(' && regparse[1] == '?' && regparse[2] == '#') {
588 while (op && op != ')')
596 if (op == '{' && regcurly(regparse)) {
599 while (isDIGIT(*next) || *next == ',') {
608 if (*next == '}') { /* got one */
612 min = atoi(regparse);
618 if (!max && *maxpos != '0')
619 max = 32767; /* meaning "infinity" */
624 if ((flags&SIMPLE)) {
625 regnaughty += 2 + regnaughty / 2;
626 reginsert(CURLY, ret);
629 regnaughty += 4 + regnaughty; /* compound interest */
630 regtail(ret, regnode(WHILEM));
631 reginsert(CURLYX,ret);
632 regtail(ret, regnode(NOTHING));
636 *flagp = (WORST|HASWIDTH);
637 if (max && max < min)
638 croak("Can't do {n,m} with n > m");
639 if (regcode != ®dummy) {
641 *(unsigned short *)(ret+3) = min;
642 *(unsigned short *)(ret+5) = max;
644 ret[3] = min >> 8; ret[4] = min & 0377;
645 ret[5] = max >> 8; ret[6] = max & 0377;
659 *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);
661 if (op == '*' && (flags&SIMPLE)) {
662 reginsert(STAR, ret);
665 else if (op == '*') {
668 } else if (op == '+' && (flags&SIMPLE)) {
669 reginsert(PLUS, ret);
672 else if (op == '+') {
675 } else if (op == '?') {
680 if (dowarn && regcode != ®dummy && !(flags&HASWIDTH) && max > 10000) {
681 warn("%.*s matches null string many times",
682 regparse - origparse, origparse);
685 if (*regparse == '?') {
687 reginsert(MINMOD, ret);
689 regtail(ret, ret + 4);
691 regtail(ret, ret + 3);
694 if (ISMULT2(regparse))
695 FAIL("nested *?+ in regexp");
701 - regatom - the lowest level
703 * Optimization: gobbles an entire sequence of ordinary characters so that
704 * it can turn them into a single node, which is smaller to store and
705 * faster to run. Backslashed characters are exceptions, each becoming a
706 * separate node; the code is simpler that way and it's not worth fixing.
708 * [Yes, it is worth fixing, some scripts can run twice the speed.]
714 register char *ret = 0;
717 *flagp = WORST; /* Tentatively. */
723 if (regflags & PMf_MULTILINE)
725 else if (regflags & PMf_SINGLELINE)
732 if (regflags & PMf_MULTILINE)
734 else if (regflags & PMf_SINGLELINE)
741 if (regflags & PMf_SINGLELINE)
746 *flagp |= HASWIDTH|SIMPLE;
751 *flagp |= HASWIDTH|SIMPLE;
755 ret = reg(1, &flags);
757 if (flags & TRYAGAIN)
761 *flagp |= flags&(HASWIDTH|SPSTART);
765 if (flags & TRYAGAIN) {
769 croak("internal urp in regexp at /%s/", regparse);
770 /* Supposed to be caught earlier. */
773 if (!regcurly(regparse)) {
781 FAIL("?+*{} follows nothing in regexp");
784 switch (*++regparse) {
801 ret = regnode((regflags & PMf_LOCALE) ? ALNUML : ALNUM);
802 *flagp |= HASWIDTH|SIMPLE;
806 ret = regnode((regflags & PMf_LOCALE) ? NALNUML : NALNUM);
807 *flagp |= HASWIDTH|SIMPLE;
811 ret = regnode((regflags & PMf_LOCALE) ? BOUNDL : BOUND);
816 ret = regnode((regflags & PMf_LOCALE) ? NBOUNDL : NBOUND);
821 ret = regnode((regflags & PMf_LOCALE) ? SPACEL : SPACE);
822 *flagp |= HASWIDTH|SIMPLE;
826 ret = regnode((regflags & PMf_LOCALE) ? NSPACEL : NSPACE);
827 *flagp |= HASWIDTH|SIMPLE;
831 ret = regnode(DIGIT);
832 *flagp |= HASWIDTH|SIMPLE;
836 ret = regnode(NDIGIT);
837 *flagp |= HASWIDTH|SIMPLE;
850 case '1': case '2': case '3': case '4':
851 case '5': case '6': case '7': case '8': case '9':
853 I32 num = atoi(regparse);
855 if (num > 9 && num >= regnpar)
859 ret = reganode(REF, num);
861 while (isDIGIT(*regparse))
869 if (regparse >= regxend)
870 FAIL("trailing \\ in regexp");
878 if (regflags & PMf_EXTENDED) {
879 while (regparse < regxend && *regparse != '\n') regparse++;
880 if (regparse < regxend)
895 ret = regnode((regflags & PMf_FOLD)
896 ? ((regflags & PMf_LOCALE) ? EXACTFL : EXACTF)
898 regc(0); /* save spot for len */
899 for (len = 0, p = regparse - 1;
900 len < 127 && p < regxend;
953 ender = scan_hex(++p, 2, &numlen);
958 ender = UCHARAT(p++);
959 ender = toCTRL(ender);
961 case '0': case '1': case '2': case '3':case '4':
962 case '5': case '6': case '7': case '8':case '9':
964 (isDIGIT(p[1]) && atoi(p) >= regnpar) ) {
965 ender = scan_oct(p, 3, &numlen);
975 FAIL("trailing \\ in regexp");
983 if (regflags & PMf_EXTENDED) {
984 while (p < regxend && *p != '\n') p++;
987 case ' ': case '\t': case '\n': case '\r': case '\f': case '\v':
988 if (regflags & PMf_EXTENDED) {
998 if (ISMULT2(p)) { /* Back off on ?+*. */
1013 FAIL("internal disaster in regexp");
1018 if (regcode != ®dummy)
1019 *OPERAND(ret) = len;
1033 if (opnd == ®dummy)
1036 opnd[1 + (c >> 3)] |= (1 << (c & 7));
1042 register char *opnd;
1044 register I32 lastclass = 1234;
1045 register I32 range = 0;
1050 ret = regnode(ANYOF);
1052 for (class = 0; class < 33; class++)
1054 if (*regparse == '^') { /* Complement of range. */
1057 if (opnd != ®dummy)
1058 *opnd |= ANYOF_INVERT;
1060 if (opnd != ®dummy) {
1061 if (regflags & PMf_FOLD)
1062 *opnd |= ANYOF_FOLD;
1063 if (regflags & PMf_LOCALE)
1064 *opnd |= ANYOF_LOCALE;
1066 if (*regparse == ']' || *regparse == '-')
1067 goto skipcond; /* allow 1st char to be ] or - */
1068 while (regparse < regxend && *regparse != ']') {
1070 class = UCHARAT(regparse++);
1071 if (class == '\\') {
1072 class = UCHARAT(regparse++);
1075 if (regflags & PMf_LOCALE) {
1076 if (opnd != ®dummy)
1077 *opnd |= ANYOF_ALNUML;
1080 for (class = 0; class < 256; class++)
1082 regset(opnd, class);
1087 if (regflags & PMf_LOCALE) {
1088 if (opnd != ®dummy)
1089 *opnd |= ANYOF_NALNUML;
1092 for (class = 0; class < 256; class++)
1093 if (!isALNUM(class))
1094 regset(opnd, class);
1099 if (regflags & PMf_LOCALE) {
1100 if (opnd != ®dummy)
1101 *opnd |= ANYOF_SPACEL;
1104 for (class = 0; class < 256; class++)
1106 regset(opnd, class);
1111 if (regflags & PMf_LOCALE) {
1112 if (opnd != ®dummy)
1113 *opnd |= ANYOF_NSPACEL;
1116 for (class = 0; class < 256; class++)
1117 if (!isSPACE(class))
1118 regset(opnd, class);
1123 for (class = '0'; class <= '9'; class++)
1124 regset(opnd, class);
1128 for (class = 0; class < '0'; class++)
1129 regset(opnd, class);
1130 for (class = '9' + 1; class < 256; class++)
1131 regset(opnd, class);
1156 class = scan_hex(regparse, 2, &numlen);
1160 class = UCHARAT(regparse++);
1161 class = toCTRL(class);
1163 case '0': case '1': case '2': case '3': case '4':
1164 case '5': case '6': case '7': case '8': case '9':
1165 class = scan_oct(--regparse, 3, &numlen);
1171 if (lastclass > class)
1172 FAIL("invalid [] range in regexp");
1177 if (*regparse == '-' && regparse+1 < regxend &&
1178 regparse[1] != ']') {
1181 continue; /* do it next time */
1184 for ( ; lastclass <= class; lastclass++)
1185 regset(opnd, lastclass);
1188 if (*regparse != ']')
1189 FAIL("unmatched [] in regexp");
1197 char* retval = regparse++;
1200 if (*regparse == '(' && regparse[1] == '?' &&
1201 regparse[2] == '#') {
1202 while (*regparse && *regparse != ')')
1207 if (regflags & PMf_EXTENDED) {
1208 if (isSPACE(*regparse)) {
1212 else if (*regparse == '#') {
1213 while (*regparse && *regparse != '\n')
1224 - regnode - emit a node
1226 #ifdef CAN_PROTOTYPE
1227 static char * /* Location. */
1230 static char * /* Location. */
1239 if (ret == ®dummy) {
1250 if (!((long)ret & 1))
1256 *ptr++ = '\0'; /* Null "next" pointer. */
1264 - reganode - emit a node with an argument
1266 #ifdef CAN_PROTOTYPE
1267 static char * /* Location. */
1268 reganode(char op, unsigned short arg)
1270 static char * /* Location. */
1280 if (ret == ®dummy) {
1291 if (!((long)ret & 1))
1297 *ptr++ = '\0'; /* Null "next" pointer. */
1300 *(unsigned short *)(ret+3) = arg;
1302 ret[3] = arg >> 8; ret[4] = arg & 0377;
1311 - regc - emit (if appropriate) a byte of code
1313 #ifdef CAN_PROTOTYPE
1322 if (regcode != ®dummy)
1329 - reginsert - insert an operator in front of already-emitted operand
1331 * Means relocating the operand.
1333 #ifdef CAN_PROTOTYPE
1335 reginsert(char op, char *opnd)
1345 register char *place;
1346 register int offset = (regkind[(U8)op] == CURLY ? 4 : 0);
1348 if (regcode == ®dummy) {
1350 regsize += 4 + offset;
1352 regsize += 3 + offset;
1359 regcode += 4 + offset;
1361 regcode += 3 + offset;
1367 place = opnd; /* Op node, where operand used to be. */
1371 while (offset-- > 0)
1379 - regtail - set the next-pointer at the end of a node chain
1386 register char *scan;
1387 register char *temp;
1388 register I32 offset;
1393 /* Find last node. */
1396 temp = regnext(scan);
1403 offset = val - scan;
1405 *(short*)(scan+1) = offset;
1410 if (OP(scan) == BACK)
1411 offset = scan - val;
1413 offset = val - scan;
1414 *(scan+1) = (offset>>8)&0377;
1415 *(scan+2) = offset&0377;
1420 - regoptail - regtail on operand of first argument; nop if operandless
1427 /* "Operandless" and "op != BRANCH" are synonymous in practice. */
1428 if (p == NULL || p == ®dummy || regkind[(U8)OP(p)] != BRANCH)
1430 regtail(NEXTOPER(p), val);
1434 - regcurly - a little FSA that accepts {\d+,?\d*}
1458 - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
1465 register char op = EXACT; /* Arbitrary non-END op. */
1466 register char *next;
1470 while (op != END) { /* While that wasn't END last time... */
1476 PerlIO_printf(Perl_debug_log, "%2d%s", s-r->program, regprop(s)); /* Where, what. */
1478 s += regarglen[(U8)op];
1479 if (next == NULL) /* Next ptr. */
1480 PerlIO_printf(Perl_debug_log, "(0)");
1482 PerlIO_printf(Perl_debug_log, "(%d)", (s-r->program)+(next-s));
1487 if (regkind[(U8)op] == EXACT) {
1488 /* Literal string, where present. */
1490 (void)PerlIO_putc(Perl_debug_log, ' ');
1491 (void)PerlIO_putc(Perl_debug_log, '<');
1492 while (*s != '\0') {
1493 (void)PerlIO_putc(Perl_debug_log,*s);
1496 (void)PerlIO_putc(Perl_debug_log, '>');
1499 (void)PerlIO_putc(Perl_debug_log, '\n');
1502 /* Header fields of interest. */
1504 PerlIO_printf(Perl_debug_log, "start `%s' ", SvPVX(r->regstart));
1506 PerlIO_printf(Perl_debug_log, "stclass `%s' ", regprop(r->regstclass));
1507 if (r->reganch & ROPT_ANCH) {
1508 PerlIO_printf(Perl_debug_log, "anchored");
1509 if (r->reganch & ROPT_ANCH_BOL)
1510 PerlIO_printf(Perl_debug_log, "(BOL)");
1511 if (r->reganch & ROPT_ANCH_GPOS)
1512 PerlIO_printf(Perl_debug_log, "(GPOS)");
1513 PerlIO_putc(Perl_debug_log, ' ');
1515 if (r->reganch & ROPT_SKIP)
1516 PerlIO_printf(Perl_debug_log, "plus ");
1517 if (r->reganch & ROPT_IMPLICIT)
1518 PerlIO_printf(Perl_debug_log, "implicit ");
1519 if (r->regmust != NULL)
1520 PerlIO_printf(Perl_debug_log, "must have \"%s\" back %ld ", SvPVX(r->regmust),
1522 PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen);
1523 PerlIO_printf(Perl_debug_log, "\n");
1527 - regprop - printable representation of opcode
1533 register char *p = 0;
1535 (void) strcpy(buf, ":");
1599 (void)sprintf(buf+strlen(buf), "CURLY {%d,%d}", ARG1(op),ARG2(op));
1603 (void)sprintf(buf+strlen(buf), "CURLYX {%d,%d}", ARG1(op),ARG2(op));
1607 (void)sprintf(buf+strlen(buf), "REF%d", ARG1(op));
1611 (void)sprintf(buf+strlen(buf), "OPEN%d", ARG1(op));
1615 (void)sprintf(buf+strlen(buf), "CLOSE%d", ARG1(op));
1673 FAIL("corrupted regexp opcode");
1676 (void) strcat(buf, p);
1679 #endif /* DEBUGGING */
1688 Safefree(r->precomp);
1689 r->precomp = Nullch;
1692 Safefree(r->subbase);
1693 r->subbase = Nullch;
1696 SvREFCNT_dec(r->regmust);
1697 r->regmust = Nullsv;
1700 SvREFCNT_dec(r->regstart);
1701 r->regstart = Nullsv;
1703 Safefree(r->startp);