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