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