This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Avoid core dump on some paren'd regexp matches
[perl5.git] / regexec.c
1 /*    regexec.c
2  */
3
4 /*
5  * "One Ring to rule them all, One Ring to find them..."
6  */
7
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
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
22 /*SUPPRESS 112*/
23 /*
24  * pregcomp and pregexec -- regsub and regerror are not used in perl
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  ****    Alterations to Henry's code are...
44  ****
45  ****    Copyright (c) 1991-1997, Larry Wall
46  ****
47  ****    You may distribute under the terms of either the GNU General Public
48  ****    License or the Artistic License, as specified in the README file.
49  *
50  * Beware that some of this code is subtly aware of the way operator
51  * precedence is structured in regular expressions.  Serious changes in
52  * regular-expression syntax might require a total rethink.
53  */
54 #include "EXTERN.h"
55 #include "perl.h"
56 #include "regcomp.h"
57
58 #ifndef STATIC
59 #define STATIC  static
60 #endif
61
62 #ifdef DEBUGGING
63 static I32 regnarrate = 0;
64 static char* regprogram = 0;
65 #endif
66
67 /* Current curly descriptor */
68 typedef struct curcur CURCUR;
69 struct curcur {
70     int         parenfloor;     /* how far back to strip paren data */
71     int         cur;            /* how many instances of scan we've matched */
72     int         min;            /* the minimal number of scans to match */
73     int         max;            /* the maximal number of scans to match */
74     int         minmod;         /* whether to work our way up or down */
75     char *      scan;           /* the thing to match */
76     char *      next;           /* what has to match after it */
77     char *      lastloc;        /* where we started matching this scan */
78     CURCUR *    oldcc;          /* current curly before we started this one */
79 };
80
81 static CURCUR* regcc;
82
83 typedef I32 CHECKPOINT;
84
85 static CHECKPOINT regcppush _((I32 parenfloor));
86 static char * regcppop _((void));
87
88 static CHECKPOINT
89 regcppush(parenfloor)
90 I32 parenfloor;
91 {
92     int retval = savestack_ix;
93     int i = (regsize - parenfloor) * 3;
94     int p;
95
96     SSCHECK(i + 5);
97     for (p = regsize; p > parenfloor; p--) {
98         SSPUSHPTR(regendp[p]);
99         SSPUSHPTR(regstartp[p]);
100         SSPUSHINT(p);
101     }
102     SSPUSHINT(regsize);
103     SSPUSHINT(*reglastparen);
104     SSPUSHPTR(reginput);
105     SSPUSHINT(i + 3);
106     SSPUSHINT(SAVEt_REGCONTEXT);
107     return retval;
108 }
109
110 static char *
111 regcppop()
112 {
113     I32 i = SSPOPINT;
114     U32 paren = 0;
115     char *input;
116     char *tmps;
117     assert(i == SAVEt_REGCONTEXT);
118     i = SSPOPINT;
119     input = (char *) SSPOPPTR;
120     *reglastparen = SSPOPINT;
121     regsize = SSPOPINT;
122     for (i -= 3; i > 0; i -= 3) {
123         paren = (U32)SSPOPINT;
124         regstartp[paren] = (char *) SSPOPPTR;
125         tmps = (char*)SSPOPPTR;
126         if (paren <= *reglastparen)
127             regendp[paren] = tmps;
128     }
129     for (paren = *reglastparen + 1; paren <= regnpar; paren++) {
130         if (paren > regsize)
131             regstartp[paren] = Nullch;
132         regendp[paren] = Nullch;
133     }
134     return input;
135 }
136
137 static void
138 regcppartblow()
139 {
140     I32 i = SSPOPINT;
141     U32 paren = 0;
142     char *input;
143     char *startp;
144     char *endp;
145     int lastparen;
146     int size;
147     assert(i == SAVEt_REGCONTEXT);
148     i = SSPOPINT;
149     input = (char *) SSPOPPTR;
150     lastparen = SSPOPINT;
151     size = SSPOPINT;
152     for (i -= 3; i > 0; i -= 3) {
153         paren = (U32)SSPOPINT;
154         startp = (char *) SSPOPPTR;
155         endp = (char *) SSPOPPTR;
156         if (paren <= *reglastparen && regendp[paren] == endp)
157             regstartp[paren] = startp;
158     }
159 }
160
161 #define regcpblow(cp) leave_scope(cp)
162
163 /*
164  * pregexec and friends
165  */
166
167 /*
168  * Forwards.
169  */
170
171 static I32 regmatch _((char *prog));
172 static I32 regrepeat _((char *p, I32 max));
173 static I32 regtry _((regexp *prog, char *startpos));
174 static bool reginclass _((char *p, I32 c));
175
176 static bool regtainted;         /* tainted information used? */
177
178 /*
179  - pregexec - match a regexp against a string
180  */
181 I32
182 pregexec(prog, stringarg, strend, strbeg, minend, screamer, safebase)
183 register regexp *prog;
184 char *stringarg;
185 register char *strend;  /* pointer to null at end of string */
186 char *strbeg;   /* real beginning of string */
187 I32 minend;     /* end of match must be at least minend after stringarg */
188 SV *screamer;
189 I32 safebase;   /* no need to remember string in subbase */
190 {
191     register char *s;
192     register char *c;
193     register char *startpos = stringarg;
194     register I32 tmp;
195     I32 minlen = 0;             /* must match at least this many chars */
196     I32 dontbother = 0; /* how many characters not to try at end */
197     CURCUR cc;
198
199     cc.cur = 0;
200     cc.oldcc = 0;
201     regcc = &cc;
202
203 #ifdef DEBUGGING
204     regnarrate = debug & 512;
205     regprogram = prog->program;
206 #endif
207
208     /* Be paranoid... */
209     if (prog == NULL || startpos == NULL) {
210         croak("NULL regexp parameter");
211         return 0;
212     }
213
214     if (startpos == strbeg)     /* is ^ valid at stringarg? */
215         regprev = '\n';
216     else {
217         regprev = stringarg[-1];
218         if (!multiline && regprev == '\n')
219             regprev = '\0';             /* force ^ to NOT match */
220     }
221
222     regprecomp = prog->precomp;
223     /* Check validity of program. */
224     if (UCHARAT(prog->program) != MAGIC) {
225         FAIL("corrupted regexp program");
226     }
227
228     regnpar = prog->nparens;
229     regtainted = FALSE;
230
231     /* If there is a "must appear" string, look for it. */
232     s = startpos;
233     if (prog->regmust != Nullsv &&
234         !(prog->reganch & ROPT_ANCH_GPOS) &&
235         (!(prog->reganch & ROPT_ANCH_BOL)
236          || (multiline && prog->regback >= 0)) )
237     {
238         if (stringarg == strbeg && screamer) {
239             if (screamfirst[BmRARE(prog->regmust)] >= 0)
240                     s = screaminstr(screamer,prog->regmust);
241             else
242                     s = Nullch;
243         }
244         else
245             s = fbm_instr((unsigned char*)s, (unsigned char*)strend,
246                 prog->regmust);
247         if (!s) {
248             ++BmUSEFUL(prog->regmust);  /* hooray */
249             goto phooey;        /* not present */
250         }
251         else if (prog->regback >= 0) {
252             s -= prog->regback;
253             if (s < startpos)
254                 s = startpos;
255             minlen = prog->regback + SvCUR(prog->regmust);
256         }
257         else if (!prog->naughty && --BmUSEFUL(prog->regmust) < 0) { /* boo */
258             SvREFCNT_dec(prog->regmust);
259             prog->regmust = Nullsv;     /* disable regmust */
260             s = startpos;
261         }
262         else {
263             s = startpos;
264             minlen = SvCUR(prog->regmust);
265         }
266     }
267
268     /* Mark beginning of line for ^ . */
269     regbol = startpos;
270
271     /* Mark end of line for $ (and such) */
272     regeol = strend;
273
274     /* see how far we have to get to not match where we matched before */
275     regtill = startpos+minend;
276
277     /* Simplest case:  anchored match need be tried only once. */
278     /*  [unless only anchor is BOL and multiline is set] */
279     if (prog->reganch & ROPT_ANCH) {
280         if (regtry(prog, startpos))
281             goto got_it;
282         else if (!(prog->reganch & ROPT_ANCH_GPOS) &&
283                  (multiline || (prog->reganch & ROPT_IMPLICIT)))
284         {
285             if (minlen)
286                 dontbother = minlen - 1;
287             strend -= dontbother;
288             /* for multiline we only have to try after newlines */
289             if (s > startpos)
290                 s--;
291             while (s < strend) {
292                 if (*s++ == '\n') {
293                     if (s < strend && regtry(prog, s))
294                         goto got_it;
295                 }
296             }
297         }
298         goto phooey;
299     }
300
301     /* Messy cases:  unanchored match. */
302     if (prog->regstart) {
303         if (prog->reganch & ROPT_SKIP) {  /* we have /x+whatever/ */
304             /* it must be a one character string */
305             char ch = SvPVX(prog->regstart)[0];
306             while (s < strend) {
307                 if (*s == ch) {
308                     if (regtry(prog, s))
309                         goto got_it;
310                     s++;
311                     while (s < strend && *s == ch)
312                         s++;
313                 }
314                 s++;
315             }
316         }
317         else if (SvTYPE(prog->regstart) == SVt_PVBM) {
318             /* We know what string it must start with. */
319             while ((s = fbm_instr((unsigned char*)s,
320               (unsigned char*)strend, prog->regstart)) != NULL)
321             {
322                 if (regtry(prog, s))
323                     goto got_it;
324                 s++;
325             }
326         }
327         else {                          /* Optimized fbm_instr: */
328             c = SvPVX(prog->regstart);
329             while ((s = ninstr(s, strend, c, c + SvCUR(prog->regstart))) != NULL)
330             {
331                 if (regtry(prog, s))
332                     goto got_it;
333                 s++;
334             }
335         }
336         goto phooey;
337     }
338     /*SUPPRESS 560*/
339     if (c = prog->regstclass) {
340         I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
341
342         if (minlen)
343             dontbother = minlen - 1;
344         strend -= dontbother;   /* don't bother with what can't match */
345         tmp = 1;
346         /* We know what class it must start with. */
347         switch (OP(c)) {
348         case ANYOF:
349             c = OPERAND(c);
350             while (s < strend) {
351                 if (reginclass(c, *s)) {
352                     if (tmp && regtry(prog, s))
353                         goto got_it;
354                     else
355                         tmp = doevery;
356                 }
357                 else
358                     tmp = 1;
359                 s++;
360             }
361             break;
362         case BOUNDL:
363             regtainted = TRUE;
364             /* FALL THROUGH */
365         case BOUND:
366             if (minlen)
367                 dontbother++,strend--;
368             tmp = (s != startpos) ? UCHARAT(s - 1) : regprev;
369             tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
370             while (s < strend) {
371                 if (tmp == !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
372                     tmp = !tmp;
373                     if (regtry(prog, s))
374                         goto got_it;
375                 }
376                 s++;
377             }
378             if ((minlen || tmp) && regtry(prog,s))
379                 goto got_it;
380             break;
381         case NBOUNDL:
382             regtainted = TRUE;
383             /* FALL THROUGH */
384         case NBOUND:
385             if (minlen)
386                 dontbother++,strend--;
387             tmp = (s != startpos) ? UCHARAT(s - 1) : regprev;
388             tmp = ((OP(c) == NBOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
389             while (s < strend) {
390                 if (tmp == !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
391                     tmp = !tmp;
392                 else if (regtry(prog, s))
393                     goto got_it;
394                 s++;
395             }
396             if ((minlen || !tmp) && regtry(prog,s))
397                 goto got_it;
398             break;
399         case ALNUM:
400             while (s < strend) {
401                 if (isALNUM(*s)) {
402                     if (tmp && regtry(prog, s))
403                         goto got_it;
404                     else
405                         tmp = doevery;
406                 }
407                 else
408                     tmp = 1;
409                 s++;
410             }
411             break;
412         case ALNUML:
413             regtainted = TRUE;
414             while (s < strend) {
415                 if (isALNUM_LC(*s)) {
416                     if (tmp && regtry(prog, s))
417                         goto got_it;
418                     else
419                         tmp = doevery;
420                 }
421                 else
422                     tmp = 1;
423                 s++;
424             }
425             break;
426         case NALNUM:
427             while (s < strend) {
428                 if (!isALNUM(*s)) {
429                     if (tmp && regtry(prog, s))
430                         goto got_it;
431                     else
432                         tmp = doevery;
433                 }
434                 else
435                     tmp = 1;
436                 s++;
437             }
438             break;
439         case NALNUML:
440             regtainted = TRUE;
441             while (s < strend) {
442                 if (!isALNUM_LC(*s)) {
443                     if (tmp && regtry(prog, s))
444                         goto got_it;
445                     else
446                         tmp = doevery;
447                 }
448                 else
449                     tmp = 1;
450                 s++;
451             }
452             break;
453         case SPACE:
454             while (s < strend) {
455                 if (isSPACE(*s)) {
456                     if (tmp && regtry(prog, s))
457                         goto got_it;
458                     else
459                         tmp = doevery;
460                 }
461                 else
462                     tmp = 1;
463                 s++;
464             }
465             break;
466         case SPACEL:
467             regtainted = TRUE;
468             while (s < strend) {
469                 if (isSPACE_LC(*s)) {
470                     if (tmp && regtry(prog, s))
471                         goto got_it;
472                     else
473                         tmp = doevery;
474                 }
475                 else
476                     tmp = 1;
477                 s++;
478             }
479             break;
480         case NSPACE:
481             while (s < strend) {
482                 if (!isSPACE(*s)) {
483                     if (tmp && regtry(prog, s))
484                         goto got_it;
485                     else
486                         tmp = doevery;
487                 }
488                 else
489                     tmp = 1;
490                 s++;
491             }
492             break;
493         case NSPACEL:
494             regtainted = TRUE;
495             while (s < strend) {
496                 if (!isSPACE_LC(*s)) {
497                     if (tmp && regtry(prog, s))
498                         goto got_it;
499                     else
500                         tmp = doevery;
501                 }
502                 else
503                     tmp = 1;
504                 s++;
505             }
506             break;
507         case DIGIT:
508             while (s < strend) {
509                 if (isDIGIT(*s)) {
510                     if (tmp && regtry(prog, s))
511                         goto got_it;
512                     else
513                         tmp = doevery;
514                 }
515                 else
516                     tmp = 1;
517                 s++;
518             }
519             break;
520         case NDIGIT:
521             while (s < strend) {
522                 if (!isDIGIT(*s)) {
523                     if (tmp && regtry(prog, s))
524                         goto got_it;
525                     else
526                         tmp = doevery;
527                 }
528                 else
529                     tmp = 1;
530                 s++;
531             }
532             break;
533         }
534     }
535     else {
536         if (minlen)
537             dontbother = minlen - 1;
538         strend -= dontbother;
539         /* We don't know much -- general case. */
540         do {
541             if (regtry(prog, s))
542                 goto got_it;
543         } while (s++ < strend);
544     }
545
546     /* Failure. */
547     goto phooey;
548
549 got_it:
550     strend += dontbother;       /* uncheat */
551     prog->subbeg = strbeg;
552     prog->subend = strend;
553     prog->exec_tainted = regtainted;
554
555     /* make sure $`, $&, $', and $digit will work later */
556     if (strbeg != prog->subbase) {
557         if (safebase) {
558             if (prog->subbase) {
559                 Safefree(prog->subbase);
560                 prog->subbase = Nullch;
561             }
562         }
563         else {
564             I32 i = strend - startpos + (stringarg - strbeg);
565             s = savepvn(strbeg, i);
566             Safefree(prog->subbase);
567             prog->subbase = s;
568             prog->subbeg = prog->subbase;
569             prog->subend = prog->subbase + i;
570             s = prog->subbase + (stringarg - strbeg);
571             for (i = 0; i <= prog->nparens; i++) {
572                 if (prog->endp[i]) {
573                     prog->startp[i] = s + (prog->startp[i] - startpos);
574                     prog->endp[i] = s + (prog->endp[i] - startpos);
575                 }
576             }
577         }
578     }
579     return 1;
580
581 phooey:
582     return 0;
583 }
584
585 /*
586  - regtry - try match at specific point
587  */
588 static I32                      /* 0 failure, 1 success */
589 regtry(prog, startpos)
590 regexp *prog;
591 char *startpos;
592 {
593     register I32 i;
594     register char **sp;
595     register char **ep;
596
597     reginput = startpos;
598     regstartp = prog->startp;
599     regendp = prog->endp;
600     reglastparen = &prog->lastparen;
601     prog->lastparen = 0;
602     regsize = 0;
603
604     sp = prog->startp;
605     ep = prog->endp;
606     if (prog->nparens) {
607         for (i = prog->nparens; i >= 0; i--) {
608             *sp++ = NULL;
609             *ep++ = NULL;
610         }
611     }
612     if (regmatch(prog->program + 1) && reginput >= regtill) {
613         prog->startp[0] = startpos;
614         prog->endp[0] = reginput;
615         return 1;
616     }
617     else
618         return 0;
619 }
620
621 /*
622  - regmatch - main matching routine
623  *
624  * Conceptually the strategy is simple:  check to see whether the current
625  * node matches, call self recursively to see whether the rest matches,
626  * and then act accordingly.  In practice we make some effort to avoid
627  * recursion, in particular by going through "ordinary" nodes (that don't
628  * need to know whether the rest of the match failed) by a loop instead of
629  * by recursion.
630  */
631 /* [lwall] I've hoisted the register declarations to the outer block in order to
632  * maybe save a little bit of pushing and popping on the stack.  It also takes
633  * advantage of machines that use a register save mask on subroutine entry.
634  */
635 static I32                      /* 0 failure, 1 success */
636 regmatch(prog)
637 char *prog;
638 {
639     register char *scan;        /* Current node. */
640     char *next;                 /* Next node. */
641     register I32 nextchar;
642     register I32 n;             /* no or next */
643     register I32 ln;            /* len or last */
644     register char *s;           /* operand or save */
645     register char *locinput = reginput;
646     register I32 c1, c2;        /* case fold search */
647     int minmod = 0;
648 #ifdef DEBUGGING
649     static int regindent = 0;
650     regindent++;
651 #endif
652
653     nextchar = UCHARAT(locinput);
654     scan = prog;
655     while (scan != NULL) {
656 #ifdef DEBUGGING
657 #define sayYES goto yes
658 #define sayNO goto no
659 #define saySAME(x) if (x) goto yes; else goto no
660         if (regnarrate) {
661             SV *prop = sv_newmortal();
662             regprop(prop, scan);
663             PerlIO_printf(Perl_debug_log, "%*s%2d%-8.8s\t<%.10s>\n",
664                           regindent*2, "", scan - regprogram,
665                           SvPVX(prop), locinput);
666         }
667 #else
668 #define sayYES return 1
669 #define sayNO return 0
670 #define saySAME(x) return x
671 #endif
672
673 #ifdef REGALIGN
674         next = scan + NEXT(scan);
675         if (next == scan)
676             next = NULL;
677 #else
678         next = regnext(scan);
679 #endif
680
681         switch (OP(scan)) {
682         case BOL:
683             if (locinput == regbol
684                 ? regprev == '\n'
685                 : ((nextchar || locinput < regeol) && locinput[-1] == '\n') )
686             {
687                 /* regtill = regbol; */
688                 break;
689             }
690             sayNO;
691         case MBOL:
692             if (locinput == regbol
693                 ? regprev == '\n'
694                 : ((nextchar || locinput < regeol) && locinput[-1] == '\n') )
695             {
696                 break;
697             }
698             sayNO;
699         case SBOL:
700             if (locinput == regbol && regprev == '\n')
701                 break;
702             sayNO;
703         case GPOS:
704             if (locinput == regbol)
705                 break;
706             sayNO;
707         case EOL:
708             if (multiline)
709                 goto meol;
710             else
711                 goto seol;
712         case MEOL:
713           meol:
714             if ((nextchar || locinput < regeol) && nextchar != '\n')
715                 sayNO;
716             break;
717         case SEOL:
718           seol:
719             if ((nextchar || locinput < regeol) && nextchar != '\n')
720                 sayNO;
721             if (regeol - locinput > 1)
722                 sayNO;
723             break;
724         case SANY:
725             if (!nextchar && locinput >= regeol)
726                 sayNO;
727             nextchar = UCHARAT(++locinput);
728             break;
729         case ANY:
730             if (!nextchar && locinput >= regeol || nextchar == '\n')
731                 sayNO;
732             nextchar = UCHARAT(++locinput);
733             break;
734         case EXACT:
735             s = OPERAND(scan);
736             ln = *s++;
737             /* Inline the first character, for speed. */
738             if (UCHARAT(s) != nextchar)
739                 sayNO;
740             if (regeol - locinput < ln)
741                 sayNO;
742             if (ln > 1 && memNE(s, locinput, ln))
743                 sayNO;
744             locinput += ln;
745             nextchar = UCHARAT(locinput);
746             break;
747         case EXACTFL:
748             regtainted = TRUE;
749             /* FALL THROUGH */
750         case EXACTF:
751             s = OPERAND(scan);
752             ln = *s++;
753             /* Inline the first character, for speed. */
754             if (UCHARAT(s) != nextchar &&
755                 UCHARAT(s) != ((OP(scan) == EXACTF)
756                                ? fold : fold_locale)[nextchar])
757                 sayNO;
758             if (regeol - locinput < ln)
759                 sayNO;
760             if (ln > 1 && (OP(scan) == EXACTF
761                            ? ibcmp(s, locinput, ln)
762                            : ibcmp_locale(s, locinput, ln)))
763                 sayNO;
764             locinput += ln;
765             nextchar = UCHARAT(locinput);
766             break;
767         case ANYOF:
768             s = OPERAND(scan);
769             if (nextchar < 0)
770                 nextchar = UCHARAT(locinput);
771             if (!reginclass(s, nextchar))
772                 sayNO;
773             if (!nextchar && locinput >= regeol)
774                 sayNO;
775             nextchar = UCHARAT(++locinput);
776             break;
777         case ALNUML:
778             regtainted = TRUE;
779             /* FALL THROUGH */
780         case ALNUM:
781             if (!nextchar)
782                 sayNO;
783             if (!(OP(scan) == ALNUM
784                   ? isALNUM(nextchar) : isALNUM_LC(nextchar)))
785                 sayNO;
786             nextchar = UCHARAT(++locinput);
787             break;
788         case NALNUML:
789             regtainted = TRUE;
790             /* FALL THROUGH */
791         case NALNUM:
792             if (!nextchar && locinput >= regeol)
793                 sayNO;
794             if (OP(scan) == NALNUM
795                 ? isALNUM(nextchar) : isALNUM_LC(nextchar))
796                 sayNO;
797             nextchar = UCHARAT(++locinput);
798             break;
799         case BOUNDL:
800         case NBOUNDL:
801             regtainted = TRUE;
802             /* FALL THROUGH */
803         case BOUND:
804         case NBOUND:
805             /* was last char in word? */
806             ln = (locinput != regbol) ? UCHARAT(locinput - 1) : regprev;
807             if (OP(scan) == BOUND || OP(scan) == NBOUND) {
808                 ln = isALNUM(ln);
809                 n = isALNUM(nextchar);
810             }
811             else {
812                 ln = isALNUM_LC(ln);
813                 n = isALNUM_LC(nextchar);
814             }
815             if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL))
816                 sayNO;
817             break;
818         case SPACEL:
819             regtainted = TRUE;
820             /* FALL THROUGH */
821         case SPACE:
822             if (!nextchar && locinput >= regeol)
823                 sayNO;
824             if (!(OP(scan) == SPACE
825                   ? isSPACE(nextchar) : isSPACE_LC(nextchar)))
826                 sayNO;
827             nextchar = UCHARAT(++locinput);
828             break;
829         case NSPACEL:
830             regtainted = TRUE;
831             /* FALL THROUGH */
832         case NSPACE:
833             if (!nextchar)
834                 sayNO;
835             if (OP(scan) == SPACE
836                 ? isSPACE(nextchar) : isSPACE_LC(nextchar))
837                 sayNO;
838             nextchar = UCHARAT(++locinput);
839             break;
840         case DIGIT:
841             if (!isDIGIT(nextchar))
842                 sayNO;
843             nextchar = UCHARAT(++locinput);
844             break;
845         case NDIGIT:
846             if (!nextchar && locinput >= regeol)
847                 sayNO;
848             if (isDIGIT(nextchar))
849                 sayNO;
850             nextchar = UCHARAT(++locinput);
851             break;
852         case REFFL:
853             regtainted = TRUE;
854             /* FALL THROUGH */
855         case REF:
856         case REFF:
857             n = ARG1(scan);  /* which paren pair */
858             s = regstartp[n];
859             if (!s)
860                 sayNO;
861             if (!regendp[n])
862                 sayNO;
863             if (s == regendp[n])
864                 break;
865             /* Inline the first character, for speed. */
866             if (UCHARAT(s) != nextchar &&
867                 (OP(scan) == REF ||
868                  (UCHARAT(s) != ((OP(scan) == REFF
869                                  ? fold : fold_locale)[nextchar]))))
870                 sayNO;
871             ln = regendp[n] - s;
872             if (locinput + ln > regeol)
873                 sayNO;
874             if (ln > 1 && (OP(scan) == REF
875                            ? memNE(s, locinput, ln)
876                            : (OP(scan) == REFF
877                               ? ibcmp(s, locinput, ln)
878                               : ibcmp_locale(s, locinput, ln))))
879                 sayNO;
880             locinput += ln;
881             nextchar = UCHARAT(locinput);
882             break;
883
884         case NOTHING:
885             break;
886         case BACK:
887             break;
888         case OPEN:
889             n = ARG1(scan);  /* which paren pair */
890             regstartp[n] = locinput;
891             regendp[n] = 0;
892             if (n > regsize)
893                 regsize = n;
894             break;
895         case CLOSE:
896             n = ARG1(scan);  /* which paren pair */
897             regendp[n] = locinput;
898             if (n > *reglastparen)
899                 *reglastparen = n;
900             break;
901         case CURLYX: {
902                 CURCUR cc;
903                 CHECKPOINT cp = savestack_ix;
904                 cc.oldcc = regcc;
905                 regcc = &cc;
906                 cc.parenfloor = *reglastparen;
907                 cc.cur = -1;
908                 cc.min = ARG1(scan);
909                 cc.max  = ARG2(scan);
910                 cc.scan = NEXTOPER(scan) + 4;
911                 cc.next = next;
912                 cc.minmod = minmod;
913                 cc.lastloc = 0;
914                 reginput = locinput;
915                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
916                 regcpblow(cp);
917                 regcc = cc.oldcc;
918                 saySAME(n);
919             }
920             /* NOT REACHED */
921         case WHILEM: {
922                 /*
923                  * This is really hard to understand, because after we match
924                  * what we're trying to match, we must make sure the rest of
925                  * the RE is going to match for sure, and to do that we have
926                  * to go back UP the parse tree by recursing ever deeper.  And
927                  * if it fails, we have to reset our parent's current state
928                  * that we can try again after backing off.
929                  */
930
931                 CHECKPOINT cp;
932                 CURCUR* cc = regcc;
933                 n = cc->cur + 1;        /* how many we know we matched */
934                 reginput = locinput;
935
936 #ifdef DEBUGGING
937                 if (regnarrate)
938                     PerlIO_printf(Perl_debug_log, "%*s  %ld  %lx\n", regindent*2, "",
939                         (long)n, (long)cc);
940 #endif
941
942                 /* If degenerate scan matches "", assume scan done. */
943
944                 if (locinput == cc->lastloc && n >= cc->min) {
945                     regcc = cc->oldcc;
946                     ln = regcc->cur;
947                     if (regmatch(cc->next))
948                         sayYES;
949                     regcc->cur = ln;
950                     regcc = cc;
951                     sayNO;
952                 }
953
954                 /* First just match a string of min scans. */
955
956                 if (n < cc->min) {
957                     cc->cur = n;
958                     cc->lastloc = locinput;
959                     if (regmatch(cc->scan))
960                         sayYES;
961                     cc->cur = n - 1;
962                     sayNO;
963                 }
964
965                 /* Prefer next over scan for minimal matching. */
966
967                 if (cc->minmod) {
968                     regcc = cc->oldcc;
969                     ln = regcc->cur;
970                     cp = regcppush(cc->parenfloor);
971                     if (regmatch(cc->next)) {
972                         regcppartblow(cp);
973                         sayYES; /* All done. */
974                     }
975                     regcppop();
976                     regcc->cur = ln;
977                     regcc = cc;
978
979                     if (n >= cc->max)   /* Maximum greed exceeded? */
980                         sayNO;
981
982                     /* Try scanning more and see if it helps. */
983                     reginput = locinput;
984                     cc->cur = n;
985                     cc->lastloc = locinput;
986                     cp = regcppush(cc->parenfloor);
987                     if (regmatch(cc->scan)) {
988                         regcppartblow(cp);
989                         sayYES;
990                     }
991                     regcppop();
992                     cc->cur = n - 1;
993                     sayNO;
994                 }
995
996                 /* Prefer scan over next for maximal matching. */
997
998                 if (n < cc->max) {      /* More greed allowed? */
999                     cp = regcppush(cc->parenfloor);
1000                     cc->cur = n;
1001                     cc->lastloc = locinput;
1002                     if (regmatch(cc->scan)) {
1003                         regcppartblow(cp);
1004                         sayYES;
1005                     }
1006                     regcppop();         /* Restore some previous $<digit>s? */
1007                     reginput = locinput;
1008                 }
1009
1010                 /* Failed deeper matches of scan, so see if this one works. */
1011                 regcc = cc->oldcc;
1012                 ln = regcc->cur;
1013                 if (regmatch(cc->next))
1014                     sayYES;
1015                 regcc->cur = ln;
1016                 regcc = cc;
1017                 cc->cur = n - 1;
1018                 sayNO;
1019             }
1020             /* NOT REACHED */
1021         case BRANCH: {
1022                 if (OP(next) != BRANCH)   /* No choice. */
1023                     next = NEXTOPER(scan);/* Avoid recursion. */
1024                 else {
1025                     int lastparen = *reglastparen;
1026                     do {
1027                         reginput = locinput;
1028                         if (regmatch(NEXTOPER(scan)))
1029                             sayYES;
1030                         for (n = *reglastparen; n > lastparen; n--)
1031                             regendp[n] = 0;
1032                         *reglastparen = n;
1033                             
1034 #ifdef REGALIGN
1035                         /*SUPPRESS 560*/
1036                         if (n = NEXT(scan))
1037                             scan += n;
1038                         else
1039                             scan = NULL;
1040 #else
1041                         scan = regnext(scan);
1042 #endif
1043                     } while (scan != NULL && OP(scan) == BRANCH);
1044                     sayNO;
1045                     /* NOTREACHED */
1046                 }
1047             }
1048             break;
1049         case MINMOD:
1050             minmod = 1;
1051             break;
1052         case CURLY:
1053             ln = ARG1(scan);  /* min to match */
1054             n  = ARG2(scan);  /* max to match */
1055             scan = NEXTOPER(scan) + 4;
1056             goto repeat;
1057         case STAR:
1058             ln = 0;
1059             n = 32767;
1060             scan = NEXTOPER(scan);
1061             goto repeat;
1062         case PLUS:
1063             /*
1064             * Lookahead to avoid useless match attempts
1065             * when we know what character comes next.
1066             */
1067             ln = 1;
1068             n = 32767;
1069             scan = NEXTOPER(scan);
1070           repeat:
1071             if (regkind[(U8)OP(next)] == EXACT) {
1072                 c1 = UCHARAT(OPERAND(next) + 1);
1073                 if (OP(next) == EXACTF)
1074                     c2 = fold[c1];
1075                 else if (OP(next) == EXACTFL)
1076                     c2 = fold_locale[c1];
1077                 else
1078                     c2 = c1;
1079             }
1080             else
1081                 c1 = c2 = -1000;
1082             reginput = locinput;
1083             if (minmod) {
1084                 minmod = 0;
1085                 if (ln && regrepeat(scan, ln) < ln)
1086                     sayNO;
1087                 while (n >= ln || (n == 32767 && ln > 0)) { /* ln overflow ? */
1088                     /* If it could work, try it. */
1089                     if (c1 == -1000 ||
1090                         UCHARAT(reginput) == c1 ||
1091                         UCHARAT(reginput) == c2)
1092                     {
1093                         if (regmatch(next))
1094                             sayYES;
1095                     }
1096                     /* Couldn't or didn't -- back up. */
1097                     reginput = locinput + ln;
1098                     if (regrepeat(scan, 1)) {
1099                         ln++;
1100                         reginput = locinput + ln;
1101                     }
1102                     else
1103                         sayNO;
1104                 }
1105             }
1106             else {
1107                 n = regrepeat(scan, n);
1108                 if (ln < n && regkind[(U8)OP(next)] == EOL &&
1109                     (!multiline || OP(next) == SEOL))
1110                     ln = n;                     /* why back off? */
1111                 while (n >= ln) {
1112                     /* If it could work, try it. */
1113                     if (c1 == -1000 ||
1114                         UCHARAT(reginput) == c1 ||
1115                         UCHARAT(reginput) == c2)
1116                     {
1117                         if (regmatch(next))
1118                             sayYES;
1119                     }
1120                     /* Couldn't or didn't -- back up. */
1121                     n--;
1122                     reginput = locinput + n;
1123                 }
1124             }
1125             sayNO;
1126         case SUCCEED:
1127         case END:
1128             reginput = locinput;        /* put where regtry can find it */
1129             sayYES;                     /* Success! */
1130         case IFMATCH:
1131             reginput = locinput;
1132             scan = NEXTOPER(scan);
1133             if (!regmatch(scan))
1134                 sayNO;
1135             break;
1136         case UNLESSM:
1137             reginput = locinput;
1138             scan = NEXTOPER(scan);
1139             if (regmatch(scan))
1140                 sayNO;
1141             break;
1142         default:
1143             PerlIO_printf(PerlIO_stderr(), "%lx %d\n",
1144                           (unsigned long)scan, scan[1]);
1145             FAIL("regexp memory corruption");
1146         }
1147         scan = next;
1148     }
1149
1150     /*
1151     * We get here only if there's trouble -- normally "case END" is
1152     * the terminating point.
1153     */
1154     FAIL("corrupted regexp pointers");
1155     /*NOTREACHED*/
1156     sayNO;
1157
1158 yes:
1159 #ifdef DEBUGGING
1160     regindent--;
1161 #endif
1162     return 1;
1163
1164 no:
1165 #ifdef DEBUGGING
1166     regindent--;
1167 #endif
1168     return 0;
1169 }
1170
1171 /*
1172  - regrepeat - repeatedly match something simple, report how many
1173  */
1174 /*
1175  * [This routine now assumes that it will only match on things of length 1.
1176  * That was true before, but now we assume scan - reginput is the count,
1177  * rather than incrementing count on every character.]
1178  */
1179 static I32
1180 regrepeat(p, max)
1181 char *p;
1182 I32 max;
1183 {
1184     register char *scan;
1185     register char *opnd;
1186     register I32 c;
1187     register char *loceol = regeol;
1188
1189     scan = reginput;
1190     if (max != 32767 && max < loceol - scan)
1191       loceol = scan + max;
1192     opnd = OPERAND(p);
1193     switch (OP(p)) {
1194     case ANY:
1195         while (scan < loceol && *scan != '\n')
1196             scan++;
1197         break;
1198     case SANY:
1199         scan = loceol;
1200         break;
1201     case EXACT:         /* length of string is 1 */
1202         c = UCHARAT(++opnd);
1203         while (scan < loceol && UCHARAT(scan) == c)
1204             scan++;
1205         break;
1206     case EXACTF:        /* length of string is 1 */
1207         c = UCHARAT(++opnd);
1208         while (scan < loceol &&
1209                (UCHARAT(scan) == c || UCHARAT(scan) == fold[c]))
1210             scan++;
1211         break;
1212     case EXACTFL:       /* length of string is 1 */
1213         regtainted = TRUE;
1214         c = UCHARAT(++opnd);
1215         while (scan < loceol &&
1216                (UCHARAT(scan) == c || UCHARAT(scan) == fold_locale[c]))
1217             scan++;
1218         break;
1219     case ANYOF:
1220         while (scan < loceol && reginclass(opnd, *scan))
1221             scan++;
1222         break;
1223     case ALNUM:
1224         while (scan < loceol && isALNUM(*scan))
1225             scan++;
1226         break;
1227     case ALNUML:
1228         regtainted = TRUE;
1229         while (scan < loceol && isALNUM_LC(*scan))
1230             scan++;
1231         break;
1232     case NALNUM:
1233         while (scan < loceol && !isALNUM(*scan))
1234             scan++;
1235         break;
1236     case NALNUML:
1237         regtainted = TRUE;
1238         while (scan < loceol && !isALNUM_LC(*scan))
1239             scan++;
1240         break;
1241     case SPACE:
1242         while (scan < loceol && isSPACE(*scan))
1243             scan++;
1244         break;
1245     case SPACEL:
1246         regtainted = TRUE;
1247         while (scan < loceol && isSPACE_LC(*scan))
1248             scan++;
1249         break;
1250     case NSPACE:
1251         while (scan < loceol && !isSPACE(*scan))
1252             scan++;
1253         break;
1254     case NSPACEL:
1255         regtainted = TRUE;
1256         while (scan < loceol && !isSPACE_LC(*scan))
1257             scan++;
1258         break;
1259     case DIGIT:
1260         while (scan < loceol && isDIGIT(*scan))
1261             scan++;
1262         break;
1263     case NDIGIT:
1264         while (scan < loceol && !isDIGIT(*scan))
1265             scan++;
1266         break;
1267     default:            /* Called on something of 0 width. */
1268         break;          /* So match right here or not at all. */
1269     }
1270
1271     c = scan - reginput;
1272     reginput = scan;
1273
1274     return(c);
1275 }
1276
1277 /*
1278  - regclass - determine if a character falls into a character class
1279  */
1280
1281 static bool
1282 reginclass(p, c)
1283 register char *p;
1284 register I32 c;
1285 {
1286     char flags = *p;
1287     bool match = FALSE;
1288
1289     c &= 0xFF;
1290     if (p[1 + (c >> 3)] & (1 << (c & 7)))
1291         match = TRUE;
1292     else if (flags & ANYOF_FOLD) {
1293         I32 cf;
1294         if (flags & ANYOF_LOCALE) {
1295             regtainted = TRUE;
1296             cf = fold_locale[c];
1297         }
1298         else
1299             cf = fold[c];
1300         if (p[1 + (cf >> 3)] & (1 << (cf & 7)))
1301             match = TRUE;
1302     }
1303
1304     if (!match && (flags & ANYOF_ISA)) {
1305         regtainted = TRUE;
1306
1307         if (((flags & ANYOF_ALNUML)  && isALNUM_LC(c))  ||
1308             ((flags & ANYOF_NALNUML) && !isALNUM_LC(c)) ||
1309             ((flags & ANYOF_SPACEL)  && isSPACE_LC(c))  ||
1310             ((flags & ANYOF_NSPACEL) && !isSPACE_LC(c)))
1311         {
1312             match = TRUE;
1313         }
1314     }
1315
1316     return match ^ ((flags & ANYOF_INVERT) != 0);
1317 }
1318
1319 /*
1320  - regnext - dig the "next" pointer out of a node
1321  *
1322  * [Note, when REGALIGN is defined there are two places in regmatch()
1323  * that bypass this code for speed.]
1324  */
1325 char *
1326 regnext(p)
1327 register char *p;
1328 {
1329     register I32 offset;
1330
1331     if (p == &regdummy)
1332         return(NULL);
1333
1334     offset = NEXT(p);
1335     if (offset == 0)
1336         return(NULL);
1337
1338 #ifdef REGALIGN
1339     return(p+offset);
1340 #else
1341     if (OP(p) == BACK)
1342         return(p-offset);
1343     else
1344         return(p+offset);
1345 #endif
1346 }