This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
applied patch, with indentation tweaks
[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 #define RF_tainted      1               /* tainted information used? */
59 #define RF_warned       2               /* warned about big count? */
60 #define RF_evaled       4               /* Did an EVAL with setting? */
61
62 #define RS_init         1               /* eval environment created */
63 #define RS_set          2               /* replsv value is set */
64
65 #ifndef STATIC
66 #define STATIC  static
67 #endif
68
69 #ifndef PERL_OBJECT
70 typedef I32 CHECKPOINT;
71
72 /*
73  * Forwards.
74  */
75
76 static I32 regmatch _((regnode *prog));
77 static I32 regrepeat _((regnode *p, I32 max));
78 static I32 regrepeat_hard _((regnode *p, I32 max, I32 *lp));
79 static I32 regtry _((regexp *prog, char *startpos));
80
81 static bool reginclass _((char *p, I32 c));
82 static CHECKPOINT regcppush _((I32 parenfloor));
83 static char * regcppop _((void));
84 #endif
85 #define REGINCLASS(p,c)  (*(p) ? reginclass(p,c) : ANYOF_TEST(p,c))
86
87 STATIC CHECKPOINT
88 regcppush(I32 parenfloor)
89 {
90     dTHR;
91     int retval = savestack_ix;
92     int i = (regsize - parenfloor) * 4;
93     int p;
94
95     SSCHECK(i + 5);
96     for (p = regsize; p > parenfloor; p--) {
97         SSPUSHPTR(regendp[p]);
98         SSPUSHPTR(regstartp[p]);
99         SSPUSHPTR(reg_start_tmp[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 /* These are needed since we do not localize EVAL nodes: */
111 #  define REGCP_SET  DEBUG_r(PerlIO_printf(Perl_debug_log, "  Setting an EVAL scope, savestack=%i\n", savestack_ix)); lastcp = savestack_ix
112 #  define REGCP_UNWIND  DEBUG_r(lastcp != savestack_ix ? PerlIO_printf(Perl_debug_log,"  Clearing an EVAL scope, savestack=%i..%i\n", lastcp, savestack_ix) : 0); regcpblow(lastcp)
113
114 STATIC char *
115 regcppop(void)
116 {
117     dTHR;
118     I32 i = SSPOPINT;
119     U32 paren = 0;
120     char *input;
121     char *tmps;
122     assert(i == SAVEt_REGCONTEXT);
123     i = SSPOPINT;
124     input = (char *) SSPOPPTR;
125     *reglastparen = SSPOPINT;
126     regsize = SSPOPINT;
127     for (i -= 3; i > 0; i -= 4) {
128         paren = (U32)SSPOPINT;
129         reg_start_tmp[paren] = (char *) SSPOPPTR;
130         regstartp[paren] = (char *) SSPOPPTR;
131         tmps = (char*)SSPOPPTR;
132         if (paren <= *reglastparen)
133             regendp[paren] = tmps;
134         DEBUG_r(
135             PerlIO_printf(Perl_debug_log, "     restoring \\%d to %d(%d)..%d%s\n",
136                           paren, regstartp[paren] - regbol, 
137                           reg_start_tmp[paren] - regbol,
138                           regendp[paren] - regbol, 
139                           (paren > *reglastparen ? "(no)" : ""));
140         );
141     }
142     DEBUG_r(
143         if (*reglastparen + 1 <= regnpar) {
144             PerlIO_printf(Perl_debug_log, "     restoring \\%d..\\%d to undef\n",
145                           *reglastparen + 1, regnpar);
146         }
147     );
148     for (paren = *reglastparen + 1; paren <= regnpar; paren++) {
149         if (paren > regsize)
150             regstartp[paren] = Nullch;
151         regendp[paren] = Nullch;
152     }
153     return input;
154 }
155
156 #define regcpblow(cp) LEAVE_SCOPE(cp)
157
158 /*
159  * pregexec and friends
160  */
161
162 /*
163  - pregexec - match a regexp against a string
164  */
165 I32
166 pregexec(register regexp *prog, char *stringarg, register char *strend, char *strbeg, I32 minend, SV *screamer, U32 nosave)
167 /* strend: pointer to null at end of string */
168 /* strbeg: real beginning of string */
169 /* minend: end of match must be >=minend after stringarg. */
170 /* nosave: For optimizations. */
171 {
172     return
173         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL, 
174                       nosave ? 0 : REXEC_COPY_STR);
175 }
176   
177 /*
178  - regexec_flags - match a regexp against a string
179  */
180 I32
181 regexec_flags(register regexp *prog, char *stringarg, register char *strend, char *strbeg, I32 minend, SV *screamer, void *data, U32 flags)
182 /* strend: pointer to null at end of string */
183 /* strbeg: real beginning of string */
184 /* minend: end of match must be >=minend after stringarg. */
185 /* data: May be used for some additional optimizations. */
186 /* nosave: For optimizations. */
187 {
188     register char *s;
189     register regnode *c;
190     register char *startpos = stringarg;
191     register I32 tmp;
192     I32 minlen;         /* must match at least this many chars */
193     I32 dontbother = 0; /* how many characters not to try at end */
194     CURCUR cc;
195     I32 start_shift = 0;                /* Offset of the start to find
196                                          constant substr. */
197     I32 end_shift = 0;                  /* Same for the end. */
198     I32 scream_pos = -1;                /* Internal iterator of scream. */
199     char *scream_olds;
200     SV* oreplsv = GvSV(replgv);
201
202     cc.cur = 0;
203     cc.oldcc = 0;
204     regcc = &cc;
205
206     regprecomp = prog->precomp;         /* Needed for error messages. */
207 #ifdef DEBUGGING
208     regnarrate = debug & 512;
209     regprogram = prog->program;
210 #endif
211
212     /* Be paranoid... */
213     if (prog == NULL || startpos == NULL) {
214         croak("NULL regexp parameter");
215         return 0;
216     }
217
218     minlen = prog->minlen;
219     if (strend - startpos < minlen) goto phooey;
220
221     if (startpos == strbeg)     /* is ^ valid at stringarg? */
222         regprev = '\n';
223     else {
224         regprev = stringarg[-1];
225         if (!multiline && regprev == '\n')
226             regprev = '\0';             /* force ^ to NOT match */
227     }
228
229     /* Check validity of program. */
230     if (UCHARAT(prog->program) != MAGIC) {
231         FAIL("corrupted regexp program");
232     }
233
234     regnpar = prog->nparens;
235     reg_flags = 0;
236     reg_eval_set = 0;
237
238     /* If there is a "must appear" string, look for it. */
239     s = startpos;
240     if (!(flags & REXEC_CHECKED) 
241         && prog->check_substr != Nullsv &&
242         !(prog->reganch & ROPT_ANCH_GPOS) &&
243         (!(prog->reganch & (ROPT_ANCH_BOL | ROPT_ANCH_MBOL))
244          || (multiline && prog->check_substr == prog->anchored_substr)) )
245     {
246         start_shift = prog->check_offset_min;
247         /* Should be nonnegative! */
248         end_shift = minlen - start_shift - SvCUR(prog->check_substr);
249         if (screamer) {
250             if (screamfirst[BmRARE(prog->check_substr)] >= 0)
251                     s = screaminstr(screamer, prog->check_substr, 
252                                     start_shift + (stringarg - strbeg),
253                                     end_shift, &scream_pos, 0);
254             else
255                     s = Nullch;
256             scream_olds = s;
257         }
258         else
259             s = fbm_instr((unsigned char*)s + start_shift,
260                           (unsigned char*)strend - end_shift,
261                 prog->check_substr);
262         if (!s) {
263             ++BmUSEFUL(prog->check_substr);     /* hooray */
264             goto phooey;        /* not present */
265         } else if ((s - stringarg) > prog->check_offset_max) {
266             ++BmUSEFUL(prog->check_substr);     /* hooray/2 */
267             s -= prog->check_offset_max;
268         } else if (!prog->naughty 
269                    && --BmUSEFUL(prog->check_substr) < 0
270                    && prog->check_substr == prog->float_substr) { /* boo */
271             SvREFCNT_dec(prog->check_substr);
272             prog->check_substr = Nullsv;        /* disable */
273             prog->float_substr = Nullsv;        /* clear */
274             s = startpos;
275         } else s = startpos;
276     }
277
278     /* Mark beginning of line for ^ and lookbehind. */
279     regbol = startpos;
280     bostr  = strbeg;
281
282     /* Mark end of line for $ (and such) */
283     regeol = strend;
284
285     /* see how far we have to get to not match where we matched before */
286     regtill = startpos+minend;
287
288     DEBUG_r(
289         PerlIO_printf(Perl_debug_log, 
290                       "Matching `%.60s%s' against `%.*s%s'\n",
291                       prog->precomp, 
292                       (strlen(prog->precomp) > 60 ? "..." : ""),
293                       (strend - startpos > 60 ? 60 : strend - startpos),
294                       startpos, 
295                       (strend - startpos > 60 ? "..." : ""))
296         );
297
298     /* Simplest case:  anchored match need be tried only once. */
299     /*  [unless only anchor is BOL and multiline is set] */
300     if (prog->reganch & ROPT_ANCH) {
301         if (regtry(prog, startpos))
302             goto got_it;
303         else if (!(prog->reganch & ROPT_ANCH_GPOS) &&
304                  (multiline || (prog->reganch & ROPT_IMPLICIT)
305                   || (prog->reganch & ROPT_ANCH_MBOL)))
306         {
307             if (minlen)
308                 dontbother = minlen - 1;
309             strend -= dontbother;
310             /* for multiline we only have to try after newlines */
311             if (s > startpos)
312                 s--;
313             while (s < strend) {
314                 if (*s++ == '\n') {
315                     if (s < strend && regtry(prog, s))
316                         goto got_it;
317                 }
318             }
319         }
320         goto phooey;
321     }
322
323     /* Messy cases:  unanchored match. */
324     if (prog->anchored_substr && prog->reganch & ROPT_SKIP) { 
325         /* we have /x+whatever/ */
326         /* it must be a one character string */
327         char ch = SvPVX(prog->anchored_substr)[0];
328         while (s < strend) {
329             if (*s == ch) {
330                 if (regtry(prog, s)) goto got_it;
331                 s++;
332                 while (s < strend && *s == ch)
333                     s++;
334             }
335             s++;
336         }
337     }
338     /*SUPPRESS 560*/
339     else if (prog->anchored_substr != Nullsv
340              || (prog->float_substr != Nullsv 
341                  && prog->float_max_offset < strend - s)) {
342         SV *must = prog->anchored_substr 
343             ? prog->anchored_substr : prog->float_substr;
344         I32 back_max = 
345             prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset;
346         I32 back_min = 
347             prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset;
348         I32 delta = back_max - back_min;
349         char *last = strend - SvCUR(must) - back_min; /* Cannot start after this */
350         char *last1 = s - 1;            /* Last position checked before */
351
352         /* XXXX check_substr already used to find `s', can optimize if
353            check_substr==must. */
354         scream_pos = -1;
355         dontbother = end_shift;
356         strend -= dontbother;
357         while ( (s <= last) &&
358                 (screamer 
359                  ? (s = screaminstr(screamer, must, s + back_min - strbeg,
360                                     end_shift, &scream_pos, 0))
361                  : (s = fbm_instr((unsigned char*)s + back_min,
362                                   (unsigned char*)strend, must))) ) {
363             if (s - back_max > last1) {
364                 last1 = s - back_min;
365                 s = s - back_max;
366             } else {
367                 char *t = last1 + 1;            
368
369                 last1 = s - back_min;
370                 s = t;          
371             }
372             while (s <= last1) {
373                 if (regtry(prog, s))
374                     goto got_it;
375                 s++;
376             }
377         }
378         goto phooey;
379     } else if (c = prog->regstclass) {
380         I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
381         char *Class;
382
383         if (minlen)
384             dontbother = minlen - 1;
385         strend -= dontbother;   /* don't bother with what can't match */
386         tmp = 1;
387         /* We know what class it must start with. */
388         switch (OP(c)) {
389         case ANYOF:
390             Class = (char *) OPERAND(c);
391             while (s < strend) {
392                 if (REGINCLASS(Class, *s)) {
393                     if (tmp && regtry(prog, s))
394                         goto got_it;
395                     else
396                         tmp = doevery;
397                 }
398                 else
399                     tmp = 1;
400                 s++;
401             }
402             break;
403         case BOUNDL:
404             reg_flags |= RF_tainted;
405             /* FALL THROUGH */
406         case BOUND:
407             if (minlen)
408                 dontbother++,strend--;
409             tmp = (s != startpos) ? UCHARAT(s - 1) : regprev;
410             tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
411             while (s < strend) {
412                 if (tmp == !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
413                     tmp = !tmp;
414                     if (regtry(prog, s))
415                         goto got_it;
416                 }
417                 s++;
418             }
419             if ((minlen || tmp) && regtry(prog,s))
420                 goto got_it;
421             break;
422         case NBOUNDL:
423             reg_flags |= RF_tainted;
424             /* FALL THROUGH */
425         case NBOUND:
426             if (minlen)
427                 dontbother++,strend--;
428             tmp = (s != startpos) ? UCHARAT(s - 1) : regprev;
429             tmp = ((OP(c) == NBOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
430             while (s < strend) {
431                 if (tmp == !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
432                     tmp = !tmp;
433                 else if (regtry(prog, s))
434                     goto got_it;
435                 s++;
436             }
437             if ((minlen || !tmp) && regtry(prog,s))
438                 goto got_it;
439             break;
440         case ALNUM:
441             while (s < strend) {
442                 if (isALNUM(*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 ALNUML:
454             reg_flags |= RF_tainted;
455             while (s < strend) {
456                 if (isALNUM_LC(*s)) {
457                     if (tmp && regtry(prog, s))
458                         goto got_it;
459                     else
460                         tmp = doevery;
461                 }
462                 else
463                     tmp = 1;
464                 s++;
465             }
466             break;
467         case NALNUM:
468             while (s < strend) {
469                 if (!isALNUM(*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 NALNUML:
481             reg_flags |= RF_tainted;
482             while (s < strend) {
483                 if (!isALNUM_LC(*s)) {
484                     if (tmp && regtry(prog, s))
485                         goto got_it;
486                     else
487                         tmp = doevery;
488                 }
489                 else
490                     tmp = 1;
491                 s++;
492             }
493             break;
494         case SPACE:
495             while (s < strend) {
496                 if (isSPACE(*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 SPACEL:
508             reg_flags |= RF_tainted;
509             while (s < strend) {
510                 if (isSPACE_LC(*s)) {
511                     if (tmp && regtry(prog, s))
512                         goto got_it;
513                     else
514                         tmp = doevery;
515                 }
516                 else
517                     tmp = 1;
518                 s++;
519             }
520             break;
521         case NSPACE:
522             while (s < strend) {
523                 if (!isSPACE(*s)) {
524                     if (tmp && regtry(prog, s))
525                         goto got_it;
526                     else
527                         tmp = doevery;
528                 }
529                 else
530                     tmp = 1;
531                 s++;
532             }
533             break;
534         case NSPACEL:
535             reg_flags |= RF_tainted;
536             while (s < strend) {
537                 if (!isSPACE_LC(*s)) {
538                     if (tmp && regtry(prog, s))
539                         goto got_it;
540                     else
541                         tmp = doevery;
542                 }
543                 else
544                     tmp = 1;
545                 s++;
546             }
547             break;
548         case DIGIT:
549             while (s < strend) {
550                 if (isDIGIT(*s)) {
551                     if (tmp && regtry(prog, s))
552                         goto got_it;
553                     else
554                         tmp = doevery;
555                 }
556                 else
557                     tmp = 1;
558                 s++;
559             }
560             break;
561         case NDIGIT:
562             while (s < strend) {
563                 if (!isDIGIT(*s)) {
564                     if (tmp && regtry(prog, s))
565                         goto got_it;
566                     else
567                         tmp = doevery;
568                 }
569                 else
570                     tmp = 1;
571                 s++;
572             }
573             break;
574         }
575     }
576     else {
577         dontbother = 0;
578         if (prog->float_substr != Nullsv) {     /* Trim the end. */
579             char *last;
580             I32 oldpos = scream_pos;
581
582             if (screamer) {
583                 last = screaminstr(screamer, prog->float_substr, s - strbeg,
584                                    end_shift, &scream_pos, 1); /* last one */
585                 if (!last) {
586                     last = scream_olds; /* Only one occurence. */
587                 }
588             } else {
589                 STRLEN len;
590                 char *little = SvPV(prog->float_substr, len);
591                 last = rninstr(s, strend, little, little + len);
592             }
593             if (last == NULL) goto phooey; /* Should not happen! */
594             dontbother = strend - last - 1;
595         }
596         if (minlen && (dontbother < minlen))
597             dontbother = minlen - 1;
598         strend -= dontbother;
599         /* We don't know much -- general case. */
600         do {
601             if (regtry(prog, s))
602                 goto got_it;
603         } while (s++ < strend);
604     }
605
606     /* Failure. */
607     goto phooey;
608
609 got_it:
610     strend += dontbother;       /* uncheat */
611     prog->subbeg = strbeg;
612     prog->subend = strend;
613     RX_MATCH_TAINTED_SET(prog, reg_flags & RF_tainted);
614
615     /* make sure $`, $&, $', and $digit will work later */
616     if (strbeg != prog->subbase) {      /* second+ //g match.  */
617         if (!(flags & REXEC_COPY_STR)) {
618             if (prog->subbase) {
619                 Safefree(prog->subbase);
620                 prog->subbase = Nullch;
621             }
622         }
623         else {
624             I32 i = strend - startpos + (stringarg - strbeg);
625             s = savepvn(strbeg, i);
626             Safefree(prog->subbase);
627             prog->subbase = s;
628             prog->subbeg = prog->subbase;
629             prog->subend = prog->subbase + i;
630             s = prog->subbase + (stringarg - strbeg);
631             for (i = 0; i <= prog->nparens; i++) {
632                 if (prog->endp[i]) {
633                     prog->startp[i] = s + (prog->startp[i] - startpos);
634                     prog->endp[i] = s + (prog->endp[i] - startpos);
635                 }
636             }
637         }
638     }
639     /* Preserve the current value of $^R */
640     if (oreplsv != GvSV(replgv)) {
641         sv_setsv(oreplsv, GvSV(replgv));/* So that when GvSV(replgv) is
642                                            restored, the value remains
643                                            the same. */
644     }
645     return 1;
646
647 phooey:
648     return 0;
649 }
650
651 /*
652  - regtry - try match at specific point
653  */
654 STATIC I32                      /* 0 failure, 1 success */
655 regtry(regexp *prog, char *startpos)
656 {
657     dTHR;
658     register I32 i;
659     register char **sp;
660     register char **ep;
661     CHECKPOINT lastcp;
662
663     if ((prog->reganch & ROPT_EVAL_SEEN) && !reg_eval_set) {
664         reg_eval_set = RS_init;
665         DEBUG_r(DEBUG_s(
666             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %i\n", stack_sp - stack_base);
667             ));
668         SAVEINT(cxstack[cxstack_ix].blk_oldsp);
669         cxstack[cxstack_ix].blk_oldsp = stack_sp - stack_base;
670         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
671         SAVETMPS;
672         /* Apparently this is not needed, judging by wantarray. */
673         /* SAVEINT(cxstack[cxstack_ix].blk_gimme);
674            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
675     }
676     reginput = startpos;
677     regstartp = prog->startp;
678     regendp = prog->endp;
679     reglastparen = &prog->lastparen;
680     prog->lastparen = 0;
681     regsize = 0;
682     if (reg_start_tmpl <= prog->nparens) {
683         reg_start_tmpl = prog->nparens*3/2 + 3;
684         if(reg_start_tmp)
685             Renew(reg_start_tmp, reg_start_tmpl, char*);
686         else
687             New(22,reg_start_tmp, reg_start_tmpl, char*);
688     }
689
690     sp = prog->startp;
691     ep = prog->endp;
692     regdata = prog->data;
693     if (prog->nparens) {
694         for (i = prog->nparens; i >= 0; i--) {
695             *sp++ = NULL;
696             *ep++ = NULL;
697         }
698     }
699     REGCP_SET;
700     if (regmatch(prog->program + 1) && reginput >= regtill) {
701         prog->startp[0] = startpos;
702         prog->endp[0] = reginput;
703         return 1;
704     }
705     REGCP_UNWIND;
706     return 0;
707 }
708
709 /*
710  - regmatch - main matching routine
711  *
712  * Conceptually the strategy is simple:  check to see whether the current
713  * node matches, call self recursively to see whether the rest matches,
714  * and then act accordingly.  In practice we make some effort to avoid
715  * recursion, in particular by going through "ordinary" nodes (that don't
716  * need to know whether the rest of the match failed) by a loop instead of
717  * by recursion.
718  */
719 /* [lwall] I've hoisted the register declarations to the outer block in order to
720  * maybe save a little bit of pushing and popping on the stack.  It also takes
721  * advantage of machines that use a register save mask on subroutine entry.
722  */
723 STATIC I32                      /* 0 failure, 1 success */
724 regmatch(regnode *prog)
725 {
726     dTHR;
727     register regnode *scan;     /* Current node. */
728     regnode *next;              /* Next node. */
729     regnode *inner;             /* Next node in internal branch. */
730     register I32 nextchr; /* renamed nextchr - nextchar colides with function of same name */
731     register I32 n;             /* no or next */
732     register I32 ln;            /* len or last */
733     register char *s;           /* operand or save */
734     register char *locinput = reginput;
735     register I32 c1, c2, paren; /* case fold search, parenth */
736     int minmod = 0, sw = 0, logical = 0;
737 #ifdef DEBUGGING
738     regindent++;
739 #endif
740
741     nextchr = UCHARAT(locinput);
742     scan = prog;
743     while (scan != NULL) {
744 #define sayNO_L (logical ? (logical = 0, sw = 0, goto cont) : sayNO)
745 #ifdef DEBUGGING
746 #  define sayYES goto yes
747 #  define sayNO goto no
748 #  define saySAME(x) if (x) goto yes; else goto no
749 #  define REPORT_CODE_OFF 24
750 #else
751 #  define sayYES return 1
752 #  define sayNO return 0
753 #  define saySAME(x) return x
754 #endif
755         DEBUG_r( {
756             SV *prop = sv_newmortal();
757             int docolor = *colors[0];
758             int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
759             int l = (regeol - locinput > taill ? taill : regeol - locinput);
760             int pref_len = (locinput - bostr > (5 + taill) - l 
761                             ? (5 + taill) - l : locinput - bostr);
762
763             if (l + pref_len < (5 + taill) && l < regeol - locinput)
764                 l = ( regeol - locinput > (5 + taill) - pref_len 
765                       ? (5 + taill) - pref_len : regeol - locinput);
766             regprop(prop, scan);
767             PerlIO_printf(Perl_debug_log, 
768                           "%4i <%s%.*s%s%s%s%.*s%s>%*s|%*s%2d%s\n",
769                           locinput - bostr, 
770                           colors[2], pref_len, locinput - pref_len, colors[3],
771                           (docolor ? "" : "> <"),
772                           colors[0], l, locinput, colors[1],
773                           15 - l - pref_len + 1,
774                           "",
775                           regindent*2, "", scan - regprogram,
776                           SvPVX(prop));
777         } );
778
779         next = scan + NEXT_OFF(scan);
780         if (next == scan)
781             next = NULL;
782
783         switch (OP(scan)) {
784         case BOL:
785             if (locinput == regbol
786                 ? regprev == '\n'
787                 : (multiline && 
788                    (nextchr || locinput < regeol) && locinput[-1] == '\n') )
789             {
790                 /* regtill = regbol; */
791                 break;
792             }
793             sayNO;
794         case MBOL:
795             if (locinput == regbol
796                 ? regprev == '\n'
797                 : ((nextchr || locinput < regeol) && locinput[-1] == '\n') )
798             {
799                 break;
800             }
801             sayNO;
802         case SBOL:
803             if (locinput == regbol && regprev == '\n')
804                 break;
805             sayNO;
806         case GPOS:
807             if (locinput == regbol)
808                 break;
809             sayNO;
810         case EOL:
811             if (multiline)
812                 goto meol;
813             else
814                 goto seol;
815         case MEOL:
816           meol:
817             if ((nextchr || locinput < regeol) && nextchr != '\n')
818                 sayNO;
819             break;
820         case SEOL:
821           seol:
822             if ((nextchr || locinput < regeol) && nextchr != '\n')
823                 sayNO;
824             if (regeol - locinput > 1)
825                 sayNO;
826             break;
827         case SANY:
828             if (!nextchr && locinput >= regeol)
829                 sayNO;
830             nextchr = UCHARAT(++locinput);
831             break;
832         case ANY:
833             if (!nextchr && locinput >= regeol || nextchr == '\n')
834                 sayNO;
835             nextchr = UCHARAT(++locinput);
836             break;
837         case EXACT:
838             s = (char *) OPERAND(scan);
839             ln = UCHARAT(s++);
840             /* Inline the first character, for speed. */
841             if (UCHARAT(s) != nextchr)
842                 sayNO;
843             if (regeol - locinput < ln)
844                 sayNO;
845             if (ln > 1 && memNE(s, locinput, ln))
846                 sayNO;
847             locinput += ln;
848             nextchr = UCHARAT(locinput);
849             break;
850         case EXACTFL:
851             reg_flags |= RF_tainted;
852             /* FALL THROUGH */
853         case EXACTF:
854             s = (char *) OPERAND(scan);
855             ln = UCHARAT(s++);
856             /* Inline the first character, for speed. */
857             if (UCHARAT(s) != nextchr &&
858                 UCHARAT(s) != ((OP(scan) == EXACTF)
859                                ? fold : fold_locale)[nextchr])
860                 sayNO;
861             if (regeol - locinput < ln)
862                 sayNO;
863             if (ln > 1 && (OP(scan) == EXACTF
864                            ? ibcmp(s, locinput, ln)
865                            : ibcmp_locale(s, locinput, ln)))
866                 sayNO;
867             locinput += ln;
868             nextchr = UCHARAT(locinput);
869             break;
870         case ANYOF:
871             s = (char *) OPERAND(scan);
872             if (nextchr < 0)
873                 nextchr = UCHARAT(locinput);
874             if (!REGINCLASS(s, nextchr))
875                 sayNO;
876             if (!nextchr && locinput >= regeol)
877                 sayNO;
878             nextchr = UCHARAT(++locinput);
879             break;
880         case ALNUML:
881             reg_flags |= RF_tainted;
882             /* FALL THROUGH */
883         case ALNUM:
884             if (!nextchr)
885                 sayNO;
886             if (!(OP(scan) == ALNUM
887                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
888                 sayNO;
889             nextchr = UCHARAT(++locinput);
890             break;
891         case NALNUML:
892             reg_flags |= RF_tainted;
893             /* FALL THROUGH */
894         case NALNUM:
895             if (!nextchr && locinput >= regeol)
896                 sayNO;
897             if (OP(scan) == NALNUM
898                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
899                 sayNO;
900             nextchr = UCHARAT(++locinput);
901             break;
902         case BOUNDL:
903         case NBOUNDL:
904             reg_flags |= RF_tainted;
905             /* FALL THROUGH */
906         case BOUND:
907         case NBOUND:
908             /* was last char in word? */
909             ln = (locinput != regbol) ? UCHARAT(locinput - 1) : regprev;
910             if (OP(scan) == BOUND || OP(scan) == NBOUND) {
911                 ln = isALNUM(ln);
912                 n = isALNUM(nextchr);
913             }
914             else {
915                 ln = isALNUM_LC(ln);
916                 n = isALNUM_LC(nextchr);
917             }
918             if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL))
919                 sayNO;
920             break;
921         case SPACEL:
922             reg_flags |= RF_tainted;
923             /* FALL THROUGH */
924         case SPACE:
925             if (!nextchr && locinput >= regeol)
926                 sayNO;
927             if (!(OP(scan) == SPACE
928                   ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
929                 sayNO;
930             nextchr = UCHARAT(++locinput);
931             break;
932         case NSPACEL:
933             reg_flags |= RF_tainted;
934             /* FALL THROUGH */
935         case NSPACE:
936             if (!nextchr)
937                 sayNO;
938             if (OP(scan) == SPACE
939                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
940                 sayNO;
941             nextchr = UCHARAT(++locinput);
942             break;
943         case DIGIT:
944             if (!isDIGIT(nextchr))
945                 sayNO;
946             nextchr = UCHARAT(++locinput);
947             break;
948         case NDIGIT:
949             if (!nextchr && locinput >= regeol)
950                 sayNO;
951             if (isDIGIT(nextchr))
952                 sayNO;
953             nextchr = UCHARAT(++locinput);
954             break;
955         case REFFL:
956             reg_flags |= RF_tainted;
957             /* FALL THROUGH */
958         case REF:
959         case REFF:
960             n = ARG(scan);  /* which paren pair */
961             s = regstartp[n];
962             if (*reglastparen < n || !s)
963                 sayNO;                  /* Do not match unless seen CLOSEn. */
964             if (s == regendp[n])
965                 break;
966             /* Inline the first character, for speed. */
967             if (UCHARAT(s) != nextchr &&
968                 (OP(scan) == REF ||
969                  (UCHARAT(s) != ((OP(scan) == REFF
970                                   ? fold : fold_locale)[nextchr]))))
971                 sayNO;
972             ln = regendp[n] - s;
973             if (locinput + ln > regeol)
974                 sayNO;
975             if (ln > 1 && (OP(scan) == REF
976                            ? memNE(s, locinput, ln)
977                            : (OP(scan) == REFF
978                               ? ibcmp(s, locinput, ln)
979                               : ibcmp_locale(s, locinput, ln))))
980                 sayNO;
981             locinput += ln;
982             nextchr = UCHARAT(locinput);
983             break;
984
985         case NOTHING:
986         case TAIL:
987             break;
988         case BACK:
989             break;
990         case EVAL:
991         {
992             dSP;
993             OP_4tree *oop = op;
994             COP *ocurcop = curcop;
995             SV **ocurpad = curpad;
996             SV *ret;
997             
998             n = ARG(scan);
999             op = (OP_4tree*)regdata->data[n];
1000             DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%x\n", op) );
1001             curpad = AvARRAY((AV*)regdata->data[n + 1]);
1002
1003             CALLRUNOPS();                       /* Scalar context. */
1004             SPAGAIN;
1005             ret = POPs;
1006             PUTBACK;
1007             
1008             if (logical) {
1009                 logical = 0;
1010                 sw = SvTRUE(ret);
1011             } else
1012                 sv_setsv(save_scalar(replgv), ret);
1013             op = oop;
1014             curpad = ocurpad;
1015             curcop = ocurcop;
1016             break;
1017         }
1018         case OPEN:
1019             n = ARG(scan);  /* which paren pair */
1020             reg_start_tmp[n] = locinput;
1021             if (n > regsize)
1022                 regsize = n;
1023             break;
1024         case CLOSE:
1025             n = ARG(scan);  /* which paren pair */
1026             regstartp[n] = reg_start_tmp[n];
1027             regendp[n] = locinput;
1028             if (n > *reglastparen)
1029                 *reglastparen = n;
1030             break;
1031         case GROUPP:
1032             n = ARG(scan);  /* which paren pair */
1033             sw = (*reglastparen >= n && regendp[n] != NULL);
1034             break;
1035         case IFTHEN:
1036             if (sw)
1037                 next = NEXTOPER(NEXTOPER(scan));
1038             else {
1039                 next = scan + ARG(scan);
1040                 if (OP(next) == IFTHEN) /* Fake one. */
1041                     next = NEXTOPER(NEXTOPER(next));
1042             }
1043             break;
1044         case LOGICAL:
1045             logical = 1;
1046             break;
1047         case CURLYX: {
1048                 CURCUR cc;
1049                 CHECKPOINT cp = savestack_ix;
1050
1051                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
1052                     next += ARG(next);
1053                 cc.oldcc = regcc;
1054                 regcc = &cc;
1055                 cc.parenfloor = *reglastparen;
1056                 cc.cur = -1;
1057                 cc.min = ARG1(scan);
1058                 cc.max  = ARG2(scan);
1059                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
1060                 cc.next = next;
1061                 cc.minmod = minmod;
1062                 cc.lastloc = 0;
1063                 reginput = locinput;
1064                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
1065                 regcpblow(cp);
1066                 regcc = cc.oldcc;
1067                 saySAME(n);
1068             }
1069             /* NOT REACHED */
1070         case WHILEM: {
1071                 /*
1072                  * This is really hard to understand, because after we match
1073                  * what we're trying to match, we must make sure the rest of
1074                  * the RE is going to match for sure, and to do that we have
1075                  * to go back UP the parse tree by recursing ever deeper.  And
1076                  * if it fails, we have to reset our parent's current state
1077                  * that we can try again after backing off.
1078                  */
1079
1080                 CHECKPOINT cp, lastcp;
1081                 CURCUR* cc = regcc;
1082                 char *lastloc = cc->lastloc; /* Detection of 0-len. */
1083                 
1084                 n = cc->cur + 1;        /* how many we know we matched */
1085                 reginput = locinput;
1086
1087                 DEBUG_r(
1088                     PerlIO_printf(Perl_debug_log, 
1089                                   "%*s  %ld out of %ld..%ld  cc=%lx\n", 
1090                                   REPORT_CODE_OFF+regindent*2, "",
1091                                   (long)n, (long)cc->min, 
1092                                   (long)cc->max, (long)cc)
1093                     );
1094
1095                 /* If degenerate scan matches "", assume scan done. */
1096
1097                 if (locinput == cc->lastloc && n >= cc->min) {
1098                     regcc = cc->oldcc;
1099                     ln = regcc->cur;
1100                     DEBUG_r(
1101                         PerlIO_printf(Perl_debug_log, "%*s  empty match detected, try continuation...\n", REPORT_CODE_OFF+regindent*2, "")
1102                         );
1103                     if (regmatch(cc->next))
1104                         sayYES;
1105                     DEBUG_r(
1106                         PerlIO_printf(Perl_debug_log, "%*s  failed...\n", REPORT_CODE_OFF+regindent*2, "")
1107                         );
1108                     regcc->cur = ln;
1109                     regcc = cc;
1110                     sayNO;
1111                 }
1112
1113                 /* First just match a string of min scans. */
1114
1115                 if (n < cc->min) {
1116                     cc->cur = n;
1117                     cc->lastloc = locinput;
1118                     if (regmatch(cc->scan))
1119                         sayYES;
1120                     cc->cur = n - 1;
1121                     cc->lastloc = lastloc;
1122                     DEBUG_r(
1123                         PerlIO_printf(Perl_debug_log, "%*s  failed...\n", REPORT_CODE_OFF+regindent*2, "")
1124                         );
1125                     sayNO;
1126                 }
1127
1128                 /* Prefer next over scan for minimal matching. */
1129
1130                 if (cc->minmod) {
1131                     regcc = cc->oldcc;
1132                     ln = regcc->cur;
1133                     cp = regcppush(cc->parenfloor);
1134                     REGCP_SET;
1135                     if (regmatch(cc->next)) {
1136                         regcpblow(cp);
1137                         sayYES; /* All done. */
1138                     }
1139                     REGCP_UNWIND;
1140                     regcppop();
1141                     regcc->cur = ln;
1142                     regcc = cc;
1143
1144                     if (n >= cc->max) { /* Maximum greed exceeded? */
1145                         if (dowarn && n >= REG_INFTY 
1146                             && !(reg_flags & RF_warned)) {
1147                             reg_flags |= RF_warned;
1148                             warn("count exceeded %d", REG_INFTY - 1);
1149                         }
1150                         sayNO;
1151                     }
1152
1153                     DEBUG_r(
1154                         PerlIO_printf(Perl_debug_log, "%*s  trying longer...\n", REPORT_CODE_OFF+regindent*2, "")
1155                         );
1156                     /* Try scanning more and see if it helps. */
1157                     reginput = locinput;
1158                     cc->cur = n;
1159                     cc->lastloc = locinput;
1160                     cp = regcppush(cc->parenfloor);
1161                     REGCP_SET;
1162                     if (regmatch(cc->scan)) {
1163                         regcpblow(cp);
1164                         sayYES;
1165                     }
1166                     DEBUG_r(
1167                         PerlIO_printf(Perl_debug_log, "%*s  failed...\n", REPORT_CODE_OFF+regindent*2, "")
1168                         );
1169                     REGCP_UNWIND;
1170                     regcppop();
1171                     cc->cur = n - 1;
1172                     cc->lastloc = lastloc;
1173                     sayNO;
1174                 }
1175
1176                 /* Prefer scan over next for maximal matching. */
1177
1178                 if (n < cc->max) {      /* More greed allowed? */
1179                     cp = regcppush(cc->parenfloor);
1180                     cc->cur = n;
1181                     cc->lastloc = locinput;
1182                     REGCP_SET;
1183                     if (regmatch(cc->scan)) {
1184                         regcpblow(cp);
1185                         sayYES;
1186                     }
1187                     REGCP_UNWIND;
1188                     regcppop();         /* Restore some previous $<digit>s? */
1189                     reginput = locinput;
1190                     DEBUG_r(
1191                         PerlIO_printf(Perl_debug_log, "%*s  failed, try continuation...\n", REPORT_CODE_OFF+regindent*2, "")
1192                         );
1193                 }
1194                 if (dowarn && n >= REG_INFTY && !(reg_flags & RF_warned)) {
1195                     reg_flags |= RF_warned;
1196                     warn("count exceeded %d", REG_INFTY - 1);
1197                 }
1198
1199                 /* Failed deeper matches of scan, so see if this one works. */
1200                 regcc = cc->oldcc;
1201                 ln = regcc->cur;
1202                 if (regmatch(cc->next))
1203                     sayYES;
1204                 DEBUG_r(
1205                     PerlIO_printf(Perl_debug_log, "%*s  failed...\n", REPORT_CODE_OFF+regindent*2, "")
1206                     );
1207                 regcc->cur = ln;
1208                 regcc = cc;
1209                 cc->cur = n - 1;
1210                 cc->lastloc = lastloc;
1211                 sayNO;
1212             }
1213             /* NOT REACHED */
1214         case BRANCHJ: 
1215             next = scan + ARG(scan);
1216             if (next == scan)
1217                 next = NULL;
1218             inner = NEXTOPER(NEXTOPER(scan));
1219             goto do_branch;
1220         case BRANCH: 
1221             inner = NEXTOPER(scan);
1222           do_branch:
1223             {
1224                 CHECKPOINT lastcp;
1225                 c1 = OP(scan);
1226                 if (OP(next) != c1)     /* No choice. */
1227                     next = inner;       /* Avoid recursion. */
1228                 else {
1229                     int lastparen = *reglastparen;
1230
1231                     REGCP_SET;
1232                     do {
1233                         reginput = locinput;
1234                         if (regmatch(inner))
1235                             sayYES;
1236                         REGCP_UNWIND;
1237                         for (n = *reglastparen; n > lastparen; n--)
1238                             regendp[n] = 0;
1239                         *reglastparen = n;
1240                         scan = next;
1241                         /*SUPPRESS 560*/
1242                         if (n = (c1 == BRANCH ? NEXT_OFF(next) : ARG(next)))
1243                             next += n;
1244                         else
1245                             next = NULL;
1246                         inner = NEXTOPER(scan);
1247                         if (c1 == BRANCHJ) {
1248                             inner = NEXTOPER(inner);
1249                         }
1250                     } while (scan != NULL && OP(scan) == c1);
1251                     sayNO;
1252                     /* NOTREACHED */
1253                 }
1254             }
1255             break;
1256         case MINMOD:
1257             minmod = 1;
1258             break;
1259         case CURLYM:
1260         {
1261             I32 l;
1262             CHECKPOINT lastcp;
1263             
1264             /* We suppose that the next guy does not need
1265                backtracking: in particular, it is of constant length,
1266                and has no parenths to influence future backrefs. */
1267             ln = ARG1(scan);  /* min to match */
1268             n  = ARG2(scan);  /* max to match */
1269             paren = scan->flags;
1270             if (paren) {
1271                 if (paren > regsize)
1272                     regsize = paren;
1273                 if (paren > *reglastparen)
1274                     *reglastparen = paren;
1275             }
1276             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
1277             if (paren)
1278                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
1279             reginput = locinput;
1280             if (minmod) {
1281                 minmod = 0;
1282                 if (ln && regrepeat_hard(scan, ln, &l) < ln)
1283                     sayNO;
1284                 if (ln && l == 0 && n >= ln
1285                     /* In fact, this is tricky.  If paren, then the
1286                        fact that we did/didnot match may influence
1287                        future execution. */
1288                     && !(paren && ln == 0))
1289                     ln = n;
1290                 locinput = reginput;
1291                 if (regkind[(U8)OP(next)] == EXACT) {
1292                     c1 = UCHARAT(OPERAND(next) + 1);
1293                     if (OP(next) == EXACTF)
1294                         c2 = fold[c1];
1295                     else if (OP(next) == EXACTFL)
1296                         c2 = fold_locale[c1];
1297                     else
1298                         c2 = c1;
1299                 } else
1300                     c1 = c2 = -1000;
1301                 REGCP_SET;
1302                 /* This may be improved if l == 0.  */
1303                 while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */
1304                     /* If it could work, try it. */
1305                     if (c1 == -1000 ||
1306                         UCHARAT(reginput) == c1 ||
1307                         UCHARAT(reginput) == c2)
1308                     {
1309                         if (paren) {
1310                             if (n) {
1311                                 regstartp[paren] = reginput - l;
1312                                 regendp[paren] = reginput;
1313                             } else
1314                                 regendp[paren] = NULL;
1315                         }
1316                         if (regmatch(next))
1317                             sayYES;
1318                         REGCP_UNWIND;
1319                     }
1320                     /* Couldn't or didn't -- move forward. */
1321                     reginput = locinput;
1322                     if (regrepeat_hard(scan, 1, &l)) {
1323                         ln++;
1324                         locinput = reginput;
1325                     }
1326                     else
1327                         sayNO;
1328                 }
1329             } else {
1330                 n = regrepeat_hard(scan, n, &l);
1331                 if (n != 0 && l == 0
1332                     /* In fact, this is tricky.  If paren, then the
1333                        fact that we did/didnot match may influence
1334                        future execution. */
1335                     && !(paren && ln == 0))
1336                     ln = n;
1337                 locinput = reginput;
1338                 DEBUG_r(
1339                     PerlIO_printf(Perl_debug_log, "%*s  matched %ld times, len=%ld...\n", REPORT_CODE_OFF+regindent*2, "", n, l)
1340                     );
1341                 if (n >= ln) {
1342                     if (regkind[(U8)OP(next)] == EXACT) {
1343                         c1 = UCHARAT(OPERAND(next) + 1);
1344                         if (OP(next) == EXACTF)
1345                             c2 = fold[c1];
1346                         else if (OP(next) == EXACTFL)
1347                             c2 = fold_locale[c1];
1348                         else
1349                             c2 = c1;
1350                     } else
1351                         c1 = c2 = -1000;
1352                 }
1353                 REGCP_SET;
1354                 while (n >= ln) {
1355                     /* If it could work, try it. */
1356                     if (c1 == -1000 ||
1357                         UCHARAT(reginput) == c1 ||
1358                         UCHARAT(reginput) == c2)
1359                         {
1360                             DEBUG_r(
1361                                 PerlIO_printf(Perl_debug_log, "%*s  trying tail with n=%ld...\n", REPORT_CODE_OFF+regindent*2, "", n)
1362                                 );
1363                             if (paren) {
1364                                 if (n) {
1365                                     regstartp[paren] = reginput - l;
1366                                     regendp[paren] = reginput;
1367                                 } else
1368                                     regendp[paren] = NULL;
1369                             }
1370                             if (regmatch(next))
1371                                 sayYES;
1372                             REGCP_UNWIND;
1373                         }
1374                     /* Couldn't or didn't -- back up. */
1375                     n--;
1376                     locinput -= l;
1377                     reginput = locinput;
1378                 }
1379             }
1380             sayNO;
1381             break;
1382         }
1383         case CURLYN:
1384             paren = scan->flags;        /* Which paren to set */
1385             if (paren > regsize)
1386                 regsize = paren;
1387             if (paren > *reglastparen)
1388                 *reglastparen = paren;
1389             ln = ARG1(scan);  /* min to match */
1390             n  = ARG2(scan);  /* max to match */
1391             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
1392             goto repeat;
1393         case CURLY:
1394             paren = 0;
1395             ln = ARG1(scan);  /* min to match */
1396             n  = ARG2(scan);  /* max to match */
1397             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
1398             goto repeat;
1399         case STAR:
1400             ln = 0;
1401             n = REG_INFTY;
1402             scan = NEXTOPER(scan);
1403             paren = 0;
1404             goto repeat;
1405         case PLUS:
1406             ln = 1;
1407             n = REG_INFTY;
1408             scan = NEXTOPER(scan);
1409             paren = 0;
1410           repeat:
1411             /*
1412             * Lookahead to avoid useless match attempts
1413             * when we know what character comes next.
1414             */
1415             if (regkind[(U8)OP(next)] == EXACT) {
1416                 c1 = UCHARAT(OPERAND(next) + 1);
1417                 if (OP(next) == EXACTF)
1418                     c2 = fold[c1];
1419                 else if (OP(next) == EXACTFL)
1420                     c2 = fold_locale[c1];
1421                 else
1422                     c2 = c1;
1423             }
1424             else
1425                 c1 = c2 = -1000;
1426             reginput = locinput;
1427             if (minmod) {
1428                 CHECKPOINT lastcp;
1429                 minmod = 0;
1430                 if (ln && regrepeat(scan, ln) < ln)
1431                     sayNO;
1432                 REGCP_SET;
1433                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
1434                     /* If it could work, try it. */
1435                     if (c1 == -1000 ||
1436                         UCHARAT(reginput) == c1 ||
1437                         UCHARAT(reginput) == c2)
1438                     {
1439                         if (paren) {
1440                             if (n) {
1441                                 regstartp[paren] = reginput - 1;
1442                                 regendp[paren] = reginput;
1443                             } else
1444                                 regendp[paren] = NULL;
1445                         }
1446                         if (regmatch(next))
1447                             sayYES;
1448                         REGCP_UNWIND;
1449                     }
1450                     /* Couldn't or didn't -- move forward. */
1451                     reginput = locinput + ln;
1452                     if (regrepeat(scan, 1)) {
1453                         ln++;
1454                         reginput = locinput + ln;
1455                     } else
1456                         sayNO;
1457                 }
1458             }
1459             else {
1460                 CHECKPOINT lastcp;
1461                 n = regrepeat(scan, n);
1462                 if (ln < n && regkind[(U8)OP(next)] == EOL &&
1463                     (!multiline  || OP(next) == SEOL))
1464                     ln = n;                     /* why back off? */
1465                 REGCP_SET;
1466                 if (paren) {
1467                     while (n >= ln) {
1468                         /* If it could work, try it. */
1469                         if (c1 == -1000 ||
1470                             UCHARAT(reginput) == c1 ||
1471                             UCHARAT(reginput) == c2)
1472                             {
1473                                 if (paren && n) {
1474                                     if (n) {
1475                                         regstartp[paren] = reginput - 1;
1476                                         regendp[paren] = reginput;
1477                                     } else
1478                                         regendp[paren] = NULL;
1479                                 }
1480                                 if (regmatch(next))
1481                                     sayYES;
1482                                 REGCP_UNWIND;
1483                             }
1484                         /* Couldn't or didn't -- back up. */
1485                         n--;
1486                         reginput = locinput + n;
1487                     }
1488                 } else {
1489                     while (n >= ln) {
1490                         /* If it could work, try it. */
1491                         if (c1 == -1000 ||
1492                             UCHARAT(reginput) == c1 ||
1493                             UCHARAT(reginput) == c2)
1494                             {
1495                                 if (regmatch(next))
1496                                     sayYES;
1497                                 REGCP_UNWIND;
1498                             }
1499                         /* Couldn't or didn't -- back up. */
1500                         n--;
1501                         reginput = locinput + n;
1502                     }
1503                 }
1504             }
1505             sayNO;
1506             break;
1507         case SUCCEED:
1508         case END:
1509             reginput = locinput;        /* put where regtry can find it */
1510             sayYES;                     /* Success! */
1511         case SUSPEND:
1512             n = 1;
1513             goto do_ifmatch;        
1514         case UNLESSM:
1515             n = 0;
1516             if (locinput < bostr + scan->flags) 
1517                 goto say_yes;
1518             goto do_ifmatch;
1519         case IFMATCH:
1520             n = 1;
1521             if (locinput < bostr + scan->flags) 
1522                 goto say_no;
1523           do_ifmatch:
1524             reginput = locinput - scan->flags;
1525             inner = NEXTOPER(NEXTOPER(scan));
1526             if (regmatch(inner) != n) {
1527               say_no:
1528                 if (logical) {
1529                     logical = 0;
1530                     sw = 0;
1531                     goto do_longjump;
1532                 } else
1533                     sayNO;
1534             }
1535           say_yes:
1536             if (logical) {
1537                 logical = 0;
1538                 sw = 1;
1539             }
1540             if (OP(scan) == SUSPEND) {
1541                 locinput = reginput;
1542                 nextchr = UCHARAT(locinput);
1543             }
1544             /* FALL THROUGH. */
1545         case LONGJMP:
1546           do_longjump:
1547             next = scan + ARG(scan);
1548             if (next == scan)
1549                 next = NULL;
1550             break;
1551         default:
1552             PerlIO_printf(PerlIO_stderr(), "%lx %d\n",
1553                           (unsigned long)scan, OP(scan));
1554             FAIL("regexp memory corruption");
1555         }
1556         scan = next;
1557     }
1558
1559     /*
1560     * We get here only if there's trouble -- normally "case END" is
1561     * the terminating point.
1562     */
1563     FAIL("corrupted regexp pointers");
1564     /*NOTREACHED*/
1565     sayNO;
1566
1567 yes:
1568 #ifdef DEBUGGING
1569     regindent--;
1570 #endif
1571     return 1;
1572
1573 no:
1574 #ifdef DEBUGGING
1575     regindent--;
1576 #endif
1577     return 0;
1578 }
1579
1580 /*
1581  - regrepeat - repeatedly match something simple, report how many
1582  */
1583 /*
1584  * [This routine now assumes that it will only match on things of length 1.
1585  * That was true before, but now we assume scan - reginput is the count,
1586  * rather than incrementing count on every character.]
1587  */
1588 STATIC I32
1589 regrepeat(regnode *p, I32 max)
1590 {
1591     register char *scan;
1592     register char *opnd;
1593     register I32 c;
1594     register char *loceol = regeol;
1595
1596     scan = reginput;
1597     if (max != REG_INFTY && max < loceol - scan)
1598       loceol = scan + max;
1599     opnd = (char *) OPERAND(p);
1600     switch (OP(p)) {
1601     case ANY:
1602         while (scan < loceol && *scan != '\n')
1603             scan++;
1604         break;
1605     case SANY:
1606         scan = loceol;
1607         break;
1608     case EXACT:         /* length of string is 1 */
1609         c = UCHARAT(++opnd);
1610         while (scan < loceol && UCHARAT(scan) == c)
1611             scan++;
1612         break;
1613     case EXACTF:        /* length of string is 1 */
1614         c = UCHARAT(++opnd);
1615         while (scan < loceol &&
1616                (UCHARAT(scan) == c || UCHARAT(scan) == fold[c]))
1617             scan++;
1618         break;
1619     case EXACTFL:       /* length of string is 1 */
1620         reg_flags |= RF_tainted;
1621         c = UCHARAT(++opnd);
1622         while (scan < loceol &&
1623                (UCHARAT(scan) == c || UCHARAT(scan) == fold_locale[c]))
1624             scan++;
1625         break;
1626     case ANYOF:
1627         while (scan < loceol && REGINCLASS(opnd, *scan))
1628             scan++;
1629         break;
1630     case ALNUM:
1631         while (scan < loceol && isALNUM(*scan))
1632             scan++;
1633         break;
1634     case ALNUML:
1635         reg_flags |= RF_tainted;
1636         while (scan < loceol && isALNUM_LC(*scan))
1637             scan++;
1638         break;
1639     case NALNUM:
1640         while (scan < loceol && !isALNUM(*scan))
1641             scan++;
1642         break;
1643     case NALNUML:
1644         reg_flags |= RF_tainted;
1645         while (scan < loceol && !isALNUM_LC(*scan))
1646             scan++;
1647         break;
1648     case SPACE:
1649         while (scan < loceol && isSPACE(*scan))
1650             scan++;
1651         break;
1652     case SPACEL:
1653         reg_flags |= RF_tainted;
1654         while (scan < loceol && isSPACE_LC(*scan))
1655             scan++;
1656         break;
1657     case NSPACE:
1658         while (scan < loceol && !isSPACE(*scan))
1659             scan++;
1660         break;
1661     case NSPACEL:
1662         reg_flags |= RF_tainted;
1663         while (scan < loceol && !isSPACE_LC(*scan))
1664             scan++;
1665         break;
1666     case DIGIT:
1667         while (scan < loceol && isDIGIT(*scan))
1668             scan++;
1669         break;
1670     case NDIGIT:
1671         while (scan < loceol && !isDIGIT(*scan))
1672             scan++;
1673         break;
1674     default:            /* Called on something of 0 width. */
1675         break;          /* So match right here or not at all. */
1676     }
1677
1678     c = scan - reginput;
1679     reginput = scan;
1680
1681     DEBUG_r( 
1682         {
1683                 SV *prop = sv_newmortal();
1684
1685                 regprop(prop, p);
1686                 PerlIO_printf(Perl_debug_log, 
1687                               "%*s  %s can match %ld times out of %ld...\n", 
1688                               REPORT_CODE_OFF+1, "", SvPVX(prop),c,max);
1689         });
1690     
1691     return(c);
1692 }
1693
1694 /*
1695  - regrepeat_hard - repeatedly match something, report total lenth and length
1696  * 
1697  * The repeater is supposed to have constant length.
1698  */
1699
1700 STATIC I32
1701 regrepeat_hard(regnode *p, I32 max, I32 *lp)
1702 {
1703     register char *scan;
1704     register char *start;
1705     register char *loceol = regeol;
1706     I32 l = -1;
1707
1708     start = reginput;
1709     while (reginput < loceol && (scan = reginput, regmatch(p))) {
1710         if (l == -1) {
1711             *lp = l = reginput - start;
1712             if (max != REG_INFTY && l*max < loceol - scan)
1713                 loceol = scan + l*max;
1714             if (l == 0) {
1715                 return max;
1716             }
1717         }
1718     }
1719     if (reginput < loceol)
1720         reginput = scan;
1721     else
1722         scan = reginput;
1723     
1724     return (scan - start)/l;
1725 }
1726
1727 /*
1728  - regclass - determine if a character falls into a character class
1729  */
1730
1731 STATIC bool
1732 reginclass(register char *p, register I32 c)
1733 {
1734     char flags = *p;
1735     bool match = FALSE;
1736
1737     c &= 0xFF;
1738     if (ANYOF_TEST(p, c))
1739         match = TRUE;
1740     else if (flags & ANYOF_FOLD) {
1741         I32 cf;
1742         if (flags & ANYOF_LOCALE) {
1743             reg_flags |= RF_tainted;
1744             cf = fold_locale[c];
1745         }
1746         else
1747             cf = fold[c];
1748         if (ANYOF_TEST(p, cf))
1749             match = TRUE;
1750     }
1751
1752     if (!match && (flags & ANYOF_ISA)) {
1753         reg_flags |= RF_tainted;
1754
1755         if (((flags & ANYOF_ALNUML)  && isALNUM_LC(c))  ||
1756             ((flags & ANYOF_NALNUML) && !isALNUM_LC(c)) ||
1757             ((flags & ANYOF_SPACEL)  && isSPACE_LC(c))  ||
1758             ((flags & ANYOF_NSPACEL) && !isSPACE_LC(c)))
1759         {
1760             match = TRUE;
1761         }
1762     }
1763
1764     return (flags & ANYOF_INVERT) ? !match : match;
1765 }
1766
1767
1768