Root is the lizard king.
[p5sagit/p5-mst-13.2.git] / regexec.c
1 /*    regexec.c
2  */
3
4 /*
5  * "One Ring to rule them all, One Ring to find them..."
6  */
7
8 /* NOTE: this is derived from Henry Spencer's regexp code, and should not
9  * confused with the original package (see point 3 below).  Thanks, Henry!
10  */
11
12 /* Additional note: this code is very heavily munged from Henry's version
13  * in places.  In some spots I've traded clarity for efficiency, so don't
14  * blame Henry for some of the lack of readability.
15  */
16
17 /* The names of the functions have been changed from regcomp and
18  * regexec to  pregcomp and pregexec in order to avoid conflicts
19  * with the POSIX routines of the same names.
20 */
21
22 #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 #  if defined(PERL_EXT_RE_DEBUG) && !defined(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 #  define Perl_re_intuit_start my_re_intuit_start
39 /* *These* symbols are masked to allow static link. */
40 #  define Perl_pregexec my_pregexec
41 #  define Perl_reginitcolors my_reginitcolors
42 #  define Perl_regclass_swash my_regclass_swash
43
44 #  define PERL_NO_GET_CONTEXT
45 #endif
46
47 /*SUPPRESS 112*/
48 /*
49  * pregcomp and pregexec -- regsub and regerror are not used in perl
50  *
51  *      Copyright (c) 1986 by University of Toronto.
52  *      Written by Henry Spencer.  Not derived from licensed software.
53  *
54  *      Permission is granted to anyone to use this software for any
55  *      purpose on any computer system, and to redistribute it freely,
56  *      subject to the following restrictions:
57  *
58  *      1. The author is not responsible for the consequences of use of
59  *              this software, no matter how awful, even if they arise
60  *              from defects in it.
61  *
62  *      2. The origin of this software must not be misrepresented, either
63  *              by explicit claim or by omission.
64  *
65  *      3. Altered versions must be plainly marked as such, and must not
66  *              be misrepresented as being the original software.
67  *
68  ****    Alterations to Henry's code are...
69  ****
70  ****    Copyright (c) 1991-2001, Larry Wall
71  ****
72  ****    You may distribute under the terms of either the GNU General Public
73  ****    License or the Artistic License, as specified in the README file.
74  *
75  * Beware that some of this code is subtly aware of the way operator
76  * precedence is structured in regular expressions.  Serious changes in
77  * regular-expression syntax might require a total rethink.
78  */
79 #include "EXTERN.h"
80 #define PERL_IN_REGEXEC_C
81 #include "perl.h"
82
83 #include "regcomp.h"
84
85 #define RF_tainted      1               /* tainted information used? */
86 #define RF_warned       2               /* warned about big count? */
87 #define RF_evaled       4               /* Did an EVAL with setting? */
88 #define RF_utf8         8               /* String contains multibyte chars? */
89
90 #define UTF (PL_reg_flags & RF_utf8)
91
92 #define RS_init         1               /* eval environment created */
93 #define RS_set          2               /* replsv value is set */
94
95 #ifndef STATIC
96 #define STATIC  static
97 #endif
98
99 /*
100  * Forwards.
101  */
102
103 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
104 #define CHR_DIST(a,b) (PL_reg_match_utf8 ? utf8_distance(a,b) : a - b)
105
106 #define reghop_c(pos,off) ((char*)reghop((U8*)pos, off))
107 #define reghopmaybe_c(pos,off) ((char*)reghopmaybe((U8*)pos, off))
108 #define HOP(pos,off) (PL_reg_match_utf8 ? reghop((U8*)pos, off) : (U8*)(pos + off))
109 #define HOPMAYBE(pos,off) (PL_reg_match_utf8 ? reghopmaybe((U8*)pos, off) : (U8*)(pos + off))
110 #define HOPc(pos,off) ((char*)HOP(pos,off))
111 #define HOPMAYBEc(pos,off) ((char*)HOPMAYBE(pos,off))
112
113 #define HOPBACK(pos, off) (             \
114     (UTF && PL_reg_match_utf8)          \
115         ? reghopmaybe((U8*)pos, -off)   \
116     : (pos - off >= PL_bostr)           \
117         ? (U8*)(pos - off)              \
118     : (U8*)NULL                         \
119 )
120 #define HOPBACKc(pos, off) (char*)HOPBACK(pos, off)
121
122 #define reghop3_c(pos,off,lim) ((char*)reghop3((U8*)pos, off, (U8*)lim))
123 #define reghopmaybe3_c(pos,off,lim) ((char*)reghopmaybe3((U8*)pos, off, (U8*)lim))
124 #define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
125 #define HOPMAYBE3(pos,off,lim) (PL_reg_match_utf8 ? reghopmaybe3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
126 #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
127 #define HOPMAYBE3c(pos,off,lim) ((char*)HOPMAYBE3(pos,off,lim))
128
129 #define LOAD_UTF8_CHARCLASS(a,b) STMT_START { if (!CAT2(PL_utf8_,a)) (void)CAT2(is_utf8_, a)((U8*)b); } STMT_END
130
131 /* for use after a quantifier and before an EXACT-like node -- japhy */
132 #define JUMPABLE(rn) ( \
133     OP(rn) == OPEN || OP(rn) == CLOSE || OP(rn) == EVAL || \
134     OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
135     OP(rn) == PLUS || OP(rn) == MINMOD || \
136     (PL_regkind[(U8)OP(rn)] == CURLY && ARG1(rn) > 0) \
137 )
138
139 #define HAS_TEXT(rn) ( \
140     PL_regkind[(U8)OP(rn)] == EXACT || PL_regkind[(U8)OP(rn)] == REF \
141 )
142
143 #define FIND_NEXT_IMPT(rn) STMT_START { \
144     while (JUMPABLE(rn)) \
145         if (OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
146             PL_regkind[(U8)OP(rn)] == CURLY) \
147             rn = NEXTOPER(NEXTOPER(rn)); \
148         else if (OP(rn) == PLUS) \
149             rn = NEXTOPER(rn); \
150         else rn += NEXT_OFF(rn); \
151 } STMT_END 
152
153 static void restore_pos(pTHX_ void *arg);
154
155 STATIC CHECKPOINT
156 S_regcppush(pTHX_ I32 parenfloor)
157 {
158     int retval = PL_savestack_ix;
159 #define REGCP_PAREN_ELEMS 4
160     int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS;
161     int p;
162
163     if (paren_elems_to_push < 0)
164         Perl_croak(aTHX_ "panic: paren_elems_to_push < 0");
165
166 #define REGCP_OTHER_ELEMS 6
167     SSCHECK(paren_elems_to_push + REGCP_OTHER_ELEMS);
168     for (p = PL_regsize; p > parenfloor; p--) {
169 /* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
170         SSPUSHINT(PL_regendp[p]);
171         SSPUSHINT(PL_regstartp[p]);
172         SSPUSHPTR(PL_reg_start_tmp[p]);
173         SSPUSHINT(p);
174     }
175 /* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
176     SSPUSHINT(PL_regsize);
177     SSPUSHINT(*PL_reglastparen);
178     SSPUSHINT(*PL_reglastcloseparen);
179     SSPUSHPTR(PL_reginput);
180 #define REGCP_FRAME_ELEMS 2
181 /* REGCP_FRAME_ELEMS are part of the REGCP_OTHER_ELEMS and
182  * are needed for the regexp context stack bookkeeping. */
183     SSPUSHINT(paren_elems_to_push + REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
184     SSPUSHINT(SAVEt_REGCONTEXT); /* Magic cookie. */
185
186     return retval;
187 }
188
189 /* These are needed since we do not localize EVAL nodes: */
190 #  define REGCP_SET(cp)  DEBUG_r(PerlIO_printf(Perl_debug_log,          \
191                              "  Setting an EVAL scope, savestack=%"IVdf"\n",    \
192                              (IV)PL_savestack_ix)); cp = PL_savestack_ix
193
194 #  define REGCP_UNWIND(cp)  DEBUG_r(cp != PL_savestack_ix ?             \
195                                 PerlIO_printf(Perl_debug_log,           \
196                                 "  Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
197                                 (IV)(cp), (IV)PL_savestack_ix) : 0); regcpblow(cp)
198
199 STATIC char *
200 S_regcppop(pTHX)
201 {
202     I32 i;
203     U32 paren = 0;
204     char *input;
205     I32 tmps;
206
207     /* Pop REGCP_OTHER_ELEMS before the parentheses loop starts. */
208     i = SSPOPINT;
209     assert(i == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
210     i = SSPOPINT; /* Parentheses elements to pop. */
211     input = (char *) SSPOPPTR;
212     *PL_reglastcloseparen = SSPOPINT;
213     *PL_reglastparen = SSPOPINT;
214     PL_regsize = SSPOPINT;
215
216     /* Now restore the parentheses context. */
217     for (i -= (REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
218          i > 0; i -= REGCP_PAREN_ELEMS) {
219         paren = (U32)SSPOPINT;
220         PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
221         PL_regstartp[paren] = SSPOPINT;
222         tmps = SSPOPINT;
223         if (paren <= *PL_reglastparen)
224             PL_regendp[paren] = tmps;
225         DEBUG_r(
226             PerlIO_printf(Perl_debug_log,
227                           "     restoring \\%"UVuf" to %"IVdf"(%"IVdf")..%"IVdf"%s\n",
228                           (UV)paren, (IV)PL_regstartp[paren],
229                           (IV)(PL_reg_start_tmp[paren] - PL_bostr),
230                           (IV)PL_regendp[paren],
231                           (paren > *PL_reglastparen ? "(no)" : ""));
232         );
233     }
234     DEBUG_r(
235         if (*PL_reglastparen + 1 <= PL_regnpar) {
236             PerlIO_printf(Perl_debug_log,
237                           "     restoring \\%"IVdf"..\\%"IVdf" to undef\n",
238                           (IV)(*PL_reglastparen + 1), (IV)PL_regnpar);
239         }
240     );
241 #if 1
242     /* It would seem that the similar code in regtry()
243      * already takes care of this, and in fact it is in
244      * a better location to since this code can #if 0-ed out
245      * but the code in regtry() is needed or otherwise tests
246      * requiring null fields (pat.t#187 and split.t#{13,14}
247      * (as of patchlevel 7877)  will fail.  Then again,
248      * this code seems to be necessary or otherwise
249      * building DynaLoader will fail:
250      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
251      * --jhi */
252     for (paren = *PL_reglastparen + 1; paren <= PL_regnpar; paren++) {
253         if (paren > PL_regsize)
254             PL_regstartp[paren] = -1;
255         PL_regendp[paren] = -1;
256     }
257 #endif
258     return input;
259 }
260
261 STATIC char *
262 S_regcp_set_to(pTHX_ I32 ss)
263 {
264     I32 tmp = PL_savestack_ix;
265
266     PL_savestack_ix = ss;
267     regcppop();
268     PL_savestack_ix = tmp;
269     return Nullch;
270 }
271
272 typedef struct re_cc_state
273 {
274     I32 ss;
275     regnode *node;
276     struct re_cc_state *prev;
277     CURCUR *cc;
278     regexp *re;
279 } re_cc_state;
280
281 #define regcpblow(cp) LEAVE_SCOPE(cp)   /* Ignores regcppush()ed data. */
282
283 #define TRYPAREN(paren, n, input) {                             \
284     if (paren) {                                                \
285         if (n) {                                                \
286             PL_regstartp[paren] = HOPc(input, -1) - PL_bostr;   \
287             PL_regendp[paren] = input - PL_bostr;               \
288         }                                                       \
289         else                                                    \
290             PL_regendp[paren] = -1;                             \
291     }                                                           \
292     if (regmatch(next))                                         \
293         sayYES;                                                 \
294     if (paren && n)                                             \
295         PL_regendp[paren] = -1;                                 \
296 }
297
298
299 /*
300  * pregexec and friends
301  */
302
303 /*
304  - pregexec - match a regexp against a string
305  */
306 I32
307 Perl_pregexec(pTHX_ register regexp *prog, char *stringarg, register char *strend,
308          char *strbeg, I32 minend, SV *screamer, U32 nosave)
309 /* strend: pointer to null at end of string */
310 /* strbeg: real beginning of string */
311 /* minend: end of match must be >=minend after stringarg. */
312 /* nosave: For optimizations. */
313 {
314     return
315         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
316                       nosave ? 0 : REXEC_COPY_STR);
317 }
318
319 STATIC void
320 S_cache_re(pTHX_ regexp *prog)
321 {
322     PL_regprecomp = prog->precomp;              /* Needed for FAIL. */
323 #ifdef DEBUGGING
324     PL_regprogram = prog->program;
325 #endif
326     PL_regnpar = prog->nparens;
327     PL_regdata = prog->data;
328     PL_reg_re = prog;
329 }
330
331 /*
332  * Need to implement the following flags for reg_anch:
333  *
334  * USE_INTUIT_NOML              - Useful to call re_intuit_start() first
335  * USE_INTUIT_ML
336  * INTUIT_AUTORITATIVE_NOML     - Can trust a positive answer
337  * INTUIT_AUTORITATIVE_ML
338  * INTUIT_ONCE_NOML             - Intuit can match in one location only.
339  * INTUIT_ONCE_ML
340  *
341  * Another flag for this function: SECOND_TIME (so that float substrs
342  * with giant delta may be not rechecked).
343  */
344
345 /* Assumptions: if ANCH_GPOS, then strpos is anchored. XXXX Check GPOS logic */
346
347 /* If SCREAM, then SvPVX(sv) should be compatible with strpos and strend.
348    Otherwise, only SvCUR(sv) is used to get strbeg. */
349
350 /* XXXX We assume that strpos is strbeg unless sv. */
351
352 /* XXXX Some places assume that there is a fixed substring.
353         An update may be needed if optimizer marks as "INTUITable"
354         RExen without fixed substrings.  Similarly, it is assumed that
355         lengths of all the strings are no more than minlen, thus they
356         cannot come from lookahead.
357         (Or minlen should take into account lookahead.) */
358
359 /* A failure to find a constant substring means that there is no need to make
360    an expensive call to REx engine, thus we celebrate a failure.  Similarly,
361    finding a substring too deep into the string means that less calls to
362    regtry() should be needed.
363
364    REx compiler's optimizer found 4 possible hints:
365         a) Anchored substring;
366         b) Fixed substring;
367         c) Whether we are anchored (beginning-of-line or \G);
368         d) First node (of those at offset 0) which may distingush positions;
369    We use a)b)d) and multiline-part of c), and try to find a position in the
370    string which does not contradict any of them.
371  */
372
373 /* Most of decisions we do here should have been done at compile time.
374    The nodes of the REx which we used for the search should have been
375    deleted from the finite automaton. */
376
377 char *
378 Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
379                      char *strend, U32 flags, re_scream_pos_data *data)
380 {
381     register I32 start_shift = 0;
382     /* Should be nonnegative! */
383     register I32 end_shift   = 0;
384     register char *s;
385     register SV *check;
386     char *strbeg;
387     char *t;
388     I32 ml_anch;
389     register char *other_last = Nullch; /* other substr checked before this */
390     char *check_at = Nullch;            /* check substr found at this pos */
391 #ifdef DEBUGGING
392     char *i_strpos = strpos;
393     SV *dsv = PERL_DEBUG_PAD_ZERO(0);
394 #endif
395
396     DEBUG_r({
397          char*s   = UTF ? sv_uni_display(dsv, sv, 60, 0) : strpos;
398          int  len = UTF ? strlen(s) : strend - strpos;
399          if (!PL_colorset)
400               reginitcolors();
401          PerlIO_printf(Perl_debug_log,
402                        "%sGuessing start of match, REx%s `%s%.60s%s%s' against `%s%.*s%s%s'...\n",
403                        PL_colors[4],PL_colors[5],PL_colors[0],
404                        prog->precomp,
405                        PL_colors[1],
406                        (strlen(prog->precomp) > 60 ? "..." : ""),
407                        PL_colors[0],
408                        (int)(len > 60 ? 60 : len),
409                        s, PL_colors[1],
410                        (len > 60 ? "..." : "")
411               );
412     });
413
414     if (prog->reganch & ROPT_UTF8)
415         PL_reg_flags |= RF_utf8;
416
417     if (prog->minlen > CHR_DIST((U8*)strend, (U8*)strpos)) {
418         DEBUG_r(PerlIO_printf(Perl_debug_log,
419                               "String too short... [re_intuit_start]\n"));
420         goto fail;
421     }
422     strbeg = (sv && SvPOK(sv)) ? strend - SvCUR(sv) : strpos;
423     PL_regeol = strend;
424     check = prog->check_substr;
425     if (prog->reganch & ROPT_ANCH) {    /* Match at beg-of-str or after \n */
426         ml_anch = !( (prog->reganch & ROPT_ANCH_SINGLE)
427                      || ( (prog->reganch & ROPT_ANCH_BOL)
428                           && !PL_multiline ) ); /* Check after \n? */
429
430         if (!ml_anch) {
431           if ( !(prog->reganch & (ROPT_ANCH_GPOS /* Checked by the caller */
432                                   | ROPT_IMPLICIT)) /* not a real BOL */
433                /* SvCUR is not set on references: SvRV and SvPVX overlap */
434                && sv && !SvROK(sv)
435                && (strpos != strbeg)) {
436               DEBUG_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
437               goto fail;
438           }
439           if (prog->check_offset_min == prog->check_offset_max &&
440               !(prog->reganch & ROPT_CANY_SEEN)) {
441             /* Substring at constant offset from beg-of-str... */
442             I32 slen;
443
444             s = HOP3c(strpos, prog->check_offset_min, strend);
445             if (SvTAIL(check)) {
446                 slen = SvCUR(check);    /* >= 1 */
447
448                 if ( strend - s > slen || strend - s < slen - 1
449                      || (strend - s == slen && strend[-1] != '\n')) {
450                     DEBUG_r(PerlIO_printf(Perl_debug_log, "String too long...\n"));
451                     goto fail_finish;
452                 }
453                 /* Now should match s[0..slen-2] */
454                 slen--;
455                 if (slen && (*SvPVX(check) != *s
456                              || (slen > 1
457                                  && memNE(SvPVX(check), s, slen)))) {
458                   report_neq:
459                     DEBUG_r(PerlIO_printf(Perl_debug_log, "String not equal...\n"));
460                     goto fail_finish;
461                 }
462             }
463             else if (*SvPVX(check) != *s
464                      || ((slen = SvCUR(check)) > 1
465                          && memNE(SvPVX(check), s, slen)))
466                 goto report_neq;
467             goto success_at_start;
468           }
469         }
470         /* Match is anchored, but substr is not anchored wrt beg-of-str. */
471         s = strpos;
472         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
473         end_shift = prog->minlen - start_shift -
474             CHR_SVLEN(check) + (SvTAIL(check) != 0);
475         if (!ml_anch) {
476             I32 end = prog->check_offset_max + CHR_SVLEN(check)
477                                          - (SvTAIL(check) != 0);
478             I32 eshift = CHR_DIST((U8*)strend, (U8*)s) - end;
479
480             if (end_shift < eshift)
481                 end_shift = eshift;
482         }
483     }
484     else {                              /* Can match at random position */
485         ml_anch = 0;
486         s = strpos;
487         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
488         /* Should be nonnegative! */
489         end_shift = prog->minlen - start_shift -
490             CHR_SVLEN(check) + (SvTAIL(check) != 0);
491     }
492
493 #ifdef DEBUGGING        /* 7/99: reports of failure (with the older version) */
494     if (end_shift < 0)
495         Perl_croak(aTHX_ "panic: end_shift");
496 #endif
497
498   restart:
499     /* Find a possible match in the region s..strend by looking for
500        the "check" substring in the region corrected by start/end_shift. */
501     if (flags & REXEC_SCREAM) {
502         I32 p = -1;                     /* Internal iterator of scream. */
503         I32 *pp = data ? data->scream_pos : &p;
504
505         if (PL_screamfirst[BmRARE(check)] >= 0
506             || ( BmRARE(check) == '\n'
507                  && (BmPREVIOUS(check) == SvCUR(check) - 1)
508                  && SvTAIL(check) ))
509             s = screaminstr(sv, check,
510                             start_shift + (s - strbeg), end_shift, pp, 0);
511         else
512             goto fail_finish;
513         if (data)
514             *data->scream_olds = s;
515     }
516     else if (prog->reganch & ROPT_CANY_SEEN)
517         s = fbm_instr((U8*)(s + start_shift),
518                       (U8*)(strend - end_shift),
519                       check, PL_multiline ? FBMrf_MULTILINE : 0);
520     else
521         s = fbm_instr(HOP3(s, start_shift, strend),
522                       HOP3(strend, -end_shift, strbeg),
523                       check, PL_multiline ? FBMrf_MULTILINE : 0);
524
525     /* Update the count-of-usability, remove useless subpatterns,
526         unshift s.  */
527
528     DEBUG_r(PerlIO_printf(Perl_debug_log, "%s %s substr `%s%.*s%s'%s%s",
529                           (s ? "Found" : "Did not find"),
530                           ((check == prog->anchored_substr) ? "anchored" : "floating"),
531                           PL_colors[0],
532                           (int)(SvCUR(check) - (SvTAIL(check)!=0)),
533                           SvPVX(check),
534                           PL_colors[1], (SvTAIL(check) ? "$" : ""),
535                           (s ? " at offset " : "...\n") ) );
536
537     if (!s)
538         goto fail_finish;
539
540     check_at = s;
541
542     /* Finish the diagnostic message */
543     DEBUG_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - i_strpos)) );
544
545     /* Got a candidate.  Check MBOL anchoring, and the *other* substr.
546        Start with the other substr.
547        XXXX no SCREAM optimization yet - and a very coarse implementation
548        XXXX /ttx+/ results in anchored=`ttx', floating=`x'.  floating will
549                 *always* match.  Probably should be marked during compile...
550        Probably it is right to do no SCREAM here...
551      */
552
553     if (prog->float_substr && prog->anchored_substr) {
554         /* Take into account the "other" substring. */
555         /* XXXX May be hopelessly wrong for UTF... */
556         if (!other_last)
557             other_last = strpos;
558         if (check == prog->float_substr) {
559           do_other_anchored:
560             {
561                 char *last = HOP3c(s, -start_shift, strbeg), *last1, *last2;
562                 char *s1 = s;
563
564                 t = s - prog->check_offset_max;
565                 if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
566                     && (!(prog->reganch & ROPT_UTF8)
567                         || ((t = reghopmaybe3_c(s, -(prog->check_offset_max), strpos))
568                             && t > strpos)))
569                     /* EMPTY */;
570                 else
571                     t = strpos;
572                 t = HOP3c(t, prog->anchored_offset, strend);
573                 if (t < other_last)     /* These positions already checked */
574                     t = other_last;
575                 last2 = last1 = HOP3c(strend, -prog->minlen, strbeg);
576                 if (last < last1)
577                     last1 = last;
578  /* XXXX It is not documented what units *_offsets are in.  Assume bytes.  */
579                 /* On end-of-str: see comment below. */
580                 s = fbm_instr((unsigned char*)t,
581                               HOP3(HOP3(last1, prog->anchored_offset, strend)
582                                    + SvCUR(prog->anchored_substr),
583                                    -(SvTAIL(prog->anchored_substr)!=0), strbeg),
584                               prog->anchored_substr,
585                               PL_multiline ? FBMrf_MULTILINE : 0);
586                 DEBUG_r(PerlIO_printf(Perl_debug_log,
587                         "%s anchored substr `%s%.*s%s'%s",
588                         (s ? "Found" : "Contradicts"),
589                         PL_colors[0],
590                           (int)(SvCUR(prog->anchored_substr)
591                           - (SvTAIL(prog->anchored_substr)!=0)),
592                           SvPVX(prog->anchored_substr),
593                           PL_colors[1], (SvTAIL(prog->anchored_substr) ? "$" : "")));
594                 if (!s) {
595                     if (last1 >= last2) {
596                         DEBUG_r(PerlIO_printf(Perl_debug_log,
597                                                 ", giving up...\n"));
598                         goto fail_finish;
599                     }
600                     DEBUG_r(PerlIO_printf(Perl_debug_log,
601                         ", trying floating at offset %ld...\n",
602                         (long)(HOP3c(s1, 1, strend) - i_strpos)));
603                     other_last = HOP3c(last1, prog->anchored_offset+1, strend);
604                     s = HOP3c(last, 1, strend);
605                     goto restart;
606                 }
607                 else {
608                     DEBUG_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
609                           (long)(s - i_strpos)));
610                     t = HOP3c(s, -prog->anchored_offset, strbeg);
611                     other_last = HOP3c(s, 1, strend);
612                     s = s1;
613                     if (t == strpos)
614                         goto try_at_start;
615                     goto try_at_offset;
616                 }
617             }
618         }
619         else {          /* Take into account the floating substring. */
620                 char *last, *last1;
621                 char *s1 = s;
622
623                 t = HOP3c(s, -start_shift, strbeg);
624                 last1 = last =
625                     HOP3c(strend, -prog->minlen + prog->float_min_offset, strbeg);
626                 if (CHR_DIST((U8*)last, (U8*)t) > prog->float_max_offset)
627                     last = HOP3c(t, prog->float_max_offset, strend);
628                 s = HOP3c(t, prog->float_min_offset, strend);
629                 if (s < other_last)
630                     s = other_last;
631  /* XXXX It is not documented what units *_offsets are in.  Assume bytes.  */
632                 /* fbm_instr() takes into account exact value of end-of-str
633                    if the check is SvTAIL(ed).  Since false positives are OK,
634                    and end-of-str is not later than strend we are OK. */
635                 s = fbm_instr((unsigned char*)s,
636                               (unsigned char*)last + SvCUR(prog->float_substr)
637                                   - (SvTAIL(prog->float_substr)!=0),
638                               prog->float_substr, PL_multiline ? FBMrf_MULTILINE : 0);
639                 DEBUG_r(PerlIO_printf(Perl_debug_log, "%s floating substr `%s%.*s%s'%s",
640                         (s ? "Found" : "Contradicts"),
641                         PL_colors[0],
642                           (int)(SvCUR(prog->float_substr)
643                           - (SvTAIL(prog->float_substr)!=0)),
644                           SvPVX(prog->float_substr),
645                           PL_colors[1], (SvTAIL(prog->float_substr) ? "$" : "")));
646                 if (!s) {
647                     if (last1 == last) {
648                         DEBUG_r(PerlIO_printf(Perl_debug_log,
649                                                 ", giving up...\n"));
650                         goto fail_finish;
651                     }
652                     DEBUG_r(PerlIO_printf(Perl_debug_log,
653                         ", trying anchored starting at offset %ld...\n",
654                         (long)(s1 + 1 - i_strpos)));
655                     other_last = last;
656                     s = HOP3c(t, 1, strend);
657                     goto restart;
658                 }
659                 else {
660                     DEBUG_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
661                           (long)(s - i_strpos)));
662                     other_last = s; /* Fix this later. --Hugo */
663                     s = s1;
664                     if (t == strpos)
665                         goto try_at_start;
666                     goto try_at_offset;
667                 }
668         }
669     }
670
671     t = s - prog->check_offset_max;
672     if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
673         && (!(prog->reganch & ROPT_UTF8)
674             || ((t = reghopmaybe3_c(s, -prog->check_offset_max, strpos))
675                  && t > strpos))) {
676         /* Fixed substring is found far enough so that the match
677            cannot start at strpos. */
678       try_at_offset:
679         if (ml_anch && t[-1] != '\n') {
680             /* Eventually fbm_*() should handle this, but often
681                anchored_offset is not 0, so this check will not be wasted. */
682             /* XXXX In the code below we prefer to look for "^" even in
683                presence of anchored substrings.  And we search even
684                beyond the found float position.  These pessimizations
685                are historical artefacts only.  */
686           find_anchor:
687             while (t < strend - prog->minlen) {
688                 if (*t == '\n') {
689                     if (t < check_at - prog->check_offset_min) {
690                         if (prog->anchored_substr) {
691                             /* Since we moved from the found position,
692                                we definitely contradict the found anchored
693                                substr.  Due to the above check we do not
694                                contradict "check" substr.
695                                Thus we can arrive here only if check substr
696                                is float.  Redo checking for "other"=="fixed".
697                              */
698                             strpos = t + 1;                     
699                             DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld, rescanning for anchored from offset %ld...\n",
700                                 PL_colors[0],PL_colors[1], (long)(strpos - i_strpos), (long)(strpos - i_strpos + prog->anchored_offset)));
701                             goto do_other_anchored;
702                         }
703                         /* We don't contradict the found floating substring. */
704                         /* XXXX Why not check for STCLASS? */
705                         s = t + 1;
706                         DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld...\n",
707                             PL_colors[0],PL_colors[1], (long)(s - i_strpos)));
708                         goto set_useful;
709                     }
710                     /* Position contradicts check-string */
711                     /* XXXX probably better to look for check-string
712                        than for "\n", so one should lower the limit for t? */
713                     DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting lookup for check-string at offset %ld...\n",
714                         PL_colors[0],PL_colors[1], (long)(t + 1 - i_strpos)));
715                     other_last = strpos = s = t + 1;
716                     goto restart;
717                 }
718                 t++;
719             }
720             DEBUG_r(PerlIO_printf(Perl_debug_log, "Did not find /%s^%s/m...\n",
721                         PL_colors[0],PL_colors[1]));
722             goto fail_finish;
723         }
724         else {
725             DEBUG_r(PerlIO_printf(Perl_debug_log, "Starting position does not contradict /%s^%s/m...\n",
726                         PL_colors[0],PL_colors[1]));
727         }
728         s = t;
729       set_useful:
730         ++BmUSEFUL(prog->check_substr); /* hooray/5 */
731     }
732     else {
733         /* The found string does not prohibit matching at strpos,
734            - no optimization of calling REx engine can be performed,
735            unless it was an MBOL and we are not after MBOL,
736            or a future STCLASS check will fail this. */
737       try_at_start:
738         /* Even in this situation we may use MBOL flag if strpos is offset
739            wrt the start of the string. */
740         if (ml_anch && sv && !SvROK(sv) /* See prev comment on SvROK */
741             && (strpos != strbeg) && strpos[-1] != '\n'
742             /* May be due to an implicit anchor of m{.*foo}  */
743             && !(prog->reganch & ROPT_IMPLICIT))
744         {
745             t = strpos;
746             goto find_anchor;
747         }
748         DEBUG_r( if (ml_anch)
749             PerlIO_printf(Perl_debug_log, "Position at offset %ld does not contradict /%s^%s/m...\n",
750                         (long)(strpos - i_strpos), PL_colors[0],PL_colors[1]);
751         );
752       success_at_start:
753         if (!(prog->reganch & ROPT_NAUGHTY)     /* XXXX If strpos moved? */
754             && prog->check_substr               /* Could be deleted already */
755             && --BmUSEFUL(prog->check_substr) < 0
756             && prog->check_substr == prog->float_substr)
757         {
758             /* If flags & SOMETHING - do not do it many times on the same match */
759             DEBUG_r(PerlIO_printf(Perl_debug_log, "... Disabling check substring...\n"));
760             SvREFCNT_dec(prog->check_substr);
761             prog->check_substr = Nullsv;        /* disable */
762             prog->float_substr = Nullsv;        /* clear */
763             check = Nullsv;                     /* abort */
764             s = strpos;
765             /* XXXX This is a remnant of the old implementation.  It
766                     looks wasteful, since now INTUIT can use many
767                     other heuristics. */
768             prog->reganch &= ~RE_USE_INTUIT;
769         }
770         else
771             s = strpos;
772     }
773
774     /* Last resort... */
775     /* XXXX BmUSEFUL already changed, maybe multiple change is meaningful... */
776     if (prog->regstclass) {
777         /* minlen == 0 is possible if regstclass is \b or \B,
778            and the fixed substr is ''$.
779            Since minlen is already taken into account, s+1 is before strend;
780            accidentally, minlen >= 1 guaranties no false positives at s + 1
781            even for \b or \B.  But (minlen? 1 : 0) below assumes that
782            regstclass does not come from lookahead...  */
783         /* If regstclass takes bytelength more than 1: If charlength==1, OK.
784            This leaves EXACTF only, which is dealt with in find_byclass().  */
785         U8* str = (U8*)STRING(prog->regstclass);
786         int cl_l = (PL_regkind[(U8)OP(prog->regstclass)] == EXACT
787                     ? CHR_DIST(str+STR_LEN(prog->regstclass), str)
788                     : 1);
789         char *endpos = (prog->anchored_substr || ml_anch)
790                 ? HOP3c(s, (prog->minlen ? cl_l : 0), strend)
791                 : (prog->float_substr
792                    ? HOP3c(HOP3c(check_at, -start_shift, strbeg),
793                            cl_l, strend)
794                    : strend);
795         char *startpos = strbeg;
796
797         t = s;
798         if (prog->reganch & ROPT_UTF8) {        
799             PL_regdata = prog->data;
800             PL_bostr = startpos;
801         }
802         s = find_byclass(prog, prog->regstclass, s, endpos, startpos, 1);
803         if (!s) {
804 #ifdef DEBUGGING
805             char *what = 0;
806 #endif
807             if (endpos == strend) {
808                 DEBUG_r( PerlIO_printf(Perl_debug_log,
809                                 "Could not match STCLASS...\n") );
810                 goto fail;
811             }
812             DEBUG_r( PerlIO_printf(Perl_debug_log,
813                                    "This position contradicts STCLASS...\n") );
814             if ((prog->reganch & ROPT_ANCH) && !ml_anch)
815                 goto fail;
816             /* Contradict one of substrings */
817             if (prog->anchored_substr) {
818                 if (prog->anchored_substr == check) {
819                     DEBUG_r( what = "anchored" );
820                   hop_and_restart:
821                     s = HOP3c(t, 1, strend);
822                     if (s + start_shift + end_shift > strend) {
823                         /* XXXX Should be taken into account earlier? */
824                         DEBUG_r( PerlIO_printf(Perl_debug_log,
825                                                "Could not match STCLASS...\n") );
826                         goto fail;
827                     }
828                     if (!check)
829                         goto giveup;
830                     DEBUG_r( PerlIO_printf(Perl_debug_log,
831                                 "Looking for %s substr starting at offset %ld...\n",
832                                  what, (long)(s + start_shift - i_strpos)) );
833                     goto restart;
834                 }
835                 /* Have both, check_string is floating */
836                 if (t + start_shift >= check_at) /* Contradicts floating=check */
837                     goto retry_floating_check;
838                 /* Recheck anchored substring, but not floating... */
839                 s = check_at;
840                 if (!check)
841                     goto giveup;
842                 DEBUG_r( PerlIO_printf(Perl_debug_log,
843                           "Looking for anchored substr starting at offset %ld...\n",
844                           (long)(other_last - i_strpos)) );
845                 goto do_other_anchored;
846             }
847             /* Another way we could have checked stclass at the
848                current position only: */
849             if (ml_anch) {
850                 s = t = t + 1;
851                 if (!check)
852                     goto giveup;
853                 DEBUG_r( PerlIO_printf(Perl_debug_log,
854                           "Looking for /%s^%s/m starting at offset %ld...\n",
855                           PL_colors[0],PL_colors[1], (long)(t - i_strpos)) );
856                 goto try_at_offset;
857             }
858             if (!prog->float_substr)    /* Could have been deleted */
859                 goto fail;
860             /* Check is floating subtring. */
861           retry_floating_check:
862             t = check_at - start_shift;
863             DEBUG_r( what = "floating" );
864             goto hop_and_restart;
865         }
866         if (t != s) {
867             DEBUG_r(PerlIO_printf(Perl_debug_log,
868                         "By STCLASS: moving %ld --> %ld\n",
869                                   (long)(t - i_strpos), (long)(s - i_strpos))
870                    );
871         }
872         else {
873             DEBUG_r(PerlIO_printf(Perl_debug_log,
874                                   "Does not contradict STCLASS...\n"); 
875                    );
876         }
877     }
878   giveup:
879     DEBUG_r(PerlIO_printf(Perl_debug_log, "%s%s:%s match at offset %ld\n",
880                           PL_colors[4], (check ? "Guessed" : "Giving up"),
881                           PL_colors[5], (long)(s - i_strpos)) );
882     return s;
883
884   fail_finish:                          /* Substring not found */
885     if (prog->check_substr)             /* could be removed already */
886         BmUSEFUL(prog->check_substr) += 5; /* hooray */
887   fail:
888     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n",
889                           PL_colors[4],PL_colors[5]));
890     return Nullch;
891 }
892
893 /* We know what class REx starts with.  Try to find this position... */
894 STATIC char *
895 S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *startpos, I32 norun)
896 {
897         I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
898         char *m;
899         STRLEN ln;
900         unsigned int c1;
901         unsigned int c2;
902         char *e;
903         register I32 tmp = 1;   /* Scratch variable? */
904         register bool do_utf8 = PL_reg_match_utf8;
905
906         /* We know what class it must start with. */
907         switch (OP(c)) {
908         case ANYOF:
909             while (s < strend) {
910                 if (reginclass(c, (U8*)s, do_utf8)) {
911                     if (tmp && (norun || regtry(prog, s)))
912                         goto got_it;
913                     else
914                         tmp = doevery;
915                 }
916                 else
917                     tmp = 1;
918                 s += do_utf8 ? UTF8SKIP(s) : 1;
919             }
920             break;
921         case CANY:
922             while (s < strend) {
923                 if (tmp && (norun || regtry(prog, s)))
924                     goto got_it;
925                 else
926                     tmp = doevery;
927                 s++;
928             }
929             break;
930         case EXACTF:
931             m = STRING(c);
932             ln = STR_LEN(c);
933             if (UTF) {
934                 STRLEN ulen1, ulen2;
935                 U8 tmpbuf1[UTF8_MAXLEN*2+1];
936                 U8 tmpbuf2[UTF8_MAXLEN*2+1];
937
938                 to_utf8_lower((U8*)m, tmpbuf1, &ulen1);
939                 to_utf8_upper((U8*)m, tmpbuf2, &ulen2);
940
941                 c1 = utf8_to_uvuni(tmpbuf1, 0);
942                 c2 = utf8_to_uvuni(tmpbuf2, 0);
943             }
944             else {
945                 c1 = *(U8*)m;
946                 c2 = PL_fold[c1];
947             }
948             goto do_exactf;
949         case EXACTFL:
950             m = STRING(c);
951             ln = STR_LEN(c);
952             c1 = *(U8*)m;
953             c2 = PL_fold_locale[c1];
954           do_exactf:
955             e = strend - ln;
956
957             if (norun && e < s)
958                 e = s;                  /* Due to minlen logic of intuit() */
959
960             if (do_utf8) {
961                 STRLEN len;
962                 /* The ibcmp_utf8() uses to_uni_fold() which is more
963                  * correct folding for Unicode than using lowercase.
964                  * However, it doesn't work quite fully since the folding
965                  * is a one-to-many mapping and the regex optimizer is
966                  * unaware of this, so it may throw out good matches.
967                  * Fortunately, not getting this right is allowed
968                  * for Unicode Regular Expression Support level 1,
969                  * only one-to-one matching is required. --jhi */
970                 if (c1 == c2)
971                     while (s <= e) {
972                         if ( utf8_to_uvchr((U8*)s, &len) == c1
973                              && (ln == 1 ||
974                                  ibcmp_utf8(s, do_utf8, m, UTF, ln)) )
975                             goto got_it;
976                         s += len;
977                     }
978                 else
979                     while (s <= e) {
980                         UV c = utf8_to_uvchr((U8*)s, &len);
981                         if ( (c == c1 || c == c2)
982                              && (ln == 1 ||
983                                  ibcmp_utf8(s, do_utf8, m, UTF, ln)) )
984                             goto got_it;
985                         s += len;
986                     }
987             }
988             else {
989                 if (c1 == c2)
990                     while (s <= e) {
991                         if ( *(U8*)s == c1
992                              && (ln == 1 || !(OP(c) == EXACTF
993                                               ? ibcmp(s, m, ln)
994                                               : ibcmp_locale(s, m, ln)))
995                              && (norun || regtry(prog, s)) )
996                             goto got_it;
997                         s++;
998                     }
999                 else
1000                     while (s <= e) {
1001                         if ( (*(U8*)s == c1 || *(U8*)s == c2)
1002                              && (ln == 1 || !(OP(c) == EXACTF
1003                                               ? ibcmp(s, m, ln)
1004                                               : ibcmp_locale(s, m, ln)))
1005                              && (norun || regtry(prog, s)) )
1006                             goto got_it;
1007                         s++;
1008                     }
1009             }
1010             break;
1011         case BOUNDL:
1012             PL_reg_flags |= RF_tainted;
1013             /* FALL THROUGH */
1014         case BOUND:
1015             if (do_utf8) {
1016                 if (s == PL_bostr)
1017                     tmp = '\n';
1018                 else {
1019                     U8 *r = reghop3((U8*)s, -1, (U8*)startpos);
1020                 
1021                     if (s > (char*)r)
1022                         tmp = (I32)utf8n_to_uvchr(r, s - (char*)r, 0, 0);
1023                 }
1024                 tmp = ((OP(c) == BOUND ?
1025                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1026                 LOAD_UTF8_CHARCLASS(alnum,"a");
1027                 while (s < strend) {
1028                     if (tmp == !(OP(c) == BOUND ?
1029                                  swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1030                                  isALNUM_LC_utf8((U8*)s)))
1031                     {
1032                         tmp = !tmp;
1033                         if ((norun || regtry(prog, s)))
1034                             goto got_it;
1035                     }
1036                     s += UTF8SKIP(s);
1037                 }
1038             }
1039             else {
1040                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1041                 tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1042                 while (s < strend) {
1043                     if (tmp ==
1044                         !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
1045                         tmp = !tmp;
1046                         if ((norun || regtry(prog, s)))
1047                             goto got_it;
1048                     }
1049                     s++;
1050                 }
1051             }
1052             if ((!prog->minlen && tmp) && (norun || regtry(prog, s)))
1053                 goto got_it;
1054             break;
1055         case NBOUNDL:
1056             PL_reg_flags |= RF_tainted;
1057             /* FALL THROUGH */
1058         case NBOUND:
1059             if (do_utf8) {
1060                 if (s == PL_bostr)
1061                     tmp = '\n';
1062                 else {
1063                     U8 *r = reghop3((U8*)s, -1, (U8*)startpos);
1064                 
1065                     if (s > (char*)r)
1066                         tmp = (I32)utf8n_to_uvchr(r, s - (char*)r, 0, 0);
1067                 }
1068                 tmp = ((OP(c) == NBOUND ?
1069                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1070                 LOAD_UTF8_CHARCLASS(alnum,"a");
1071                 while (s < strend) {
1072                     if (tmp == !(OP(c) == NBOUND ?
1073                                  swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1074                                  isALNUM_LC_utf8((U8*)s)))
1075                         tmp = !tmp;
1076                     else if ((norun || regtry(prog, s)))
1077                         goto got_it;
1078                     s += UTF8SKIP(s);
1079                 }
1080             }
1081             else {
1082                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1083                 tmp = ((OP(c) == NBOUND ?
1084                         isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1085                 while (s < strend) {
1086                     if (tmp ==
1087                         !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
1088                         tmp = !tmp;
1089                     else if ((norun || regtry(prog, s)))
1090                         goto got_it;
1091                     s++;
1092                 }
1093             }
1094             if ((!prog->minlen && !tmp) && (norun || regtry(prog, s)))
1095                 goto got_it;
1096             break;
1097         case ALNUM:
1098             if (do_utf8) {
1099                 LOAD_UTF8_CHARCLASS(alnum,"a");
1100                 while (s < strend) {
1101                     if (swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) {
1102                         if (tmp && (norun || regtry(prog, s)))
1103                             goto got_it;
1104                         else
1105                             tmp = doevery;
1106                     }
1107                     else
1108                         tmp = 1;
1109                     s += UTF8SKIP(s);
1110                 }
1111             }
1112             else {
1113                 while (s < strend) {
1114                     if (isALNUM(*s)) {
1115                         if (tmp && (norun || regtry(prog, s)))
1116                             goto got_it;
1117                         else
1118                             tmp = doevery;
1119                     }
1120                     else
1121                         tmp = 1;
1122                     s++;
1123                 }
1124             }
1125             break;
1126         case ALNUML:
1127             PL_reg_flags |= RF_tainted;
1128             if (do_utf8) {
1129                 while (s < strend) {
1130                     if (isALNUM_LC_utf8((U8*)s)) {
1131                         if (tmp && (norun || regtry(prog, s)))
1132                             goto got_it;
1133                         else
1134                             tmp = doevery;
1135                     }
1136                     else
1137                         tmp = 1;
1138                     s += UTF8SKIP(s);
1139                 }
1140             }
1141             else {
1142                 while (s < strend) {
1143                     if (isALNUM_LC(*s)) {
1144                         if (tmp && (norun || regtry(prog, s)))
1145                             goto got_it;
1146                         else
1147                             tmp = doevery;
1148                     }
1149                     else
1150                         tmp = 1;
1151                     s++;
1152                 }
1153             }
1154             break;
1155         case NALNUM:
1156             if (do_utf8) {
1157                 LOAD_UTF8_CHARCLASS(alnum,"a");
1158                 while (s < strend) {
1159                     if (!swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) {
1160                         if (tmp && (norun || regtry(prog, s)))
1161                             goto got_it;
1162                         else
1163                             tmp = doevery;
1164                     }
1165                     else
1166                         tmp = 1;
1167                     s += UTF8SKIP(s);
1168                 }
1169             }
1170             else {
1171                 while (s < strend) {
1172                     if (!isALNUM(*s)) {
1173                         if (tmp && (norun || regtry(prog, s)))
1174                             goto got_it;
1175                         else
1176                             tmp = doevery;
1177                     }
1178                     else
1179                         tmp = 1;
1180                     s++;
1181                 }
1182             }
1183             break;
1184         case NALNUML:
1185             PL_reg_flags |= RF_tainted;
1186             if (do_utf8) {
1187                 while (s < strend) {
1188                     if (!isALNUM_LC_utf8((U8*)s)) {
1189                         if (tmp && (norun || regtry(prog, s)))
1190                             goto got_it;
1191                         else
1192                             tmp = doevery;
1193                     }
1194                     else
1195                         tmp = 1;
1196                     s += UTF8SKIP(s);
1197                 }
1198             }
1199             else {
1200                 while (s < strend) {
1201                     if (!isALNUM_LC(*s)) {
1202                         if (tmp && (norun || regtry(prog, s)))
1203                             goto got_it;
1204                         else
1205                             tmp = doevery;
1206                     }
1207                     else
1208                         tmp = 1;
1209                     s++;
1210                 }
1211             }
1212             break;
1213         case SPACE:
1214             if (do_utf8) {
1215                 LOAD_UTF8_CHARCLASS(space," ");
1216                 while (s < strend) {
1217                     if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8)) {
1218                         if (tmp && (norun || regtry(prog, s)))
1219                             goto got_it;
1220                         else
1221                             tmp = doevery;
1222                     }
1223                     else
1224                         tmp = 1;
1225                     s += UTF8SKIP(s);
1226                 }
1227             }
1228             else {
1229                 while (s < strend) {
1230                     if (isSPACE(*s)) {
1231                         if (tmp && (norun || regtry(prog, s)))
1232                             goto got_it;
1233                         else
1234                             tmp = doevery;
1235                     }
1236                     else
1237                         tmp = 1;
1238                     s++;
1239                 }
1240             }
1241             break;
1242         case SPACEL:
1243             PL_reg_flags |= RF_tainted;
1244             if (do_utf8) {
1245                 while (s < strend) {
1246                     if (*s == ' ' || isSPACE_LC_utf8((U8*)s)) {
1247                         if (tmp && (norun || regtry(prog, s)))
1248                             goto got_it;
1249                         else
1250                             tmp = doevery;
1251                     }
1252                     else
1253                         tmp = 1;
1254                     s += UTF8SKIP(s);
1255                 }
1256             }
1257             else {
1258                 while (s < strend) {
1259                     if (isSPACE_LC(*s)) {
1260                         if (tmp && (norun || regtry(prog, s)))
1261                             goto got_it;
1262                         else
1263                             tmp = doevery;
1264                     }
1265                     else
1266                         tmp = 1;
1267                     s++;
1268                 }
1269             }
1270             break;
1271         case NSPACE:
1272             if (do_utf8) {
1273                 LOAD_UTF8_CHARCLASS(space," ");
1274                 while (s < strend) {
1275                     if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8))) {
1276                         if (tmp && (norun || regtry(prog, s)))
1277                             goto got_it;
1278                         else
1279                             tmp = doevery;
1280                     }
1281                     else
1282                         tmp = 1;
1283                     s += UTF8SKIP(s);
1284                 }
1285             }
1286             else {
1287                 while (s < strend) {
1288                     if (!isSPACE(*s)) {
1289                         if (tmp && (norun || regtry(prog, s)))
1290                             goto got_it;
1291                         else
1292                             tmp = doevery;
1293                     }
1294                     else
1295                         tmp = 1;
1296                     s++;
1297                 }
1298             }
1299             break;
1300         case NSPACEL:
1301             PL_reg_flags |= RF_tainted;
1302             if (do_utf8) {
1303                 while (s < strend) {
1304                     if (!(*s == ' ' || isSPACE_LC_utf8((U8*)s))) {
1305                         if (tmp && (norun || regtry(prog, s)))
1306                             goto got_it;
1307                         else
1308                             tmp = doevery;
1309                     }
1310                     else
1311                         tmp = 1;
1312                     s += UTF8SKIP(s);
1313                 }
1314             }
1315             else {
1316                 while (s < strend) {
1317                     if (!isSPACE_LC(*s)) {
1318                         if (tmp && (norun || regtry(prog, s)))
1319                             goto got_it;
1320                         else
1321                             tmp = doevery;
1322                     }
1323                     else
1324                         tmp = 1;
1325                     s++;
1326                 }
1327             }
1328             break;
1329         case DIGIT:
1330             if (do_utf8) {
1331                 LOAD_UTF8_CHARCLASS(digit,"0");
1332                 while (s < strend) {
1333                     if (swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) {
1334                         if (tmp && (norun || regtry(prog, s)))
1335                             goto got_it;
1336                         else
1337                             tmp = doevery;
1338                     }
1339                     else
1340                         tmp = 1;
1341                     s += UTF8SKIP(s);
1342                 }
1343             }
1344             else {
1345                 while (s < strend) {
1346                     if (isDIGIT(*s)) {
1347                         if (tmp && (norun || regtry(prog, s)))
1348                             goto got_it;
1349                         else
1350                             tmp = doevery;
1351                     }
1352                     else
1353                         tmp = 1;
1354                     s++;
1355                 }
1356             }
1357             break;
1358         case DIGITL:
1359             PL_reg_flags |= RF_tainted;
1360             if (do_utf8) {
1361                 while (s < strend) {
1362                     if (isDIGIT_LC_utf8((U8*)s)) {
1363                         if (tmp && (norun || regtry(prog, s)))
1364                             goto got_it;
1365                         else
1366                             tmp = doevery;
1367                     }
1368                     else
1369                         tmp = 1;
1370                     s += UTF8SKIP(s);
1371                 }
1372             }
1373             else {
1374                 while (s < strend) {
1375                     if (isDIGIT_LC(*s)) {
1376                         if (tmp && (norun || regtry(prog, s)))
1377                             goto got_it;
1378                         else
1379                             tmp = doevery;
1380                     }
1381                     else
1382                         tmp = 1;
1383                     s++;
1384                 }
1385             }
1386             break;
1387         case NDIGIT:
1388             if (do_utf8) {
1389                 LOAD_UTF8_CHARCLASS(digit,"0");
1390                 while (s < strend) {
1391                     if (!swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) {
1392                         if (tmp && (norun || regtry(prog, s)))
1393                             goto got_it;
1394                         else
1395                             tmp = doevery;
1396                     }
1397                     else
1398                         tmp = 1;
1399                     s += UTF8SKIP(s);
1400                 }
1401             }
1402             else {
1403                 while (s < strend) {
1404                     if (!isDIGIT(*s)) {
1405                         if (tmp && (norun || regtry(prog, s)))
1406                             goto got_it;
1407                         else
1408                             tmp = doevery;
1409                     }
1410                     else
1411                         tmp = 1;
1412                     s++;
1413                 }
1414             }
1415             break;
1416         case NDIGITL:
1417             PL_reg_flags |= RF_tainted;
1418             if (do_utf8) {
1419                 while (s < strend) {
1420                     if (!isDIGIT_LC_utf8((U8*)s)) {
1421                         if (tmp && (norun || regtry(prog, s)))
1422                             goto got_it;
1423                         else
1424                             tmp = doevery;
1425                     }
1426                     else
1427                         tmp = 1;
1428                     s += UTF8SKIP(s);
1429                 }
1430             }
1431             else {
1432                 while (s < strend) {
1433                     if (!isDIGIT_LC(*s)) {
1434                         if (tmp && (norun || regtry(prog, s)))
1435                             goto got_it;
1436                         else
1437                             tmp = doevery;
1438                     }
1439                     else
1440                         tmp = 1;
1441                     s++;
1442                 }
1443             }
1444             break;
1445         default:
1446             Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
1447             break;
1448         }
1449         return 0;
1450       got_it:
1451         return s;
1452 }
1453
1454 /*
1455  - regexec_flags - match a regexp against a string
1456  */
1457 I32
1458 Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *strend,
1459               char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
1460 /* strend: pointer to null at end of string */
1461 /* strbeg: real beginning of string */
1462 /* minend: end of match must be >=minend after stringarg. */
1463 /* data: May be used for some additional optimizations. */
1464 /* nosave: For optimizations. */
1465 {
1466     register char *s;
1467     register regnode *c;
1468     register char *startpos = stringarg;
1469     I32 minlen;         /* must match at least this many chars */
1470     I32 dontbother = 0; /* how many characters not to try at end */
1471     /* I32 start_shift = 0; */          /* Offset of the start to find
1472                                          constant substr. */            /* CC */
1473     I32 end_shift = 0;                  /* Same for the end. */         /* CC */
1474     I32 scream_pos = -1;                /* Internal iterator of scream. */
1475     char *scream_olds;
1476     SV* oreplsv = GvSV(PL_replgv);
1477     bool do_utf8 = DO_UTF8(sv);
1478 #ifdef DEBUGGING
1479     SV *dsv = PERL_DEBUG_PAD_ZERO(0);
1480 #endif
1481
1482     PL_regcc = 0;
1483
1484     cache_re(prog);
1485 #ifdef DEBUGGING
1486     PL_regnarrate = DEBUG_r_TEST;
1487 #endif
1488
1489     /* Be paranoid... */
1490     if (prog == NULL || startpos == NULL) {
1491         Perl_croak(aTHX_ "NULL regexp parameter");
1492         return 0;
1493     }
1494
1495     minlen = prog->minlen;
1496     if (strend - startpos < minlen) {
1497         DEBUG_r(PerlIO_printf(Perl_debug_log,
1498                               "String too short [regexec_flags]...\n"));
1499         goto phooey;
1500     }
1501
1502     /* Check validity of program. */
1503     if (UCHARAT(prog->program) != REG_MAGIC) {
1504         Perl_croak(aTHX_ "corrupted regexp program");
1505     }
1506
1507     PL_reg_flags = 0;
1508     PL_reg_eval_set = 0;
1509     PL_reg_maxiter = 0;
1510
1511     if (prog->reganch & ROPT_UTF8)
1512         PL_reg_flags |= RF_utf8;
1513
1514     /* Mark beginning of line for ^ and lookbehind. */
1515     PL_regbol = startpos;
1516     PL_bostr  = strbeg;
1517     PL_reg_sv = sv;
1518
1519     /* Mark end of line for $ (and such) */
1520     PL_regeol = strend;
1521
1522     /* see how far we have to get to not match where we matched before */
1523     PL_regtill = startpos+minend;
1524
1525     /* We start without call_cc context.  */
1526     PL_reg_call_cc = 0;
1527
1528     /* If there is a "must appear" string, look for it. */
1529     s = startpos;
1530
1531     if (prog->reganch & ROPT_GPOS_SEEN) { /* Need to have PL_reg_ganch */
1532         MAGIC *mg;
1533
1534         if (flags & REXEC_IGNOREPOS)    /* Means: check only at start */
1535             PL_reg_ganch = startpos;
1536         else if (sv && SvTYPE(sv) >= SVt_PVMG
1537                   && SvMAGIC(sv)
1538                   && (mg = mg_find(sv, PERL_MAGIC_regex_global))
1539                   && mg->mg_len >= 0) {
1540             PL_reg_ganch = strbeg + mg->mg_len; /* Defined pos() */
1541             if (prog->reganch & ROPT_ANCH_GPOS) {
1542                 if (s > PL_reg_ganch)
1543                     goto phooey;
1544                 s = PL_reg_ganch;
1545             }
1546         }
1547         else                            /* pos() not defined */
1548             PL_reg_ganch = strbeg;
1549     }
1550
1551     if (do_utf8 == (UTF!=0) &&
1552         !(flags & REXEC_CHECKED) && prog->check_substr != Nullsv) {
1553         re_scream_pos_data d;
1554
1555         d.scream_olds = &scream_olds;
1556         d.scream_pos = &scream_pos;
1557         s = re_intuit_start(prog, sv, s, strend, flags, &d);
1558         if (!s) {
1559             DEBUG_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
1560             goto phooey;        /* not present */
1561         }
1562     }
1563
1564     DEBUG_r({
1565          char *s   = do_utf8 ? sv_uni_display(dsv, sv, 60, 0) : startpos;
1566          int   len = do_utf8 ? strlen(s) : strend - startpos;
1567          if (!PL_colorset)
1568              reginitcolors();
1569          PerlIO_printf(Perl_debug_log,
1570                        "%sMatching REx%s `%s%.60s%s%s' against `%s%.*s%s%s'\n",
1571                        PL_colors[4],PL_colors[5],PL_colors[0],
1572                        prog->precomp,
1573                        PL_colors[1],
1574                        (strlen(prog->precomp) > 60 ? "..." : ""),
1575                        PL_colors[0],
1576                        (int)(len > 60 ? 60 : len),
1577                        s, PL_colors[1],
1578                        (len > 60 ? "..." : "")
1579               );
1580     });
1581
1582     /* Simplest case:  anchored match need be tried only once. */
1583     /*  [unless only anchor is BOL and multiline is set] */
1584     if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
1585         if (s == startpos && regtry(prog, startpos))
1586             goto got_it;
1587         else if (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
1588                  || (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
1589         {
1590             char *end;
1591
1592             if (minlen)
1593                 dontbother = minlen - 1;
1594             end = HOP3c(strend, -dontbother, strbeg) - 1;
1595             /* for multiline we only have to try after newlines */
1596             if (prog->check_substr) {
1597                 if (s == startpos)
1598                     goto after_try;
1599                 while (1) {
1600                     if (regtry(prog, s))
1601                         goto got_it;
1602                   after_try:
1603                     if (s >= end)
1604                         goto phooey;
1605                     if (prog->reganch & RE_USE_INTUIT) {
1606                         s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
1607                         if (!s)
1608                             goto phooey;
1609                     }
1610                     else
1611                         s++;
1612                 }               
1613             } else {
1614                 if (s > startpos)
1615                     s--;
1616                 while (s < end) {
1617                     if (*s++ == '\n') { /* don't need PL_utf8skip here */
1618                         if (regtry(prog, s))
1619                             goto got_it;
1620                     }
1621                 }               
1622             }
1623         }
1624         goto phooey;
1625     } else if (prog->reganch & ROPT_ANCH_GPOS) {
1626         if (regtry(prog, PL_reg_ganch))
1627             goto got_it;
1628         goto phooey;
1629     }
1630
1631     /* Messy cases:  unanchored match. */
1632     if (prog->anchored_substr && prog->reganch & ROPT_SKIP) {
1633         /* we have /x+whatever/ */
1634         /* it must be a one character string (XXXX Except UTF?) */
1635         char ch = SvPVX(prog->anchored_substr)[0];
1636 #ifdef DEBUGGING
1637         int did_match = 0;
1638 #endif
1639
1640         if (do_utf8) {
1641             while (s < strend) {
1642                 if (*s == ch) {
1643                     DEBUG_r( did_match = 1 );
1644                     if (regtry(prog, s)) goto got_it;
1645                     s += UTF8SKIP(s);
1646                     while (s < strend && *s == ch)
1647                         s += UTF8SKIP(s);
1648                 }
1649                 s += UTF8SKIP(s);
1650             }
1651         }
1652         else {
1653             while (s < strend) {
1654                 if (*s == ch) {
1655                     DEBUG_r( did_match = 1 );
1656                     if (regtry(prog, s)) goto got_it;
1657                     s++;
1658                     while (s < strend && *s == ch)
1659                         s++;
1660                 }
1661                 s++;
1662             }
1663         }
1664         DEBUG_r(if (!did_match)
1665                 PerlIO_printf(Perl_debug_log,
1666                                   "Did not find anchored character...\n")
1667                );
1668     }
1669     /*SUPPRESS 560*/
1670     else if (do_utf8 == (UTF!=0) &&
1671              (prog->anchored_substr != Nullsv
1672               || (prog->float_substr != Nullsv
1673                   && prog->float_max_offset < strend - s))) {
1674         SV *must = prog->anchored_substr
1675             ? prog->anchored_substr : prog->float_substr;
1676         I32 back_max =
1677             prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset;
1678         I32 back_min =
1679             prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset;
1680         char *last = HOP3c(strend,      /* Cannot start after this */
1681                           -(I32)(CHR_SVLEN(must)
1682                                  - (SvTAIL(must) != 0) + back_min), strbeg);
1683         char *last1;            /* Last position checked before */
1684 #ifdef DEBUGGING
1685         int did_match = 0;
1686 #endif
1687
1688         if (s > PL_bostr)
1689             last1 = HOPc(s, -1);
1690         else
1691             last1 = s - 1;      /* bogus */
1692
1693         /* XXXX check_substr already used to find `s', can optimize if
1694            check_substr==must. */
1695         scream_pos = -1;
1696         dontbother = end_shift;
1697         strend = HOPc(strend, -dontbother);
1698         while ( (s <= last) &&
1699                 ((flags & REXEC_SCREAM)
1700                  ? (s = screaminstr(sv, must, HOP3c(s, back_min, strend) - strbeg,
1701                                     end_shift, &scream_pos, 0))
1702                  : (s = fbm_instr((unsigned char*)HOP3(s, back_min, strend),
1703                                   (unsigned char*)strend, must,
1704                                   PL_multiline ? FBMrf_MULTILINE : 0))) ) {
1705             DEBUG_r( did_match = 1 );
1706             if (HOPc(s, -back_max) > last1) {
1707                 last1 = HOPc(s, -back_min);
1708                 s = HOPc(s, -back_max);
1709             }
1710             else {
1711                 char *t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
1712
1713                 last1 = HOPc(s, -back_min);
1714                 s = t;          
1715             }
1716             if (do_utf8) {
1717                 while (s <= last1) {
1718                     if (regtry(prog, s))
1719                         goto got_it;
1720                     s += UTF8SKIP(s);
1721                 }
1722             }
1723             else {
1724                 while (s <= last1) {
1725                     if (regtry(prog, s))
1726                         goto got_it;
1727                     s++;
1728                 }
1729             }
1730         }
1731         DEBUG_r(if (!did_match)
1732                     PerlIO_printf(Perl_debug_log, 
1733                                   "Did not find %s substr `%s%.*s%s'%s...\n",
1734                               ((must == prog->anchored_substr)
1735                                ? "anchored" : "floating"),
1736                               PL_colors[0],
1737                               (int)(SvCUR(must) - (SvTAIL(must)!=0)),
1738                               SvPVX(must),
1739                                   PL_colors[1], (SvTAIL(must) ? "$" : ""))
1740                );
1741         goto phooey;
1742     }
1743     else if ((c = prog->regstclass)) {
1744         if (minlen && PL_regkind[(U8)OP(prog->regstclass)] != EXACT)
1745             /* don't bother with what can't match */
1746             strend = HOPc(strend, -(minlen - 1));
1747         DEBUG_r({
1748             SV *prop = sv_newmortal();
1749             regprop(prop, c);
1750             PerlIO_printf(Perl_debug_log, "Matching stclass `%s' against `%s'\n", SvPVX(prop), UTF ? sv_uni_display(dsv, sv, 60, 0) : s);
1751         });
1752         if (find_byclass(prog, c, s, strend, startpos, 0))
1753             goto got_it;
1754         DEBUG_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass...\n"));
1755     }
1756     else {
1757         dontbother = 0;
1758         if (prog->float_substr != Nullsv) {     /* Trim the end. */
1759             char *last;
1760
1761             if (flags & REXEC_SCREAM) {
1762                 last = screaminstr(sv, prog->float_substr, s - strbeg,
1763                                    end_shift, &scream_pos, 1); /* last one */
1764                 if (!last)
1765                     last = scream_olds; /* Only one occurrence. */
1766             }
1767             else {
1768                 STRLEN len;
1769                 char *little = SvPV(prog->float_substr, len);
1770
1771                 if (SvTAIL(prog->float_substr)) {
1772                     if (memEQ(strend - len + 1, little, len - 1))
1773                         last = strend - len + 1;
1774                     else if (!PL_multiline)
1775                         last = memEQ(strend - len, little, len)
1776                             ? strend - len : Nullch;
1777                     else
1778                         goto find_last;
1779                 } else {
1780                   find_last:
1781                     if (len)
1782                         last = rninstr(s, strend, little, little + len);
1783                     else
1784                         last = strend;  /* matching `$' */
1785                 }
1786             }
1787             if (last == NULL) {
1788                 DEBUG_r(PerlIO_printf(Perl_debug_log,
1789                                       "%sCan't trim the tail, match fails (should not happen)%s\n",
1790                                       PL_colors[4],PL_colors[5]));
1791                 goto phooey; /* Should not happen! */
1792             }
1793             dontbother = strend - last + prog->float_min_offset;
1794         }
1795         if (minlen && (dontbother < minlen))
1796             dontbother = minlen - 1;
1797         strend -= dontbother;              /* this one's always in bytes! */
1798         /* We don't know much -- general case. */
1799         if (do_utf8) {
1800             for (;;) {
1801                 if (regtry(prog, s))
1802                     goto got_it;
1803                 if (s >= strend)
1804                     break;
1805                 s += UTF8SKIP(s);
1806             };
1807         }
1808         else {
1809             do {
1810                 if (regtry(prog, s))
1811                     goto got_it;
1812             } while (s++ < strend);
1813         }
1814     }
1815
1816     /* Failure. */
1817     goto phooey;
1818
1819 got_it:
1820     RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
1821
1822     if (PL_reg_eval_set) {
1823         /* Preserve the current value of $^R */
1824         if (oreplsv != GvSV(PL_replgv))
1825             sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
1826                                                   restored, the value remains
1827                                                   the same. */
1828         restore_pos(aTHX_ 0);
1829     }
1830
1831     /* make sure $`, $&, $', and $digit will work later */
1832     if ( !(flags & REXEC_NOT_FIRST) ) {
1833         if (RX_MATCH_COPIED(prog)) {
1834             Safefree(prog->subbeg);
1835             RX_MATCH_COPIED_off(prog);
1836         }
1837         if (flags & REXEC_COPY_STR) {
1838             I32 i = PL_regeol - startpos + (stringarg - strbeg);
1839
1840             s = savepvn(strbeg, i);
1841             prog->subbeg = s;
1842             prog->sublen = i;
1843             RX_MATCH_COPIED_on(prog);
1844         }
1845         else {
1846             prog->subbeg = strbeg;
1847             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
1848         }
1849     }
1850
1851     return 1;
1852
1853 phooey:
1854     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
1855                           PL_colors[4],PL_colors[5]));
1856     if (PL_reg_eval_set)
1857         restore_pos(aTHX_ 0);
1858     return 0;
1859 }
1860
1861 /*
1862  - regtry - try match at specific point
1863  */
1864 STATIC I32                      /* 0 failure, 1 success */
1865 S_regtry(pTHX_ regexp *prog, char *startpos)
1866 {
1867     register I32 i;
1868     register I32 *sp;
1869     register I32 *ep;
1870     CHECKPOINT lastcp;
1871
1872 #ifdef DEBUGGING
1873     PL_regindent = 0;   /* XXXX Not good when matches are reenterable... */
1874 #endif
1875     if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
1876         MAGIC *mg;
1877
1878         PL_reg_eval_set = RS_init;
1879         DEBUG_r(DEBUG_s(
1880             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %"IVdf"\n",
1881                           (IV)(PL_stack_sp - PL_stack_base));
1882             ));
1883         SAVEI32(cxstack[cxstack_ix].blk_oldsp);
1884         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
1885         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
1886         SAVETMPS;
1887         /* Apparently this is not needed, judging by wantarray. */
1888         /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
1889            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
1890
1891         if (PL_reg_sv) {
1892             /* Make $_ available to executed code. */
1893             if (PL_reg_sv != DEFSV) {
1894                 /* SAVE_DEFSV does *not* suffice here for USE_5005THREADS */
1895                 SAVESPTR(DEFSV);
1896                 DEFSV = PL_reg_sv;
1897             }
1898         
1899             if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv)
1900                   && (mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global)))) {
1901                 /* prepare for quick setting of pos */
1902                 sv_magic(PL_reg_sv, (SV*)0,
1903                         PERL_MAGIC_regex_global, Nullch, 0);
1904                 mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global);
1905                 mg->mg_len = -1;
1906             }
1907             PL_reg_magic    = mg;
1908             PL_reg_oldpos   = mg->mg_len;
1909             SAVEDESTRUCTOR_X(restore_pos, 0);
1910         }
1911         if (!PL_reg_curpm) {
1912             Newz(22,PL_reg_curpm, 1, PMOP);
1913 #ifdef USE_ITHREADS
1914             {
1915                 SV* repointer = newSViv(0);
1916                 /* so we know which PL_regex_padav element is PL_reg_curpm */
1917                 SvFLAGS(repointer) |= SVf_BREAK;
1918                 av_push(PL_regex_padav,repointer);
1919                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
1920                 PL_regex_pad = AvARRAY(PL_regex_padav);
1921             }
1922 #endif      
1923         }
1924         PM_SETRE(PL_reg_curpm, prog);
1925         PL_reg_oldcurpm = PL_curpm;
1926         PL_curpm = PL_reg_curpm;
1927         if (RX_MATCH_COPIED(prog)) {
1928             /*  Here is a serious problem: we cannot rewrite subbeg,
1929                 since it may be needed if this match fails.  Thus
1930                 $` inside (?{}) could fail... */
1931             PL_reg_oldsaved = prog->subbeg;
1932             PL_reg_oldsavedlen = prog->sublen;
1933             RX_MATCH_COPIED_off(prog);
1934         }
1935         else
1936             PL_reg_oldsaved = Nullch;
1937         prog->subbeg = PL_bostr;
1938         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
1939     }
1940     prog->startp[0] = startpos - PL_bostr;
1941     PL_reginput = startpos;
1942     PL_regstartp = prog->startp;
1943     PL_regendp = prog->endp;
1944     PL_reglastparen = &prog->lastparen;
1945     PL_reglastcloseparen = &prog->lastcloseparen;
1946     prog->lastparen = 0;
1947     PL_regsize = 0;
1948     DEBUG_r(PL_reg_starttry = startpos);
1949     if (PL_reg_start_tmpl <= prog->nparens) {
1950         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
1951         if(PL_reg_start_tmp)
1952             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
1953         else
1954             New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*);
1955     }
1956
1957 #ifdef DEBUGGING
1958     sv_setpvn(PERL_DEBUG_PAD(0), "", 0);
1959     sv_setpvn(PERL_DEBUG_PAD(1), "", 0);
1960     sv_setpvn(PERL_DEBUG_PAD(2), "", 0);
1961 #endif
1962
1963     /* XXXX What this code is doing here?!!!  There should be no need
1964        to do this again and again, PL_reglastparen should take care of
1965        this!  --ilya*/
1966
1967     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
1968      * Actually, the code in regcppop() (which Ilya may be meaning by
1969      * PL_reglastparen), is not needed at all by the test suite
1970      * (op/regexp, op/pat, op/split), but that code is needed, oddly
1971      * enough, for building DynaLoader, or otherwise this
1972      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
1973      * will happen.  Meanwhile, this code *is* needed for the
1974      * above-mentioned test suite tests to succeed.  The common theme
1975      * on those tests seems to be returning null fields from matches.
1976      * --jhi */
1977 #if 1
1978     sp = prog->startp;
1979     ep = prog->endp;
1980     if (prog->nparens) {
1981         for (i = prog->nparens; i > *PL_reglastparen; i--) {
1982             *++sp = -1;
1983             *++ep = -1;
1984         }
1985     }
1986 #endif
1987     REGCP_SET(lastcp);
1988     if (regmatch(prog->program + 1)) {
1989         prog->endp[0] = PL_reginput - PL_bostr;
1990         return 1;
1991     }
1992     REGCP_UNWIND(lastcp);
1993     return 0;
1994 }
1995
1996 #define RE_UNWIND_BRANCH        1
1997 #define RE_UNWIND_BRANCHJ       2
1998
1999 union re_unwind_t;
2000
2001 typedef struct {                /* XX: makes sense to enlarge it... */
2002     I32 type;
2003     I32 prev;
2004     CHECKPOINT lastcp;
2005 } re_unwind_generic_t;
2006
2007 typedef struct {
2008     I32 type;
2009     I32 prev;
2010     CHECKPOINT lastcp;
2011     I32 lastparen;
2012     regnode *next;
2013     char *locinput;
2014     I32 nextchr;
2015 #ifdef DEBUGGING
2016     int regindent;
2017 #endif
2018 } re_unwind_branch_t;
2019
2020 typedef union re_unwind_t {
2021     I32 type;
2022     re_unwind_generic_t generic;
2023     re_unwind_branch_t branch;
2024 } re_unwind_t;
2025
2026 #define sayYES goto yes
2027 #define sayNO goto no
2028 #define sayYES_FINAL goto yes_final
2029 #define sayYES_LOUD  goto yes_loud
2030 #define sayNO_FINAL  goto no_final
2031 #define sayNO_SILENT goto do_no
2032 #define saySAME(x) if (x) goto yes; else goto no
2033
2034 #define REPORT_CODE_OFF 24
2035
2036 /*
2037  - regmatch - main matching routine
2038  *
2039  * Conceptually the strategy is simple:  check to see whether the current
2040  * node matches, call self recursively to see whether the rest matches,
2041  * and then act accordingly.  In practice we make some effort to avoid
2042  * recursion, in particular by going through "ordinary" nodes (that don't
2043  * need to know whether the rest of the match failed) by a loop instead of
2044  * by recursion.
2045  */
2046 /* [lwall] I've hoisted the register declarations to the outer block in order to
2047  * maybe save a little bit of pushing and popping on the stack.  It also takes
2048  * advantage of machines that use a register save mask on subroutine entry.
2049  */
2050 STATIC I32                      /* 0 failure, 1 success */
2051 S_regmatch(pTHX_ regnode *prog)
2052 {
2053     register regnode *scan;     /* Current node. */
2054     regnode *next;              /* Next node. */
2055     regnode *inner;             /* Next node in internal branch. */
2056     register I32 nextchr;       /* renamed nextchr - nextchar colides with
2057                                    function of same name */
2058     register I32 n;             /* no or next */
2059     register I32 ln = 0;        /* len or last */
2060     register char *s = Nullch;  /* operand or save */
2061     register char *locinput = PL_reginput;
2062     register I32 c1 = 0, c2 = 0, paren; /* case fold search, parenth */
2063     int minmod = 0, sw = 0, logical = 0;
2064     I32 unwind = 0;
2065 #if 0
2066     I32 firstcp = PL_savestack_ix;
2067 #endif
2068     register bool do_utf8 = PL_reg_match_utf8;
2069 #ifdef DEBUGGING
2070     SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
2071     SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
2072     SV *dsv2 = PERL_DEBUG_PAD_ZERO(2);
2073 #endif
2074
2075 #ifdef DEBUGGING
2076     PL_regindent++;
2077 #endif
2078
2079     /* Note that nextchr is a byte even in UTF */
2080     nextchr = UCHARAT(locinput);
2081     scan = prog;
2082     while (scan != NULL) {
2083
2084         DEBUG_r( {
2085             SV *prop = sv_newmortal();
2086             int docolor = *PL_colors[0];
2087             int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
2088             int l = (PL_regeol - locinput) > taill ? taill : (PL_regeol - locinput);
2089             /* The part of the string before starttry has one color
2090                (pref0_len chars), between starttry and current
2091                position another one (pref_len - pref0_len chars),
2092                after the current position the third one.
2093                We assume that pref0_len <= pref_len, otherwise we
2094                decrease pref0_len.  */
2095             int pref_len = (locinput - PL_bostr) > (5 + taill) - l
2096                 ? (5 + taill) - l : locinput - PL_bostr;
2097             int pref0_len;
2098
2099             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
2100                 pref_len++;
2101             pref0_len = pref_len  - (locinput - PL_reg_starttry);
2102             if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
2103                 l = ( PL_regeol - locinput > (5 + taill) - pref_len
2104                       ? (5 + taill) - pref_len : PL_regeol - locinput);
2105             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
2106                 l--;
2107             if (pref0_len < 0)
2108                 pref0_len = 0;
2109             if (pref0_len > pref_len)
2110                 pref0_len = pref_len;
2111             regprop(prop, scan);
2112             {
2113               char *s0 =
2114                 do_utf8 ?
2115                 pv_uni_display(dsv0, (U8*)(locinput - pref_len),
2116                                pref0_len, 60, 0) :
2117                 locinput - pref_len;
2118               int len0 = do_utf8 ? strlen(s0) : pref0_len;
2119               char *s1 = do_utf8 ?
2120                 pv_uni_display(dsv1, (U8*)(locinput - pref_len + pref0_len),
2121                                pref_len - pref0_len, 60, 0) :
2122                 locinput - pref_len + pref0_len;
2123               int len1 = do_utf8 ? strlen(s1) : pref_len - pref0_len;
2124               char *s2 = do_utf8 ?
2125                 pv_uni_display(dsv2, (U8*)locinput,
2126                                PL_regeol - locinput, 60, 0) :
2127                 locinput;
2128               int len2 = do_utf8 ? strlen(s2) : l;
2129               PerlIO_printf(Perl_debug_log,
2130                             "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n",
2131                             (IV)(locinput - PL_bostr),
2132                             PL_colors[4],
2133                             len0, s0,
2134                             PL_colors[5],
2135                             PL_colors[2],
2136                             len1, s1,
2137                             PL_colors[3],
2138                             (docolor ? "" : "> <"),
2139                             PL_colors[0],
2140                             len2, s2,
2141                             PL_colors[1],
2142                             15 - l - pref_len + 1,
2143                             "",
2144                             (IV)(scan - PL_regprogram), PL_regindent*2, "",
2145                             SvPVX(prop));
2146             }
2147         });
2148
2149         next = scan + NEXT_OFF(scan);
2150         if (next == scan)
2151             next = NULL;
2152
2153         switch (OP(scan)) {
2154         case BOL:
2155             if (locinput == PL_bostr || (PL_multiline &&
2156                 (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
2157             {
2158                 /* regtill = regbol; */
2159                 break;
2160             }
2161             sayNO;
2162         case MBOL:
2163             if (locinput == PL_bostr ||
2164                 ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n'))
2165             {
2166                 break;
2167             }
2168             sayNO;
2169         case SBOL:
2170             if (locinput == PL_bostr)
2171                 break;
2172             sayNO;
2173         case GPOS:
2174             if (locinput == PL_reg_ganch)
2175                 break;
2176             sayNO;
2177         case EOL:
2178             if (PL_multiline)
2179                 goto meol;
2180             else
2181                 goto seol;
2182         case MEOL:
2183           meol:
2184             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2185                 sayNO;
2186             break;
2187         case SEOL:
2188           seol:
2189             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2190                 sayNO;
2191             if (PL_regeol - locinput > 1)
2192                 sayNO;
2193             break;
2194         case EOS:
2195             if (PL_regeol != locinput)
2196                 sayNO;
2197             break;
2198         case SANY:
2199             if (!nextchr && locinput >= PL_regeol)
2200                 sayNO;
2201             if (do_utf8) {
2202                 locinput += PL_utf8skip[nextchr];
2203                 if (locinput > PL_regeol)
2204                     sayNO;
2205                 nextchr = UCHARAT(locinput);
2206             }
2207             else
2208                 nextchr = UCHARAT(++locinput);
2209             break;
2210         case CANY:
2211             if (!nextchr && locinput >= PL_regeol)
2212                 sayNO;
2213             nextchr = UCHARAT(++locinput);
2214             break;
2215         case REG_ANY:
2216             if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
2217                 sayNO;
2218             if (do_utf8) {
2219                 locinput += PL_utf8skip[nextchr];
2220                 if (locinput > PL_regeol)
2221                     sayNO;
2222                 nextchr = UCHARAT(locinput);
2223             }
2224             else
2225                 nextchr = UCHARAT(++locinput);
2226             break;
2227         case EXACT:
2228             s = STRING(scan);
2229             ln = STR_LEN(scan);
2230             if (do_utf8 != (UTF!=0)) {
2231                 /* The target and the pattern have differing "utf8ness". */
2232                 char *l = locinput;
2233                 char *e = s + ln;
2234                 STRLEN len;
2235
2236                 if (do_utf8) {
2237                     /* The target is utf8, the pattern is not utf8. */
2238                     while (s < e) {
2239                         if (l >= PL_regeol)
2240                              sayNO;
2241                         if (NATIVE_TO_UNI(*(U8*)s) !=
2242                             utf8_to_uvchr((U8*)l, &len))
2243                              sayNO;
2244                         l += len;
2245                         s ++;
2246                     }
2247                 }
2248                 else {
2249                     /* The target is not utf8, the pattern is utf8. */
2250                     while (s < e) {
2251                         if (l >= PL_regeol)
2252                             sayNO;
2253                         if (NATIVE_TO_UNI(*((U8*)l)) !=
2254                             utf8_to_uvchr((U8*)s, &len))
2255                             sayNO;
2256                         s += len;
2257                         l ++;
2258                     }
2259                 }
2260                 locinput = l;
2261                 nextchr = UCHARAT(locinput);
2262                 break;
2263             }
2264             /* The target and the pattern have the same "utf8ness". */
2265             /* Inline the first character, for speed. */
2266             if (UCHARAT(s) != nextchr)
2267                 sayNO;
2268             if (PL_regeol - locinput < ln)
2269                 sayNO;
2270             if (ln > 1 && memNE(s, locinput, ln))
2271                 sayNO;
2272             locinput += ln;
2273             nextchr = UCHARAT(locinput);
2274             break;
2275         case EXACTFL:
2276             PL_reg_flags |= RF_tainted;
2277             /* FALL THROUGH */
2278         case EXACTF:
2279             s = STRING(scan);
2280             ln = STR_LEN(scan);
2281
2282             if (do_utf8) {
2283                 char *l = locinput;
2284                 char *e;
2285                 STRLEN ulen;
2286                 U8 tmpbuf[UTF8_MAXLEN*2+1];
2287                 e = s + ln;
2288                 while (s < e) {
2289                     if (l >= PL_regeol)
2290                         sayNO;
2291                     toLOWER_utf8((U8*)l, tmpbuf, &ulen);
2292                     if (memNE(s, (char*)tmpbuf, ulen))
2293                         sayNO;
2294                     s += UTF8SKIP(s);
2295                     l += ulen;
2296                 }
2297                 locinput = l;
2298                 nextchr = UCHARAT(locinput);
2299                 break;
2300             }
2301
2302             /* Inline the first character, for speed. */
2303             if (UCHARAT(s) != nextchr &&
2304                 UCHARAT(s) != ((OP(scan) == EXACTF)
2305                                ? PL_fold : PL_fold_locale)[nextchr])
2306                 sayNO;
2307             if (PL_regeol - locinput < ln)
2308                 sayNO;
2309             if (ln > 1 && (OP(scan) == EXACTF
2310                            ? ibcmp(s, locinput, ln)
2311                            : ibcmp_locale(s, locinput, ln)))
2312                 sayNO;
2313             locinput += ln;
2314             nextchr = UCHARAT(locinput);
2315             break;
2316         case ANYOF:
2317             if (do_utf8) {
2318                 if (!reginclass(scan, (U8*)locinput, do_utf8))
2319                     sayNO;
2320                 if (locinput >= PL_regeol)
2321                     sayNO;
2322                 locinput += PL_utf8skip[nextchr];
2323                 nextchr = UCHARAT(locinput);
2324             }
2325             else {
2326                 if (nextchr < 0)
2327                     nextchr = UCHARAT(locinput);
2328                 if (!reginclass(scan, (U8*)locinput, do_utf8))
2329                     sayNO;
2330                 if (!nextchr && locinput >= PL_regeol)
2331                     sayNO;
2332                 nextchr = UCHARAT(++locinput);
2333             }
2334             break;
2335         case ALNUML:
2336             PL_reg_flags |= RF_tainted;
2337             /* FALL THROUGH */
2338         case ALNUM:
2339             if (!nextchr)
2340                 sayNO;
2341             if (do_utf8) {
2342                 LOAD_UTF8_CHARCLASS(alnum,"a");
2343                 if (!(OP(scan) == ALNUM
2344                       ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2345                       : isALNUM_LC_utf8((U8*)locinput)))
2346                 {
2347                     sayNO;
2348                 }
2349                 locinput += PL_utf8skip[nextchr];
2350                 nextchr = UCHARAT(locinput);
2351                 break;
2352             }
2353             if (!(OP(scan) == ALNUM
2354                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
2355                 sayNO;
2356             nextchr = UCHARAT(++locinput);
2357             break;
2358         case NALNUML:
2359             PL_reg_flags |= RF_tainted;
2360             /* FALL THROUGH */
2361         case NALNUM:
2362             if (!nextchr && locinput >= PL_regeol)
2363                 sayNO;
2364             if (do_utf8) {
2365                 LOAD_UTF8_CHARCLASS(alnum,"a");
2366                 if (OP(scan) == NALNUM
2367                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2368                     : isALNUM_LC_utf8((U8*)locinput))
2369                 {
2370                     sayNO;
2371                 }
2372                 locinput += PL_utf8skip[nextchr];
2373                 nextchr = UCHARAT(locinput);
2374                 break;
2375             }
2376             if (OP(scan) == NALNUM
2377                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
2378                 sayNO;
2379             nextchr = UCHARAT(++locinput);
2380             break;
2381         case BOUNDL:
2382         case NBOUNDL:
2383             PL_reg_flags |= RF_tainted;
2384             /* FALL THROUGH */
2385         case BOUND:
2386         case NBOUND:
2387             /* was last char in word? */
2388             if (do_utf8) {
2389                 if (locinput == PL_bostr)
2390                     ln = '\n';
2391                 else {
2392                     U8 *r = reghop((U8*)locinput, -1);
2393                 
2394                     ln = utf8n_to_uvchr(r, s - (char*)r, 0, 0);
2395                 }
2396                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2397                     ln = isALNUM_uni(ln);
2398                     LOAD_UTF8_CHARCLASS(alnum,"a");
2399                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
2400                 }
2401                 else {
2402                     ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
2403                     n = isALNUM_LC_utf8((U8*)locinput);
2404                 }
2405             }
2406             else {
2407                 ln = (locinput != PL_bostr) ?
2408                     UCHARAT(locinput - 1) : '\n';
2409                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2410                     ln = isALNUM(ln);
2411                     n = isALNUM(nextchr);
2412                 }
2413                 else {
2414                     ln = isALNUM_LC(ln);
2415                     n = isALNUM_LC(nextchr);
2416                 }
2417             }
2418             if (((!ln) == (!n)) == (OP(scan) == BOUND ||
2419                                     OP(scan) == BOUNDL))
2420                     sayNO;
2421             break;
2422         case SPACEL:
2423             PL_reg_flags |= RF_tainted;
2424             /* FALL THROUGH */
2425         case SPACE:
2426             if (!nextchr)
2427                 sayNO;
2428             if (do_utf8) {
2429                 if (UTF8_IS_CONTINUED(nextchr)) {
2430                     LOAD_UTF8_CHARCLASS(space," ");
2431                     if (!(OP(scan) == SPACE
2432                           ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
2433                           : isSPACE_LC_utf8((U8*)locinput)))
2434                     {
2435                         sayNO;
2436                     }
2437                     locinput += PL_utf8skip[nextchr];
2438                     nextchr = UCHARAT(locinput);
2439                     break;
2440                 }
2441                 if (!(OP(scan) == SPACE
2442                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
2443                     sayNO;
2444                 nextchr = UCHARAT(++locinput);
2445             }
2446             else {
2447                 if (!(OP(scan) == SPACE
2448                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
2449                     sayNO;
2450                 nextchr = UCHARAT(++locinput);
2451             }
2452             break;
2453         case NSPACEL:
2454             PL_reg_flags |= RF_tainted;
2455             /* FALL THROUGH */
2456         case NSPACE:
2457             if (!nextchr && locinput >= PL_regeol)
2458                 sayNO;
2459             if (do_utf8) {
2460                 LOAD_UTF8_CHARCLASS(space," ");
2461                 if (OP(scan) == NSPACE
2462                     ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
2463                     : isSPACE_LC_utf8((U8*)locinput))
2464                 {
2465                     sayNO;
2466                 }
2467                 locinput += PL_utf8skip[nextchr];
2468                 nextchr = UCHARAT(locinput);
2469                 break;
2470             }
2471             if (OP(scan) == NSPACE
2472                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
2473                 sayNO;
2474             nextchr = UCHARAT(++locinput);
2475             break;
2476         case DIGITL:
2477             PL_reg_flags |= RF_tainted;
2478             /* FALL THROUGH */
2479         case DIGIT:
2480             if (!nextchr)
2481                 sayNO;
2482             if (do_utf8) {
2483                 LOAD_UTF8_CHARCLASS(digit,"0");
2484                 if (!(OP(scan) == DIGIT
2485                       ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
2486                       : isDIGIT_LC_utf8((U8*)locinput)))
2487                 {
2488                     sayNO;
2489                 }
2490                 locinput += PL_utf8skip[nextchr];
2491                 nextchr = UCHARAT(locinput);
2492                 break;
2493             }
2494             if (!(OP(scan) == DIGIT
2495                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
2496                 sayNO;
2497             nextchr = UCHARAT(++locinput);
2498             break;
2499         case NDIGITL:
2500             PL_reg_flags |= RF_tainted;
2501             /* FALL THROUGH */
2502         case NDIGIT:
2503             if (!nextchr && locinput >= PL_regeol)
2504                 sayNO;
2505             if (do_utf8) {
2506                 LOAD_UTF8_CHARCLASS(digit,"0");
2507                 if (OP(scan) == NDIGIT
2508                     ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
2509                     : isDIGIT_LC_utf8((U8*)locinput))
2510                 {
2511                     sayNO;
2512                 }
2513                 locinput += PL_utf8skip[nextchr];
2514                 nextchr = UCHARAT(locinput);
2515                 break;
2516             }
2517             if (OP(scan) == NDIGIT
2518                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
2519                 sayNO;
2520             nextchr = UCHARAT(++locinput);
2521             break;
2522         case CLUMP:
2523             LOAD_UTF8_CHARCLASS(mark,"~");
2524             if (locinput >= PL_regeol ||
2525                 swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
2526                 sayNO;
2527             locinput += PL_utf8skip[nextchr];
2528             while (locinput < PL_regeol &&
2529                    swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
2530                 locinput += UTF8SKIP(locinput);
2531             if (locinput > PL_regeol)
2532                 sayNO;
2533             nextchr = UCHARAT(locinput);
2534             break;
2535         case REFFL:
2536             PL_reg_flags |= RF_tainted;
2537             /* FALL THROUGH */
2538         case REF:
2539         case REFF:
2540             n = ARG(scan);  /* which paren pair */
2541             ln = PL_regstartp[n];
2542             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2543             if (*PL_reglastparen < n || ln == -1)
2544                 sayNO;                  /* Do not match unless seen CLOSEn. */
2545             if (ln == PL_regendp[n])
2546                 break;
2547
2548             s = PL_bostr + ln;
2549             if (do_utf8 && OP(scan) != REF) {   /* REF can do byte comparison */
2550                 char *l = locinput;
2551                 char *e = PL_bostr + PL_regendp[n];
2552                 /*
2553                  * Note that we can't do the "other character" lookup trick as
2554                  * in the 8-bit case (no pun intended) because in Unicode we
2555                  * have to map both upper and title case to lower case.
2556                  */
2557                 if (OP(scan) == REFF) {
2558                     STRLEN ulen1, ulen2;
2559                     U8 tmpbuf1[UTF8_MAXLEN*2+1];
2560                     U8 tmpbuf2[UTF8_MAXLEN*2+1];
2561                     while (s < e) {
2562                         if (l >= PL_regeol)
2563                             sayNO;
2564                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
2565                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
2566                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
2567                             sayNO;
2568                         s += ulen1;
2569                         l += ulen2;
2570                     }
2571                 }
2572                 locinput = l;
2573                 nextchr = UCHARAT(locinput);
2574                 break;
2575             }
2576
2577             /* Inline the first character, for speed. */
2578             if (UCHARAT(s) != nextchr &&
2579                 (OP(scan) == REF ||
2580                  (UCHARAT(s) != ((OP(scan) == REFF
2581                                   ? PL_fold : PL_fold_locale)[nextchr]))))
2582                 sayNO;
2583             ln = PL_regendp[n] - ln;
2584             if (locinput + ln > PL_regeol)
2585                 sayNO;
2586             if (ln > 1 && (OP(scan) == REF
2587                            ? memNE(s, locinput, ln)
2588                            : (OP(scan) == REFF
2589                               ? ibcmp(s, locinput, ln)
2590                               : ibcmp_locale(s, locinput, ln))))
2591                 sayNO;
2592             locinput += ln;
2593             nextchr = UCHARAT(locinput);
2594             break;
2595
2596         case NOTHING:
2597         case TAIL:
2598             break;
2599         case BACK:
2600             break;
2601         case EVAL:
2602         {
2603             dSP;
2604             OP_4tree *oop = PL_op;
2605             COP *ocurcop = PL_curcop;
2606             SV **ocurpad = PL_curpad;
2607             SV *ret;
2608         
2609             n = ARG(scan);
2610             PL_op = (OP_4tree*)PL_regdata->data[n];
2611             DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
2612             PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 2]);
2613             PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
2614
2615             {
2616                 SV **before = SP;
2617                 CALLRUNOPS(aTHX);                       /* Scalar context. */
2618                 SPAGAIN;
2619                 if (SP == before)
2620                     ret = Nullsv;   /* protect against empty (?{}) blocks. */
2621                 else {
2622                     ret = POPs;
2623                     PUTBACK;
2624                 }
2625             }
2626
2627             PL_op = oop;
2628             PL_curpad = ocurpad;
2629             PL_curcop = ocurcop;
2630             if (logical) {
2631                 if (logical == 2) {     /* Postponed subexpression. */
2632                     regexp *re;
2633                     MAGIC *mg = Null(MAGIC*);
2634                     re_cc_state state;
2635                     CHECKPOINT cp, lastcp;
2636
2637                     if(SvROK(ret) || SvRMAGICAL(ret)) {
2638                         SV *sv = SvROK(ret) ? SvRV(ret) : ret;
2639
2640                         if(SvMAGICAL(sv))
2641                             mg = mg_find(sv, PERL_MAGIC_qr);
2642                     }
2643                     if (mg) {
2644                         re = (regexp *)mg->mg_obj;
2645                         (void)ReREFCNT_inc(re);
2646                     }
2647                     else {
2648                         STRLEN len;
2649                         char *t = SvPV(ret, len);
2650                         PMOP pm;
2651                         char *oprecomp = PL_regprecomp;
2652                         I32 osize = PL_regsize;
2653                         I32 onpar = PL_regnpar;
2654
2655                         Zero(&pm, 1, PMOP);
2656                         re = CALLREGCOMP(aTHX_ t, t + len, &pm);
2657                         if (!(SvFLAGS(ret)
2658                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)))
2659                             sv_magic(ret,(SV*)ReREFCNT_inc(re),
2660                                         PERL_MAGIC_qr,0,0);
2661                         PL_regprecomp = oprecomp;
2662                         PL_regsize = osize;
2663                         PL_regnpar = onpar;
2664                     }
2665                     DEBUG_r(
2666                         PerlIO_printf(Perl_debug_log,
2667                                       "Entering embedded `%s%.60s%s%s'\n",
2668                                       PL_colors[0],
2669                                       re->precomp,
2670                                       PL_colors[1],
2671                                       (strlen(re->precomp) > 60 ? "..." : ""))
2672                         );
2673                     state.node = next;
2674                     state.prev = PL_reg_call_cc;
2675                     state.cc = PL_regcc;
2676                     state.re = PL_reg_re;
2677
2678                     PL_regcc = 0;
2679                 
2680                     cp = regcppush(0);  /* Save *all* the positions. */
2681                     REGCP_SET(lastcp);
2682                     cache_re(re);
2683                     state.ss = PL_savestack_ix;
2684                     *PL_reglastparen = 0;
2685                     *PL_reglastcloseparen = 0;
2686                     PL_reg_call_cc = &state;
2687                     PL_reginput = locinput;
2688
2689                     /* XXXX This is too dramatic a measure... */
2690                     PL_reg_maxiter = 0;
2691
2692                     if (regmatch(re->program + 1)) {
2693                         /* Even though we succeeded, we need to restore
2694                            global variables, since we may be wrapped inside
2695                            SUSPEND, thus the match may be not finished yet. */
2696
2697                         /* XXXX Do this only if SUSPENDed? */
2698                         PL_reg_call_cc = state.prev;
2699                         PL_regcc = state.cc;
2700                         PL_reg_re = state.re;
2701                         cache_re(PL_reg_re);
2702
2703                         /* XXXX This is too dramatic a measure... */
2704                         PL_reg_maxiter = 0;
2705
2706                         /* These are needed even if not SUSPEND. */
2707                         ReREFCNT_dec(re);
2708                         regcpblow(cp);
2709                         sayYES;
2710                     }
2711                     ReREFCNT_dec(re);
2712                     REGCP_UNWIND(lastcp);
2713                     regcppop();
2714                     PL_reg_call_cc = state.prev;
2715                     PL_regcc = state.cc;
2716                     PL_reg_re = state.re;
2717                     cache_re(PL_reg_re);
2718
2719                     /* XXXX This is too dramatic a measure... */
2720                     PL_reg_maxiter = 0;
2721
2722                     logical = 0;
2723                     sayNO;
2724                 }
2725                 sw = SvTRUE(ret);
2726                 logical = 0;
2727             }
2728             else
2729                 sv_setsv(save_scalar(PL_replgv), ret);
2730             break;
2731         }
2732         case OPEN:
2733             n = ARG(scan);  /* which paren pair */
2734             PL_reg_start_tmp[n] = locinput;
2735             if (n > PL_regsize)
2736                 PL_regsize = n;
2737             break;
2738         case CLOSE:
2739             n = ARG(scan);  /* which paren pair */
2740             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
2741             PL_regendp[n] = locinput - PL_bostr;
2742             if (n > *PL_reglastparen)
2743                 *PL_reglastparen = n;
2744             *PL_reglastcloseparen = n;
2745             break;
2746         case GROUPP:
2747             n = ARG(scan);  /* which paren pair */
2748             sw = (*PL_reglastparen >= n && PL_regendp[n] != -1);
2749             break;
2750         case IFTHEN:
2751             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2752             if (sw)
2753                 next = NEXTOPER(NEXTOPER(scan));
2754             else {
2755                 next = scan + ARG(scan);
2756                 if (OP(next) == IFTHEN) /* Fake one. */
2757                     next = NEXTOPER(NEXTOPER(next));
2758             }
2759             break;
2760         case LOGICAL:
2761             logical = scan->flags;
2762             break;
2763 /*******************************************************************
2764  PL_regcc contains infoblock about the innermost (...)* loop, and
2765  a pointer to the next outer infoblock.
2766
2767  Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM):
2768
2769    1) After matching X, regnode for CURLYX is processed;
2770
2771    2) This regnode creates infoblock on the stack, and calls
2772       regmatch() recursively with the starting point at WHILEM node;
2773
2774    3) Each hit of WHILEM node tries to match A and Z (in the order
2775       depending on the current iteration, min/max of {min,max} and
2776       greediness).  The information about where are nodes for "A"
2777       and "Z" is read from the infoblock, as is info on how many times "A"
2778       was already matched, and greediness.
2779
2780    4) After A matches, the same WHILEM node is hit again.
2781
2782    5) Each time WHILEM is hit, PL_regcc is the infoblock created by CURLYX
2783       of the same pair.  Thus when WHILEM tries to match Z, it temporarily
2784       resets PL_regcc, since this Y(A)*Z can be a part of some other loop:
2785       as in (Y(A)*Z)*.  If Z matches, the automaton will hit the WHILEM node
2786       of the external loop.
2787
2788  Currently present infoblocks form a tree with a stem formed by PL_curcc
2789  and whatever it mentions via ->next, and additional attached trees
2790  corresponding to temporarily unset infoblocks as in "5" above.
2791
2792  In the following picture infoblocks for outer loop of
2793  (Y(A)*?Z)*?T are denoted O, for inner I.  NULL starting block
2794  is denoted by x.  The matched string is YAAZYAZT.  Temporarily postponed
2795  infoblocks are drawn below the "reset" infoblock.
2796
2797  In fact in the picture below we do not show failed matches for Z and T
2798  by WHILEM blocks.  [We illustrate minimal matches, since for them it is
2799  more obvious *why* one needs to *temporary* unset infoblocks.]
2800
2801   Matched       REx position    InfoBlocks      Comment
2802                 (Y(A)*?Z)*?T    x
2803                 Y(A)*?Z)*?T     x <- O
2804   Y             (A)*?Z)*?T      x <- O
2805   Y             A)*?Z)*?T       x <- O <- I
2806   YA            )*?Z)*?T        x <- O <- I
2807   YA            A)*?Z)*?T       x <- O <- I
2808   YAA           )*?Z)*?T        x <- O <- I
2809   YAA           Z)*?T           x <- O          # Temporary unset I
2810                                      I
2811
2812   YAAZ          Y(A)*?Z)*?T     x <- O
2813                                      I
2814
2815   YAAZY         (A)*?Z)*?T      x <- O
2816                                      I
2817
2818   YAAZY         A)*?Z)*?T       x <- O <- I
2819                                      I
2820
2821   YAAZYA        )*?Z)*?T        x <- O <- I     
2822                                      I
2823
2824   YAAZYA        Z)*?T           x <- O          # Temporary unset I
2825                                      I,I
2826
2827   YAAZYAZ       )*?T            x <- O
2828                                      I,I
2829
2830   YAAZYAZ       T               x               # Temporary unset O
2831                                 O
2832                                 I,I
2833
2834   YAAZYAZT                      x
2835                                 O
2836                                 I,I
2837  *******************************************************************/
2838         case CURLYX: {
2839                 CURCUR cc;
2840                 CHECKPOINT cp = PL_savestack_ix;
2841                 /* No need to save/restore up to this paren */
2842                 I32 parenfloor = scan->flags;
2843
2844                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
2845                     next += ARG(next);
2846                 cc.oldcc = PL_regcc;
2847                 PL_regcc = &cc;
2848                 /* XXXX Probably it is better to teach regpush to support
2849                    parenfloor > PL_regsize... */
2850                 if (parenfloor > *PL_reglastparen)
2851                     parenfloor = *PL_reglastparen; /* Pessimization... */
2852                 cc.parenfloor = parenfloor;
2853                 cc.cur = -1;
2854                 cc.min = ARG1(scan);
2855                 cc.max  = ARG2(scan);
2856                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
2857                 cc.next = next;
2858                 cc.minmod = minmod;
2859                 cc.lastloc = 0;
2860                 PL_reginput = locinput;
2861                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
2862                 regcpblow(cp);
2863                 PL_regcc = cc.oldcc;
2864                 saySAME(n);
2865             }
2866             /* NOT REACHED */
2867         case WHILEM: {
2868                 /*
2869                  * This is really hard to understand, because after we match
2870                  * what we're trying to match, we must make sure the rest of
2871                  * the REx is going to match for sure, and to do that we have
2872                  * to go back UP the parse tree by recursing ever deeper.  And
2873                  * if it fails, we have to reset our parent's current state
2874                  * that we can try again after backing off.
2875                  */
2876
2877                 CHECKPOINT cp, lastcp;
2878                 CURCUR* cc = PL_regcc;
2879                 char *lastloc = cc->lastloc; /* Detection of 0-len. */
2880                 
2881                 n = cc->cur + 1;        /* how many we know we matched */
2882                 PL_reginput = locinput;
2883
2884                 DEBUG_r(
2885                     PerlIO_printf(Perl_debug_log,
2886                                   "%*s  %ld out of %ld..%ld  cc=%lx\n",
2887                                   REPORT_CODE_OFF+PL_regindent*2, "",
2888                                   (long)n, (long)cc->min,
2889                                   (long)cc->max, (long)cc)
2890                     );
2891
2892                 /* If degenerate scan matches "", assume scan done. */
2893
2894                 if (locinput == cc->lastloc && n >= cc->min) {
2895                     PL_regcc = cc->oldcc;
2896                     if (PL_regcc)
2897                         ln = PL_regcc->cur;
2898                     DEBUG_r(
2899                         PerlIO_printf(Perl_debug_log,
2900                            "%*s  empty match detected, try continuation...\n",
2901                            REPORT_CODE_OFF+PL_regindent*2, "")
2902                         );
2903                     if (regmatch(cc->next))
2904                         sayYES;
2905                     if (PL_regcc)
2906                         PL_regcc->cur = ln;
2907                     PL_regcc = cc;
2908                     sayNO;
2909                 }
2910
2911                 /* First just match a string of min scans. */
2912
2913                 if (n < cc->min) {
2914                     cc->cur = n;
2915                     cc->lastloc = locinput;
2916                     if (regmatch(cc->scan))
2917                         sayYES;
2918                     cc->cur = n - 1;
2919                     cc->lastloc = lastloc;
2920                     sayNO;
2921                 }
2922
2923                 if (scan->flags) {
2924                     /* Check whether we already were at this position.
2925                         Postpone detection until we know the match is not
2926                         *that* much linear. */
2927                 if (!PL_reg_maxiter) {
2928                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
2929                     PL_reg_leftiter = PL_reg_maxiter;
2930                 }
2931                 if (PL_reg_leftiter-- == 0) {
2932                     I32 size = (PL_reg_maxiter + 7)/8;
2933                     if (PL_reg_poscache) {
2934                         if (PL_reg_poscache_size < size) {
2935                             Renew(PL_reg_poscache, size, char);
2936                             PL_reg_poscache_size = size;
2937                         }
2938                         Zero(PL_reg_poscache, size, char);
2939                     }
2940                     else {
2941                         PL_reg_poscache_size = size;
2942                         Newz(29, PL_reg_poscache, size, char);
2943                     }
2944                     DEBUG_r(
2945                         PerlIO_printf(Perl_debug_log,
2946               "%sDetected a super-linear match, switching on caching%s...\n",
2947                                       PL_colors[4], PL_colors[5])
2948                         );
2949                 }
2950                 if (PL_reg_leftiter < 0) {
2951                     I32 o = locinput - PL_bostr, b;
2952
2953                     o = (scan->flags & 0xf) - 1 + o * (scan->flags>>4);
2954                     b = o % 8;
2955                     o /= 8;
2956                     if (PL_reg_poscache[o] & (1<<b)) {
2957                     DEBUG_r(
2958                         PerlIO_printf(Perl_debug_log,
2959                                       "%*s  already tried at this position...\n",
2960                                       REPORT_CODE_OFF+PL_regindent*2, "")
2961                         );
2962                         sayNO_SILENT;
2963                     }
2964                     PL_reg_poscache[o] |= (1<<b);
2965                 }
2966                 }
2967
2968                 /* Prefer next over scan for minimal matching. */
2969
2970                 if (cc->minmod) {
2971                     PL_regcc = cc->oldcc;
2972                     if (PL_regcc)
2973                         ln = PL_regcc->cur;
2974                     cp = regcppush(cc->parenfloor);
2975                     REGCP_SET(lastcp);
2976                     if (regmatch(cc->next)) {
2977                         regcpblow(cp);
2978                         sayYES; /* All done. */
2979                     }
2980                     REGCP_UNWIND(lastcp);
2981                     regcppop();
2982                     if (PL_regcc)
2983                         PL_regcc->cur = ln;
2984                     PL_regcc = cc;
2985
2986                     if (n >= cc->max) { /* Maximum greed exceeded? */
2987                         if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
2988                             && !(PL_reg_flags & RF_warned)) {
2989                             PL_reg_flags |= RF_warned;
2990                             Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded",
2991                                  "Complex regular subexpression recursion",
2992                                  REG_INFTY - 1);
2993                         }
2994                         sayNO;
2995                     }
2996
2997                     DEBUG_r(
2998                         PerlIO_printf(Perl_debug_log,
2999                                       "%*s  trying longer...\n",
3000                                       REPORT_CODE_OFF+PL_regindent*2, "")
3001                         );
3002                     /* Try scanning more and see if it helps. */
3003                     PL_reginput = locinput;
3004                     cc->cur = n;
3005                     cc->lastloc = locinput;
3006                     cp = regcppush(cc->parenfloor);
3007                     REGCP_SET(lastcp);
3008                     if (regmatch(cc->scan)) {
3009                         regcpblow(cp);
3010                         sayYES;
3011                     }
3012                     REGCP_UNWIND(lastcp);
3013                     regcppop();
3014                     cc->cur = n - 1;
3015                     cc->lastloc = lastloc;
3016                     sayNO;
3017                 }
3018
3019                 /* Prefer scan over next for maximal matching. */
3020
3021                 if (n < cc->max) {      /* More greed allowed? */
3022                     cp = regcppush(cc->parenfloor);
3023                     cc->cur = n;
3024                     cc->lastloc = locinput;
3025                     REGCP_SET(lastcp);
3026                     if (regmatch(cc->scan)) {
3027                         regcpblow(cp);
3028                         sayYES;
3029                     }
3030                     REGCP_UNWIND(lastcp);
3031                     regcppop();         /* Restore some previous $<digit>s? */
3032                     PL_reginput = locinput;
3033                     DEBUG_r(
3034                         PerlIO_printf(Perl_debug_log,
3035                                       "%*s  failed, try continuation...\n",
3036                                       REPORT_CODE_OFF+PL_regindent*2, "")
3037                         );
3038                 }
3039                 if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3040                         && !(PL_reg_flags & RF_warned)) {
3041                     PL_reg_flags |= RF_warned;
3042                     Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded",
3043                          "Complex regular subexpression recursion",
3044                          REG_INFTY - 1);
3045                 }
3046
3047                 /* Failed deeper matches of scan, so see if this one works. */
3048                 PL_regcc = cc->oldcc;
3049                 if (PL_regcc)
3050                     ln = PL_regcc->cur;
3051                 if (regmatch(cc->next))
3052                     sayYES;
3053                 if (PL_regcc)
3054                     PL_regcc->cur = ln;
3055                 PL_regcc = cc;
3056                 cc->cur = n - 1;
3057                 cc->lastloc = lastloc;
3058                 sayNO;
3059             }
3060             /* NOT REACHED */
3061         case BRANCHJ:
3062             next = scan + ARG(scan);
3063             if (next == scan)
3064                 next = NULL;
3065             inner = NEXTOPER(NEXTOPER(scan));
3066             goto do_branch;
3067         case BRANCH:
3068             inner = NEXTOPER(scan);
3069           do_branch:
3070             {
3071                 c1 = OP(scan);
3072                 if (OP(next) != c1)     /* No choice. */
3073                     next = inner;       /* Avoid recursion. */
3074                 else {
3075                     I32 lastparen = *PL_reglastparen;
3076                     I32 unwind1;
3077                     re_unwind_branch_t *uw;
3078
3079                     /* Put unwinding data on stack */
3080                     unwind1 = SSNEWt(1,re_unwind_branch_t);
3081                     uw = SSPTRt(unwind1,re_unwind_branch_t);
3082                     uw->prev = unwind;
3083                     unwind = unwind1;
3084                     uw->type = ((c1 == BRANCH)
3085                                 ? RE_UNWIND_BRANCH
3086                                 : RE_UNWIND_BRANCHJ);
3087                     uw->lastparen = lastparen;
3088                     uw->next = next;
3089                     uw->locinput = locinput;
3090                     uw->nextchr = nextchr;
3091 #ifdef DEBUGGING
3092                     uw->regindent = ++PL_regindent;
3093 #endif
3094
3095                     REGCP_SET(uw->lastcp);
3096
3097                     /* Now go into the first branch */
3098                     next = inner;
3099                 }
3100             }
3101             break;
3102         case MINMOD:
3103             minmod = 1;
3104             break;
3105         case CURLYM:
3106         {
3107             I32 l = 0;
3108             CHECKPOINT lastcp;
3109         
3110             /* We suppose that the next guy does not need
3111                backtracking: in particular, it is of constant length,
3112                and has no parenths to influence future backrefs. */
3113             ln = ARG1(scan);  /* min to match */
3114             n  = ARG2(scan);  /* max to match */
3115             paren = scan->flags;
3116             if (paren) {
3117                 if (paren > PL_regsize)
3118                     PL_regsize = paren;
3119                 if (paren > *PL_reglastparen)
3120                     *PL_reglastparen = paren;
3121             }
3122             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3123             if (paren)
3124                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
3125             PL_reginput = locinput;
3126             if (minmod) {
3127                 minmod = 0;
3128                 if (ln && regrepeat_hard(scan, ln, &l) < ln)
3129                     sayNO;
3130                 /* if we matched something zero-length we don't need to
3131                    backtrack - capturing parens are already defined, so
3132                    the caveat in the maximal case doesn't apply
3133
3134                    XXXX if ln == 0, we can redo this check first time
3135                    through the following loop
3136                 */
3137                 if (ln && l == 0)
3138                     n = ln;     /* don't backtrack */
3139                 locinput = PL_reginput;
3140                 if (HAS_TEXT(next) || JUMPABLE(next)) {
3141                     regnode *text_node = next;
3142
3143                     if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3144
3145                     if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3146                     else {
3147                         if (PL_regkind[(U8)OP(text_node)] == REF) {
3148                             I32 n, ln;
3149                             n = ARG(text_node);  /* which paren pair */
3150                             ln = PL_regstartp[n];
3151                             /* assume yes if we haven't seen CLOSEn */
3152                             if (
3153                                 *PL_reglastparen < n ||
3154                                 ln == -1 ||
3155                                 ln == PL_regendp[n]
3156                             ) {
3157                                 c1 = c2 = -1000;
3158                                 goto assume_ok_MM;
3159                             }
3160                             c1 = *(PL_bostr + ln);
3161                         }
3162                         else { c1 = (U8)*STRING(text_node); }
3163                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3164                             c2 = PL_fold[c1];
3165                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3166                             c2 = PL_fold_locale[c1];
3167                         else
3168                             c2 = c1;
3169                     }
3170                 }
3171                 else
3172                     c1 = c2 = -1000;
3173             assume_ok_MM:
3174                 REGCP_SET(lastcp);
3175                 /* This may be improved if l == 0.  */
3176                 while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */
3177                     /* If it could work, try it. */
3178                     if (c1 == -1000 ||
3179                         UCHARAT(PL_reginput) == c1 ||
3180                         UCHARAT(PL_reginput) == c2)
3181                     {
3182                         if (paren) {
3183                             if (ln) {
3184                                 PL_regstartp[paren] =
3185                                     HOPc(PL_reginput, -l) - PL_bostr;
3186                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3187                             }
3188                             else
3189                                 PL_regendp[paren] = -1;
3190                         }
3191                         if (regmatch(next))
3192                             sayYES;
3193                         REGCP_UNWIND(lastcp);
3194                     }
3195                     /* Couldn't or didn't -- move forward. */
3196                     PL_reginput = locinput;
3197                     if (regrepeat_hard(scan, 1, &l)) {
3198                         ln++;
3199                         locinput = PL_reginput;
3200                     }
3201                     else
3202                         sayNO;
3203                 }
3204             }
3205             else {
3206                 n = regrepeat_hard(scan, n, &l);
3207                 /* if we matched something zero-length we don't need to
3208                    backtrack, unless the minimum count is zero and we
3209                    are capturing the result - in that case the capture
3210                    being defined or not may affect later execution
3211                 */
3212                 if (n != 0 && l == 0 && !(paren && ln == 0))
3213                     ln = n;     /* don't backtrack */
3214                 locinput = PL_reginput;
3215                 DEBUG_r(
3216                     PerlIO_printf(Perl_debug_log,
3217                                   "%*s  matched %"IVdf" times, len=%"IVdf"...\n",
3218                                   (int)(REPORT_CODE_OFF+PL_regindent*2), "",
3219                                   (IV) n, (IV)l)
3220                     );
3221                 if (n >= ln) {
3222                     if (HAS_TEXT(next) || JUMPABLE(next)) {
3223                         regnode *text_node = next;
3224
3225                         if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3226
3227                         if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3228                         else {
3229                             if (PL_regkind[(U8)OP(text_node)] == REF) {
3230                                 I32 n, ln;
3231                                 n = ARG(text_node);  /* which paren pair */
3232                                 ln = PL_regstartp[n];
3233                                 /* assume yes if we haven't seen CLOSEn */
3234                                 if (
3235                                     *PL_reglastparen < n ||
3236                                     ln == -1 ||
3237                                     ln == PL_regendp[n]
3238                                 ) {
3239                                     c1 = c2 = -1000;
3240                                     goto assume_ok_REG;
3241                                 }
3242                                 c1 = *(PL_bostr + ln);
3243                             }
3244                             else { c1 = (U8)*STRING(text_node); }
3245
3246                             if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3247                                 c2 = PL_fold[c1];
3248                             else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3249                                 c2 = PL_fold_locale[c1];
3250                             else
3251                                 c2 = c1;
3252                         }
3253                     }
3254                     else
3255                         c1 = c2 = -1000;
3256                 }
3257             assume_ok_REG:
3258                 REGCP_SET(lastcp);
3259                 while (n >= ln) {
3260                     /* If it could work, try it. */
3261                     if (c1 == -1000 ||
3262                         UCHARAT(PL_reginput) == c1 ||
3263                         UCHARAT(PL_reginput) == c2)
3264                     {
3265                         DEBUG_r(
3266                                 PerlIO_printf(Perl_debug_log,
3267                                               "%*s  trying tail with n=%"IVdf"...\n",
3268                                               (int)(REPORT_CODE_OFF+PL_regindent*2), "", (IV)n)
3269                             );
3270                         if (paren) {
3271                             if (n) {
3272                                 PL_regstartp[paren] = HOPc(PL_reginput, -l) - PL_bostr;
3273                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3274                             }
3275                             else
3276                                 PL_regendp[paren] = -1;
3277                         }
3278                         if (regmatch(next))
3279                             sayYES;
3280                         REGCP_UNWIND(lastcp);
3281                     }
3282                     /* Couldn't or didn't -- back up. */
3283                     n--;
3284                     locinput = HOPc(locinput, -l);
3285                     PL_reginput = locinput;
3286                 }
3287             }
3288             sayNO;
3289             break;
3290         }
3291         case CURLYN:
3292             paren = scan->flags;        /* Which paren to set */
3293             if (paren > PL_regsize)
3294                 PL_regsize = paren;
3295             if (paren > *PL_reglastparen)
3296                 *PL_reglastparen = paren;
3297             ln = ARG1(scan);  /* min to match */
3298             n  = ARG2(scan);  /* max to match */
3299             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
3300             goto repeat;
3301         case CURLY:
3302             paren = 0;
3303             ln = ARG1(scan);  /* min to match */
3304             n  = ARG2(scan);  /* max to match */
3305             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3306             goto repeat;
3307         case STAR:
3308             ln = 0;
3309             n = REG_INFTY;
3310             scan = NEXTOPER(scan);
3311             paren = 0;
3312             goto repeat;
3313         case PLUS:
3314             ln = 1;
3315             n = REG_INFTY;
3316             scan = NEXTOPER(scan);
3317             paren = 0;
3318           repeat:
3319             /*
3320             * Lookahead to avoid useless match attempts
3321             * when we know what character comes next.
3322             */
3323
3324             /*
3325             * Used to only do .*x and .*?x, but now it allows
3326             * for )'s, ('s and (?{ ... })'s to be in the way
3327             * of the quantifier and the EXACT-like node.  -- japhy
3328             */
3329
3330             if (HAS_TEXT(next) || JUMPABLE(next)) {
3331                 U8 *s;
3332                 regnode *text_node = next;
3333
3334                 if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3335
3336                 if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3337                 else {
3338                     if (PL_regkind[(U8)OP(text_node)] == REF) {
3339                         I32 n, ln;
3340                         n = ARG(text_node);  /* which paren pair */
3341                         ln = PL_regstartp[n];
3342                         /* assume yes if we haven't seen CLOSEn */
3343                         if (
3344                             *PL_reglastparen < n ||
3345                             ln == -1 ||
3346                             ln == PL_regendp[n]
3347                         ) {
3348                             c1 = c2 = -1000;
3349                             goto assume_ok_easy;
3350                         }
3351                         s = (U8*)PL_bostr + ln;
3352                     }
3353                     else { s = (U8*)STRING(text_node); }
3354
3355                     if (!UTF) {
3356                         c2 = c1 = *s;
3357                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3358                             c2 = PL_fold[c1];
3359                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3360                             c2 = PL_fold_locale[c1];
3361                     }
3362                     else { /* UTF */
3363                         if (OP(text_node) == EXACTF || OP(text_node) == REFF) {
3364                              STRLEN ulen1, ulen2;
3365                              U8 tmpbuf1[UTF8_MAXLEN*2+1];
3366                              U8 tmpbuf2[UTF8_MAXLEN*2+1];
3367
3368                              to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
3369                              to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
3370
3371                              c1 = utf8_to_uvuni(tmpbuf1, 0);
3372                              c2 = utf8_to_uvuni(tmpbuf2, 0);
3373                         }
3374                         else {
3375                             c2 = c1 = utf8_to_uvchr(s, NULL);
3376                         }
3377                     }
3378                 }
3379             }
3380             else
3381                 c1 = c2 = -1000;
3382         assume_ok_easy:
3383             PL_reginput = locinput;
3384             if (minmod) {
3385                 CHECKPOINT lastcp;
3386                 minmod = 0;
3387                 if (ln && regrepeat(scan, ln) < ln)
3388                     sayNO;
3389                 locinput = PL_reginput;
3390                 REGCP_SET(lastcp);
3391                 if (c1 != -1000) {
3392                     char *e; /* Should not check after this */
3393                     char *old = locinput;
3394
3395                     if  (n == REG_INFTY) {
3396                         e = PL_regeol - 1;
3397                         if (do_utf8)
3398                             while (UTF8_IS_CONTINUATION(*(U8*)e))
3399                                 e--;
3400                     }
3401                     else if (do_utf8) {
3402                         int m = n - ln;
3403                         for (e = locinput;
3404                              m >0 && e + UTF8SKIP(e) <= PL_regeol; m--)
3405                             e += UTF8SKIP(e);
3406                     }
3407                     else {
3408                         e = locinput + n - ln;
3409                         if (e >= PL_regeol)
3410                             e = PL_regeol - 1;
3411                     }
3412                     while (1) {
3413                         int count;
3414                         /* Find place 'next' could work */
3415                         if (!do_utf8) {
3416                             if (c1 == c2) {
3417                                 while (locinput <= e &&
3418                                        UCHARAT(locinput) != c1)
3419                                     locinput++;
3420                             } else {
3421                                 while (locinput <= e
3422                                        && UCHARAT(locinput) != c1
3423                                        && UCHARAT(locinput) != c2)
3424                                     locinput++;
3425                             }
3426                             count = locinput - old;
3427                         }
3428                         else {
3429                             STRLEN len;
3430                             if (c1 == c2) {
3431                                 for (count = 0;
3432                                      locinput <= e &&
3433                                          utf8_to_uvchr((U8*)locinput, &len) != c1;
3434                                      count++)
3435                                     locinput += len;
3436                                 
3437                             } else {
3438                                 for (count = 0; locinput <= e; count++) {
3439                                     UV c = utf8_to_uvchr((U8*)locinput, &len);
3440                                     if (c == c1 || c == c2)
3441                                         break;
3442                                     locinput += len;                    
3443                                 }
3444                             }
3445                         }
3446                         if (locinput > e)
3447                             sayNO;
3448                         /* PL_reginput == old now */
3449                         if (locinput != old) {
3450                             ln = 1;     /* Did some */
3451                             if (regrepeat(scan, count) < count)
3452                                 sayNO;
3453                         }
3454                         /* PL_reginput == locinput now */
3455                         TRYPAREN(paren, ln, locinput);
3456                         PL_reginput = locinput; /* Could be reset... */
3457                         REGCP_UNWIND(lastcp);
3458                         /* Couldn't or didn't -- move forward. */
3459                         old = locinput;
3460                         if (do_utf8)
3461                             locinput += UTF8SKIP(locinput);
3462                         else
3463                             locinput++;
3464                     }
3465                 }
3466                 else
3467                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
3468                     UV c;
3469                     if (c1 != -1000) {
3470                         if (do_utf8)
3471                             c = utf8_to_uvchr((U8*)PL_reginput, NULL);
3472                         else
3473                             c = UCHARAT(PL_reginput);
3474                         /* If it could work, try it. */
3475                         if (c == c1 || c == c2)
3476                         {
3477                             TRYPAREN(paren, n, PL_reginput);
3478                             REGCP_UNWIND(lastcp);
3479                         }
3480                     }
3481                     /* If it could work, try it. */
3482                     else if (c1 == -1000)
3483                     {
3484                         TRYPAREN(paren, n, PL_reginput);
3485                         REGCP_UNWIND(lastcp);
3486                     }
3487                     /* Couldn't or didn't -- move forward. */
3488                     PL_reginput = locinput;
3489                     if (regrepeat(scan, 1)) {
3490                         ln++;
3491                         locinput = PL_reginput;
3492                     }
3493                     else
3494                         sayNO;
3495                 }
3496             }
3497             else {
3498                 CHECKPOINT lastcp;
3499                 n = regrepeat(scan, n);
3500                 locinput = PL_reginput;
3501                 if (ln < n && PL_regkind[(U8)OP(next)] == EOL &&
3502                     (!PL_multiline  || OP(next) == SEOL || OP(next) == EOS)) {
3503                     ln = n;                     /* why back off? */
3504                     /* ...because $ and \Z can match before *and* after
3505                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
3506                        We should back off by one in this case. */
3507                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(next) != EOS)
3508                         ln--;
3509                 }
3510                 REGCP_SET(lastcp);
3511                 if (paren) {
3512                     UV c = 0;
3513                     while (n >= ln) {
3514                         if (c1 != -1000) {
3515                             if (do_utf8)
3516                                 c = utf8_to_uvchr((U8*)PL_reginput, NULL);
3517                             else
3518                                 c = UCHARAT(PL_reginput);
3519                         }
3520                         /* If it could work, try it. */
3521                         if (c1 == -1000 || c == c1 || c == c2)
3522                             {
3523                                 TRYPAREN(paren, n, PL_reginput);
3524                                 REGCP_UNWIND(lastcp);
3525                             }
3526                         /* Couldn't or didn't -- back up. */
3527                         n--;
3528                         PL_reginput = locinput = HOPc(locinput, -1);
3529                     }
3530                 }
3531                 else {
3532                     UV c = 0;
3533                     while (n >= ln) {
3534                         if (c1 != -1000) {
3535                             if (do_utf8)
3536                                 c = utf8_to_uvchr((U8*)PL_reginput, NULL);
3537                             else
3538                                 c = UCHARAT(PL_reginput);
3539                         }
3540                         /* If it could work, try it. */
3541                         if (c1 == -1000 || c == c1 || c == c2)
3542                             {
3543                                 TRYPAREN(paren, n, PL_reginput);
3544                                 REGCP_UNWIND(lastcp);
3545                             }
3546                         /* Couldn't or didn't -- back up. */
3547                         n--;
3548                         PL_reginput = locinput = HOPc(locinput, -1);
3549                     }
3550                 }
3551             }
3552             sayNO;
3553             break;
3554         case END:
3555             if (PL_reg_call_cc) {
3556                 re_cc_state *cur_call_cc = PL_reg_call_cc;
3557                 CURCUR *cctmp = PL_regcc;
3558                 regexp *re = PL_reg_re;
3559                 CHECKPOINT cp, lastcp;
3560                 
3561                 cp = regcppush(0);      /* Save *all* the positions. */
3562                 REGCP_SET(lastcp);
3563                 regcp_set_to(PL_reg_call_cc->ss); /* Restore parens of
3564                                                     the caller. */
3565                 PL_reginput = locinput; /* Make position available to
3566                                            the callcc. */
3567                 cache_re(PL_reg_call_cc->re);
3568                 PL_regcc = PL_reg_call_cc->cc;
3569                 PL_reg_call_cc = PL_reg_call_cc->prev;
3570                 if (regmatch(cur_call_cc->node)) {
3571                     PL_reg_call_cc = cur_call_cc;
3572                     regcpblow(cp);
3573                     sayYES;
3574                 }
3575                 REGCP_UNWIND(lastcp);
3576                 regcppop();
3577                 PL_reg_call_cc = cur_call_cc;
3578                 PL_regcc = cctmp;
3579                 PL_reg_re = re;
3580                 cache_re(re);
3581
3582                 DEBUG_r(
3583                     PerlIO_printf(Perl_debug_log,
3584                                   "%*s  continuation failed...\n",
3585                                   REPORT_CODE_OFF+PL_regindent*2, "")
3586                     );
3587                 sayNO_SILENT;
3588             }
3589             if (locinput < PL_regtill) {
3590                 DEBUG_r(PerlIO_printf(Perl_debug_log,
3591                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
3592                                       PL_colors[4],
3593                                       (long)(locinput - PL_reg_starttry),
3594                                       (long)(PL_regtill - PL_reg_starttry),
3595                                       PL_colors[5]));
3596                 sayNO_FINAL;            /* Cannot match: too short. */
3597             }
3598             PL_reginput = locinput;     /* put where regtry can find it */
3599             sayYES_FINAL;               /* Success! */
3600         case SUCCEED:
3601             PL_reginput = locinput;     /* put where regtry can find it */
3602             sayYES_LOUD;                /* Success! */
3603         case SUSPEND:
3604             n = 1;
3605             PL_reginput = locinput;
3606             goto do_ifmatch;    
3607         case UNLESSM:
3608             n = 0;
3609             if (scan->flags) {
3610                 s = HOPBACKc(locinput, scan->flags);
3611                 if (!s)
3612                     goto say_yes;
3613                 PL_reginput = s;
3614             }
3615             else
3616                 PL_reginput = locinput;
3617             goto do_ifmatch;
3618         case IFMATCH:
3619             n = 1;
3620             if (scan->flags) {
3621                 s = HOPBACKc(locinput, scan->flags);
3622                 if (!s)
3623                     goto say_no;
3624                 PL_reginput = s;
3625             }
3626             else
3627                 PL_reginput = locinput;
3628
3629           do_ifmatch:
3630             inner = NEXTOPER(NEXTOPER(scan));
3631             if (regmatch(inner) != n) {
3632               say_no:
3633                 if (logical) {
3634                     logical = 0;
3635                     sw = 0;
3636                     goto do_longjump;
3637                 }
3638                 else
3639                     sayNO;
3640             }
3641           say_yes:
3642             if (logical) {
3643                 logical = 0;
3644                 sw = 1;
3645             }
3646             if (OP(scan) == SUSPEND) {
3647                 locinput = PL_reginput;
3648                 nextchr = UCHARAT(locinput);
3649             }
3650             /* FALL THROUGH. */
3651         case LONGJMP:
3652           do_longjump:
3653             next = scan + ARG(scan);
3654             if (next == scan)
3655                 next = NULL;
3656             break;
3657         default:
3658             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
3659                           PTR2UV(scan), OP(scan));
3660             Perl_croak(aTHX_ "regexp memory corruption");
3661         }
3662       reenter:
3663         scan = next;
3664     }
3665
3666     /*
3667     * We get here only if there's trouble -- normally "case END" is
3668     * the terminating point.
3669     */
3670     Perl_croak(aTHX_ "corrupted regexp pointers");
3671     /*NOTREACHED*/
3672     sayNO;
3673
3674 yes_loud:
3675     DEBUG_r(
3676         PerlIO_printf(Perl_debug_log,
3677                       "%*s  %scould match...%s\n",
3678                       REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],PL_colors[5])
3679         );
3680     goto yes;
3681 yes_final:
3682     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
3683                           PL_colors[4],PL_colors[5]));
3684 yes:
3685 #ifdef DEBUGGING
3686     PL_regindent--;
3687 #endif
3688
3689 #if 0                                   /* Breaks $^R */
3690     if (unwind)
3691         regcpblow(firstcp);
3692 #endif
3693     return 1;
3694
3695 no:
3696     DEBUG_r(
3697         PerlIO_printf(Perl_debug_log,
3698                       "%*s  %sfailed...%s\n",
3699                       REPORT_CODE_OFF+PL_regindent*2, "",PL_colors[4],PL_colors[5])
3700         );
3701     goto do_no;
3702 no_final:
3703 do_no:
3704     if (unwind) {
3705         re_unwind_t *uw = SSPTRt(unwind,re_unwind_t);
3706
3707         switch (uw->type) {
3708         case RE_UNWIND_BRANCH:
3709         case RE_UNWIND_BRANCHJ:
3710         {
3711             re_unwind_branch_t *uwb = &(uw->branch);
3712             I32 lastparen = uwb->lastparen;
3713         
3714             REGCP_UNWIND(uwb->lastcp);
3715             for (n = *PL_reglastparen; n > lastparen; n--)
3716                 PL_regendp[n] = -1;
3717             *PL_reglastparen = n;
3718             scan = next = uwb->next;
3719             if ( !scan ||
3720                  OP(scan) != (uwb->type == RE_UNWIND_BRANCH
3721                               ? BRANCH : BRANCHJ) ) {           /* Failure */
3722                 unwind = uwb->prev;
3723 #ifdef DEBUGGING
3724                 PL_regindent--;
3725 #endif
3726                 goto do_no;
3727             }
3728             /* Have more choice yet.  Reuse the same uwb.  */
3729             /*SUPPRESS 560*/
3730             if ((n = (uwb->type == RE_UNWIND_BRANCH
3731                       ? NEXT_OFF(next) : ARG(next))))
3732                 next += n;
3733             else
3734                 next = NULL;    /* XXXX Needn't unwinding in this case... */
3735             uwb->next = next;
3736             next = NEXTOPER(scan);
3737             if (uwb->type == RE_UNWIND_BRANCHJ)
3738                 next = NEXTOPER(next);
3739             locinput = uwb->locinput;
3740             nextchr = uwb->nextchr;
3741 #ifdef DEBUGGING
3742             PL_regindent = uwb->regindent;
3743 #endif
3744
3745             goto reenter;
3746         }
3747         /* NOT REACHED */
3748         default:
3749             Perl_croak(aTHX_ "regexp unwind memory corruption");
3750         }
3751         /* NOT REACHED */
3752     }
3753 #ifdef DEBUGGING
3754     PL_regindent--;
3755 #endif
3756     return 0;
3757 }
3758
3759 /*
3760  - regrepeat - repeatedly match something simple, report how many
3761  */
3762 /*
3763  * [This routine now assumes that it will only match on things of length 1.
3764  * That was true before, but now we assume scan - reginput is the count,
3765  * rather than incrementing count on every character.  [Er, except utf8.]]
3766  */
3767 STATIC I32
3768 S_regrepeat(pTHX_ regnode *p, I32 max)
3769 {
3770     register char *scan;
3771     register I32 c;
3772     register char *loceol = PL_regeol;
3773     register I32 hardcount = 0;
3774     register bool do_utf8 = PL_reg_match_utf8;
3775
3776     scan = PL_reginput;
3777     if (max != REG_INFTY && max < loceol - scan)
3778       loceol = scan + max;
3779     switch (OP(p)) {
3780     case REG_ANY:
3781         if (do_utf8) {
3782             loceol = PL_regeol;
3783             while (scan < loceol && hardcount < max && *scan != '\n') {
3784                 scan += UTF8SKIP(scan);
3785                 hardcount++;
3786             }
3787         } else {
3788             while (scan < loceol && *scan != '\n')
3789                 scan++;
3790         }
3791         break;
3792     case SANY:
3793         scan = loceol;
3794         break;
3795     case CANY:
3796         scan = loceol;
3797         break;
3798     case EXACT:         /* length of string is 1 */
3799         c = (U8)*STRING(p);
3800         while (scan < loceol && UCHARAT(scan) == c)
3801             scan++;
3802         break;
3803     case EXACTF:        /* length of string is 1 */
3804         c = (U8)*STRING(p);
3805         while (scan < loceol &&
3806                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
3807             scan++;
3808         break;
3809     case EXACTFL:       /* length of string is 1 */
3810         PL_reg_flags |= RF_tainted;
3811         c = (U8)*STRING(p);
3812         while (scan < loceol &&
3813                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
3814             scan++;
3815         break;
3816     case ANYOF:
3817         if (do_utf8) {
3818             loceol = PL_regeol;
3819             while (hardcount < max && scan < loceol &&
3820                    reginclass(p, (U8*)scan, do_utf8)) {
3821                 scan += UTF8SKIP(scan);
3822                 hardcount++;
3823             }
3824         } else {
3825             while (scan < loceol && reginclass(p, (U8*)scan, do_utf8))
3826                 scan++;
3827         }
3828         break;
3829     case ALNUM:
3830         if (do_utf8) {
3831             loceol = PL_regeol;
3832             LOAD_UTF8_CHARCLASS(alnum,"a");
3833             while (hardcount < max && scan < loceol &&
3834                    swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
3835                 scan += UTF8SKIP(scan);
3836                 hardcount++;
3837             }
3838         } else {
3839             while (scan < loceol && isALNUM(*scan))
3840                 scan++;
3841         }
3842         break;
3843     case ALNUML:
3844         PL_reg_flags |= RF_tainted;
3845         if (do_utf8) {
3846             loceol = PL_regeol;
3847             while (hardcount < max && scan < loceol &&
3848                    isALNUM_LC_utf8((U8*)scan)) {
3849                 scan += UTF8SKIP(scan);
3850                 hardcount++;
3851             }
3852         } else {
3853             while (scan < loceol && isALNUM_LC(*scan))
3854                 scan++;
3855         }
3856         break;
3857     case NALNUM:
3858         if (do_utf8) {
3859             loceol = PL_regeol;
3860             LOAD_UTF8_CHARCLASS(alnum,"a");
3861             while (hardcount < max && scan < loceol &&
3862                    !swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
3863                 scan += UTF8SKIP(scan);
3864                 hardcount++;
3865             }
3866         } else {
3867             while (scan < loceol && !isALNUM(*scan))
3868                 scan++;
3869         }
3870         break;
3871     case NALNUML:
3872         PL_reg_flags |= RF_tainted;
3873         if (do_utf8) {
3874             loceol = PL_regeol;
3875             while (hardcount < max && scan < loceol &&
3876                    !isALNUM_LC_utf8((U8*)scan)) {
3877                 scan += UTF8SKIP(scan);
3878                 hardcount++;
3879             }
3880         } else {
3881             while (scan < loceol && !isALNUM_LC(*scan))
3882                 scan++;
3883         }
3884         break;
3885     case SPACE:
3886         if (do_utf8) {
3887             loceol = PL_regeol;
3888             LOAD_UTF8_CHARCLASS(space," ");
3889             while (hardcount < max && scan < loceol &&
3890                    (*scan == ' ' ||
3891                     swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
3892                 scan += UTF8SKIP(scan);
3893                 hardcount++;
3894             }
3895         } else {
3896             while (scan < loceol && isSPACE(*scan))
3897                 scan++;
3898         }
3899         break;
3900     case SPACEL:
3901         PL_reg_flags |= RF_tainted;
3902         if (do_utf8) {
3903             loceol = PL_regeol;
3904             while (hardcount < max && scan < loceol &&
3905                    (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
3906                 scan += UTF8SKIP(scan);
3907                 hardcount++;
3908             }
3909         } else {
3910             while (scan < loceol && isSPACE_LC(*scan))
3911                 scan++;
3912         }
3913         break;
3914     case NSPACE:
3915         if (do_utf8) {
3916             loceol = PL_regeol;
3917             LOAD_UTF8_CHARCLASS(space," ");
3918             while (hardcount < max && scan < loceol &&
3919                    !(*scan == ' ' ||
3920                      swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
3921                 scan += UTF8SKIP(scan);
3922                 hardcount++;
3923             }
3924         } else {
3925             while (scan < loceol && !isSPACE(*scan))
3926                 scan++;
3927             break;
3928         }
3929     case NSPACEL:
3930         PL_reg_flags |= RF_tainted;
3931         if (do_utf8) {
3932             loceol = PL_regeol;
3933             while (hardcount < max && scan < loceol &&
3934                    !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
3935                 scan += UTF8SKIP(scan);
3936                 hardcount++;
3937             }
3938         } else {
3939             while (scan < loceol && !isSPACE_LC(*scan))
3940                 scan++;
3941         }
3942         break;
3943     case DIGIT:
3944         if (do_utf8) {
3945             loceol = PL_regeol;
3946             LOAD_UTF8_CHARCLASS(digit,"0");
3947             while (hardcount < max && scan < loceol &&
3948                    swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
3949                 scan += UTF8SKIP(scan);
3950                 hardcount++;
3951             }
3952         } else {
3953             while (scan < loceol && isDIGIT(*scan))
3954                 scan++;
3955         }
3956         break;
3957     case NDIGIT:
3958         if (do_utf8) {
3959             loceol = PL_regeol;
3960             LOAD_UTF8_CHARCLASS(digit,"0");
3961             while (hardcount < max && scan < loceol &&
3962                    !swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
3963                 scan += UTF8SKIP(scan);
3964                 hardcount++;
3965             }
3966         } else {
3967             while (scan < loceol && !isDIGIT(*scan))
3968                 scan++;
3969         }
3970         break;
3971     default:            /* Called on something of 0 width. */
3972         break;          /* So match right here or not at all. */
3973     }
3974
3975     if (hardcount)
3976         c = hardcount;
3977     else
3978         c = scan - PL_reginput;
3979     PL_reginput = scan;
3980
3981     DEBUG_r(
3982         {
3983                 SV *prop = sv_newmortal();
3984
3985                 regprop(prop, p);
3986                 PerlIO_printf(Perl_debug_log,
3987                               "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
3988                               REPORT_CODE_OFF+1, "", SvPVX(prop),(IV)c,(IV)max);
3989         });
3990
3991     return(c);
3992 }
3993
3994 /*
3995  - regrepeat_hard - repeatedly match something, report total lenth and length
3996  *
3997  * The repeater is supposed to have constant length.
3998  */
3999
4000 STATIC I32
4001 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp)
4002 {
4003     register char *scan = Nullch;
4004     register char *start;
4005     register char *loceol = PL_regeol;
4006     I32 l = 0;
4007     I32 count = 0, res = 1;
4008
4009     if (!max)
4010         return 0;
4011
4012     start = PL_reginput;
4013     if (PL_reg_match_utf8) {
4014         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
4015             if (!count++) {
4016                 l = 0;
4017                 while (start < PL_reginput) {
4018                     l++;
4019                     start += UTF8SKIP(start);
4020                 }
4021                 *lp = l;
4022                 if (l == 0)
4023                     return max;
4024             }
4025             if (count == max)
4026                 return count;
4027         }
4028     }
4029     else {
4030         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
4031             if (!count++) {
4032                 *lp = l = PL_reginput - start;
4033                 if (max != REG_INFTY && l*max < loceol - scan)
4034                     loceol = scan + l*max;
4035                 if (l == 0)
4036                     return max;
4037             }
4038         }
4039     }
4040     if (!res)
4041         PL_reginput = scan;
4042
4043     return count;
4044 }
4045
4046 /*
4047 - regclass_swash - prepare the utf8 swash
4048 */
4049
4050 SV *
4051 Perl_regclass_swash(pTHX_ register regnode* node, bool doinit, SV** initsvp)
4052 {
4053     SV *sw = NULL;
4054     SV *si = NULL;
4055
4056     if (PL_regdata && PL_regdata->count) {
4057         U32 n = ARG(node);
4058
4059         if (PL_regdata->what[n] == 's') {
4060             SV *rv = (SV*)PL_regdata->data[n];
4061             AV *av = (AV*)SvRV((SV*)rv);
4062             SV **a;
4063         
4064             si = *av_fetch(av, 0, FALSE);
4065             a  =  av_fetch(av, 1, FALSE);
4066         
4067             if (a)
4068                 sw = *a;
4069             else if (si && doinit) {
4070                 sw = swash_init("utf8", "", si, 1, 0);
4071                 (void)av_store(av, 1, sw);
4072             }
4073         }
4074     }
4075         
4076     if (initsvp)
4077         *initsvp = si;
4078
4079     return sw;
4080 }
4081
4082 /*
4083  - reginclass - determine if a character falls into a character class
4084  */
4085
4086 STATIC bool
4087 S_reginclass(pTHX_ register regnode *n, register U8* p, register bool do_utf8)
4088 {
4089     char flags = ANYOF_FLAGS(n);
4090     bool match = FALSE;
4091     UV c;
4092     STRLEN len = 0;
4093
4094     c = do_utf8 ? utf8_to_uvchr(p, &len) : *p;
4095
4096     if (do_utf8 || (flags & ANYOF_UNICODE)) {
4097         if (do_utf8 && !ANYOF_RUNTIME(n)) {
4098             if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
4099                 match = TRUE;
4100         }
4101         if (!match && do_utf8 && (flags & ANYOF_UNICODE_ALL) && c >= 256)
4102             match = TRUE;
4103         if (!match) {
4104             SV *sw = regclass_swash(n, TRUE, 0);
4105         
4106             if (sw) {
4107                 if (swash_fetch(sw, p, do_utf8))
4108                     match = TRUE;
4109                 else if (flags & ANYOF_FOLD) {
4110                     STRLEN ulen;
4111                     U8 tmpbuf[UTF8_MAXLEN*2+1];
4112
4113                     toLOWER_utf8(p, tmpbuf, &ulen);
4114                     if (swash_fetch(sw, tmpbuf, do_utf8))
4115                         match = TRUE;
4116                 }
4117             }
4118         }
4119     }
4120     if (!match && c < 256) {
4121         if (ANYOF_BITMAP_TEST(n, c))
4122             match = TRUE;
4123         else if (flags & ANYOF_FOLD) {
4124           I32 f;
4125
4126             if (flags & ANYOF_LOCALE) {
4127                 PL_reg_flags |= RF_tainted;
4128                 f = PL_fold_locale[c];
4129             }
4130             else
4131                 f = PL_fold[c];
4132             if (f != c && ANYOF_BITMAP_TEST(n, f))
4133                 match = TRUE;
4134         }
4135         
4136         if (!match && (flags & ANYOF_CLASS)) {
4137             PL_reg_flags |= RF_tainted;
4138             if (
4139                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
4140                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
4141                 (ANYOF_CLASS_TEST(n, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
4142                 (ANYOF_CLASS_TEST(n, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
4143                 (ANYOF_CLASS_TEST(n, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
4144                 (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
4145                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
4146                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
4147                 (ANYOF_CLASS_TEST(n, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
4148                 (ANYOF_CLASS_TEST(n, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
4149                 (ANYOF_CLASS_TEST(n, ANYOF_ASCII)   &&  isASCII(c))     ||
4150                 (ANYOF_CLASS_TEST(n, ANYOF_NASCII)  && !isASCII(c))     ||
4151                 (ANYOF_CLASS_TEST(n, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
4152                 (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
4153                 (ANYOF_CLASS_TEST(n, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
4154                 (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
4155                 (ANYOF_CLASS_TEST(n, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
4156                 (ANYOF_CLASS_TEST(n, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
4157                 (ANYOF_CLASS_TEST(n, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
4158                 (ANYOF_CLASS_TEST(n, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
4159                 (ANYOF_CLASS_TEST(n, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
4160                 (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
4161                 (ANYOF_CLASS_TEST(n, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
4162                 (ANYOF_CLASS_TEST(n, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
4163                 (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
4164                 (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c))    ||
4165                 (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC)  &&  isPSXSPC(c))    ||
4166                 (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c))    ||
4167                 (ANYOF_CLASS_TEST(n, ANYOF_BLANK)   &&  isBLANK(c))     ||
4168                 (ANYOF_CLASS_TEST(n, ANYOF_NBLANK)  && !isBLANK(c))
4169                 ) /* How's that for a conditional? */
4170             {
4171                 match = TRUE;
4172             }
4173         }
4174     }
4175
4176     return (flags & ANYOF_INVERT) ? !match : match;
4177 }
4178
4179 STATIC U8 *
4180 S_reghop(pTHX_ U8 *s, I32 off)
4181 {
4182     return S_reghop3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4183 }
4184
4185 STATIC U8 *
4186 S_reghop3(pTHX_ U8 *s, I32 off, U8* lim)
4187 {
4188     if (off >= 0) {
4189         while (off-- && s < lim) {
4190             /* XXX could check well-formedness here */
4191             s += UTF8SKIP(s);
4192         }
4193     }
4194     else {
4195         while (off++) {
4196             if (s > lim) {
4197                 s--;
4198                 if (UTF8_IS_CONTINUED(*s)) {
4199                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4200                         s--;
4201                 }
4202                 /* XXX could check well-formedness here */
4203             }
4204         }
4205     }
4206     return s;
4207 }
4208
4209 STATIC U8 *
4210 S_reghopmaybe(pTHX_ U8 *s, I32 off)
4211 {
4212     return S_reghopmaybe3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4213 }
4214
4215 STATIC U8 *
4216 S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim)
4217 {
4218     if (off >= 0) {
4219         while (off-- && s < lim) {
4220             /* XXX could check well-formedness here */
4221             s += UTF8SKIP(s);
4222         }
4223         if (off >= 0)
4224             return 0;
4225     }
4226     else {
4227         while (off++) {
4228             if (s > lim) {
4229                 s--;
4230                 if (UTF8_IS_CONTINUED(*s)) {
4231                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4232                         s--;
4233                 }
4234                 /* XXX could check well-formedness here */
4235             }
4236             else
4237                 break;
4238         }
4239         if (off <= 0)
4240             return 0;
4241     }
4242     return s;
4243 }
4244
4245 static void
4246 restore_pos(pTHX_ void *arg)
4247 {
4248     if (PL_reg_eval_set) {
4249         if (PL_reg_oldsaved) {
4250             PL_reg_re->subbeg = PL_reg_oldsaved;
4251             PL_reg_re->sublen = PL_reg_oldsavedlen;
4252             RX_MATCH_COPIED_on(PL_reg_re);
4253         }
4254         PL_reg_magic->mg_len = PL_reg_oldpos;
4255         PL_reg_eval_set = 0;
4256         PL_curpm = PL_reg_oldcurpm;
4257     }   
4258 }