projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Fix file-descriptor leak when pipes fail via taint checks:
[p5sagit/p5-mst-13.2.git] / regcomp.c
CommitLineData
a0d0e21e 1/* regcomp.c
2 */
3
4/*
5 * "A fair jaw-cracker dwarf-language must be." --Samwise Gamgee
6 */
7
a687059c 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 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 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 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 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"
c277df42 59
60#define REG_COMP_C
a687059c 61#include "regcomp.h"
62
d4cce5f1 63#ifdef op
11343788 64#undef op
d4cce5f1 65#endif /* op */
11343788 66
c277df42 67static regnode regdummy;
68static char * regparse; /* Input-scan pointer. */
69static char * regxend; /* End of input for compile */
70static regnode * regcode; /* Code-emit pointer; &regdummy = don't. */
71static I32 regnaughty; /* How bad is this pattern? */
72static I32 regsawback; /* Did we see \1, ...? */
73
74/* This guys appear both in regcomp.c and regexec.c, but there is no
75 other reason to have them global. */
76static char * regprecomp; /* uncompiled string. */
77static I32 regnpar; /* () count. */
78static I32 regsize; /* Code size. */
79static U16 regflags; /* are we folding, multilining? */
80
fe14fcc3 81#ifdef MSDOS
82# if defined(BUGGY_MSC6)
83 /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
84 # pragma optimize("a",off)
85 /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
86 # pragma optimize("w",on )
87# endif /* BUGGY_MSC6 */
88#endif /* MSDOS */
89
a687059c 90#ifndef STATIC
91#define STATIC static
92#endif
93
94#define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?')
95#define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
96 ((*s) == '{' && regcurly(s)))
2b69d0c2 97#ifdef atarist
98#define PERL_META "^$.[()|?+*\\"
99#else
a687059c 100#define META "^$.[()|?+*\\"
2b69d0c2 101#endif
a687059c 102
35c8bce7 103#ifdef SPSTART
104#undef SPSTART /* dratted cpp namespace... */
105#endif
a687059c 106/*
107 * Flags to be passed up and down.
108 */
a687059c 109#define WORST 0 /* Worst case. */
a0d0e21e 110#define HASWIDTH 0x1 /* Known never to match null string. */
111#define SIMPLE 0x2 /* Simple enough to be STAR/PLUS operand. */
112#define SPSTART 0x4 /* Starts with * or +. */
113#define TRYAGAIN 0x8 /* Weeded out a declaration. */
a687059c 114
115/*
e50aee73 116 * Forward declarations for pregcomp()'s friends.
a687059c 117 */
a0d0e21e 118
c277df42 119static regnode *reg _((I32, I32 *));
120static regnode *reganode _((U8, U32));
121static regnode *regatom _((I32 *));
122static regnode *regbranch _((I32 *, I32));
123static void regc _((U8, char *));
124static regnode *regclass _((void));
a0d0e21e 125STATIC I32 regcurly _((char *));
c277df42 126static regnode *reg_node _((U8));
127static regnode *regpiece _((I32 *));
128static void reginsert _((U8, regnode *));
129static void regoptail _((regnode *, regnode *));
bbce6d69 130static void regset _((char *, I32));
c277df42 131static void regtail _((regnode *, regnode *));
5b5a24f7 132static char* regwhite _((char *, char *));
a0d0e21e 133static char* nextchar _((void));
a687059c 134
c277df42 135static U32 regseen;
136static I32 seen_zerolen;
137static regexp *rx;
138static I32 extralen;
139
140#ifdef DEBUGGING
141static int colorset;
142char *colors[4];
143#endif
144
145/* Length of a variant. */
146
147typedef struct {
148 I32 len_min;
149 I32 len_delta;
150 I32 pos_min;
151 I32 pos_delta;
152 SV *last_found;
153 I32 last_end; /* min value, <0 unless valid. */
154 I32 last_start_min;
155 I32 last_start_max;
156 SV **longest; /* Either &l_fixed, or &l_float. */
157 SV *longest_fixed;
158 I32 offset_fixed;
159 SV *longest_float;
160 I32 offset_float_min;
161 I32 offset_float_max;
162 I32 flags;
163} scan_data_t;
164
165static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
166
167#define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
168#define SF_BEFORE_SEOL 0x1
169#define SF_BEFORE_MEOL 0x2
170#define SF_FIX_BEFORE_EOL (SF_FIX_BEFORE_SEOL|SF_FIX_BEFORE_MEOL)
171#define SF_FL_BEFORE_EOL (SF_FL_BEFORE_SEOL|SF_FL_BEFORE_MEOL)
172
173#define SF_FIX_SHIFT_EOL (+2)
174#define SF_FL_SHIFT_EOL (+4)
175
176#define SF_FIX_BEFORE_SEOL (SF_BEFORE_SEOL << SF_FIX_SHIFT_EOL)
177#define SF_FIX_BEFORE_MEOL (SF_BEFORE_MEOL << SF_FIX_SHIFT_EOL)
178
179#define SF_FL_BEFORE_SEOL (SF_BEFORE_SEOL << SF_FL_SHIFT_EOL)
180#define SF_FL_BEFORE_MEOL (SF_BEFORE_MEOL << SF_FL_SHIFT_EOL) /* 0x20 */
181#define SF_IS_INF 0x40
182#define SF_HAS_PAR 0x80
183#define SF_IN_PAR 0x100
184#define SF_HAS_EVAL 0x200
4bfe0158 185#define SCF_DO_SUBSTR 0x400
c277df42 186
187static void
188scan_commit(scan_data_t *data)
189{
190 STRLEN l = SvCUR(data->last_found);
191 STRLEN old_l = SvCUR(*data->longest);
192
193 if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
194 sv_setsv(*data->longest, data->last_found);
195 if (*data->longest == data->longest_fixed) {
196 data->offset_fixed = l ? data->last_start_min : data->pos_min;
197 if (data->flags & SF_BEFORE_EOL)
198 data->flags
199 |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL);
200 else
201 data->flags &= ~SF_FIX_BEFORE_EOL;
202 } else {
203 data->offset_float_min = l ? data->last_start_min : data->pos_min;
204 data->offset_float_max = (l
205 ? data->last_start_max
206 : data->pos_min + data->pos_delta);
207 if (data->flags & SF_BEFORE_EOL)
208 data->flags
209 |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL);
210 else
211 data->flags &= ~SF_FL_BEFORE_EOL;
212 }
213 }
214 SvCUR_set(data->last_found, 0);
215 data->last_end = -1;
216 data->flags &= ~SF_BEFORE_EOL;
217}
218
c277df42 219/* Stops at toplevel WHILEM as well as at `last'. At end *scanp is set
220 to the position after last scanned or to NULL. */
221
222static I32
223study_chunk(regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags)
224 /* scanp: Start here (read-write). */
225 /* deltap: Write maxlen-minlen here. */
226 /* last: Stop before this one. */
227{
228 I32 min = 0, pars = 0, code;
229 regnode *scan = *scanp, *next;
230 I32 delta = 0;
231 int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
232 I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
233 scan_data_t data_fake;
234
235 while (scan && OP(scan) != END && scan < last) {
236 /* Peephole optimizer: */
237
238 if (regkind[(U8)OP(scan)] == EXACT) {
239 regnode *n = regnext(scan);
240 U32 stringok = 1;
241#ifdef DEBUGGING
242 regnode *stop = scan;
243#endif
244
245 next = scan + (*OPERAND(scan) + 2 - 1)/sizeof(regnode) + 2;
246 /* Skip NOTHING, merge EXACT*. */
247 while (n &&
248 ( regkind[(U8)OP(n)] == NOTHING ||
249 (stringok && (OP(n) == OP(scan))))
250 && NEXT_OFF(n)
251 && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
252 if (OP(n) == TAIL || n > next)
253 stringok = 0;
254 if (regkind[(U8)OP(n)] == NOTHING) {
255 NEXT_OFF(scan) += NEXT_OFF(n);
256 next = n + NODE_STEP_REGNODE;
257#ifdef DEBUGGING
258 if (stringok)
259 stop = n;
260#endif
261 n = regnext(n);
262 } else {
263 int oldl = *OPERAND(scan);
264 regnode *nnext = regnext(n);
265
266 if (oldl + *OPERAND(n) > U8_MAX)
267 break;
268 NEXT_OFF(scan) += NEXT_OFF(n);
269 *OPERAND(scan) += *OPERAND(n);
270 next = n + (*OPERAND(n) + 2 - 1)/sizeof(regnode) + 2;
271 /* Now we can overwrite *n : */
272 Move(OPERAND(n) + 1, OPERAND(scan) + oldl + 1,
273 *OPERAND(n) + 1, char);
274#ifdef DEBUGGING
275 if (stringok)
276 stop = next - 1;
277#endif
278 n = nnext;
279 }
280 }
281#ifdef DEBUGGING
282 /* Allow dumping */
283 n = scan + (*OPERAND(scan) + 2 - 1)/sizeof(regnode) + 2;
284 while (n <= stop) {
285 if (regkind[(U8)OP(n)] != NOTHING || OP(n) == NOTHING) {
286 OP(n) = OPTIMIZED;
287 NEXT_OFF(n) = 0;
288 }
289 n++;
290 }
291#endif
292
293 }
294 if (OP(scan) != CURLYX) {
295 int max = (reg_off_by_arg[OP(scan)] ? I32_MAX : U16_MAX);
296 int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
297 int noff;
298 regnode *n = scan;
299
300 /* Skip NOTHING and LONGJMP. */
301 while ((n = regnext(n))
302 && ((regkind[(U8)OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
303 || ((OP(n) == LONGJMP) && (noff = ARG(n))))
304 && off + noff < max)
305 off += noff;
306 if (reg_off_by_arg[OP(scan)])
307 ARG(scan) = off;
308 else
309 NEXT_OFF(scan) = off;
310 }
311 if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
312 || OP(scan) == IFTHEN || OP(scan) == SUSPEND) {
313 next = regnext(scan);
314 code = OP(scan);
315
316 if (OP(next) == code || code == IFTHEN || code == SUSPEND) {
317 I32 max1 = 0, min1 = I32_MAX, num = 0;
318
319 if (flags & SCF_DO_SUBSTR)
320 scan_commit(data);
321 while (OP(scan) == code) {
322 I32 deltanext, minnext;
323
324 num++;
325 data_fake.flags = 0;
326 next = regnext(scan);
327 scan = NEXTOPER(scan);
328 if (code != BRANCH)
329 scan = NEXTOPER(scan);
330 /* We suppose the run is continuous, last=next...*/
331 minnext = study_chunk(&scan, &deltanext, next,
332 &data_fake, 0);
333 if (min1 > minnext)
334 min1 = minnext;
335 if (max1 < minnext + deltanext)
336 max1 = minnext + deltanext;
337 if (deltanext == I32_MAX)
338 is_inf = 1;
339 scan = next;
340 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
341 pars++;
405ff068 342 if (data && (data_fake.flags & SF_HAS_EVAL))
c277df42 343 data->flags |= SF_HAS_EVAL;
344 if (code == SUSPEND)
345 break;
346 }
347 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
348 min1 = 0;
349 if (flags & SCF_DO_SUBSTR) {
350 data->pos_min += min1;
351 data->pos_delta += max1 - min1;
352 if (max1 != min1 || is_inf)
353 data->longest = &(data->longest_float);
354 }
355 min += min1;
356 delta += max1 - min1;
357 } else if (code == BRANCHJ) /* single branch is optimized. */
358 scan = NEXTOPER(NEXTOPER(scan));
359 else /* single branch is optimized. */
360 scan = NEXTOPER(scan);
361 continue;
362 } else if (OP(scan) == EXACT) {
363 min += *OPERAND(scan);
364 if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
365 I32 l = *OPERAND(scan);
366
367 /* The code below prefers earlier match for fixed
368 offset, later match for variable offset. */
369 if (data->last_end == -1) { /* Update the start info. */
370 data->last_start_min = data->pos_min;
371 data->last_start_max = is_inf
372 ? I32_MAX : data->pos_min + data->pos_delta;
373 }
161b471a 374 sv_catpvn(data->last_found, (char *)(OPERAND(scan)+1), l);
c277df42 375 data->last_end = data->pos_min + l;
376 data->pos_min += l; /* As in the first entry. */
377 data->flags &= ~SF_BEFORE_EOL;
378 }
379 } else if (regkind[(U8)OP(scan)] == EXACT) {
380 if (flags & SCF_DO_SUBSTR)
381 scan_commit(data);
382 min += *OPERAND(scan);
383 if (data && (flags & SCF_DO_SUBSTR))
384 data->pos_min += *OPERAND(scan);
385 } else if (strchr(varies,OP(scan))) {
386 I32 mincount, maxcount, minnext, deltanext, pos_before, fl;
387 regnode *oscan = scan;
388
389 switch (regkind[(U8)OP(scan)]) {
390 case WHILEM:
391 scan = NEXTOPER(scan);
392 goto finish;
393 case PLUS:
394 if (flags & SCF_DO_SUBSTR) {
395 next = NEXTOPER(scan);
396 if (OP(next) == EXACT) {
397 mincount = 1;
398 maxcount = REG_INFTY;
399 next = regnext(scan);
400 scan = NEXTOPER(scan);
401 goto do_curly;
402 }
403 }
404 if (flags & SCF_DO_SUBSTR)
405 data->pos_min++;
406 min++;
407 /* Fall through. */
408 case STAR:
409 is_inf = 1;
410 scan = regnext(scan);
411 if (flags & SCF_DO_SUBSTR) {
412 scan_commit(data);
413 data->longest = &(data->longest_float);
414 }
415 goto optimize_curly_tail;
416 case CURLY:
417 mincount = ARG1(scan);
418 maxcount = ARG2(scan);
419 next = regnext(scan);
420 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
421 do_curly:
422 if (flags & SCF_DO_SUBSTR) {
423 if (mincount == 0) scan_commit(data);
424 pos_before = data->pos_min;
425 }
426 if (data) {
427 fl = data->flags;
428 data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
429 if (is_inf)
430 data->flags |= SF_IS_INF;
431 }
432 /* This will finish on WHILEM, setting scan, or on NULL: */
433 minnext = study_chunk(&scan, &deltanext, last, data,
434 mincount == 0
435 ? (flags & ~SCF_DO_SUBSTR) : flags);
436 if (!scan) /* It was not CURLYX, but CURLY. */
437 scan = next;
438 if (dowarn && (minnext + deltanext == 0)
439 && !(data->flags & (SF_HAS_PAR|SF_IN_PAR)))
440 warn("Strange *+?{} on zero-length expression");
441 min += minnext * mincount;
442 is_inf |= (maxcount == REG_INFTY && (minnext + deltanext) > 0
443 || deltanext == I32_MAX);
444 delta += (minnext + deltanext) * maxcount - minnext * mincount;
445
446 /* Try powerful optimization CURLYX => CURLYN. */
447#ifdef REGALIGN_STRUCT
448 if ( OP(oscan) == CURLYX && data
449 && data->flags & SF_IN_PAR
450 && !(data->flags & SF_HAS_EVAL)
451 && !deltanext && minnext == 1 ) {
452 /* Try to optimize to CURLYN. */
453 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
454 regnode *nxt1 = nxt, *nxt2;
455
456 /* Skip open. */
457 nxt = regnext(nxt);
458 if (!strchr(simple,OP(nxt))
459 && !(regkind[(U8)OP(nxt)] == EXACT
460 && *OPERAND(nxt) == 1))
461 goto nogo;
462 nxt2 = nxt;
463 nxt = regnext(nxt);
464 if (OP(nxt) != CLOSE)
465 goto nogo;
466 /* Now we know that nxt2 is the only contents: */
467 oscan->flags = ARG(nxt);
468 OP(oscan) = CURLYN;
469 OP(nxt1) = NOTHING; /* was OPEN. */
470#ifdef DEBUGGING
471 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
472 NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
473 NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */
474 OP(nxt) = OPTIMIZED; /* was CLOSE. */
475 OP(nxt + 1) = OPTIMIZED; /* was count. */
476 NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
477#endif
478 }
479#endif
480 nogo:
481
482 /* Try optimization CURLYX => CURLYM. */
483 if ( OP(oscan) == CURLYX && data
484#ifdef REGALIGN_STRUCT
485 && !(data->flags & SF_HAS_PAR)
486#else
487 && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
488#endif
489 && !(data->flags & SF_HAS_EVAL)
490 && !deltanext ) {
491 /* XXXX How to optimize if data == 0? */
492 /* Optimize to a simpler form. */
493 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
494 regnode *nxt2;
495
496 OP(oscan) = CURLYM;
497 while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
498 && (OP(nxt2) != WHILEM))
499 nxt = nxt2;
500 OP(nxt2) = SUCCEED; /* Whas WHILEM */
501#ifdef REGALIGN_STRUCT
502 /* Need to optimize away parenths. */
503 if (data->flags & SF_IN_PAR) {
504 /* Set the parenth number. */
505 regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
506
507 if (OP(nxt) != CLOSE)
508 FAIL("panic opt close");
509 oscan->flags = ARG(nxt);
510 OP(nxt1) = OPTIMIZED; /* was OPEN. */
511 OP(nxt) = OPTIMIZED; /* was CLOSE. */
512#ifdef DEBUGGING
513 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
514 OP(nxt + 1) = OPTIMIZED; /* was count. */
515 NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
516 NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
517#endif
518#if 0
519 while ( nxt1 && (OP(nxt1) != WHILEM)) {
520 regnode *nnxt = regnext(nxt1);
521
522 if (nnxt == nxt) {
523 if (reg_off_by_arg[OP(nxt1)])
524 ARG_SET(nxt1, nxt2 - nxt1);
525 else if (nxt2 - nxt1 < U16_MAX)
526 NEXT_OFF(nxt1) = nxt2 - nxt1;
527 else
528 OP(nxt) = NOTHING; /* Cannot beautify */
529 }
530 nxt1 = nnxt;
531 }
532#endif
533 /* Optimize again: */
534 study_chunk(&nxt1, &deltanext, nxt, NULL, 0);
535 } else
536 oscan->flags = 0;
537#endif
538 }
539 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
540 pars++;
541 if (flags & SCF_DO_SUBSTR) {
542 SV *last_str = Nullsv;
543 int counted = mincount != 0;
544
545 if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
546 I32 b = pos_before >= data->last_start_min
547 ? pos_before : data->last_start_min;
548 STRLEN l;
549 char *s = SvPV(data->last_found, l);
550
551 l -= b - data->last_start_min;
552 /* Get the added string: */
553 last_str = newSVpv(s + b - data->last_start_min, l);
554 if (deltanext == 0 && pos_before == b) {
555 /* What was added is a constant string */
556 if (mincount > 1) {
557 SvGROW(last_str, (mincount * l) + 1);
558 repeatcpy(SvPVX(last_str) + l,
559 SvPVX(last_str), l, mincount - 1);
560 SvCUR(last_str) *= mincount;
561 /* Add additional parts. */
562 SvCUR_set(data->last_found,
563 SvCUR(data->last_found) - l);
564 sv_catsv(data->last_found, last_str);
565 data->last_end += l * (mincount - 1);
566 }
567 }
568 }
569 /* It is counted once already... */
570 data->pos_min += minnext * (mincount - counted);
571 data->pos_delta += - counted * deltanext +
572 (minnext + deltanext) * maxcount - minnext * mincount;
573 if (mincount != maxcount) {
574 scan_commit(data);
575 if (mincount && last_str) {
576 sv_setsv(data->last_found, last_str);
577 data->last_end = data->pos_min;
578 data->last_start_min =
579 data->pos_min - SvCUR(last_str);
580 data->last_start_max = is_inf
581 ? I32_MAX
582 : data->pos_min + data->pos_delta
583 - SvCUR(last_str);
584 }
585 data->longest = &(data->longest_float);
586 }
587 }
405ff068 588 if (data && (fl & SF_HAS_EVAL))
c277df42 589 data->flags |= SF_HAS_EVAL;
590 optimize_curly_tail:
591#ifdef REGALIGN
592 if (OP(oscan) != CURLYX) {
593 while (regkind[(U8)OP(next = regnext(oscan))] == NOTHING
594 && NEXT_OFF(next))
595 NEXT_OFF(oscan) += NEXT_OFF(next);
596 }
597#endif
598 continue;
599 default: /* REF only? */
600 if (flags & SCF_DO_SUBSTR) {
601 scan_commit(data);
602 data->longest = &(data->longest_float);
603 }
604 is_inf = 1;
605 break;
606 }
607 } else if (strchr(simple,OP(scan))) {
608 if (flags & SCF_DO_SUBSTR) {
609 scan_commit(data);
610 data->pos_min++;
611 }
612 min++;
613 } else if (regkind[(U8)OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
614 data->flags |= (OP(scan) == MEOL
615 ? SF_BEFORE_MEOL
616 : SF_BEFORE_SEOL);
617 } else if (regkind[(U8)OP(scan)] == BRANCHJ
618 && (scan->flags || data)
619 && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
620 I32 deltanext, minnext;
621 regnode *nscan;
622
623 data_fake.flags = 0;
624 next = regnext(scan);
625 nscan = NEXTOPER(NEXTOPER(scan));
626 minnext = study_chunk(&nscan, &deltanext, last, &data_fake, 0);
627 if (scan->flags) {
628 if (deltanext) {
629 FAIL("variable length lookbehind not implemented");
630 } else if (minnext > U8_MAX) {
631 FAIL2("lookbehind longer than %d not implemented", U8_MAX);
632 }
633 scan->flags = minnext;
634 }
635 if (data && data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
636 pars++;
405ff068 637 if (data && (data_fake.flags & SF_HAS_EVAL))
c277df42 638 data->flags |= SF_HAS_EVAL;
639 } else if (OP(scan) == OPEN) {
640 pars++;
641 } else if (OP(scan) == CLOSE && ARG(scan) == is_par) {
642#ifdef REGALIGN_STRUCT
643 next = regnext(scan);
644
645 if ( next && (OP(next) != WHILEM) && next < last)
646#endif
647 is_par = 0; /* Disable optimization */
648 } else if (OP(scan) == EVAL) {
649 if (data)
650 data->flags |= SF_HAS_EVAL;
651 }
652 /* Else: zero-length, ignore. */
653 scan = regnext(scan);
654 }
655
656 finish:
657 *scanp = scan;
658 *deltap = is_inf ? I32_MAX : delta;
659 if (flags & SCF_DO_SUBSTR && is_inf)
660 data->pos_delta = I32_MAX - data->pos_min;
661 if (is_par > U8_MAX)
662 is_par = 0;
663 if (is_par && pars==1 && data) {
664 data->flags |= SF_IN_PAR;
665 data->flags &= ~SF_HAS_PAR;
666 } else if (pars && data) {
667 data->flags |= SF_HAS_PAR;
668 data->flags &= ~SF_IN_PAR;
669 }
670 return min;
671}
672
673static I32
674add_data(I32 n, char *s)
675{
676 if (rx->data) {
677 Renewc(rx->data,
678 sizeof(*rx->data) + sizeof(void*) * (rx->data->count + n - 1),
679 char, struct reg_data);
680 Renew(rx->data->what, rx->data->count + n, U8);
681 rx->data->count += n;
682 } else {
683 Newc(1207, rx->data, sizeof(*rx->data) + sizeof(void*) * (n - 1),
684 char, struct reg_data);
685 New(1208, rx->data->what, n, U8);
686 rx->data->count = n;
687 }
688 Copy(s, rx->data->what + rx->data->count - n, n, U8);
689 return rx->data->count - n;
690}
691
a687059c 692/*
e50aee73 693 - pregcomp - compile a regular expression into internal code
a687059c 694 *
695 * We can't allocate space until we know how big the compiled form will be,
696 * but we can't compile it (and thus know how big it is) until we've got a
697 * place to put the code. So we cheat: we compile it twice, once with code
698 * generation turned off and size counting turned on, and once "for real".
699 * This also means that we don't allocate space until we are sure that the
700 * thing really will compile successfully, and we never have to move the
701 * code and thus invalidate pointers into it. (Note that it has to be in
702 * one piece because free() must be able to free it all.) [NB: not true in perl]
703 *
704 * Beware that the optimization-preparation code in here knows about some
705 * of the structure of the compiled regexp. [I'll say.]
706 */
707regexp *
8ac85365 708pregcomp(char *exp, char *xend, PMOP *pm)
a687059c 709{
a0d0e21e 710 register regexp *r;
c277df42 711 regnode *scan;
712 SV **longest;
713 SV *longest_fixed;
714 SV *longest_float;
715 regnode *first;
a0d0e21e 716 I32 flags;
a0d0e21e 717 I32 minlen = 0;
718 I32 sawplus = 0;
719 I32 sawopen = 0;
720
721 if (exp == NULL)
c277df42 722 FAIL("NULL regexp argument");
a0d0e21e 723
bbce6d69 724 regprecomp = savepvn(exp, xend - exp);
c277df42 725 DEBUG_r(PerlIO_printf(Perl_debug_log, "compiling RE `%*s'\n",
726 xend - exp, regprecomp));
a0d0e21e 727 regflags = pm->op_pmflags;
bbce6d69 728 regsawback = 0;
729
c277df42 730 regseen = 0;
731 seen_zerolen = *exp == '^' ? -1 : 0;
732 extralen = 0;
733
bbce6d69 734 /* First pass: determine size, legality. */
a0d0e21e 735 regparse = exp;
736 regxend = xend;
a0d0e21e 737 regnaughty = 0;
a0d0e21e 738 regnpar = 1;
739 regsize = 0L;
740 regcode = &regdummy;
c277df42 741 regc((U8)MAGIC, (char*)regcode);
a0d0e21e 742 if (reg(0, &flags) == NULL) {
743 Safefree(regprecomp);
744 regprecomp = Nullch;
745 return(NULL);
746 }
c277df42 747 DEBUG_r(PerlIO_printf(Perl_debug_log, "size %d ", regsize));
748
749 DEBUG_r(
750 if (!colorset) {
751 int i = 0;
5fd9e9a4 752 char *s = PerlEnv_getenv("TERMCAP_COLORS");
c277df42 753
754 colorset = 1;
755 if (s) {
756 colors[0] = s = savepv(s);
757 while (++i < 4) {
758 s = strchr(s, '\t');
759 if (!s)
760 FAIL("Not enough TABs in TERMCAP_COLORS");
761 *s = '\0';
762 colors[i] = ++s;
763 }
764 } else {
765 while (i < 4)
766 colors[i++] = "";
767 }
768 /* Reset colors: */
769 PerlIO_printf(Perl_debug_log, "%s%s%s%s",
770 colors[0],colors[1],colors[2],colors[3]);
771 }
772 );
a0d0e21e 773
c277df42 774 /* Small enough for pointer-storage convention?
775 If extralen==0, this means that we will not need long jumps. */
776#ifndef REGALIGN_STRUCT
777 if (regsize >= 0x10000L && extralen)
a0d0e21e 778 FAIL("regexp too big");
c277df42 779#else
780 if (regsize >= 0x10000L && extralen)
781 regsize += extralen;
782 else
783 extralen = 0;
784#endif
a0d0e21e 785
bbce6d69 786 /* Allocate space and initialize. */
c277df42 787 Newc(1001, r, sizeof(regexp) + (unsigned)regsize * sizeof(regnode),
788 char, regexp);
a0d0e21e 789 if (r == NULL)
790 FAIL("regexp out of space");
c277df42 791 r->refcnt = 1;
bbce6d69 792 r->prelen = xend - exp;
a0d0e21e 793 r->precomp = regprecomp;
794 r->subbeg = r->subbase = NULL;
c277df42 795 rx = r;
bbce6d69 796
797 /* Second pass: emit code. */
a0d0e21e 798 regparse = exp;
bbce6d69 799 regxend = xend;
800 regnaughty = 0;
a0d0e21e 801 regnpar = 1;
802 regcode = r->program;
c277df42 803 regc((U8)MAGIC, (char*) regcode++);
804 r->data = 0;
a0d0e21e 805 if (reg(0, &flags) == NULL)
806 return(NULL);
807
808 /* Dig out information for optimizations. */
809 pm->op_pmflags = regflags;
a0d0e21e 810 r->reganch = 0;
c277df42 811 r->regstclass = NULL;
a0d0e21e 812 r->naughty = regnaughty >= 10; /* Probably an expensive pattern. */
c277df42 813 scan = r->program + 1; /* First BRANCH. */
814 if (OP(scan) != BRANCH) { /* Only one top-level choice. */
815 scan_data_t data;
816 I32 fake;
c5254dd6 817 STRLEN longest_float_length, longest_fixed_length;
a0d0e21e 818
c277df42 819 StructCopy(&zero_scan_data, &data, scan_data_t);
a0d0e21e 820 first = scan;
c277df42 821 /* Skip introductions and multiplicators >= 1. */
a0d0e21e 822 while ((OP(first) == OPEN && (sawopen = 1)) ||
823 (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
824 (OP(first) == PLUS) ||
825 (OP(first) == MINMOD) ||
826 (regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) {
827 if (OP(first) == PLUS)
828 sawplus = 1;
829 else
830 first += regarglen[(U8)OP(first)];
831 first = NEXTOPER(first);
a687059c 832 }
833
a0d0e21e 834 /* Starting-point info. */
835 again:
c277df42 836 if (OP(first) == EXACT); /* Empty, get anchored substr later. */
a0d0e21e 837 else if (strchr(simple+2,OP(first)))
838 r->regstclass = first;
bbce6d69 839 else if (regkind[(U8)OP(first)] == BOUND ||
840 regkind[(U8)OP(first)] == NBOUND)
a0d0e21e 841 r->regstclass = first;
842 else if (regkind[(U8)OP(first)] == BOL) {
c277df42 843 r->reganch |= (OP(first) == MBOL ? ROPT_ANCH_MBOL: ROPT_ANCH_BOL);
a0d0e21e 844 first = NEXTOPER(first);
774d564b 845 goto again;
846 }
847 else if (OP(first) == GPOS) {
848 r->reganch |= ROPT_ANCH_GPOS;
849 first = NEXTOPER(first);
850 goto again;
a0d0e21e 851 }
852 else if ((OP(first) == STAR &&
853 regkind[(U8)OP(NEXTOPER(first))] == ANY) &&
854 !(r->reganch & ROPT_ANCH) )
855 {
856 /* turn .* into ^.* with an implied $*=1 */
774d564b 857 r->reganch |= ROPT_ANCH_BOL | ROPT_IMPLICIT;
a0d0e21e 858 first = NEXTOPER(first);
774d564b 859 goto again;
a0d0e21e 860 }
861 if (sawplus && (!sawopen || !regsawback))
862 r->reganch |= ROPT_SKIP; /* x+ must match 1st of run */
863
c277df42 864 /* Scan is after the zeroth branch, first is atomic matcher. */
865 DEBUG_r(PerlIO_printf(Perl_debug_log, "first at %d\n",
866 first - scan + 1));
a0d0e21e 867 /*
868 * If there's something expensive in the r.e., find the
869 * longest literal string that must appear and make it the
870 * regmust. Resolve ties in favor of later strings, since
871 * the regstart check works with the beginning of the r.e.
872 * and avoiding duplication strengthens checking. Not a
873 * strong reason, but sufficient in the absence of others.
874 * [Now we resolve ties in favor of the earlier string if
c277df42 875 * it happens that c_offset_min has been invalidated, since the
a0d0e21e 876 * earlier string may buy us something the later one won't.]
877 */
a0d0e21e 878 minlen = 0;
a687059c 879
c277df42 880 data.longest_fixed = newSVpv("",0);
881 data.longest_float = newSVpv("",0);
882 data.last_found = newSVpv("",0);
883 data.longest = &(data.longest_fixed);
884 first = scan;
885
886 minlen = study_chunk(&first, &fake, scan + regsize, /* Up to end */
887 &data, SCF_DO_SUBSTR);
888 if ( regnpar == 1 && data.longest == &(data.longest_fixed)
889 && data.last_start_min == 0 && data.last_end > 0
890 && !seen_zerolen
891 && (!(regseen & REG_SEEN_GPOS) || (r->reganch & ROPT_ANCH_GPOS)))
892 r->reganch |= ROPT_CHECK_ALL;
893 scan_commit(&data);
894 SvREFCNT_dec(data.last_found);
895
c5254dd6 896 longest_float_length = SvCUR(data.longest_float);
897 if (longest_float_length
c277df42 898 || (data.flags & SF_FL_BEFORE_EOL
899 && (!(data.flags & SF_FL_BEFORE_MEOL)
900 || (regflags & PMf_MULTILINE)))) {
901 if (SvCUR(data.longest_fixed)
902 && data.offset_fixed == data.offset_float_min)
903 goto remove; /* Like in (a)+. */
904
905 r->float_substr = data.longest_float;
906 r->float_min_offset = data.offset_float_min;
907 r->float_max_offset = data.offset_float_max;
908 fbm_compile(r->float_substr);
909 BmUSEFUL(r->float_substr) = 100;
910 if (data.flags & SF_FL_BEFORE_EOL /* Cannot have SEOL and MULTI */
911 && (!(data.flags & SF_FL_BEFORE_MEOL)
912 || (regflags & PMf_MULTILINE)))
913 SvTAIL_on(r->float_substr);
914 } else {
915 remove:
916 r->float_substr = Nullsv;
917 SvREFCNT_dec(data.longest_float);
c5254dd6 918 longest_float_length = 0;
a0d0e21e 919 }
c277df42 920
c5254dd6 921 longest_fixed_length = SvCUR(data.longest_fixed);
922 if (longest_fixed_length
c277df42 923 || (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
924 && (!(data.flags & SF_FIX_BEFORE_MEOL)
925 || (regflags & PMf_MULTILINE)))) {
926 r->anchored_substr = data.longest_fixed;
927 r->anchored_offset = data.offset_fixed;
928 fbm_compile(r->anchored_substr);
929 BmUSEFUL(r->anchored_substr) = 100;
930 if (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
931 && (!(data.flags & SF_FIX_BEFORE_MEOL)
932 || (regflags & PMf_MULTILINE)))
933 SvTAIL_on(r->anchored_substr);
934 } else {
935 r->anchored_substr = Nullsv;
936 SvREFCNT_dec(data.longest_fixed);
c5254dd6 937 longest_fixed_length = 0;
a0d0e21e 938 }
c277df42 939
940 /* A temporary algorithm prefers floated substr to fixed one to dig more info. */
c5254dd6 941 if (longest_fixed_length > longest_float_length) {
c277df42 942 r->check_substr = r->anchored_substr;
943 r->check_offset_min = r->check_offset_max = r->anchored_offset;
944 if (r->reganch & ROPT_ANCH_SINGLE)
945 r->reganch |= ROPT_NOSCAN;
946 } else {
947 r->check_substr = r->float_substr;
948 r->check_offset_min = data.offset_float_min;
949 r->check_offset_max = data.offset_float_max;
a0d0e21e 950 }
c277df42 951 } else {
952 /* Several toplevels. Best we can is to set minlen. */
953 I32 fake;
954
955 DEBUG_r(PerlIO_printf(Perl_debug_log, "\n"));
956 scan = r->program + 1;
957 minlen = study_chunk(&scan, &fake, scan + regsize, NULL, 0);
958 r->check_substr = r->anchored_substr = r->float_substr = Nullsv;
a0d0e21e 959 }
960
a0d0e21e 961 r->nparens = regnpar - 1;
962 r->minlen = minlen;
c277df42 963 if (regseen & REG_SEEN_GPOS)
964 r->reganch |= ROPT_GPOS_SEEN;
965 if (regseen & REG_SEEN_LOOKBEHIND)
966 r->reganch |= ROPT_LOOKBEHIND_SEEN;
a0d0e21e 967 Newz(1002, r->startp, regnpar, char*);
968 Newz(1002, r->endp, regnpar, char*);
969 DEBUG_r(regdump(r));
970 return(r);
a687059c 971}
972
973/*
974 - reg - regular expression, i.e. main body or parenthesized thing
975 *
976 * Caller must absorb opening parenthesis.
977 *
978 * Combining parenthesis handling with the base level of regular expression
979 * is a trifle forced, but the need to tie the tails of the branches to what
980 * follows makes it hard to avoid.
981 */
c277df42 982static regnode *
8ac85365 983reg(I32 paren, I32 *flagp)
c277df42 984 /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
a687059c 985{
c277df42 986 register regnode *ret; /* Will be the head of the group. */
987 register regnode *br;
988 register regnode *lastbr;
989 register regnode *ender = 0;
a0d0e21e 990 register I32 parno = 0;
c277df42 991 I32 flags, oregflags = regflags, have_branch = 0, open = 0;
992 char c;
a0d0e21e 993
994 *flagp = HASWIDTH; /* Tentatively. */
995
996 /* Make an OPEN node, if parenthesized. */
997 if (paren) {
998 if (*regparse == '?') {
999 regparse++;
748a9306 1000 paren = *regparse++;
c277df42 1001 ret = NULL; /* For look-ahead/behind. */
a0d0e21e 1002 switch (paren) {
c277df42 1003 case '<':
1004#ifndef REGALIGN_STRUCT
1005 FAIL("lookbehind non-implemented without REGALIGN_STRUCT");
1006#endif
1007 regseen |= REG_SEEN_LOOKBEHIND;
1008 if (*regparse == '!')
1009 paren = ',';
1010 if (*regparse != '=' && *regparse != '!')
1011 goto unknown;
1012 regparse++;
a0d0e21e 1013 case '=':
1014 case '!':
c277df42 1015 seen_zerolen++;
1016 case ':':
1017 case '>':
a0d0e21e 1018 break;
1019 case '$':
1020 case '@':
c277df42 1021 FAIL2("Sequence (?%c...) not implemented", (int)paren);
a0d0e21e 1022 break;
1023 case '#':
1024 while (*regparse && *regparse != ')')
1025 regparse++;
1026 if (*regparse != ')')
c277df42 1027 FAIL("Sequence (?#... not terminated");
a0d0e21e 1028 nextchar();
1029 *flagp = TRYAGAIN;
1030 return NULL;
c277df42 1031 case '{':
1032 {
1033 dTHR;
1034 I32 count = 1, n = 0;
1035 char c;
1036 char *s = regparse;
1037 SV *sv;
1038 OP_4tree *sop, *rop;
1039
1040 seen_zerolen++;
1041 while (count && (c = *regparse)) {
1042 if (c == '\\' && regparse[1])
1043 regparse++;
1044 else if (c == '{')
1045 count++;
1046 else if (c == '}')
1047 count--;
1048 regparse++;
1049 }
1050 if (*regparse != ')')
1051 FAIL("Sequence (?{...}) not terminated or not {}-balanced");
1052 if (!SIZE_ONLY) {
1053 AV *av;
1054
1055 if (regparse - 1 - s)
1056 sv = newSVpv(s, regparse - 1 - s);
1057 else
1058 sv = newSVpv("", 0);
1059
1060 rop = sv_compile_2op(sv, &sop, "re", &av);
1061
1062 n = add_data(3, "nso");
1063 rx->data->data[n] = (void*)rop;
1064 rx->data->data[n+1] = (void*)av;
1065 rx->data->data[n+2] = (void*)sop;
1066 SvREFCNT_dec(sv);
cc6b7395 1067 } else { /* First pass */
1068 if (tainted)
1069 FAIL("Eval-group in insecure regular expression");
c277df42 1070 }
1071
1072 nextchar();
c277df42 1073 return reganode(EVAL, n);
1074 }
1075 case '(':
1076 {
1077 if (regparse[0] == '?') {
1078 if (regparse[1] == '=' || regparse[1] == '!'
1079 || regparse[1] == '<'
1080 || regparse[1] == '{') { /* Lookahead or eval. */
1081 I32 flag;
1082
1083 ret = reg_node(LOGICAL);
1084 regtail(ret, reg(1, &flag));
1085 goto insert_if;
1086 }
1087 } else if (regparse[0] >= '1' && regparse[0] <= '9' ) {
1088 parno = atoi(regparse++);
1089
1090 while (isDIGIT(*regparse))
1091 regparse++;
1092 ret = reganode(GROUPP, parno);
1093 if ((c = *nextchar()) != ')')
1094 FAIL2("Switch (?(number%c not recognized", c);
1095 insert_if:
1096 regtail(ret, reganode(IFTHEN, 0));
1097 br = regbranch(&flags, 1);
1098 if (br == NULL)
1099 br = reganode(LONGJMP, 0);
1100 else
1101 regtail(br, reganode(LONGJMP, 0));
1102 c = *nextchar();
1103 if (c == '|') {
1104 lastbr = reganode(IFTHEN, 0); /* Fake one for optimizer. */
1105 regbranch(&flags, 1);
1106 regtail(ret, lastbr);
1107 c = *nextchar();
1108 } else
1109 lastbr = NULL;
1110 if (c != ')')
1111 FAIL("Switch (?(condition)... contains too many branches");
1112 ender = reg_node(TAIL);
1113 regtail(br, ender);
1114 if (lastbr) {
1115 regtail(lastbr, ender);
1116 regtail(NEXTOPER(NEXTOPER(lastbr)), ender);
1117 } else
1118 regtail(ret, ender);
1119 return ret;
1120 } else {
1121 FAIL2("Unknown condition for (?(%.2s", regparse);
1122 }
1123 }
1b1626e4 1124 case 0:
c277df42 1125 FAIL("Sequence (? incomplete");
1b1626e4 1126 break;
a0d0e21e 1127 default:
1128 --regparse;
c90c0ff4 1129 while (*regparse && strchr("iogcmsx", *regparse))
a0d0e21e 1130 pmflag(&regflags, *regparse++);
c277df42 1131 unknown:
a0d0e21e 1132 if (*regparse != ')')
c277df42 1133 FAIL2("Sequence (?%c...) not recognized", *regparse);
a0d0e21e 1134 nextchar();
1135 *flagp = TRYAGAIN;
1136 return NULL;
1137 }
1138 }
1139 else {
1140 parno = regnpar;
1141 regnpar++;
1142 ret = reganode(OPEN, parno);
c277df42 1143 open = 1;
a0d0e21e 1144 }
1145 } else
1146 ret = NULL;
1147
1148 /* Pick up the branches, linking them together. */
c277df42 1149 br = regbranch(&flags, 1);
a0d0e21e 1150 if (br == NULL)
1151 return(NULL);
c277df42 1152 if (*regparse == '|') {
1153 if (!SIZE_ONLY && extralen) {
1154 reginsert(BRANCHJ, br);
1155 } else
1156 reginsert(BRANCH, br);
1157 have_branch = 1;
1158 if (SIZE_ONLY)
1159 extralen += 1; /* For BRANCHJ-BRANCH. */
1160 } else if (paren == ':') {
1161 *flagp |= flags&SIMPLE;
1162 }
1163 if (open) { /* Starts with OPEN. */
1164 regtail(ret, br); /* OPEN -> first. */
1165 } else if (paren != '?') /* Not Conditional */
a0d0e21e 1166 ret = br;
1167 if (!(flags&HASWIDTH))
1168 *flagp &= ~HASWIDTH;
1169 *flagp |= flags&SPSTART;
c277df42 1170 lastbr = br;
a0d0e21e 1171 while (*regparse == '|') {
c277df42 1172 if (!SIZE_ONLY && extralen) {
1173 ender = reganode(LONGJMP,0);
1174 regtail(NEXTOPER(NEXTOPER(lastbr)), ender); /* Append to the previous. */
1175 }
1176 if (SIZE_ONLY)
1177 extralen += 2; /* Account for LONGJMP. */
a0d0e21e 1178 nextchar();
c277df42 1179 br = regbranch(&flags, 0);
a687059c 1180 if (br == NULL)
a0d0e21e 1181 return(NULL);
c277df42 1182 regtail(lastbr, br); /* BRANCH -> BRANCH. */
1183 lastbr = br;
a687059c 1184 if (!(flags&HASWIDTH))
a0d0e21e 1185 *flagp &= ~HASWIDTH;
a687059c 1186 *flagp |= flags&SPSTART;
a0d0e21e 1187 }
1188
c277df42 1189 if (have_branch || paren != ':') {
1190 /* Make a closing node, and hook it on the end. */
1191 switch (paren) {
1192 case ':':
1193 ender = reg_node(TAIL);
1194 break;
1195 case 1:
1196 ender = reganode(CLOSE, parno);
1197 break;
1198 case '<':
1199 case '>':
1200 case ',':
1201 case '=':
1202 case '!':
1203 ender = reg_node(SUCCEED);
1204 *flagp &= ~HASWIDTH;
1205 break;
1206 case 0:
1207 ender = reg_node(END);
1208 break;
1209 }
1210 regtail(lastbr, ender);
a0d0e21e 1211
c277df42 1212 if (have_branch) {
1213 /* Hook the tails of the branches to the closing node. */
1214 for (br = ret; br != NULL; br = regnext(br)) {
1215 regoptail(br, ender);
1216 }
1217 }
a0d0e21e 1218 }
c277df42 1219
1220 {
1221 char *p;
1222 static char parens[] = "=!<,>";
1223
1224 if (paren && (p = strchr(parens, paren))) {
1225 int node = ((p - parens) % 2) ? UNLESSM : IFMATCH;
1226 int flag = (p - parens) > 1;
1227
1228 if (paren == '>')
1229 node = SUSPEND, flag = 0;
1230 reginsert(node,ret);
1231#ifdef REGALIGN_STRUCT
1232 ret->flags = flag;
1233#endif
1234 regtail(ret, reg_node(TAIL));
1235 }
a0d0e21e 1236 }
1237
1238 /* Check for proper termination. */
4633a7c4 1239 if (paren && (regparse >= regxend || *nextchar() != ')')) {
a0d0e21e 1240 FAIL("unmatched () in regexp");
1241 } else if (!paren && regparse < regxend) {
1242 if (*regparse == ')') {
1243 FAIL("unmatched () in regexp");
1244 } else
1245 FAIL("junk on end of regexp"); /* "Can't happen". */
1246 /* NOTREACHED */
1247 }
c277df42 1248 if (paren != 0) {
1249 regflags = oregflags;
1250 }
a687059c 1251
a0d0e21e 1252 return(ret);
a687059c 1253}
1254
1255/*
1256 - regbranch - one alternative of an | operator
1257 *
1258 * Implements the concatenation operator.
1259 */
c277df42 1260static regnode *
1261regbranch(I32 *flagp, I32 first)
a687059c 1262{
c277df42 1263 register regnode *ret;
1264 register regnode *chain = NULL;
1265 register regnode *latest;
1266 I32 flags = 0, c = 0;
a0d0e21e 1267
c277df42 1268 if (first)
1269 ret = NULL;
1270 else {
1271 if (!SIZE_ONLY && extralen)
1272 ret = reganode(BRANCHJ,0);
1273 else
1274 ret = reg_node(BRANCH);
1275 }
1276
1277 if (!first && SIZE_ONLY)
1278 extralen += 1; /* BRANCHJ */
1279
1280 *flagp = WORST; /* Tentatively. */
a0d0e21e 1281
a0d0e21e 1282 regparse--;
1283 nextchar();
1284 while (regparse < regxend && *regparse != '|' && *regparse != ')') {
1285 flags &= ~TRYAGAIN;
1286 latest = regpiece(&flags);
1287 if (latest == NULL) {
1288 if (flags & TRYAGAIN)
1289 continue;
1290 return(NULL);
c277df42 1291 } else if (ret == NULL)
1292 ret = latest;
a0d0e21e 1293 *flagp |= flags&HASWIDTH;
c277df42 1294 if (chain == NULL) /* First piece. */
a0d0e21e 1295 *flagp |= flags&SPSTART;
1296 else {
1297 regnaughty++;
1298 regtail(chain, latest);
a687059c 1299 }
a0d0e21e 1300 chain = latest;
c277df42 1301 c++;
1302 }
1303 if (chain == NULL) { /* Loop ran zero times. */
1304 chain = reg_node(NOTHING);
1305 if (ret == NULL)
1306 ret = chain;
1307 }
1308 if (c == 1) {
1309 *flagp |= flags&SIMPLE;
a0d0e21e 1310 }
a687059c 1311
a0d0e21e 1312 return(ret);
a687059c 1313}
1314
1315/*
1316 - regpiece - something followed by possible [*+?]
1317 *
1318 * Note that the branching code sequences used for ? and the general cases
1319 * of * and + are somewhat optimized: they use the same NOTHING node as
1320 * both the endmarker for their branch list and the body of the last branch.
1321 * It might seem that this node could be dispensed with entirely, but the
1322 * endmarker role is not redundant.
1323 */
c277df42 1324static regnode *
8ac85365 1325regpiece(I32 *flagp)
a687059c 1326{
c277df42 1327 register regnode *ret;
a0d0e21e 1328 register char op;
1329 register char *next;
1330 I32 flags;
1331 char *origparse = regparse;
1332 char *maxpos;
1333 I32 min;
c277df42 1334 I32 max = REG_INFTY;
a0d0e21e 1335
1336 ret = regatom(&flags);
1337 if (ret == NULL) {
1338 if (flags & TRYAGAIN)
1339 *flagp |= TRYAGAIN;
1340 return(NULL);
1341 }
1342
1343 op = *regparse;
a0d0e21e 1344
1345 if (op == '{' && regcurly(regparse)) {
1346 next = regparse + 1;
1347 maxpos = Nullch;
1348 while (isDIGIT(*next) || *next == ',') {
1349 if (*next == ',') {
1350 if (maxpos)
1351 break;
1352 else
1353 maxpos = next;
a687059c 1354 }
a0d0e21e 1355 next++;
1356 }
1357 if (*next == '}') { /* got one */
1358 if (!maxpos)
1359 maxpos = next;
1360 regparse++;
1361 min = atoi(regparse);
1362 if (*maxpos == ',')
1363 maxpos++;
1364 else
1365 maxpos = regparse;
1366 max = atoi(maxpos);
1367 if (!max && *maxpos != '0')
c277df42 1368 max = REG_INFTY; /* meaning "infinity" */
1369 else if (max >= REG_INFTY)
1370 FAIL2("Quantifier in {,} bigger than %d", REG_INFTY - 1);
a0d0e21e 1371 regparse = next;
1372 nextchar();
1373
1374 do_curly:
1375 if ((flags&SIMPLE)) {
1376 regnaughty += 2 + regnaughty / 2;
1377 reginsert(CURLY, ret);
1378 }
1379 else {
1380 regnaughty += 4 + regnaughty; /* compound interest */
c277df42 1381 regtail(ret, reg_node(WHILEM));
1382 if (!SIZE_ONLY && extralen) {
1383 reginsert(LONGJMP,ret);
1384 reginsert(NOTHING,ret);
1385 NEXT_OFF(ret) = 3; /* Go over LONGJMP. */
1386 }
a0d0e21e 1387 reginsert(CURLYX,ret);
c277df42 1388 if (!SIZE_ONLY && extralen)
1389 NEXT_OFF(ret) = 3; /* Go over NOTHING to LONGJMP. */
1390 regtail(ret, reg_node(NOTHING));
1391 if (SIZE_ONLY)
1392 extralen += 3;
a0d0e21e 1393 }
c277df42 1394#ifdef REGALIGN_STRUCT
1395 ret->flags = 0;
1396#endif
a0d0e21e 1397
1398 if (min > 0)
1399 *flagp = (WORST|HASWIDTH);
1400 if (max && max < min)
c277df42 1401 FAIL("Can't do {n,m} with n > m");
1402 if (!SIZE_ONLY) {
1403 ARG1_SET(ret, min);
1404 ARG2_SET(ret, max);
a687059c 1405 }
a687059c 1406
a0d0e21e 1407 goto nest_check;
a687059c 1408 }
a0d0e21e 1409 }
a687059c 1410
a0d0e21e 1411 if (!ISMULT1(op)) {
1412 *flagp = flags;
a687059c 1413 return(ret);
a0d0e21e 1414 }
bb20fd44 1415
c277df42 1416#if 0 /* Now runtime fix should be reliable. */
bb20fd44 1417 if (!(flags&HASWIDTH) && op != '?')
c277df42 1418 FAIL("regexp *+ operand could be empty");
1419#endif
bb20fd44 1420
a0d0e21e 1421 nextchar();
1422
1423 *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);
1424
1425 if (op == '*' && (flags&SIMPLE)) {
1426 reginsert(STAR, ret);
c277df42 1427#ifdef REGALIGN_STRUCT
1428 ret->flags = 0;
1429#endif
a0d0e21e 1430 regnaughty += 4;
1431 }
1432 else if (op == '*') {
1433 min = 0;
1434 goto do_curly;
1435 } else if (op == '+' && (flags&SIMPLE)) {
1436 reginsert(PLUS, ret);
c277df42 1437#ifdef REGALIGN_STRUCT
1438 ret->flags = 0;
1439#endif
a0d0e21e 1440 regnaughty += 3;
1441 }
1442 else if (op == '+') {
1443 min = 1;
1444 goto do_curly;
1445 } else if (op == '?') {
1446 min = 0; max = 1;
1447 goto do_curly;
1448 }
1449 nest_check:
c277df42 1450 if (dowarn && !SIZE_ONLY && !(flags&HASWIDTH) && max > 10000) {
a0d0e21e 1451 warn("%.*s matches null string many times",
1452 regparse - origparse, origparse);
1453 }
1454
1455 if (*regparse == '?') {
1456 nextchar();
1457 reginsert(MINMOD, ret);
1458#ifdef REGALIGN
c277df42 1459 regtail(ret, ret + NODE_STEP_REGNODE);
a0d0e21e 1460#else
1461 regtail(ret, ret + 3);
1462#endif
1463 }
1464 if (ISMULT2(regparse))
1465 FAIL("nested *?+ in regexp");
1466
1467 return(ret);
a687059c 1468}
1469
1470/*
1471 - regatom - the lowest level
1472 *
1473 * Optimization: gobbles an entire sequence of ordinary characters so that
1474 * it can turn them into a single node, which is smaller to store and
1475 * faster to run. Backslashed characters are exceptions, each becoming a
1476 * separate node; the code is simpler that way and it's not worth fixing.
1477 *
1478 * [Yes, it is worth fixing, some scripts can run twice the speed.]
1479 */
c277df42 1480static regnode *
8ac85365 1481regatom(I32 *flagp)
a687059c 1482{
c277df42 1483 register regnode *ret = 0;
a0d0e21e 1484 I32 flags;
1485
1486 *flagp = WORST; /* Tentatively. */
1487
1488tryagain:
1489 switch (*regparse) {
1490 case '^':
c277df42 1491 seen_zerolen++;
a0d0e21e 1492 nextchar();
1493 if (regflags & PMf_MULTILINE)
c277df42 1494 ret = reg_node(MBOL);
a0d0e21e 1495 else if (regflags & PMf_SINGLELINE)
c277df42 1496 ret = reg_node(SBOL);
a0d0e21e 1497 else
c277df42 1498 ret = reg_node(BOL);
a0d0e21e 1499 break;
1500 case '$':
c277df42 1501 if (regparse[1])
1502 seen_zerolen++;
a0d0e21e 1503 nextchar();
1504 if (regflags & PMf_MULTILINE)
c277df42 1505 ret = reg_node(MEOL);
a0d0e21e 1506 else if (regflags & PMf_SINGLELINE)
c277df42 1507 ret = reg_node(SEOL);
a0d0e21e 1508 else
c277df42 1509 ret = reg_node(EOL);
a0d0e21e 1510 break;
1511 case '.':
1512 nextchar();
1513 if (regflags & PMf_SINGLELINE)
c277df42 1514 ret = reg_node(SANY);
a0d0e21e 1515 else
c277df42 1516 ret = reg_node(ANY);
a0d0e21e 1517 regnaughty++;
1518 *flagp |= HASWIDTH|SIMPLE;
1519 break;
1520 case '[':
1521 regparse++;
1522 ret = regclass();
1523 *flagp |= HASWIDTH|SIMPLE;
1524 break;
1525 case '(':
1526 nextchar();
1527 ret = reg(1, &flags);
1528 if (ret == NULL) {
1529 if (flags & TRYAGAIN)
1530 goto tryagain;
1531 return(NULL);
1532 }
c277df42 1533 *flagp |= flags&(HASWIDTH|SPSTART|SIMPLE);
a0d0e21e 1534 break;
1535 case '|':
1536 case ')':
1537 if (flags & TRYAGAIN) {
1538 *flagp |= TRYAGAIN;
1539 return NULL;
1540 }
c277df42 1541 FAIL2("internal urp in regexp at /%s/", regparse);
a0d0e21e 1542 /* Supposed to be caught earlier. */
1543 break;
85afd4ae 1544 case '{':
1545 if (!regcurly(regparse)) {
1546 regparse++;
1547 goto defchar;
1548 }
1549 /* FALL THROUGH */
a0d0e21e 1550 case '?':
1551 case '+':
1552 case '*':
3115e423 1553 FAIL("?+*{} follows nothing in regexp");
a0d0e21e 1554 break;
1555 case '\\':
1556 switch (*++regparse) {
1557 case 'A':
c277df42 1558 seen_zerolen++;
1559 ret = reg_node(SBOL);
a0d0e21e 1560 *flagp |= SIMPLE;
1561 nextchar();
1562 break;
1563 case 'G':
c277df42 1564 ret = reg_node(GPOS);
1565 regseen |= REG_SEEN_GPOS;
a0d0e21e 1566 *flagp |= SIMPLE;
1567 nextchar();
1568 break;
1569 case 'Z':
c277df42 1570 ret = reg_node(SEOL);
a0d0e21e 1571 *flagp |= SIMPLE;
1572 nextchar();
1573 break;
1574 case 'w':
c277df42 1575 ret = reg_node((regflags & PMf_LOCALE) ? ALNUML : ALNUM);
a0d0e21e 1576 *flagp |= HASWIDTH|SIMPLE;
1577 nextchar();
1578 break;
1579 case 'W':
c277df42 1580 ret = reg_node((regflags & PMf_LOCALE) ? NALNUML : NALNUM);
a0d0e21e 1581 *flagp |= HASWIDTH|SIMPLE;
1582 nextchar();
1583 break;
1584 case 'b':
c277df42 1585 seen_zerolen++;
1586 ret = reg_node((regflags & PMf_LOCALE) ? BOUNDL : BOUND);
a0d0e21e 1587 *flagp |= SIMPLE;
1588 nextchar();
1589 break;
1590 case 'B':
c277df42 1591 seen_zerolen++;
1592 ret = reg_node((regflags & PMf_LOCALE) ? NBOUNDL : NBOUND);
a0d0e21e 1593 *flagp |= SIMPLE;
1594 nextchar();
1595 break;
1596 case 's':
c277df42 1597 ret = reg_node((regflags & PMf_LOCALE) ? SPACEL : SPACE);
a0d0e21e 1598 *flagp |= HASWIDTH|SIMPLE;
1599 nextchar();
1600 break;
1601 case 'S':
c277df42 1602 ret = reg_node((regflags & PMf_LOCALE) ? NSPACEL : NSPACE);
a0d0e21e 1603 *flagp |= HASWIDTH|SIMPLE;
1604 nextchar();
1605 break;
1606 case 'd':
c277df42 1607 ret = reg_node(DIGIT);
a0d0e21e 1608 *flagp |= HASWIDTH|SIMPLE;
1609 nextchar();
1610 break;
1611 case 'D':
c277df42 1612 ret = reg_node(NDIGIT);
a0d0e21e 1613 *flagp |= HASWIDTH|SIMPLE;
1614 nextchar();
1615 break;
1616 case 'n':
1617 case 'r':
1618 case 't':
1619 case 'f':
1620 case 'e':
1621 case 'a':
1622 case 'x':
1623 case 'c':
1624 case '0':
1625 goto defchar;
1626 case '1': case '2': case '3': case '4':
1627 case '5': case '6': case '7': case '8': case '9':
1628 {
1629 I32 num = atoi(regparse);
1630
1631 if (num > 9 && num >= regnpar)
1632 goto defchar;
1633 else {
1634 regsawback = 1;
c8756f30 1635 ret = reganode((regflags & PMf_FOLD)
1636 ? ((regflags & PMf_LOCALE) ? REFFL : REFF)
1637 : REF, num);
a0d0e21e 1638 *flagp |= HASWIDTH;
1639 while (isDIGIT(*regparse))
a687059c 1640 regparse++;
a0d0e21e 1641 regparse--;
1642 nextchar();
1643 }
1644 }
1645 break;
1646 case '\0':
1647 if (regparse >= regxend)
1648 FAIL("trailing \\ in regexp");
1649 /* FALL THROUGH */
1650 default:
1651 goto defchar;
1652 }
1653 break;
4633a7c4 1654
1655 case '#':
1656 if (regflags & PMf_EXTENDED) {
1657 while (regparse < regxend && *regparse != '\n') regparse++;
1658 if (regparse < regxend)
1659 goto tryagain;
1660 }
1661 /* FALL THROUGH */
1662
a0d0e21e 1663 default: {
1664 register I32 len;
c277df42 1665 register U8 ender;
a0d0e21e 1666 register char *p;
c277df42 1667 char *oldp, *s;
a0d0e21e 1668 I32 numlen;
1669
1670 regparse++;
1671
1672 defchar:
c277df42 1673 ret = reg_node((regflags & PMf_FOLD)
bbce6d69 1674 ? ((regflags & PMf_LOCALE) ? EXACTFL : EXACTF)
1675 : EXACT);
161b471a 1676 s = (char *) OPERAND(ret);
c277df42 1677 regc(0, s++); /* save spot for len */
a0d0e21e 1678 for (len = 0, p = regparse - 1;
1679 len < 127 && p < regxend;
1680 len++)
1681 {
1682 oldp = p;
5b5a24f7 1683
1684 if (regflags & PMf_EXTENDED)
1685 p = regwhite(p, regxend);
a0d0e21e 1686 switch (*p) {
1687 case '^':
1688 case '$':
1689 case '.':
1690 case '[':
1691 case '(':
1692 case ')':
1693 case '|':
1694 goto loopdone;
1695 case '\\':
1696 switch (*++p) {
1697 case 'A':
1698 case 'G':
1699 case 'Z':
1700 case 'w':
1701 case 'W':
1702 case 'b':
1703 case 'B':
1704 case 's':
1705 case 'S':
1706 case 'd':
1707 case 'D':
1708 --p;
1709 goto loopdone;
1710 case 'n':
1711 ender = '\n';
1712 p++;
a687059c 1713 break;
a0d0e21e 1714 case 'r':
1715 ender = '\r';
1716 p++;
a687059c 1717 break;
a0d0e21e 1718 case 't':
1719 ender = '\t';
1720 p++;
a687059c 1721 break;
a0d0e21e 1722 case 'f':
1723 ender = '\f';
1724 p++;
a687059c 1725 break;
a0d0e21e 1726 case 'e':
1727 ender = '\033';
1728 p++;
a687059c 1729 break;
a0d0e21e 1730 case 'a':
1731 ender = '\007';
1732 p++;
a687059c 1733 break;
a0d0e21e 1734 case 'x':
1735 ender = scan_hex(++p, 2, &numlen);
1736 p += numlen;
a687059c 1737 break;
a0d0e21e 1738 case 'c':
1739 p++;
bbce6d69 1740 ender = UCHARAT(p++);
1741 ender = toCTRL(ender);
a687059c 1742 break;
a0d0e21e 1743 case '0': case '1': case '2': case '3':case '4':
1744 case '5': case '6': case '7': case '8':case '9':
1745 if (*p == '0' ||
1746 (isDIGIT(p[1]) && atoi(p) >= regnpar) ) {
1747 ender = scan_oct(p, 3, &numlen);
1748 p += numlen;
1749 }
1750 else {
1751 --p;
1752 goto loopdone;
a687059c 1753 }
1754 break;
a0d0e21e 1755 case '\0':
1756 if (p >= regxend)
a687059c 1757 FAIL("trailing \\ in regexp");
1758 /* FALL THROUGH */
a0d0e21e 1759 default:
1760 ender = *p++;
1761 break;
1762 }
1763 break;
a687059c 1764 default:
a0d0e21e 1765 ender = *p++;
1766 break;
a687059c 1767 }
5b5a24f7 1768 if (regflags & PMf_EXTENDED)
1769 p = regwhite(p, regxend);
a0d0e21e 1770 if (ISMULT2(p)) { /* Back off on ?+*. */
1771 if (len)
1772 p = oldp;
1773 else {
1774 len++;
c277df42 1775 regc(ender, s++);
a0d0e21e 1776 }
1777 break;
a687059c 1778 }
c277df42 1779 regc(ender, s++);
a0d0e21e 1780 }
1781 loopdone:
1782 regparse = p - 1;
1783 nextchar();
1784 if (len < 0)
1785 FAIL("internal disaster in regexp");
1786 if (len > 0)
1787 *flagp |= HASWIDTH;
1788 if (len == 1)
1789 *flagp |= SIMPLE;
c277df42 1790 if (!SIZE_ONLY)
a0d0e21e 1791 *OPERAND(ret) = len;
c277df42 1792 regc('\0', s++);
1793 if (SIZE_ONLY) {
1794#ifdef REGALIGN_STRUCT
1795 regsize += (len + 2 + sizeof(regnode) - 1) / sizeof(regnode);
1796#endif
1797 } else {
1798 regcode += (len + 2 + sizeof(regnode) - 1) / sizeof(regnode);
1799 }
a687059c 1800 }
a0d0e21e 1801 break;
1802 }
a687059c 1803
a0d0e21e 1804 return(ret);
a687059c 1805}
1806
5b5a24f7 1807static char *
8ac85365 1808regwhite(char *p, char *e)
5b5a24f7 1809{
1810 while (p < e) {
1811 if (isSPACE(*p))
1812 ++p;
1813 else if (*p == '#') {
1814 do {
1815 p++;
1816 } while (p < e && *p != '\n');
1817 }
1818 else
1819 break;
1820 }
1821 return p;
1822}
1823
a687059c 1824static void
8ac85365 1825regset(char *opnd, register I32 c)
a687059c 1826{
c277df42 1827 if (SIZE_ONLY)
bbce6d69 1828 return;
1829 c &= 0xFF;
1830 opnd[1 + (c >> 3)] |= (1 << (c & 7));
a687059c 1831}
1832
c277df42 1833static regnode *
8ac85365 1834regclass(void)
a687059c 1835{
c277df42 1836 register char *opnd, *s;
8ac85365 1837 register I32 Class;
a0d0e21e 1838 register I32 lastclass = 1234;
1839 register I32 range = 0;
c277df42 1840 register regnode *ret;
a0d0e21e 1841 register I32 def;
1842 I32 numlen;
1843
161b471a 1844 s = opnd = (char *) OPERAND(regcode);
c277df42 1845 ret = reg_node(ANYOF);
8ac85365 1846 for (Class = 0; Class < 33; Class++)
c277df42 1847 regc(0, s++);
a0d0e21e 1848 if (*regparse == '^') { /* Complement of range. */
1849 regnaughty++;
1850 regparse++;
c277df42 1851 if (!SIZE_ONLY)
bbce6d69 1852 *opnd |= ANYOF_INVERT;
1853 }
c277df42 1854 if (!SIZE_ONLY) {
1855 regcode += ANY_SKIP;
bbce6d69 1856 if (regflags & PMf_FOLD)
1857 *opnd |= ANYOF_FOLD;
1858 if (regflags & PMf_LOCALE)
1859 *opnd |= ANYOF_LOCALE;
c277df42 1860 } else {
1861 regsize += ANY_SKIP;
a0d0e21e 1862 }
a0d0e21e 1863 if (*regparse == ']' || *regparse == '-')
1864 goto skipcond; /* allow 1st char to be ] or - */
1865 while (regparse < regxend && *regparse != ']') {
1866 skipcond:
8ac85365 1867 Class = UCHARAT(regparse++);
4599a1de 1868 if (Class == '[' && regparse + 1 < regxend &&
1869 /* I smell either [: or [= or [. -- POSIX has been here, right? */
1870 (*regparse == ':' || *regparse == '=' || *regparse == '.')) {
1871 char posixccc = *regparse;
1872 char* posixccs = regparse++;
1873
1874 while (regparse < regxend && *regparse != posixccc)
1875 regparse++;
1876 if (regparse == regxend)
1877 /* Grandfather lone [:, [=, [. */
1878 regparse = posixccs;
1879 else {
1880 regparse++; /* skip over the posixccc */
1881 if (*regparse == ']') {
1882 /* Not Implemented Yet.
1883 * (POSIX Extended Character Classes, that is)
1884 * The text between e.g. [: and :] would start
1885 * at posixccs + 1 and stop at regparse - 2. */
1886 if (dowarn && !SIZE_ONLY)
1887 warn("Character class syntax [%c %c] is reserved for future extensions", posixccc, posixccc);
1888 regparse++; /* skip over the ending ] */
1889 }
1890 }
1891 }
8ac85365 1892 if (Class == '\\') {
1893 Class = UCHARAT(regparse++);
1894 switch (Class) {
a0d0e21e 1895 case 'w':
bbce6d69 1896 if (regflags & PMf_LOCALE) {
c277df42 1897 if (!SIZE_ONLY)
bbce6d69 1898 *opnd |= ANYOF_ALNUML;
1899 }
1900 else {
8ac85365 1901 for (Class = 0; Class < 256; Class++)
1902 if (isALNUM(Class))
1903 regset(opnd, Class);
bbce6d69 1904 }
a0d0e21e 1905 lastclass = 1234;
1906 continue;
1907 case 'W':
bbce6d69 1908 if (regflags & PMf_LOCALE) {
c277df42 1909 if (!SIZE_ONLY)
bbce6d69 1910 *opnd |= ANYOF_NALNUML;
1911 }
1912 else {
8ac85365 1913 for (Class = 0; Class < 256; Class++)
1914 if (!isALNUM(Class))
1915 regset(opnd, Class);
bbce6d69 1916 }
a0d0e21e 1917 lastclass = 1234;
1918 continue;
1919 case 's':
bbce6d69 1920 if (regflags & PMf_LOCALE) {
c277df42 1921 if (!SIZE_ONLY)
bbce6d69 1922 *opnd |= ANYOF_SPACEL;
1923 }
1924 else {
8ac85365 1925 for (Class = 0; Class < 256; Class++)
1926 if (isSPACE(Class))
1927 regset(opnd, Class);
bbce6d69 1928 }
a0d0e21e 1929 lastclass = 1234;
1930 continue;
1931 case 'S':
bbce6d69 1932 if (regflags & PMf_LOCALE) {
c277df42 1933 if (!SIZE_ONLY)
bbce6d69 1934 *opnd |= ANYOF_NSPACEL;
1935 }
1936 else {
8ac85365 1937 for (Class = 0; Class < 256; Class++)
1938 if (!isSPACE(Class))
1939 regset(opnd, Class);
bbce6d69 1940 }
a0d0e21e 1941 lastclass = 1234;
1942 continue;
1943 case 'd':
8ac85365 1944 for (Class = '0'; Class <= '9'; Class++)
1945 regset(opnd, Class);
a0d0e21e 1946 lastclass = 1234;
1947 continue;
1948 case 'D':
8ac85365 1949 for (Class = 0; Class < '0'; Class++)
1950 regset(opnd, Class);
1951 for (Class = '9' + 1; Class < 256; Class++)
1952 regset(opnd, Class);
a0d0e21e 1953 lastclass = 1234;
1954 continue;
1955 case 'n':
8ac85365 1956 Class = '\n';
a0d0e21e 1957 break;
1958 case 'r':
8ac85365 1959 Class = '\r';
a0d0e21e 1960 break;
1961 case 't':
8ac85365 1962 Class = '\t';
a0d0e21e 1963 break;
1964 case 'f':
8ac85365 1965 Class = '\f';
a0d0e21e 1966 break;
1967 case 'b':
8ac85365 1968 Class = '\b';
a0d0e21e 1969 break;
1970 case 'e':
8ac85365 1971 Class = '\033';
a0d0e21e 1972 break;
1973 case 'a':
8ac85365 1974 Class = '\007';
a0d0e21e 1975 break;
1976 case 'x':
8ac85365 1977 Class = scan_hex(regparse, 2, &numlen);
a0d0e21e 1978 regparse += numlen;
1979 break;
1980 case 'c':
8ac85365 1981 Class = UCHARAT(regparse++);
1982 Class = toCTRL(Class);
a0d0e21e 1983 break;
1984 case '0': case '1': case '2': case '3': case '4':
1985 case '5': case '6': case '7': case '8': case '9':
8ac85365 1986 Class = scan_oct(--regparse, 3, &numlen);
a0d0e21e 1987 regparse += numlen;
1988 break;
1989 }
1990 }
1991 if (range) {
8ac85365 1992 if (lastclass > Class)
a0d0e21e 1993 FAIL("invalid [] range in regexp");
1994 range = 0;
1995 }
1996 else {
8ac85365 1997 lastclass = Class;
a0d0e21e 1998 if (*regparse == '-' && regparse+1 < regxend &&
1999 regparse[1] != ']') {
a687059c 2000 regparse++;
a0d0e21e 2001 range = 1;
2002 continue; /* do it next time */
2003 }
a687059c 2004 }
8ac85365 2005 for ( ; lastclass <= Class; lastclass++)
bbce6d69 2006 regset(opnd, lastclass);
8ac85365 2007 lastclass = Class;
a0d0e21e 2008 }
2009 if (*regparse != ']')
2010 FAIL("unmatched [] in regexp");
2011 nextchar();
2012 return ret;
2013}
2014
2015static char*
8ac85365 2016nextchar(void)
a0d0e21e 2017{
2018 char* retval = regparse++;
2019
4633a7c4 2020 for (;;) {
2021 if (*regparse == '(' && regparse[1] == '?' &&
2022 regparse[2] == '#') {
2023 while (*regparse && *regparse != ')')
748a9306 2024 regparse++;
4633a7c4 2025 regparse++;
2026 continue;
2027 }
2028 if (regflags & PMf_EXTENDED) {
2029 if (isSPACE(*regparse)) {
748a9306 2030 regparse++;
2031 continue;
2032 }
2033 else if (*regparse == '#') {
2034 while (*regparse && *regparse != '\n')
2035 regparse++;
2036 regparse++;
2037 continue;
2038 }
748a9306 2039 }
4633a7c4 2040 return retval;
a0d0e21e 2041 }
a687059c 2042}
2043
2044/*
c277df42 2045- reg_node - emit a node
a0d0e21e 2046*/
c277df42 2047static regnode * /* Location. */
c277df42 2048reg_node(U8 op)
a687059c 2049{
c277df42 2050 register regnode *ret;
2051 register regnode *ptr;
a687059c 2052
a0d0e21e 2053 ret = regcode;
c277df42 2054 if (SIZE_ONLY) {
2055 SIZE_ALIGN(regsize);
2056#ifdef REGALIGN_STRUCT
2057 regsize += 1;
2058#else
a0d0e21e 2059 regsize += 3;
c277df42 2060#endif
a0d0e21e 2061 return(ret);
2062 }
a687059c 2063
c277df42 2064 NODE_ALIGN_FILL(ret);
a0d0e21e 2065 ptr = ret;
c277df42 2066 FILL_ADVANCE_NODE(ptr, op);
a0d0e21e 2067 regcode = ptr;
a687059c 2068
a0d0e21e 2069 return(ret);
a687059c 2070}
2071
2072/*
a0d0e21e 2073- reganode - emit a node with an argument
2074*/
c277df42 2075static regnode * /* Location. */
c277df42 2076reganode(U8 op, U32 arg)
fe14fcc3 2077{
c277df42 2078 register regnode *ret;
2079 register regnode *ptr;
fe14fcc3 2080
a0d0e21e 2081 ret = regcode;
c277df42 2082 if (SIZE_ONLY) {
2083 SIZE_ALIGN(regsize);
fe14fcc3 2084#ifdef REGALIGN
c277df42 2085 regsize += 2;
2086#else
a0d0e21e 2087 regsize += 5;
c277df42 2088#endif
a0d0e21e 2089 return(ret);
2090 }
fe14fcc3 2091
c277df42 2092 NODE_ALIGN_FILL(ret);
a0d0e21e 2093 ptr = ret;
c277df42 2094 FILL_ADVANCE_NODE_ARG(ptr, op, arg);
a0d0e21e 2095 regcode = ptr;
fe14fcc3 2096
a0d0e21e 2097 return(ret);
fe14fcc3 2098}
2099
2100/*
a0d0e21e 2101- regc - emit (if appropriate) a byte of code
2102*/
a0d0e21e 2103static void
c277df42 2104regc(U8 b, char* s)
a687059c 2105{
c277df42 2106 if (!SIZE_ONLY)
2107 *s = b;
a687059c 2108}
2109
2110/*
a0d0e21e 2111- reginsert - insert an operator in front of already-emitted operand
2112*
2113* Means relocating the operand.
2114*/
a0d0e21e 2115static void
c277df42 2116reginsert(U8 op, regnode *opnd)
a687059c 2117{
c277df42 2118 register regnode *src;
2119 register regnode *dst;
2120 register regnode *place;
2121 register int offset = regarglen[(U8)op];
2122
2123/* (regkind[(U8)op] == CURLY ? EXTRA_STEP_2ARGS : 0); */
2124
2125 if (SIZE_ONLY) {
2126 regsize += NODE_STEP_REGNODE + offset;
a0d0e21e 2127 return;
2128 }
a687059c 2129
a0d0e21e 2130 src = regcode;
c277df42 2131 regcode += NODE_STEP_REGNODE + offset;
a0d0e21e 2132 dst = regcode;
2133 while (src > opnd)
c277df42 2134 StructCopy(--src, --dst, regnode);
a0d0e21e 2135
2136 place = opnd; /* Op node, where operand used to be. */
c277df42 2137 src = NEXTOPER(place);
2138 FILL_ADVANCE_NODE(place, op);
2139 Zero(src, offset, regnode);
2140#if defined(REGALIGN) && !defined(REGALIGN_STRUCT)
2141 src[offset + 1] = '\177';
2b69d0c2 2142#endif
a687059c 2143}
2144
2145/*
c277df42 2146- regtail - set the next-pointer at the end of a node chain of p to val.
a0d0e21e 2147*/
a687059c 2148static void
c277df42 2149regtail(regnode *p, regnode *val)
a687059c 2150{
c277df42 2151 register regnode *scan;
2152 register regnode *temp;
a0d0e21e 2153 register I32 offset;
2154
c277df42 2155 if (SIZE_ONLY)
a0d0e21e 2156 return;
2157
2158 /* Find last node. */
2159 scan = p;
2160 for (;;) {
2161 temp = regnext(scan);
2162 if (temp == NULL)
2163 break;
2164 scan = temp;
2165 }
a687059c 2166
2167#ifdef REGALIGN
c277df42 2168# ifdef REGALIGN_STRUCT
2169 if (reg_off_by_arg[OP(scan)]) {
2170 ARG_SET(scan, val - scan);
2171 } else {
2172 NEXT_OFF(scan) = val - scan;
2173 }
2174# else
a0d0e21e 2175 offset = val - scan;
c277df42 2176# ifndef lint
a0d0e21e 2177 *(short*)(scan+1) = offset;
c277df42 2178# endif
2179#endif
a687059c 2180#else
a0d0e21e 2181 if (OP(scan) == BACK)
2182 offset = scan - val;
2183 else
2184 offset = val - scan;
2185 *(scan+1) = (offset>>8)&0377;
2186 *(scan+2) = offset&0377;
a687059c 2187#endif
2188}
2189
2190/*
a0d0e21e 2191- regoptail - regtail on operand of first argument; nop if operandless
2192*/
a687059c 2193static void
c277df42 2194regoptail(regnode *p, regnode *val)
a687059c 2195{
a0d0e21e 2196 /* "Operandless" and "op != BRANCH" are synonymous in practice. */
c277df42 2197 if (p == NULL || SIZE_ONLY)
2198 return;
2199 if (regkind[(U8)OP(p)] == BRANCH) {
2200 regtail(NEXTOPER(p), val);
2201 } else if ( regkind[(U8)OP(p)] == BRANCHJ) {
2202 regtail(NEXTOPER(NEXTOPER(p)), val);
2203 } else
a0d0e21e 2204 return;
a687059c 2205}
2206
2207/*
2208 - regcurly - a little FSA that accepts {\d+,?\d*}
2209 */
79072805 2210STATIC I32
8ac85365 2211regcurly(register char *s)
a687059c 2212{
2213 if (*s++ != '{')
2214 return FALSE;
f0fcb552 2215 if (!isDIGIT(*s))
a687059c 2216 return FALSE;
f0fcb552 2217 while (isDIGIT(*s))
a687059c 2218 s++;
2219 if (*s == ',')
2220 s++;
f0fcb552 2221 while (isDIGIT(*s))
a687059c 2222 s++;
2223 if (*s != '}')
2224 return FALSE;
2225 return TRUE;
2226}
2227
2228#ifdef DEBUGGING
2229
c277df42 2230static regnode *
2231dumpuntil(regnode *start, regnode *node, regnode *last, SV* sv, I32 l)
2232{
2233 register char op = EXACT; /* Arbitrary non-END op. */
2234 register regnode *next, *onode;
2235
2236 while (op != END && (!last || node < last)) {
2237 /* While that wasn't END last time... */
2238
2239 NODE_ALIGN(node);
2240 op = OP(node);
2241 if (op == CLOSE)
2242 l--;
2243 next = regnext(node);
2244 /* Where, what. */
2245 if (OP(node) == OPTIMIZED)
2246 goto after_print;
2247 regprop(sv, node);
2248 PerlIO_printf(Perl_debug_log, "%4d%*s%s", node - start,
2249 2*l + 1, "", SvPVX(sv));
2250 if (next == NULL) /* Next ptr. */
2251 PerlIO_printf(Perl_debug_log, "(0)");
2252 else
2253 PerlIO_printf(Perl_debug_log, "(%d)", next - start);
2254 (void)PerlIO_putc(Perl_debug_log, '\n');
2255 after_print:
2256 if (regkind[(U8)op] == BRANCHJ) {
2257 register regnode *nnode = (OP(next) == LONGJMP
2258 ? regnext(next)
2259 : next);
2260 if (last && nnode > last)
2261 nnode = last;
2262 node = dumpuntil(start, NEXTOPER(NEXTOPER(node)), nnode, sv, l + 1);
2263 } else if (regkind[(U8)op] == BRANCH) {
2264 node = dumpuntil(start, NEXTOPER(node), next, sv, l + 1);
2265 } else if ( op == CURLY) { /* `next' might be very big: optimizer */
2266 node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
2267 NEXTOPER(node) + EXTRA_STEP_2ARGS + 1, sv, l + 1);
2268 } else if (regkind[(U8)op] == CURLY && op != CURLYX) {
2269 node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
2270 next, sv, l + 1);
2271 } else if ( op == PLUS || op == STAR) {
2272 node = dumpuntil(start, NEXTOPER(node), NEXTOPER(node) + 1, sv, l + 1);
2273 } else if (op == ANYOF) {
2274 node = NEXTOPER(node);
2275 node += ANY_SKIP;
2276 } else if (regkind[(U8)op] == EXACT) {
2277 /* Literal string, where present. */
2278 node += ((*OPERAND(node)) + 2 + sizeof(regnode) - 1) / sizeof(regnode);
2279 node = NEXTOPER(node);
2280 } else {
2281 node = NEXTOPER(node);
2282 node += regarglen[(U8)op];
2283 }
2284 if (op == CURLYX || op == OPEN)
2285 l++;
2286 else if (op == WHILEM)
2287 l--;
2288 }
2289 return node;
2290}
2291
a687059c 2292/*
fd181c75 2293 - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
a687059c 2294 */
2295void
8ac85365 2296regdump(regexp *r)
a687059c 2297{
46fc3d4c 2298 SV *sv = sv_newmortal();
a687059c 2299
c277df42 2300 (void)dumpuntil(r->program, r->program + 1, NULL, sv, 0);
a0d0e21e 2301
2302 /* Header fields of interest. */
c277df42 2303 if (r->anchored_substr)
2304 PerlIO_printf(Perl_debug_log, "anchored `%s%s%s'%s at %d ",
2305 colors[0],
2306 SvPVX(r->anchored_substr),
2307 colors[1],
2308 SvTAIL(r->anchored_substr) ? "$" : "",
2309 r->anchored_offset);
2310 if (r->float_substr)
2311 PerlIO_printf(Perl_debug_log, "floating `%s%s%s'%s at %d..%u ",
2312 colors[0],
2313 SvPVX(r->float_substr),
2314 colors[1],
2315 SvTAIL(r->float_substr) ? "$" : "",
2316 r->float_min_offset, r->float_max_offset);
2317 if (r->check_substr)
2318 PerlIO_printf(Perl_debug_log,
2319 r->check_substr == r->float_substr
2320 ? "(checking floating" : "(checking anchored");
2321 if (r->reganch & ROPT_NOSCAN)
2322 PerlIO_printf(Perl_debug_log, " noscan");
2323 if (r->reganch & ROPT_CHECK_ALL)
2324 PerlIO_printf(Perl_debug_log, " isall");
2325 if (r->check_substr)
2326 PerlIO_printf(Perl_debug_log, ") ");
2327
46fc3d4c 2328 if (r->regstclass) {
2329 regprop(sv, r->regstclass);
2330 PerlIO_printf(Perl_debug_log, "stclass `%s' ", SvPVX(sv));
2331 }
774d564b 2332 if (r->reganch & ROPT_ANCH) {
2333 PerlIO_printf(Perl_debug_log, "anchored");
2334 if (r->reganch & ROPT_ANCH_BOL)
2335 PerlIO_printf(Perl_debug_log, "(BOL)");
c277df42 2336 if (r->reganch & ROPT_ANCH_MBOL)
2337 PerlIO_printf(Perl_debug_log, "(MBOL)");
774d564b 2338 if (r->reganch & ROPT_ANCH_GPOS)
2339 PerlIO_printf(Perl_debug_log, "(GPOS)");
2340 PerlIO_putc(Perl_debug_log, ' ');
2341 }
c277df42 2342 if (r->reganch & ROPT_GPOS_SEEN)
2343 PerlIO_printf(Perl_debug_log, "GPOS ");
a0d0e21e 2344 if (r->reganch & ROPT_SKIP)
760ac839 2345 PerlIO_printf(Perl_debug_log, "plus ");
a0d0e21e 2346 if (r->reganch & ROPT_IMPLICIT)
760ac839 2347 PerlIO_printf(Perl_debug_log, "implicit ");
760ac839 2348 PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen);
2349 PerlIO_printf(Perl_debug_log, "\n");
a687059c 2350}
2351
2352/*
a0d0e21e 2353- regprop - printable representation of opcode
2354*/
46fc3d4c 2355void
c277df42 2356regprop(SV *sv, regnode *o)
a687059c 2357{
a0d0e21e 2358 register char *p = 0;
2359
46fc3d4c 2360 sv_setpv(sv, ":");
11343788 2361 switch (OP(o)) {
a0d0e21e 2362 case BOL:
2363 p = "BOL";
2364 break;
2365 case MBOL:
2366 p = "MBOL";
2367 break;
2368 case SBOL:
2369 p = "SBOL";
2370 break;
2371 case EOL:
2372 p = "EOL";
2373 break;
2374 case MEOL:
2375 p = "MEOL";
2376 break;
2377 case SEOL:
2378 p = "SEOL";
2379 break;
2380 case ANY:
2381 p = "ANY";
2382 break;
2383 case SANY:
2384 p = "SANY";
2385 break;
2386 case ANYOF:
2387 p = "ANYOF";
2388 break;
2389 case BRANCH:
2390 p = "BRANCH";
2391 break;
bbce6d69 2392 case EXACT:
c277df42 2393 sv_catpvf(sv, "EXACT <%s%s%s>", colors[0], OPERAND(o) + 1, colors[1]);
bbce6d69 2394 break;
2395 case EXACTF:
c277df42 2396 sv_catpvf(sv, "EXACTF <%s%s%s>", colors[0], OPERAND(o) + 1, colors[1]);
bbce6d69 2397 break;
2398 case EXACTFL:
c277df42 2399 sv_catpvf(sv, "EXACTFL <%s%s%s>", colors[0], OPERAND(o) + 1, colors[1]);
a0d0e21e 2400 break;
2401 case NOTHING:
2402 p = "NOTHING";
2403 break;
c277df42 2404 case TAIL:
2405 p = "TAIL";
2406 break;
a0d0e21e 2407 case BACK:
2408 p = "BACK";
2409 break;
2410 case END:
2411 p = "END";
2412 break;
a0d0e21e 2413 case BOUND:
2414 p = "BOUND";
2415 break;
bbce6d69 2416 case BOUNDL:
2417 p = "BOUNDL";
2418 break;
a0d0e21e 2419 case NBOUND:
2420 p = "NBOUND";
2421 break;
bbce6d69 2422 case NBOUNDL:
2423 p = "NBOUNDL";
a0d0e21e 2424 break;
2425 case CURLY:
5dc0d613 2426 sv_catpvf(sv, "CURLY {%d,%d}", ARG1(o), ARG2(o));
a0d0e21e 2427 break;
c277df42 2428 case CURLYM:
2429#ifdef REGALIGN_STRUCT
2430 sv_catpvf(sv, "CURLYM[%d] {%d,%d}", o->flags, ARG1(o), ARG2(o));
2431#else
2432 sv_catpvf(sv, "CURLYM {%d,%d}", ARG1(o), ARG2(o));
2433#endif
2434 break;
2435 case CURLYN:
2436#ifdef REGALIGN_STRUCT
2437 sv_catpvf(sv, "CURLYN[%d] {%d,%d}", o->flags, ARG1(o), ARG2(o));
2438#else
2439 sv_catpvf(sv, "CURLYN {%d,%d}", ARG1(o), ARG2(o));
2440#endif
2441 break;
a0d0e21e 2442 case CURLYX:
5dc0d613 2443 sv_catpvf(sv, "CURLYX {%d,%d}", ARG1(o), ARG2(o));
a0d0e21e 2444 break;
2445 case REF:
c277df42 2446 sv_catpvf(sv, "REF%d", ARG(o));
a0d0e21e 2447 break;
c8756f30 2448 case REFF:
c277df42 2449 sv_catpvf(sv, "REFF%d", ARG(o));
c8756f30 2450 break;
2451 case REFFL:
c277df42 2452 sv_catpvf(sv, "REFFL%d", ARG(o));
c8756f30 2453 break;
a0d0e21e 2454 case OPEN:
c277df42 2455 sv_catpvf(sv, "OPEN%d", ARG(o));
a0d0e21e 2456 break;
2457 case CLOSE:
c277df42 2458 sv_catpvf(sv, "CLOSE%d", ARG(o));
a0d0e21e 2459 p = NULL;
2460 break;
2461 case STAR:
2462 p = "STAR";
2463 break;
2464 case PLUS:
2465 p = "PLUS";
2466 break;
2467 case MINMOD:
2468 p = "MINMOD";
2469 break;
774d564b 2470 case GPOS:
2471 p = "GPOS";
a0d0e21e 2472 break;
2473 case UNLESSM:
c277df42 2474#ifdef REGALIGN_STRUCT
2475 sv_catpvf(sv, "UNLESSM[-%d]", o->flags);
2476#else
a0d0e21e 2477 p = "UNLESSM";
c277df42 2478#endif
a0d0e21e 2479 break;
2480 case IFMATCH:
c277df42 2481#ifdef REGALIGN_STRUCT
2482 sv_catpvf(sv, "IFMATCH[-%d]", o->flags);
2483#else
a0d0e21e 2484 p = "IFMATCH";
c277df42 2485#endif
a0d0e21e 2486 break;
2487 case SUCCEED:
2488 p = "SUCCEED";
2489 break;
2490 case WHILEM:
2491 p = "WHILEM";
2492 break;
bbce6d69 2493 case DIGIT:
2494 p = "DIGIT";
2495 break;
2496 case NDIGIT:
2497 p = "NDIGIT";
2498 break;
2499 case ALNUM:
2500 p = "ALNUM";
2501 break;
2502 case NALNUM:
2503 p = "NALNUM";
2504 break;
2505 case SPACE:
2506 p = "SPACE";
2507 break;
2508 case NSPACE:
2509 p = "NSPACE";
2510 break;
2511 case ALNUML:
2512 p = "ALNUML";
2513 break;
2514 case NALNUML:
2515 p = "NALNUML";
2516 break;
2517 case SPACEL:
2518 p = "SPACEL";
2519 break;
2520 case NSPACEL:
2521 p = "NSPACEL";
2522 break;
c277df42 2523 case EVAL:
2524 p = "EVAL";
2525 break;
2526 case LONGJMP:
2527 p = "LONGJMP";
2528 break;
2529 case BRANCHJ:
2530 p = "BRANCHJ";
2531 break;
2532 case IFTHEN:
2533 p = "IFTHEN";
2534 break;
2535 case GROUPP:
2536 sv_catpvf(sv, "GROUPP%d", ARG(o));
2537 break;
2538 case LOGICAL:
2539 p = "LOGICAL";
2540 break;
2541 case SUSPEND:
2542 p = "SUSPEND";
2543 break;
2544 case RENUM:
2545 p = "RENUM";
2546 break;
2547 case OPTIMIZED:
2548 p = "OPTIMIZED";
2549 break;
a0d0e21e 2550 default:
2551 FAIL("corrupted regexp opcode");
2552 }
46fc3d4c 2553 if (p)
2554 sv_catpv(sv, p);
a687059c 2555}
2556#endif /* DEBUGGING */
2557
2b69d0c2 2558void
8ac85365 2559pregfree(struct regexp *r)
a687059c 2560{
c277df42 2561 if (!r || (--r->refcnt > 0))
a0d0e21e 2562 return;
c277df42 2563 if (r->precomp)
a0d0e21e 2564 Safefree(r->precomp);
c277df42 2565 if (r->subbase)
a0d0e21e 2566 Safefree(r->subbase);
c277df42 2567 if (r->anchored_substr)
2568 SvREFCNT_dec(r->anchored_substr);
2569 if (r->float_substr)
2570 SvREFCNT_dec(r->float_substr);
2571 if (r->data) {
2572 int n = r->data->count;
2573 while (--n >= 0) {
2574 switch (r->data->what[n]) {
2575 case 's':
2576 SvREFCNT_dec((SV*)r->data->data[n]);
2577 break;
2578 case 'o':
2579 op_free((OP_4tree*)r->data->data[n]);
2580 break;
2581 case 'n':
2582 break;
2583 default:
2584 FAIL2("panic: regfree data code '%c'", r->data->what[n]);
2585 }
2586 }
2587 Safefree(r->data->what);
2588 Safefree(r->data);
a0d0e21e 2589 }
2590 Safefree(r->startp);
2591 Safefree(r->endp);
2592 Safefree(r);
a687059c 2593}
c277df42 2594
2595/*
2596 - regnext - dig the "next" pointer out of a node
2597 *
2598 * [Note, when REGALIGN is defined there are two places in regmatch()
2599 * that bypass this code for speed.]
2600 */
2601regnode *
2602regnext(register regnode *p)
2603{
2604 register I32 offset;
2605
2606 if (p == &regdummy)
2607 return(NULL);
2608
2609 offset = (reg_off_by_arg[OP(p)] ? ARG(p) : NEXT_OFF(p));
2610 if (offset == 0)
2611 return(NULL);
2612
2613#ifdef REGALIGN
2614 return(p+offset);
2615#else
2616 if (OP(p) == BACK)
2617 return(p-offset);
2618 else
2619 return(p+offset);
2620#endif
2621}
2622
2623#ifdef I_STDARG
2624void
2625re_croak2(const char* pat1,const char* pat2,...)
2626#else
2627/*VARARGS0*/
2628void
2629re_croak2(const char* pat1,const char* pat2, va_alist)
2630 const char* pat1;
2631 const char* pat2;
2632 va_dcl
2633#endif
2634{
2635 va_list args;
2636 STRLEN l1 = strlen(pat1);
2637 STRLEN l2 = strlen(pat2);
2638 char buf[512];
2639 char *message;
2640
2641 if (l1 > 510)
2642 l1 = 510;
2643 if (l1 + l2 > 510)
2644 l2 = 510 - l1;
2645 Copy(pat1, buf, l1 , char);
2646 Copy(pat2, buf + l1, l2 , char);
2647 buf[l1 + l2 + 1] = '\n';
2648 buf[l1 + l2 + 2] = '\0';
2649#ifdef I_STDARG
2650 va_start(args, pat2);
2651#else
2652 va_start(args);
2653#endif
2654 message = mess(buf, &args);
2655 va_end(args);
2656 l1 = strlen(message);
2657 if (l1 > 512)
2658 l1 = 512;
2659 Copy(message, buf, l1 , char);
2660 buf[l1] = '\0'; /* Overwrite \n */
2661 croak("%s", buf);
2662}
Unnamed repository; edit this file to name it for gitweb.