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