4fe7889afb9803bdffd448a1cfa6c3757a608bb6
[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_UCLC+1];
936                 U8 tmpbuf2[UTF8_MAXLEN_UCLC+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 == len ||
974                                  ibcmp_utf8(s, do_utf8,  strend - s,
975                                             m, UTF, ln))
976                              && (norun || regtry(prog, s)) )
977                             goto got_it;
978                         s += len;
979                     }
980                 else
981                     while (s <= e) {
982                         UV c = utf8_to_uvchr((U8*)s, &len);
983                         if ( (c == c1 || c == c2)
984                              && (ln == len ||
985                                  ibcmp_utf8(s, do_utf8, strend - s,
986                                             m, UTF, ln))
987                              && (norun || regtry(prog, s)) )
988                             goto got_it;
989                         s += len;
990                     }
991             }
992             else {
993                 if (c1 == c2)
994                     while (s <= e) {
995                         if ( *(U8*)s == c1
996                              && (ln == 1 || !(OP(c) == EXACTF
997                                               ? ibcmp(s, m, ln)
998                                               : ibcmp_locale(s, m, ln)))
999                              && (norun || regtry(prog, s)) )
1000                             goto got_it;
1001                         s++;
1002                     }
1003                 else
1004                     while (s <= e) {
1005                         if ( (*(U8*)s == c1 || *(U8*)s == c2)
1006                              && (ln == 1 || !(OP(c) == EXACTF
1007                                               ? ibcmp(s, m, ln)
1008                                               : ibcmp_locale(s, m, ln)))
1009                              && (norun || regtry(prog, s)) )
1010                             goto got_it;
1011                         s++;
1012                     }
1013             }
1014             break;
1015         case BOUNDL:
1016             PL_reg_flags |= RF_tainted;
1017             /* FALL THROUGH */
1018         case BOUND:
1019             if (do_utf8) {
1020                 if (s == PL_bostr)
1021                     tmp = '\n';
1022                 else {
1023                     U8 *r = reghop3((U8*)s, -1, (U8*)startpos);
1024                 
1025                     if (s > (char*)r)
1026                         tmp = (I32)utf8n_to_uvchr(r, s - (char*)r, 0, 0);
1027                 }
1028                 tmp = ((OP(c) == BOUND ?
1029                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1030                 LOAD_UTF8_CHARCLASS(alnum,"a");
1031                 while (s < strend) {
1032                     if (tmp == !(OP(c) == BOUND ?
1033                                  swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1034                                  isALNUM_LC_utf8((U8*)s)))
1035                     {
1036                         tmp = !tmp;
1037                         if ((norun || regtry(prog, s)))
1038                             goto got_it;
1039                     }
1040                     s += UTF8SKIP(s);
1041                 }
1042             }
1043             else {
1044                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1045                 tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1046                 while (s < strend) {
1047                     if (tmp ==
1048                         !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
1049                         tmp = !tmp;
1050                         if ((norun || regtry(prog, s)))
1051                             goto got_it;
1052                     }
1053                     s++;
1054                 }
1055             }
1056             if ((!prog->minlen && tmp) && (norun || regtry(prog, s)))
1057                 goto got_it;
1058             break;
1059         case NBOUNDL:
1060             PL_reg_flags |= RF_tainted;
1061             /* FALL THROUGH */
1062         case NBOUND:
1063             if (do_utf8) {
1064                 if (s == PL_bostr)
1065                     tmp = '\n';
1066                 else {
1067                     U8 *r = reghop3((U8*)s, -1, (U8*)startpos);
1068                 
1069                     if (s > (char*)r)
1070                         tmp = (I32)utf8n_to_uvchr(r, s - (char*)r, 0, 0);
1071                 }
1072                 tmp = ((OP(c) == NBOUND ?
1073                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1074                 LOAD_UTF8_CHARCLASS(alnum,"a");
1075                 while (s < strend) {
1076                     if (tmp == !(OP(c) == NBOUND ?
1077                                  swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1078                                  isALNUM_LC_utf8((U8*)s)))
1079                         tmp = !tmp;
1080                     else if ((norun || regtry(prog, s)))
1081                         goto got_it;
1082                     s += UTF8SKIP(s);
1083                 }
1084             }
1085             else {
1086                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1087                 tmp = ((OP(c) == NBOUND ?
1088                         isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1089                 while (s < strend) {
1090                     if (tmp ==
1091                         !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
1092                         tmp = !tmp;
1093                     else if ((norun || regtry(prog, s)))
1094                         goto got_it;
1095                     s++;
1096                 }
1097             }
1098             if ((!prog->minlen && !tmp) && (norun || regtry(prog, s)))
1099                 goto got_it;
1100             break;
1101         case ALNUM:
1102             if (do_utf8) {
1103                 LOAD_UTF8_CHARCLASS(alnum,"a");
1104                 while (s < strend) {
1105                     if (swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) {
1106                         if (tmp && (norun || regtry(prog, s)))
1107                             goto got_it;
1108                         else
1109                             tmp = doevery;
1110                     }
1111                     else
1112                         tmp = 1;
1113                     s += UTF8SKIP(s);
1114                 }
1115             }
1116             else {
1117                 while (s < strend) {
1118                     if (isALNUM(*s)) {
1119                         if (tmp && (norun || regtry(prog, s)))
1120                             goto got_it;
1121                         else
1122                             tmp = doevery;
1123                     }
1124                     else
1125                         tmp = 1;
1126                     s++;
1127                 }
1128             }
1129             break;
1130         case ALNUML:
1131             PL_reg_flags |= RF_tainted;
1132             if (do_utf8) {
1133                 while (s < strend) {
1134                     if (isALNUM_LC_utf8((U8*)s)) {
1135                         if (tmp && (norun || regtry(prog, s)))
1136                             goto got_it;
1137                         else
1138                             tmp = doevery;
1139                     }
1140                     else
1141                         tmp = 1;
1142                     s += UTF8SKIP(s);
1143                 }
1144             }
1145             else {
1146                 while (s < strend) {
1147                     if (isALNUM_LC(*s)) {
1148                         if (tmp && (norun || regtry(prog, s)))
1149                             goto got_it;
1150                         else
1151                             tmp = doevery;
1152                     }
1153                     else
1154                         tmp = 1;
1155                     s++;
1156                 }
1157             }
1158             break;
1159         case NALNUM:
1160             if (do_utf8) {
1161                 LOAD_UTF8_CHARCLASS(alnum,"a");
1162                 while (s < strend) {
1163                     if (!swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) {
1164                         if (tmp && (norun || regtry(prog, s)))
1165                             goto got_it;
1166                         else
1167                             tmp = doevery;
1168                     }
1169                     else
1170                         tmp = 1;
1171                     s += UTF8SKIP(s);
1172                 }
1173             }
1174             else {
1175                 while (s < strend) {
1176                     if (!isALNUM(*s)) {
1177                         if (tmp && (norun || regtry(prog, s)))
1178                             goto got_it;
1179                         else
1180                             tmp = doevery;
1181                     }
1182                     else
1183                         tmp = 1;
1184                     s++;
1185                 }
1186             }
1187             break;
1188         case NALNUML:
1189             PL_reg_flags |= RF_tainted;
1190             if (do_utf8) {
1191                 while (s < strend) {
1192                     if (!isALNUM_LC_utf8((U8*)s)) {
1193                         if (tmp && (norun || regtry(prog, s)))
1194                             goto got_it;
1195                         else
1196                             tmp = doevery;
1197                     }
1198                     else
1199                         tmp = 1;
1200                     s += UTF8SKIP(s);
1201                 }
1202             }
1203             else {
1204                 while (s < strend) {
1205                     if (!isALNUM_LC(*s)) {
1206                         if (tmp && (norun || regtry(prog, s)))
1207                             goto got_it;
1208                         else
1209                             tmp = doevery;
1210                     }
1211                     else
1212                         tmp = 1;
1213                     s++;
1214                 }
1215             }
1216             break;
1217         case SPACE:
1218             if (do_utf8) {
1219                 LOAD_UTF8_CHARCLASS(space," ");
1220                 while (s < strend) {
1221                     if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8)) {
1222                         if (tmp && (norun || regtry(prog, s)))
1223                             goto got_it;
1224                         else
1225                             tmp = doevery;
1226                     }
1227                     else
1228                         tmp = 1;
1229                     s += UTF8SKIP(s);
1230                 }
1231             }
1232             else {
1233                 while (s < strend) {
1234                     if (isSPACE(*s)) {
1235                         if (tmp && (norun || regtry(prog, s)))
1236                             goto got_it;
1237                         else
1238                             tmp = doevery;
1239                     }
1240                     else
1241                         tmp = 1;
1242                     s++;
1243                 }
1244             }
1245             break;
1246         case SPACEL:
1247             PL_reg_flags |= RF_tainted;
1248             if (do_utf8) {
1249                 while (s < strend) {
1250                     if (*s == ' ' || isSPACE_LC_utf8((U8*)s)) {
1251                         if (tmp && (norun || regtry(prog, s)))
1252                             goto got_it;
1253                         else
1254                             tmp = doevery;
1255                     }
1256                     else
1257                         tmp = 1;
1258                     s += UTF8SKIP(s);
1259                 }
1260             }
1261             else {
1262                 while (s < strend) {
1263                     if (isSPACE_LC(*s)) {
1264                         if (tmp && (norun || regtry(prog, s)))
1265                             goto got_it;
1266                         else
1267                             tmp = doevery;
1268                     }
1269                     else
1270                         tmp = 1;
1271                     s++;
1272                 }
1273             }
1274             break;
1275         case NSPACE:
1276             if (do_utf8) {
1277                 LOAD_UTF8_CHARCLASS(space," ");
1278                 while (s < strend) {
1279                     if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8))) {
1280                         if (tmp && (norun || regtry(prog, s)))
1281                             goto got_it;
1282                         else
1283                             tmp = doevery;
1284                     }
1285                     else
1286                         tmp = 1;
1287                     s += UTF8SKIP(s);
1288                 }
1289             }
1290             else {
1291                 while (s < strend) {
1292                     if (!isSPACE(*s)) {
1293                         if (tmp && (norun || regtry(prog, s)))
1294                             goto got_it;
1295                         else
1296                             tmp = doevery;
1297                     }
1298                     else
1299                         tmp = 1;
1300                     s++;
1301                 }
1302             }
1303             break;
1304         case NSPACEL:
1305             PL_reg_flags |= RF_tainted;
1306             if (do_utf8) {
1307                 while (s < strend) {
1308                     if (!(*s == ' ' || isSPACE_LC_utf8((U8*)s))) {
1309                         if (tmp && (norun || regtry(prog, s)))
1310                             goto got_it;
1311                         else
1312                             tmp = doevery;
1313                     }
1314                     else
1315                         tmp = 1;
1316                     s += UTF8SKIP(s);
1317                 }
1318             }
1319             else {
1320                 while (s < strend) {
1321                     if (!isSPACE_LC(*s)) {
1322                         if (tmp && (norun || regtry(prog, s)))
1323                             goto got_it;
1324                         else
1325                             tmp = doevery;
1326                     }
1327                     else
1328                         tmp = 1;
1329                     s++;
1330                 }
1331             }
1332             break;
1333         case DIGIT:
1334             if (do_utf8) {
1335                 LOAD_UTF8_CHARCLASS(digit,"0");
1336                 while (s < strend) {
1337                     if (swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) {
1338                         if (tmp && (norun || regtry(prog, s)))
1339                             goto got_it;
1340                         else
1341                             tmp = doevery;
1342                     }
1343                     else
1344                         tmp = 1;
1345                     s += UTF8SKIP(s);
1346                 }
1347             }
1348             else {
1349                 while (s < strend) {
1350                     if (isDIGIT(*s)) {
1351                         if (tmp && (norun || regtry(prog, s)))
1352                             goto got_it;
1353                         else
1354                             tmp = doevery;
1355                     }
1356                     else
1357                         tmp = 1;
1358                     s++;
1359                 }
1360             }
1361             break;
1362         case DIGITL:
1363             PL_reg_flags |= RF_tainted;
1364             if (do_utf8) {
1365                 while (s < strend) {
1366                     if (isDIGIT_LC_utf8((U8*)s)) {
1367                         if (tmp && (norun || regtry(prog, s)))
1368                             goto got_it;
1369                         else
1370                             tmp = doevery;
1371                     }
1372                     else
1373                         tmp = 1;
1374                     s += UTF8SKIP(s);
1375                 }
1376             }
1377             else {
1378                 while (s < strend) {
1379                     if (isDIGIT_LC(*s)) {
1380                         if (tmp && (norun || regtry(prog, s)))
1381                             goto got_it;
1382                         else
1383                             tmp = doevery;
1384                     }
1385                     else
1386                         tmp = 1;
1387                     s++;
1388                 }
1389             }
1390             break;
1391         case NDIGIT:
1392             if (do_utf8) {
1393                 LOAD_UTF8_CHARCLASS(digit,"0");
1394                 while (s < strend) {
1395                     if (!swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) {
1396                         if (tmp && (norun || regtry(prog, s)))
1397                             goto got_it;
1398                         else
1399                             tmp = doevery;
1400                     }
1401                     else
1402                         tmp = 1;
1403                     s += UTF8SKIP(s);
1404                 }
1405             }
1406             else {
1407                 while (s < strend) {
1408                     if (!isDIGIT(*s)) {
1409                         if (tmp && (norun || regtry(prog, s)))
1410                             goto got_it;
1411                         else
1412                             tmp = doevery;
1413                     }
1414                     else
1415                         tmp = 1;
1416                     s++;
1417                 }
1418             }
1419             break;
1420         case NDIGITL:
1421             PL_reg_flags |= RF_tainted;
1422             if (do_utf8) {
1423                 while (s < strend) {
1424                     if (!isDIGIT_LC_utf8((U8*)s)) {
1425                         if (tmp && (norun || regtry(prog, s)))
1426                             goto got_it;
1427                         else
1428                             tmp = doevery;
1429                     }
1430                     else
1431                         tmp = 1;
1432                     s += UTF8SKIP(s);
1433                 }
1434             }
1435             else {
1436                 while (s < strend) {
1437                     if (!isDIGIT_LC(*s)) {
1438                         if (tmp && (norun || regtry(prog, s)))
1439                             goto got_it;
1440                         else
1441                             tmp = doevery;
1442                     }
1443                     else
1444                         tmp = 1;
1445                     s++;
1446                 }
1447             }
1448             break;
1449         default:
1450             Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
1451             break;
1452         }
1453         return 0;
1454       got_it:
1455         return s;
1456 }
1457
1458 /*
1459  - regexec_flags - match a regexp against a string
1460  */
1461 I32
1462 Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *strend,
1463               char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
1464 /* strend: pointer to null at end of string */
1465 /* strbeg: real beginning of string */
1466 /* minend: end of match must be >=minend after stringarg. */
1467 /* data: May be used for some additional optimizations. */
1468 /* nosave: For optimizations. */
1469 {
1470     register char *s;
1471     register regnode *c;
1472     register char *startpos = stringarg;
1473     I32 minlen;         /* must match at least this many chars */
1474     I32 dontbother = 0; /* how many characters not to try at end */
1475     /* I32 start_shift = 0; */          /* Offset of the start to find
1476                                          constant substr. */            /* CC */
1477     I32 end_shift = 0;                  /* Same for the end. */         /* CC */
1478     I32 scream_pos = -1;                /* Internal iterator of scream. */
1479     char *scream_olds;
1480     SV* oreplsv = GvSV(PL_replgv);
1481     bool do_utf8 = DO_UTF8(sv);
1482 #ifdef DEBUGGING
1483     SV *dsv = PERL_DEBUG_PAD_ZERO(0);
1484 #endif
1485
1486     PL_regcc = 0;
1487
1488     cache_re(prog);
1489 #ifdef DEBUGGING
1490     PL_regnarrate = DEBUG_r_TEST;
1491 #endif
1492
1493     /* Be paranoid... */
1494     if (prog == NULL || startpos == NULL) {
1495         Perl_croak(aTHX_ "NULL regexp parameter");
1496         return 0;
1497     }
1498
1499     minlen = prog->minlen;
1500     if (strend - startpos < minlen) {
1501         DEBUG_r(PerlIO_printf(Perl_debug_log,
1502                               "String too short [regexec_flags]...\n"));
1503         goto phooey;
1504     }
1505
1506     /* Check validity of program. */
1507     if (UCHARAT(prog->program) != REG_MAGIC) {
1508         Perl_croak(aTHX_ "corrupted regexp program");
1509     }
1510
1511     PL_reg_flags = 0;
1512     PL_reg_eval_set = 0;
1513     PL_reg_maxiter = 0;
1514
1515     if (prog->reganch & ROPT_UTF8)
1516         PL_reg_flags |= RF_utf8;
1517
1518     /* Mark beginning of line for ^ and lookbehind. */
1519     PL_regbol = startpos;
1520     PL_bostr  = strbeg;
1521     PL_reg_sv = sv;
1522
1523     /* Mark end of line for $ (and such) */
1524     PL_regeol = strend;
1525
1526     /* see how far we have to get to not match where we matched before */
1527     PL_regtill = startpos+minend;
1528
1529     /* We start without call_cc context.  */
1530     PL_reg_call_cc = 0;
1531
1532     /* If there is a "must appear" string, look for it. */
1533     s = startpos;
1534
1535     if (prog->reganch & ROPT_GPOS_SEEN) { /* Need to have PL_reg_ganch */
1536         MAGIC *mg;
1537
1538         if (flags & REXEC_IGNOREPOS)    /* Means: check only at start */
1539             PL_reg_ganch = startpos;
1540         else if (sv && SvTYPE(sv) >= SVt_PVMG
1541                   && SvMAGIC(sv)
1542                   && (mg = mg_find(sv, PERL_MAGIC_regex_global))
1543                   && mg->mg_len >= 0) {
1544             PL_reg_ganch = strbeg + mg->mg_len; /* Defined pos() */
1545             if (prog->reganch & ROPT_ANCH_GPOS) {
1546                 if (s > PL_reg_ganch)
1547                     goto phooey;
1548                 s = PL_reg_ganch;
1549             }
1550         }
1551         else                            /* pos() not defined */
1552             PL_reg_ganch = strbeg;
1553     }
1554
1555     if (do_utf8 == (UTF!=0) &&
1556         !(flags & REXEC_CHECKED) && prog->check_substr != Nullsv) {
1557         re_scream_pos_data d;
1558
1559         d.scream_olds = &scream_olds;
1560         d.scream_pos = &scream_pos;
1561         s = re_intuit_start(prog, sv, s, strend, flags, &d);
1562         if (!s) {
1563             DEBUG_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
1564             goto phooey;        /* not present */
1565         }
1566     }
1567
1568     DEBUG_r({
1569          char *s   = do_utf8 ? sv_uni_display(dsv, sv, 60, 0) : startpos;
1570          int   len = do_utf8 ? strlen(s) : strend - startpos;
1571          if (!PL_colorset)
1572              reginitcolors();
1573          PerlIO_printf(Perl_debug_log,
1574                        "%sMatching REx%s `%s%.60s%s%s' against `%s%.*s%s%s'\n",
1575                        PL_colors[4],PL_colors[5],PL_colors[0],
1576                        prog->precomp,
1577                        PL_colors[1],
1578                        (strlen(prog->precomp) > 60 ? "..." : ""),
1579                        PL_colors[0],
1580                        (int)(len > 60 ? 60 : len),
1581                        s, PL_colors[1],
1582                        (len > 60 ? "..." : "")
1583               );
1584     });
1585
1586     /* Simplest case:  anchored match need be tried only once. */
1587     /*  [unless only anchor is BOL and multiline is set] */
1588     if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
1589         if (s == startpos && regtry(prog, startpos))
1590             goto got_it;
1591         else if (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
1592                  || (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
1593         {
1594             char *end;
1595
1596             if (minlen)
1597                 dontbother = minlen - 1;
1598             end = HOP3c(strend, -dontbother, strbeg) - 1;
1599             /* for multiline we only have to try after newlines */
1600             if (prog->check_substr) {
1601                 if (s == startpos)
1602                     goto after_try;
1603                 while (1) {
1604                     if (regtry(prog, s))
1605                         goto got_it;
1606                   after_try:
1607                     if (s >= end)
1608                         goto phooey;
1609                     if (prog->reganch & RE_USE_INTUIT) {
1610                         s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
1611                         if (!s)
1612                             goto phooey;
1613                     }
1614                     else
1615                         s++;
1616                 }               
1617             } else {
1618                 if (s > startpos)
1619                     s--;
1620                 while (s < end) {
1621                     if (*s++ == '\n') { /* don't need PL_utf8skip here */
1622                         if (regtry(prog, s))
1623                             goto got_it;
1624                     }
1625                 }               
1626             }
1627         }
1628         goto phooey;
1629     } else if (prog->reganch & ROPT_ANCH_GPOS) {
1630         if (regtry(prog, PL_reg_ganch))
1631             goto got_it;
1632         goto phooey;
1633     }
1634
1635     /* Messy cases:  unanchored match. */
1636     if (prog->anchored_substr && prog->reganch & ROPT_SKIP) {
1637         /* we have /x+whatever/ */
1638         /* it must be a one character string (XXXX Except UTF?) */
1639         char ch = SvPVX(prog->anchored_substr)[0];
1640 #ifdef DEBUGGING
1641         int did_match = 0;
1642 #endif
1643
1644         if (do_utf8) {
1645             while (s < strend) {
1646                 if (*s == ch) {
1647                     DEBUG_r( did_match = 1 );
1648                     if (regtry(prog, s)) goto got_it;
1649                     s += UTF8SKIP(s);
1650                     while (s < strend && *s == ch)
1651                         s += UTF8SKIP(s);
1652                 }
1653                 s += UTF8SKIP(s);
1654             }
1655         }
1656         else {
1657             while (s < strend) {
1658                 if (*s == ch) {
1659                     DEBUG_r( did_match = 1 );
1660                     if (regtry(prog, s)) goto got_it;
1661                     s++;
1662                     while (s < strend && *s == ch)
1663                         s++;
1664                 }
1665                 s++;
1666             }
1667         }
1668         DEBUG_r(if (!did_match)
1669                 PerlIO_printf(Perl_debug_log,
1670                                   "Did not find anchored character...\n")
1671                );
1672     }
1673     /*SUPPRESS 560*/
1674     else if (do_utf8 == (UTF!=0) &&
1675              (prog->anchored_substr != Nullsv
1676               || (prog->float_substr != Nullsv
1677                   && prog->float_max_offset < strend - s))) {
1678         SV *must = prog->anchored_substr
1679             ? prog->anchored_substr : prog->float_substr;
1680         I32 back_max =
1681             prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset;
1682         I32 back_min =
1683             prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset;
1684         char *last = HOP3c(strend,      /* Cannot start after this */
1685                           -(I32)(CHR_SVLEN(must)
1686                                  - (SvTAIL(must) != 0) + back_min), strbeg);
1687         char *last1;            /* Last position checked before */
1688 #ifdef DEBUGGING
1689         int did_match = 0;
1690 #endif
1691
1692         if (s > PL_bostr)
1693             last1 = HOPc(s, -1);
1694         else
1695             last1 = s - 1;      /* bogus */
1696
1697         /* XXXX check_substr already used to find `s', can optimize if
1698            check_substr==must. */
1699         scream_pos = -1;
1700         dontbother = end_shift;
1701         strend = HOPc(strend, -dontbother);
1702         while ( (s <= last) &&
1703                 ((flags & REXEC_SCREAM)
1704                  ? (s = screaminstr(sv, must, HOP3c(s, back_min, strend) - strbeg,
1705                                     end_shift, &scream_pos, 0))
1706                  : (s = fbm_instr((unsigned char*)HOP3(s, back_min, strend),
1707                                   (unsigned char*)strend, must,
1708                                   PL_multiline ? FBMrf_MULTILINE : 0))) ) {
1709             DEBUG_r( did_match = 1 );
1710             if (HOPc(s, -back_max) > last1) {
1711                 last1 = HOPc(s, -back_min);
1712                 s = HOPc(s, -back_max);
1713             }
1714             else {
1715                 char *t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
1716
1717                 last1 = HOPc(s, -back_min);
1718                 s = t;          
1719             }
1720             if (do_utf8) {
1721                 while (s <= last1) {
1722                     if (regtry(prog, s))
1723                         goto got_it;
1724                     s += UTF8SKIP(s);
1725                 }
1726             }
1727             else {
1728                 while (s <= last1) {
1729                     if (regtry(prog, s))
1730                         goto got_it;
1731                     s++;
1732                 }
1733             }
1734         }
1735         DEBUG_r(if (!did_match)
1736                     PerlIO_printf(Perl_debug_log, 
1737                                   "Did not find %s substr `%s%.*s%s'%s...\n",
1738                               ((must == prog->anchored_substr)
1739                                ? "anchored" : "floating"),
1740                               PL_colors[0],
1741                               (int)(SvCUR(must) - (SvTAIL(must)!=0)),
1742                               SvPVX(must),
1743                                   PL_colors[1], (SvTAIL(must) ? "$" : ""))
1744                );
1745         goto phooey;
1746     }
1747     else if ((c = prog->regstclass)) {
1748         if (minlen && PL_regkind[(U8)OP(prog->regstclass)] != EXACT)
1749             /* don't bother with what can't match */
1750             strend = HOPc(strend, -(minlen - 1));
1751         DEBUG_r({
1752             SV *prop = sv_newmortal();
1753             regprop(prop, c);
1754             PerlIO_printf(Perl_debug_log, "Matching stclass `%s' against `%s'\n", SvPVX(prop), UTF ? sv_uni_display(dsv, sv, 60, 0) : s);
1755         });
1756         if (find_byclass(prog, c, s, strend, startpos, 0))
1757             goto got_it;
1758         DEBUG_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass...\n"));
1759     }
1760     else {
1761         dontbother = 0;
1762         if (prog->float_substr != Nullsv) {     /* Trim the end. */
1763             char *last;
1764
1765             if (flags & REXEC_SCREAM) {
1766                 last = screaminstr(sv, prog->float_substr, s - strbeg,
1767                                    end_shift, &scream_pos, 1); /* last one */
1768                 if (!last)
1769                     last = scream_olds; /* Only one occurrence. */
1770             }
1771             else {
1772                 STRLEN len;
1773                 char *little = SvPV(prog->float_substr, len);
1774
1775                 if (SvTAIL(prog->float_substr)) {
1776                     if (memEQ(strend - len + 1, little, len - 1))
1777                         last = strend - len + 1;
1778                     else if (!PL_multiline)
1779                         last = memEQ(strend - len, little, len)
1780                             ? strend - len : Nullch;
1781                     else
1782                         goto find_last;
1783                 } else {
1784                   find_last:
1785                     if (len)
1786                         last = rninstr(s, strend, little, little + len);
1787                     else
1788                         last = strend;  /* matching `$' */
1789                 }
1790             }
1791             if (last == NULL) {
1792                 DEBUG_r(PerlIO_printf(Perl_debug_log,
1793                                       "%sCan't trim the tail, match fails (should not happen)%s\n",
1794                                       PL_colors[4],PL_colors[5]));
1795                 goto phooey; /* Should not happen! */
1796             }
1797             dontbother = strend - last + prog->float_min_offset;
1798         }
1799         if (minlen && (dontbother < minlen))
1800             dontbother = minlen - 1;
1801         strend -= dontbother;              /* this one's always in bytes! */
1802         /* We don't know much -- general case. */
1803         if (do_utf8) {
1804             for (;;) {
1805                 if (regtry(prog, s))
1806                     goto got_it;
1807                 if (s >= strend)
1808                     break;
1809                 s += UTF8SKIP(s);
1810             };
1811         }
1812         else {
1813             do {
1814                 if (regtry(prog, s))
1815                     goto got_it;
1816             } while (s++ < strend);
1817         }
1818     }
1819
1820     /* Failure. */
1821     goto phooey;
1822
1823 got_it:
1824     RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
1825
1826     if (PL_reg_eval_set) {
1827         /* Preserve the current value of $^R */
1828         if (oreplsv != GvSV(PL_replgv))
1829             sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
1830                                                   restored, the value remains
1831                                                   the same. */
1832         restore_pos(aTHX_ 0);
1833     }
1834
1835     /* make sure $`, $&, $', and $digit will work later */
1836     if ( !(flags & REXEC_NOT_FIRST) ) {
1837         if (RX_MATCH_COPIED(prog)) {
1838             Safefree(prog->subbeg);
1839             RX_MATCH_COPIED_off(prog);
1840         }
1841         if (flags & REXEC_COPY_STR) {
1842             I32 i = PL_regeol - startpos + (stringarg - strbeg);
1843
1844             s = savepvn(strbeg, i);
1845             prog->subbeg = s;
1846             prog->sublen = i;
1847             RX_MATCH_COPIED_on(prog);
1848         }
1849         else {
1850             prog->subbeg = strbeg;
1851             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
1852         }
1853     }
1854
1855     return 1;
1856
1857 phooey:
1858     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
1859                           PL_colors[4],PL_colors[5]));
1860     if (PL_reg_eval_set)
1861         restore_pos(aTHX_ 0);
1862     return 0;
1863 }
1864
1865 /*
1866  - regtry - try match at specific point
1867  */
1868 STATIC I32                      /* 0 failure, 1 success */
1869 S_regtry(pTHX_ regexp *prog, char *startpos)
1870 {
1871     register I32 i;
1872     register I32 *sp;
1873     register I32 *ep;
1874     CHECKPOINT lastcp;
1875
1876 #ifdef DEBUGGING
1877     PL_regindent = 0;   /* XXXX Not good when matches are reenterable... */
1878 #endif
1879     if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
1880         MAGIC *mg;
1881
1882         PL_reg_eval_set = RS_init;
1883         DEBUG_r(DEBUG_s(
1884             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %"IVdf"\n",
1885                           (IV)(PL_stack_sp - PL_stack_base));
1886             ));
1887         SAVEI32(cxstack[cxstack_ix].blk_oldsp);
1888         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
1889         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
1890         SAVETMPS;
1891         /* Apparently this is not needed, judging by wantarray. */
1892         /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
1893            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
1894
1895         if (PL_reg_sv) {
1896             /* Make $_ available to executed code. */
1897             if (PL_reg_sv != DEFSV) {
1898                 /* SAVE_DEFSV does *not* suffice here for USE_5005THREADS */
1899                 SAVESPTR(DEFSV);
1900                 DEFSV = PL_reg_sv;
1901             }
1902         
1903             if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv)
1904                   && (mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global)))) {
1905                 /* prepare for quick setting of pos */
1906                 sv_magic(PL_reg_sv, (SV*)0,
1907                         PERL_MAGIC_regex_global, Nullch, 0);
1908                 mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global);
1909                 mg->mg_len = -1;
1910             }
1911             PL_reg_magic    = mg;
1912             PL_reg_oldpos   = mg->mg_len;
1913             SAVEDESTRUCTOR_X(restore_pos, 0);
1914         }
1915         if (!PL_reg_curpm) {
1916             Newz(22,PL_reg_curpm, 1, PMOP);
1917 #ifdef USE_ITHREADS
1918             {
1919                 SV* repointer = newSViv(0);
1920                 /* so we know which PL_regex_padav element is PL_reg_curpm */
1921                 SvFLAGS(repointer) |= SVf_BREAK;
1922                 av_push(PL_regex_padav,repointer);
1923                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
1924                 PL_regex_pad = AvARRAY(PL_regex_padav);
1925             }
1926 #endif      
1927         }
1928         PM_SETRE(PL_reg_curpm, prog);
1929         PL_reg_oldcurpm = PL_curpm;
1930         PL_curpm = PL_reg_curpm;
1931         if (RX_MATCH_COPIED(prog)) {
1932             /*  Here is a serious problem: we cannot rewrite subbeg,
1933                 since it may be needed if this match fails.  Thus
1934                 $` inside (?{}) could fail... */
1935             PL_reg_oldsaved = prog->subbeg;
1936             PL_reg_oldsavedlen = prog->sublen;
1937             RX_MATCH_COPIED_off(prog);
1938         }
1939         else
1940             PL_reg_oldsaved = Nullch;
1941         prog->subbeg = PL_bostr;
1942         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
1943     }
1944     prog->startp[0] = startpos - PL_bostr;
1945     PL_reginput = startpos;
1946     PL_regstartp = prog->startp;
1947     PL_regendp = prog->endp;
1948     PL_reglastparen = &prog->lastparen;
1949     PL_reglastcloseparen = &prog->lastcloseparen;
1950     prog->lastparen = 0;
1951     PL_regsize = 0;
1952     DEBUG_r(PL_reg_starttry = startpos);
1953     if (PL_reg_start_tmpl <= prog->nparens) {
1954         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
1955         if(PL_reg_start_tmp)
1956             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
1957         else
1958             New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*);
1959     }
1960
1961 #ifdef DEBUGGING
1962     sv_setpvn(PERL_DEBUG_PAD(0), "", 0);
1963     sv_setpvn(PERL_DEBUG_PAD(1), "", 0);
1964     sv_setpvn(PERL_DEBUG_PAD(2), "", 0);
1965 #endif
1966
1967     /* XXXX What this code is doing here?!!!  There should be no need
1968        to do this again and again, PL_reglastparen should take care of
1969        this!  --ilya*/
1970
1971     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
1972      * Actually, the code in regcppop() (which Ilya may be meaning by
1973      * PL_reglastparen), is not needed at all by the test suite
1974      * (op/regexp, op/pat, op/split), but that code is needed, oddly
1975      * enough, for building DynaLoader, or otherwise this
1976      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
1977      * will happen.  Meanwhile, this code *is* needed for the
1978      * above-mentioned test suite tests to succeed.  The common theme
1979      * on those tests seems to be returning null fields from matches.
1980      * --jhi */
1981 #if 1
1982     sp = prog->startp;
1983     ep = prog->endp;
1984     if (prog->nparens) {
1985         for (i = prog->nparens; i > *PL_reglastparen; i--) {
1986             *++sp = -1;
1987             *++ep = -1;
1988         }
1989     }
1990 #endif
1991     REGCP_SET(lastcp);
1992     if (regmatch(prog->program + 1)) {
1993         prog->endp[0] = PL_reginput - PL_bostr;
1994         return 1;
1995     }
1996     REGCP_UNWIND(lastcp);
1997     return 0;
1998 }
1999
2000 #define RE_UNWIND_BRANCH        1
2001 #define RE_UNWIND_BRANCHJ       2
2002
2003 union re_unwind_t;
2004
2005 typedef struct {                /* XX: makes sense to enlarge it... */
2006     I32 type;
2007     I32 prev;
2008     CHECKPOINT lastcp;
2009 } re_unwind_generic_t;
2010
2011 typedef struct {
2012     I32 type;
2013     I32 prev;
2014     CHECKPOINT lastcp;
2015     I32 lastparen;
2016     regnode *next;
2017     char *locinput;
2018     I32 nextchr;
2019 #ifdef DEBUGGING
2020     int regindent;
2021 #endif
2022 } re_unwind_branch_t;
2023
2024 typedef union re_unwind_t {
2025     I32 type;
2026     re_unwind_generic_t generic;
2027     re_unwind_branch_t branch;
2028 } re_unwind_t;
2029
2030 #define sayYES goto yes
2031 #define sayNO goto no
2032 #define sayYES_FINAL goto yes_final
2033 #define sayYES_LOUD  goto yes_loud
2034 #define sayNO_FINAL  goto no_final
2035 #define sayNO_SILENT goto do_no
2036 #define saySAME(x) if (x) goto yes; else goto no
2037
2038 #define REPORT_CODE_OFF 24
2039
2040 /*
2041  - regmatch - main matching routine
2042  *
2043  * Conceptually the strategy is simple:  check to see whether the current
2044  * node matches, call self recursively to see whether the rest matches,
2045  * and then act accordingly.  In practice we make some effort to avoid
2046  * recursion, in particular by going through "ordinary" nodes (that don't
2047  * need to know whether the rest of the match failed) by a loop instead of
2048  * by recursion.
2049  */
2050 /* [lwall] I've hoisted the register declarations to the outer block in order to
2051  * maybe save a little bit of pushing and popping on the stack.  It also takes
2052  * advantage of machines that use a register save mask on subroutine entry.
2053  */
2054 STATIC I32                      /* 0 failure, 1 success */
2055 S_regmatch(pTHX_ regnode *prog)
2056 {
2057     register regnode *scan;     /* Current node. */
2058     regnode *next;              /* Next node. */
2059     regnode *inner;             /* Next node in internal branch. */
2060     register I32 nextchr;       /* renamed nextchr - nextchar colides with
2061                                    function of same name */
2062     register I32 n;             /* no or next */
2063     register I32 ln = 0;        /* len or last */
2064     register char *s = Nullch;  /* operand or save */
2065     register char *locinput = PL_reginput;
2066     register I32 c1 = 0, c2 = 0, paren; /* case fold search, parenth */
2067     int minmod = 0, sw = 0, logical = 0;
2068     I32 unwind = 0;
2069 #if 0
2070     I32 firstcp = PL_savestack_ix;
2071 #endif
2072     register bool do_utf8 = PL_reg_match_utf8;
2073 #ifdef DEBUGGING
2074     SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
2075     SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
2076     SV *dsv2 = PERL_DEBUG_PAD_ZERO(2);
2077 #endif
2078
2079 #ifdef DEBUGGING
2080     PL_regindent++;
2081 #endif
2082
2083     /* Note that nextchr is a byte even in UTF */
2084     nextchr = UCHARAT(locinput);
2085     scan = prog;
2086     while (scan != NULL) {
2087
2088         DEBUG_r( {
2089             SV *prop = sv_newmortal();
2090             int docolor = *PL_colors[0];
2091             int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
2092             int l = (PL_regeol - locinput) > taill ? taill : (PL_regeol - locinput);
2093             /* The part of the string before starttry has one color
2094                (pref0_len chars), between starttry and current
2095                position another one (pref_len - pref0_len chars),
2096                after the current position the third one.
2097                We assume that pref0_len <= pref_len, otherwise we
2098                decrease pref0_len.  */
2099             int pref_len = (locinput - PL_bostr) > (5 + taill) - l
2100                 ? (5 + taill) - l : locinput - PL_bostr;
2101             int pref0_len;
2102
2103             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
2104                 pref_len++;
2105             pref0_len = pref_len  - (locinput - PL_reg_starttry);
2106             if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
2107                 l = ( PL_regeol - locinput > (5 + taill) - pref_len
2108                       ? (5 + taill) - pref_len : PL_regeol - locinput);
2109             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
2110                 l--;
2111             if (pref0_len < 0)
2112                 pref0_len = 0;
2113             if (pref0_len > pref_len)
2114                 pref0_len = pref_len;
2115             regprop(prop, scan);
2116             {
2117               char *s0 =
2118                 do_utf8 ?
2119                 pv_uni_display(dsv0, (U8*)(locinput - pref_len),
2120                                pref0_len, 60, 0) :
2121                 locinput - pref_len;
2122               int len0 = do_utf8 ? strlen(s0) : pref0_len;
2123               char *s1 = do_utf8 ?
2124                 pv_uni_display(dsv1, (U8*)(locinput - pref_len + pref0_len),
2125                                pref_len - pref0_len, 60, 0) :
2126                 locinput - pref_len + pref0_len;
2127               int len1 = do_utf8 ? strlen(s1) : pref_len - pref0_len;
2128               char *s2 = do_utf8 ?
2129                 pv_uni_display(dsv2, (U8*)locinput,
2130                                PL_regeol - locinput, 60, 0) :
2131                 locinput;
2132               int len2 = do_utf8 ? strlen(s2) : l;
2133               PerlIO_printf(Perl_debug_log,
2134                             "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n",
2135                             (IV)(locinput - PL_bostr),
2136                             PL_colors[4],
2137                             len0, s0,
2138                             PL_colors[5],
2139                             PL_colors[2],
2140                             len1, s1,
2141                             PL_colors[3],
2142                             (docolor ? "" : "> <"),
2143                             PL_colors[0],
2144                             len2, s2,
2145                             PL_colors[1],
2146                             15 - l - pref_len + 1,
2147                             "",
2148                             (IV)(scan - PL_regprogram), PL_regindent*2, "",
2149                             SvPVX(prop));
2150             }
2151         });
2152
2153         next = scan + NEXT_OFF(scan);
2154         if (next == scan)
2155             next = NULL;
2156
2157         switch (OP(scan)) {
2158         case BOL:
2159             if (locinput == PL_bostr || (PL_multiline &&
2160                 (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
2161             {
2162                 /* regtill = regbol; */
2163                 break;
2164             }
2165             sayNO;
2166         case MBOL:
2167             if (locinput == PL_bostr ||
2168                 ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n'))
2169             {
2170                 break;
2171             }
2172             sayNO;
2173         case SBOL:
2174             if (locinput == PL_bostr)
2175                 break;
2176             sayNO;
2177         case GPOS:
2178             if (locinput == PL_reg_ganch)
2179                 break;
2180             sayNO;
2181         case EOL:
2182             if (PL_multiline)
2183                 goto meol;
2184             else
2185                 goto seol;
2186         case MEOL:
2187           meol:
2188             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2189                 sayNO;
2190             break;
2191         case SEOL:
2192           seol:
2193             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2194                 sayNO;
2195             if (PL_regeol - locinput > 1)
2196                 sayNO;
2197             break;
2198         case EOS:
2199             if (PL_regeol != locinput)
2200                 sayNO;
2201             break;
2202         case SANY:
2203             if (!nextchr && locinput >= PL_regeol)
2204                 sayNO;
2205             if (do_utf8) {
2206                 locinput += PL_utf8skip[nextchr];
2207                 if (locinput > PL_regeol)
2208                     sayNO;
2209                 nextchr = UCHARAT(locinput);
2210             }
2211             else
2212                 nextchr = UCHARAT(++locinput);
2213             break;
2214         case CANY:
2215             if (!nextchr && locinput >= PL_regeol)
2216                 sayNO;
2217             nextchr = UCHARAT(++locinput);
2218             break;
2219         case REG_ANY:
2220             if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
2221                 sayNO;
2222             if (do_utf8) {
2223                 locinput += PL_utf8skip[nextchr];
2224                 if (locinput > PL_regeol)
2225                     sayNO;
2226                 nextchr = UCHARAT(locinput);
2227             }
2228             else
2229                 nextchr = UCHARAT(++locinput);
2230             break;
2231         case EXACT:
2232             s = STRING(scan);
2233             ln = STR_LEN(scan);
2234             if (do_utf8 != (UTF!=0)) {
2235                 /* The target and the pattern have differing utf8ness. */
2236                 char *l = locinput;
2237                 char *e = s + ln;
2238                 STRLEN ulen;
2239
2240                 if (do_utf8) {
2241                     /* The target is utf8, the pattern is not utf8. */
2242                     while (s < e) {
2243                         if (l >= PL_regeol)
2244                              sayNO;
2245                         if (NATIVE_TO_UNI(*(U8*)s) !=
2246                             utf8_to_uvchr((U8*)l, &ulen))
2247                              sayNO;
2248                         l += ulen;
2249                         s ++;
2250                     }
2251                 }
2252                 else {
2253                     /* The target is not utf8, the pattern is utf8. */
2254                     while (s < e) {
2255                         if (l >= PL_regeol)
2256                             sayNO;
2257                         if (NATIVE_TO_UNI(*((U8*)l)) !=
2258                             utf8_to_uvchr((U8*)s, &ulen))
2259                             sayNO;
2260                         s += ulen;
2261                         l ++;
2262                     }
2263                 }
2264                 locinput = l;
2265                 nextchr = UCHARAT(locinput);
2266                 break;
2267             }
2268             /* The target and the pattern have the same utf8ness. */
2269             /* Inline the first character, for speed. */
2270             if (UCHARAT(s) != nextchr)
2271                 sayNO;
2272             if (PL_regeol - locinput < ln)
2273                 sayNO;
2274             if (ln > 1 && memNE(s, locinput, ln))
2275                 sayNO;
2276             locinput += ln;
2277             nextchr = UCHARAT(locinput);
2278             break;
2279         case EXACTFL:
2280             PL_reg_flags |= RF_tainted;
2281             /* FALL THROUGH */
2282         case EXACTF:
2283             s = STRING(scan);
2284             ln = STR_LEN(scan);
2285
2286             {
2287                 char *l = locinput;
2288                 char *e = s + ln;
2289                 U8 tmpbuf[UTF8_MAXLEN_FOLD+1];
2290
2291                 if (do_utf8 != (UTF!=0)) {
2292                      /* The target and the pattern have differing utf8ness. */
2293                      STRLEN ulen1, ulen2;
2294                      UV cs, cl;
2295
2296                      if (do_utf8) {
2297                           /* The target is utf8, the pattern is not utf8. */
2298                           while (s < e) {
2299                                if (l >= PL_regeol)
2300                                     sayNO;
2301
2302                                cs = to_uni_fold(NATIVE_TO_UNI(*(U8*)s),
2303                                                 (U8*)s, &ulen1);
2304                                cl = utf8_to_uvchr((U8*)l, &ulen2);
2305
2306                                if (cs != cl) {
2307                                     cl = to_uni_fold(cl, (U8*)l, &ulen2);
2308                                     if (ulen1 != ulen2 || cs != cl)
2309                                          sayNO;
2310                                }
2311                                l += ulen1;
2312                                s ++;
2313                           }
2314                      }
2315                      else {
2316                           /* The target is not utf8, the pattern is utf8. */
2317                           while (s < e) {
2318                                if (l >= PL_regeol)
2319                                     sayNO;
2320
2321                                cs = utf8_to_uvchr((U8*)s, &ulen1);
2322
2323                                cl = to_uni_fold(NATIVE_TO_UNI(*(U8*)l),
2324                                                 (U8*)l, &ulen2);
2325
2326                                if (cs != cl) {
2327                                     cs = to_uni_fold(cs, (U8*)s, &ulen1);
2328                                     if (ulen1 != ulen2 || cs != cl)
2329                                          sayNO;
2330                                }
2331                                l ++;
2332                                s += ulen1;
2333                           }
2334                      }
2335                      locinput = l;
2336                      nextchr = UCHARAT(locinput);
2337                      break;
2338                 }
2339
2340                 if (do_utf8 && UTF) {
2341                      /* Both the target and the pattern are utf8. */
2342                      STRLEN ulen;
2343                      
2344                      while (s < e) {
2345                           if (l >= PL_regeol)
2346                                sayNO;
2347                           if (UTF8SKIP(s) != UTF8SKIP(l) ||
2348                               memNE(s, (char*)l, UTF8SKIP(s))) {
2349                                to_utf8_fold((U8*)l, tmpbuf, &ulen);
2350                                if (UTF8SKIP(s) != ulen ||
2351                                    memNE(s, (char*)tmpbuf, ulen))
2352                                     sayNO;
2353                           }
2354                           l += UTF8SKIP(l);
2355                           s += UTF8SKIP(s);
2356                      }
2357                      locinput = l;
2358                      nextchr = UCHARAT(locinput);
2359                      break;
2360                 }
2361             }
2362
2363             /* Neither the target and the pattern are utf8. */
2364
2365             /* Inline the first character, for speed. */
2366             if (UCHARAT(s) != nextchr &&
2367                 UCHARAT(s) != ((OP(scan) == EXACTF)
2368                                ? PL_fold : PL_fold_locale)[nextchr])
2369                 sayNO;
2370             if (PL_regeol - locinput < ln)
2371                 sayNO;
2372             if (ln > 1 && (OP(scan) == EXACTF
2373                            ? ibcmp(s, locinput, ln)
2374                            : ibcmp_locale(s, locinput, ln)))
2375                 sayNO;
2376             locinput += ln;
2377             nextchr = UCHARAT(locinput);
2378             break;
2379         case ANYOF:
2380             if (do_utf8) {
2381                 if (!reginclass(scan, (U8*)locinput, do_utf8))
2382                     sayNO;
2383                 if (locinput >= PL_regeol)
2384                     sayNO;
2385                 locinput += PL_utf8skip[nextchr];
2386                 nextchr = UCHARAT(locinput);
2387             }
2388             else {
2389                 if (nextchr < 0)
2390                     nextchr = UCHARAT(locinput);
2391                 if (!reginclass(scan, (U8*)locinput, do_utf8))
2392                     sayNO;
2393                 if (!nextchr && locinput >= PL_regeol)
2394                     sayNO;
2395                 nextchr = UCHARAT(++locinput);
2396             }
2397             break;
2398         case ALNUML:
2399             PL_reg_flags |= RF_tainted;
2400             /* FALL THROUGH */
2401         case ALNUM:
2402             if (!nextchr)
2403                 sayNO;
2404             if (do_utf8) {
2405                 LOAD_UTF8_CHARCLASS(alnum,"a");
2406                 if (!(OP(scan) == ALNUM
2407                       ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2408                       : isALNUM_LC_utf8((U8*)locinput)))
2409                 {
2410                     sayNO;
2411                 }
2412                 locinput += PL_utf8skip[nextchr];
2413                 nextchr = UCHARAT(locinput);
2414                 break;
2415             }
2416             if (!(OP(scan) == ALNUM
2417                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
2418                 sayNO;
2419             nextchr = UCHARAT(++locinput);
2420             break;
2421         case NALNUML:
2422             PL_reg_flags |= RF_tainted;
2423             /* FALL THROUGH */
2424         case NALNUM:
2425             if (!nextchr && locinput >= PL_regeol)
2426                 sayNO;
2427             if (do_utf8) {
2428                 LOAD_UTF8_CHARCLASS(alnum,"a");
2429                 if (OP(scan) == NALNUM
2430                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2431                     : isALNUM_LC_utf8((U8*)locinput))
2432                 {
2433                     sayNO;
2434                 }
2435                 locinput += PL_utf8skip[nextchr];
2436                 nextchr = UCHARAT(locinput);
2437                 break;
2438             }
2439             if (OP(scan) == NALNUM
2440                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
2441                 sayNO;
2442             nextchr = UCHARAT(++locinput);
2443             break;
2444         case BOUNDL:
2445         case NBOUNDL:
2446             PL_reg_flags |= RF_tainted;
2447             /* FALL THROUGH */
2448         case BOUND:
2449         case NBOUND:
2450             /* was last char in word? */
2451             if (do_utf8) {
2452                 if (locinput == PL_bostr)
2453                     ln = '\n';
2454                 else {
2455                     U8 *r = reghop((U8*)locinput, -1);
2456                 
2457                     ln = utf8n_to_uvchr(r, s - (char*)r, 0, 0);
2458                 }
2459                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2460                     ln = isALNUM_uni(ln);
2461                     LOAD_UTF8_CHARCLASS(alnum,"a");
2462                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
2463                 }
2464                 else {
2465                     ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
2466                     n = isALNUM_LC_utf8((U8*)locinput);
2467                 }
2468             }
2469             else {
2470                 ln = (locinput != PL_bostr) ?
2471                     UCHARAT(locinput - 1) : '\n';
2472                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2473                     ln = isALNUM(ln);
2474                     n = isALNUM(nextchr);
2475                 }
2476                 else {
2477                     ln = isALNUM_LC(ln);
2478                     n = isALNUM_LC(nextchr);
2479                 }
2480             }
2481             if (((!ln) == (!n)) == (OP(scan) == BOUND ||
2482                                     OP(scan) == BOUNDL))
2483                     sayNO;
2484             break;
2485         case SPACEL:
2486             PL_reg_flags |= RF_tainted;
2487             /* FALL THROUGH */
2488         case SPACE:
2489             if (!nextchr)
2490                 sayNO;
2491             if (do_utf8) {
2492                 if (UTF8_IS_CONTINUED(nextchr)) {
2493                     LOAD_UTF8_CHARCLASS(space," ");
2494                     if (!(OP(scan) == SPACE
2495                           ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
2496                           : isSPACE_LC_utf8((U8*)locinput)))
2497                     {
2498                         sayNO;
2499                     }
2500                     locinput += PL_utf8skip[nextchr];
2501                     nextchr = UCHARAT(locinput);
2502                     break;
2503                 }
2504                 if (!(OP(scan) == SPACE
2505                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
2506                     sayNO;
2507                 nextchr = UCHARAT(++locinput);
2508             }
2509             else {
2510                 if (!(OP(scan) == SPACE
2511                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
2512                     sayNO;
2513                 nextchr = UCHARAT(++locinput);
2514             }
2515             break;
2516         case NSPACEL:
2517             PL_reg_flags |= RF_tainted;
2518             /* FALL THROUGH */
2519         case NSPACE:
2520             if (!nextchr && locinput >= PL_regeol)
2521                 sayNO;
2522             if (do_utf8) {
2523                 LOAD_UTF8_CHARCLASS(space," ");
2524                 if (OP(scan) == NSPACE
2525                     ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
2526                     : isSPACE_LC_utf8((U8*)locinput))
2527                 {
2528                     sayNO;
2529                 }
2530                 locinput += PL_utf8skip[nextchr];
2531                 nextchr = UCHARAT(locinput);
2532                 break;
2533             }
2534             if (OP(scan) == NSPACE
2535                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
2536                 sayNO;
2537             nextchr = UCHARAT(++locinput);
2538             break;
2539         case DIGITL:
2540             PL_reg_flags |= RF_tainted;
2541             /* FALL THROUGH */
2542         case DIGIT:
2543             if (!nextchr)
2544                 sayNO;
2545             if (do_utf8) {
2546                 LOAD_UTF8_CHARCLASS(digit,"0");
2547                 if (!(OP(scan) == DIGIT
2548                       ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
2549                       : isDIGIT_LC_utf8((U8*)locinput)))
2550                 {
2551                     sayNO;
2552                 }
2553                 locinput += PL_utf8skip[nextchr];
2554                 nextchr = UCHARAT(locinput);
2555                 break;
2556             }
2557             if (!(OP(scan) == DIGIT
2558                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
2559                 sayNO;
2560             nextchr = UCHARAT(++locinput);
2561             break;
2562         case NDIGITL:
2563             PL_reg_flags |= RF_tainted;
2564             /* FALL THROUGH */
2565         case NDIGIT:
2566             if (!nextchr && locinput >= PL_regeol)
2567                 sayNO;
2568             if (do_utf8) {
2569                 LOAD_UTF8_CHARCLASS(digit,"0");
2570                 if (OP(scan) == NDIGIT
2571                     ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
2572                     : isDIGIT_LC_utf8((U8*)locinput))
2573                 {
2574                     sayNO;
2575                 }
2576                 locinput += PL_utf8skip[nextchr];
2577                 nextchr = UCHARAT(locinput);
2578                 break;
2579             }
2580             if (OP(scan) == NDIGIT
2581                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
2582                 sayNO;
2583             nextchr = UCHARAT(++locinput);
2584             break;
2585         case CLUMP:
2586             LOAD_UTF8_CHARCLASS(mark,"~");
2587             if (locinput >= PL_regeol ||
2588                 swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
2589                 sayNO;
2590             locinput += PL_utf8skip[nextchr];
2591             while (locinput < PL_regeol &&
2592                    swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
2593                 locinput += UTF8SKIP(locinput);
2594             if (locinput > PL_regeol)
2595                 sayNO;
2596             nextchr = UCHARAT(locinput);
2597             break;
2598         case REFFL:
2599             PL_reg_flags |= RF_tainted;
2600             /* FALL THROUGH */
2601         case REF:
2602         case REFF:
2603             n = ARG(scan);  /* which paren pair */
2604             ln = PL_regstartp[n];
2605             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2606             if (*PL_reglastparen < n || ln == -1)
2607                 sayNO;                  /* Do not match unless seen CLOSEn. */
2608             if (ln == PL_regendp[n])
2609                 break;
2610
2611             s = PL_bostr + ln;
2612             if (do_utf8 && OP(scan) != REF) {   /* REF can do byte comparison */
2613                 char *l = locinput;
2614                 char *e = PL_bostr + PL_regendp[n];
2615                 /*
2616                  * Note that we can't do the "other character" lookup trick as
2617                  * in the 8-bit case (no pun intended) because in Unicode we
2618                  * have to map both upper and title case to lower case.
2619                  */
2620                 if (OP(scan) == REFF) {
2621                     STRLEN ulen1, ulen2;
2622                     U8 tmpbuf1[UTF8_MAXLEN_UCLC+1];
2623                     U8 tmpbuf2[UTF8_MAXLEN_UCLC+1];
2624                     while (s < e) {
2625                         if (l >= PL_regeol)
2626                             sayNO;
2627                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
2628                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
2629                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
2630                             sayNO;
2631                         s += ulen1;
2632                         l += ulen2;
2633                     }
2634                 }
2635                 locinput = l;
2636                 nextchr = UCHARAT(locinput);
2637                 break;
2638             }
2639
2640             /* Inline the first character, for speed. */
2641             if (UCHARAT(s) != nextchr &&
2642                 (OP(scan) == REF ||
2643                  (UCHARAT(s) != ((OP(scan) == REFF
2644                                   ? PL_fold : PL_fold_locale)[nextchr]))))
2645                 sayNO;
2646             ln = PL_regendp[n] - ln;
2647             if (locinput + ln > PL_regeol)
2648                 sayNO;
2649             if (ln > 1 && (OP(scan) == REF
2650                            ? memNE(s, locinput, ln)
2651                            : (OP(scan) == REFF
2652                               ? ibcmp(s, locinput, ln)
2653                               : ibcmp_locale(s, locinput, ln))))
2654                 sayNO;
2655             locinput += ln;
2656             nextchr = UCHARAT(locinput);
2657             break;
2658
2659         case NOTHING:
2660         case TAIL:
2661             break;
2662         case BACK:
2663             break;
2664         case EVAL:
2665         {
2666             dSP;
2667             OP_4tree *oop = PL_op;
2668             COP *ocurcop = PL_curcop;
2669             SV **ocurpad = PL_curpad;
2670             SV *ret;
2671         
2672             n = ARG(scan);
2673             PL_op = (OP_4tree*)PL_regdata->data[n];
2674             DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
2675             PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 2]);
2676             PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
2677
2678             {
2679                 SV **before = SP;
2680                 CALLRUNOPS(aTHX);                       /* Scalar context. */
2681                 SPAGAIN;
2682                 if (SP == before)
2683                     ret = Nullsv;   /* protect against empty (?{}) blocks. */
2684                 else {
2685                     ret = POPs;
2686                     PUTBACK;
2687                 }
2688             }
2689
2690             PL_op = oop;
2691             PL_curpad = ocurpad;
2692             PL_curcop = ocurcop;
2693             if (logical) {
2694                 if (logical == 2) {     /* Postponed subexpression. */
2695                     regexp *re;
2696                     MAGIC *mg = Null(MAGIC*);
2697                     re_cc_state state;
2698                     CHECKPOINT cp, lastcp;
2699
2700                     if(SvROK(ret) || SvRMAGICAL(ret)) {
2701                         SV *sv = SvROK(ret) ? SvRV(ret) : ret;
2702
2703                         if(SvMAGICAL(sv))
2704                             mg = mg_find(sv, PERL_MAGIC_qr);
2705                     }
2706                     if (mg) {
2707                         re = (regexp *)mg->mg_obj;
2708                         (void)ReREFCNT_inc(re);
2709                     }
2710                     else {
2711                         STRLEN len;
2712                         char *t = SvPV(ret, len);
2713                         PMOP pm;
2714                         char *oprecomp = PL_regprecomp;
2715                         I32 osize = PL_regsize;
2716                         I32 onpar = PL_regnpar;
2717
2718                         Zero(&pm, 1, PMOP);
2719                         re = CALLREGCOMP(aTHX_ t, t + len, &pm);
2720                         if (!(SvFLAGS(ret)
2721                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)))
2722                             sv_magic(ret,(SV*)ReREFCNT_inc(re),
2723                                         PERL_MAGIC_qr,0,0);
2724                         PL_regprecomp = oprecomp;
2725                         PL_regsize = osize;
2726                         PL_regnpar = onpar;
2727                     }
2728                     DEBUG_r(
2729                         PerlIO_printf(Perl_debug_log,
2730                                       "Entering embedded `%s%.60s%s%s'\n",
2731                                       PL_colors[0],
2732                                       re->precomp,
2733                                       PL_colors[1],
2734                                       (strlen(re->precomp) > 60 ? "..." : ""))
2735                         );
2736                     state.node = next;
2737                     state.prev = PL_reg_call_cc;
2738                     state.cc = PL_regcc;
2739                     state.re = PL_reg_re;
2740
2741                     PL_regcc = 0;
2742                 
2743                     cp = regcppush(0);  /* Save *all* the positions. */
2744                     REGCP_SET(lastcp);
2745                     cache_re(re);
2746                     state.ss = PL_savestack_ix;
2747                     *PL_reglastparen = 0;
2748                     *PL_reglastcloseparen = 0;
2749                     PL_reg_call_cc = &state;
2750                     PL_reginput = locinput;
2751
2752                     /* XXXX This is too dramatic a measure... */
2753                     PL_reg_maxiter = 0;
2754
2755                     if (regmatch(re->program + 1)) {
2756                         /* Even though we succeeded, we need to restore
2757                            global variables, since we may be wrapped inside
2758                            SUSPEND, thus the match may be not finished yet. */
2759
2760                         /* XXXX Do this only if SUSPENDed? */
2761                         PL_reg_call_cc = state.prev;
2762                         PL_regcc = state.cc;
2763                         PL_reg_re = state.re;
2764                         cache_re(PL_reg_re);
2765
2766                         /* XXXX This is too dramatic a measure... */
2767                         PL_reg_maxiter = 0;
2768
2769                         /* These are needed even if not SUSPEND. */
2770                         ReREFCNT_dec(re);
2771                         regcpblow(cp);
2772                         sayYES;
2773                     }
2774                     ReREFCNT_dec(re);
2775                     REGCP_UNWIND(lastcp);
2776                     regcppop();
2777                     PL_reg_call_cc = state.prev;
2778                     PL_regcc = state.cc;
2779                     PL_reg_re = state.re;
2780                     cache_re(PL_reg_re);
2781
2782                     /* XXXX This is too dramatic a measure... */
2783                     PL_reg_maxiter = 0;
2784
2785                     logical = 0;
2786                     sayNO;
2787                 }
2788                 sw = SvTRUE(ret);
2789                 logical = 0;
2790             }
2791             else
2792                 sv_setsv(save_scalar(PL_replgv), ret);
2793             break;
2794         }
2795         case OPEN:
2796             n = ARG(scan);  /* which paren pair */
2797             PL_reg_start_tmp[n] = locinput;
2798             if (n > PL_regsize)
2799                 PL_regsize = n;
2800             break;
2801         case CLOSE:
2802             n = ARG(scan);  /* which paren pair */
2803             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
2804             PL_regendp[n] = locinput - PL_bostr;
2805             if (n > *PL_reglastparen)
2806                 *PL_reglastparen = n;
2807             *PL_reglastcloseparen = n;
2808             break;
2809         case GROUPP:
2810             n = ARG(scan);  /* which paren pair */
2811             sw = (*PL_reglastparen >= n && PL_regendp[n] != -1);
2812             break;
2813         case IFTHEN:
2814             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2815             if (sw)
2816                 next = NEXTOPER(NEXTOPER(scan));
2817             else {
2818                 next = scan + ARG(scan);
2819                 if (OP(next) == IFTHEN) /* Fake one. */
2820                     next = NEXTOPER(NEXTOPER(next));
2821             }
2822             break;
2823         case LOGICAL:
2824             logical = scan->flags;
2825             break;
2826 /*******************************************************************
2827  PL_regcc contains infoblock about the innermost (...)* loop, and
2828  a pointer to the next outer infoblock.
2829
2830  Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM):
2831
2832    1) After matching X, regnode for CURLYX is processed;
2833
2834    2) This regnode creates infoblock on the stack, and calls
2835       regmatch() recursively with the starting point at WHILEM node;
2836
2837    3) Each hit of WHILEM node tries to match A and Z (in the order
2838       depending on the current iteration, min/max of {min,max} and
2839       greediness).  The information about where are nodes for "A"
2840       and "Z" is read from the infoblock, as is info on how many times "A"
2841       was already matched, and greediness.
2842
2843    4) After A matches, the same WHILEM node is hit again.
2844
2845    5) Each time WHILEM is hit, PL_regcc is the infoblock created by CURLYX
2846       of the same pair.  Thus when WHILEM tries to match Z, it temporarily
2847       resets PL_regcc, since this Y(A)*Z can be a part of some other loop:
2848       as in (Y(A)*Z)*.  If Z matches, the automaton will hit the WHILEM node
2849       of the external loop.
2850
2851  Currently present infoblocks form a tree with a stem formed by PL_curcc
2852  and whatever it mentions via ->next, and additional attached trees
2853  corresponding to temporarily unset infoblocks as in "5" above.
2854
2855  In the following picture infoblocks for outer loop of
2856  (Y(A)*?Z)*?T are denoted O, for inner I.  NULL starting block
2857  is denoted by x.  The matched string is YAAZYAZT.  Temporarily postponed
2858  infoblocks are drawn below the "reset" infoblock.
2859
2860  In fact in the picture below we do not show failed matches for Z and T
2861  by WHILEM blocks.  [We illustrate minimal matches, since for them it is
2862  more obvious *why* one needs to *temporary* unset infoblocks.]
2863
2864   Matched       REx position    InfoBlocks      Comment
2865                 (Y(A)*?Z)*?T    x
2866                 Y(A)*?Z)*?T     x <- O
2867   Y             (A)*?Z)*?T      x <- O
2868   Y             A)*?Z)*?T       x <- O <- I
2869   YA            )*?Z)*?T        x <- O <- I
2870   YA            A)*?Z)*?T       x <- O <- I
2871   YAA           )*?Z)*?T        x <- O <- I
2872   YAA           Z)*?T           x <- O          # Temporary unset I
2873                                      I
2874
2875   YAAZ          Y(A)*?Z)*?T     x <- O
2876                                      I
2877
2878   YAAZY         (A)*?Z)*?T      x <- O
2879                                      I
2880
2881   YAAZY         A)*?Z)*?T       x <- O <- I
2882                                      I
2883
2884   YAAZYA        )*?Z)*?T        x <- O <- I     
2885                                      I
2886
2887   YAAZYA        Z)*?T           x <- O          # Temporary unset I
2888                                      I,I
2889
2890   YAAZYAZ       )*?T            x <- O
2891                                      I,I
2892
2893   YAAZYAZ       T               x               # Temporary unset O
2894                                 O
2895                                 I,I
2896
2897   YAAZYAZT                      x
2898                                 O
2899                                 I,I
2900  *******************************************************************/
2901         case CURLYX: {
2902                 CURCUR cc;
2903                 CHECKPOINT cp = PL_savestack_ix;
2904                 /* No need to save/restore up to this paren */
2905                 I32 parenfloor = scan->flags;
2906
2907                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
2908                     next += ARG(next);
2909                 cc.oldcc = PL_regcc;
2910                 PL_regcc = &cc;
2911                 /* XXXX Probably it is better to teach regpush to support
2912                    parenfloor > PL_regsize... */
2913                 if (parenfloor > *PL_reglastparen)
2914                     parenfloor = *PL_reglastparen; /* Pessimization... */
2915                 cc.parenfloor = parenfloor;
2916                 cc.cur = -1;
2917                 cc.min = ARG1(scan);
2918                 cc.max  = ARG2(scan);
2919                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
2920                 cc.next = next;
2921                 cc.minmod = minmod;
2922                 cc.lastloc = 0;
2923                 PL_reginput = locinput;
2924                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
2925                 regcpblow(cp);
2926                 PL_regcc = cc.oldcc;
2927                 saySAME(n);
2928             }
2929             /* NOT REACHED */
2930         case WHILEM: {
2931                 /*
2932                  * This is really hard to understand, because after we match
2933                  * what we're trying to match, we must make sure the rest of
2934                  * the REx is going to match for sure, and to do that we have
2935                  * to go back UP the parse tree by recursing ever deeper.  And
2936                  * if it fails, we have to reset our parent's current state
2937                  * that we can try again after backing off.
2938                  */
2939
2940                 CHECKPOINT cp, lastcp;
2941                 CURCUR* cc = PL_regcc;
2942                 char *lastloc = cc->lastloc; /* Detection of 0-len. */
2943                 
2944                 n = cc->cur + 1;        /* how many we know we matched */
2945                 PL_reginput = locinput;
2946
2947                 DEBUG_r(
2948                     PerlIO_printf(Perl_debug_log,
2949                                   "%*s  %ld out of %ld..%ld  cc=%lx\n",
2950                                   REPORT_CODE_OFF+PL_regindent*2, "",
2951                                   (long)n, (long)cc->min,
2952                                   (long)cc->max, (long)cc)
2953                     );
2954
2955                 /* If degenerate scan matches "", assume scan done. */
2956
2957                 if (locinput == cc->lastloc && n >= cc->min) {
2958                     PL_regcc = cc->oldcc;
2959                     if (PL_regcc)
2960                         ln = PL_regcc->cur;
2961                     DEBUG_r(
2962                         PerlIO_printf(Perl_debug_log,
2963                            "%*s  empty match detected, try continuation...\n",
2964                            REPORT_CODE_OFF+PL_regindent*2, "")
2965                         );
2966                     if (regmatch(cc->next))
2967                         sayYES;
2968                     if (PL_regcc)
2969                         PL_regcc->cur = ln;
2970                     PL_regcc = cc;
2971                     sayNO;
2972                 }
2973
2974                 /* First just match a string of min scans. */
2975
2976                 if (n < cc->min) {
2977                     cc->cur = n;
2978                     cc->lastloc = locinput;
2979                     if (regmatch(cc->scan))
2980                         sayYES;
2981                     cc->cur = n - 1;
2982                     cc->lastloc = lastloc;
2983                     sayNO;
2984                 }
2985
2986                 if (scan->flags) {
2987                     /* Check whether we already were at this position.
2988                         Postpone detection until we know the match is not
2989                         *that* much linear. */
2990                 if (!PL_reg_maxiter) {
2991                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
2992                     PL_reg_leftiter = PL_reg_maxiter;
2993                 }
2994                 if (PL_reg_leftiter-- == 0) {
2995                     I32 size = (PL_reg_maxiter + 7)/8;
2996                     if (PL_reg_poscache) {
2997                         if (PL_reg_poscache_size < size) {
2998                             Renew(PL_reg_poscache, size, char);
2999                             PL_reg_poscache_size = size;
3000                         }
3001                         Zero(PL_reg_poscache, size, char);
3002                     }
3003                     else {
3004                         PL_reg_poscache_size = size;
3005                         Newz(29, PL_reg_poscache, size, char);
3006                     }
3007                     DEBUG_r(
3008                         PerlIO_printf(Perl_debug_log,
3009               "%sDetected a super-linear match, switching on caching%s...\n",
3010                                       PL_colors[4], PL_colors[5])
3011                         );
3012                 }
3013                 if (PL_reg_leftiter < 0) {
3014                     I32 o = locinput - PL_bostr, b;
3015
3016                     o = (scan->flags & 0xf) - 1 + o * (scan->flags>>4);
3017                     b = o % 8;
3018                     o /= 8;
3019                     if (PL_reg_poscache[o] & (1<<b)) {
3020                     DEBUG_r(
3021                         PerlIO_printf(Perl_debug_log,
3022                                       "%*s  already tried at this position...\n",
3023                                       REPORT_CODE_OFF+PL_regindent*2, "")
3024                         );
3025                         sayNO_SILENT;
3026                     }
3027                     PL_reg_poscache[o] |= (1<<b);
3028                 }
3029                 }
3030
3031                 /* Prefer next over scan for minimal matching. */
3032
3033                 if (cc->minmod) {
3034                     PL_regcc = cc->oldcc;
3035                     if (PL_regcc)
3036                         ln = PL_regcc->cur;
3037                     cp = regcppush(cc->parenfloor);
3038                     REGCP_SET(lastcp);
3039                     if (regmatch(cc->next)) {
3040                         regcpblow(cp);
3041                         sayYES; /* All done. */
3042                     }
3043                     REGCP_UNWIND(lastcp);
3044                     regcppop();
3045                     if (PL_regcc)
3046                         PL_regcc->cur = ln;
3047                     PL_regcc = cc;
3048
3049                     if (n >= cc->max) { /* Maximum greed exceeded? */
3050                         if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3051                             && !(PL_reg_flags & RF_warned)) {
3052                             PL_reg_flags |= RF_warned;
3053                             Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded",
3054                                  "Complex regular subexpression recursion",
3055                                  REG_INFTY - 1);
3056                         }
3057                         sayNO;
3058                     }
3059
3060                     DEBUG_r(
3061                         PerlIO_printf(Perl_debug_log,
3062                                       "%*s  trying longer...\n",
3063                                       REPORT_CODE_OFF+PL_regindent*2, "")
3064                         );
3065                     /* Try scanning more and see if it helps. */
3066                     PL_reginput = locinput;
3067                     cc->cur = n;
3068                     cc->lastloc = locinput;
3069                     cp = regcppush(cc->parenfloor);
3070                     REGCP_SET(lastcp);
3071                     if (regmatch(cc->scan)) {
3072                         regcpblow(cp);
3073                         sayYES;
3074                     }
3075                     REGCP_UNWIND(lastcp);
3076                     regcppop();
3077                     cc->cur = n - 1;
3078                     cc->lastloc = lastloc;
3079                     sayNO;
3080                 }
3081
3082                 /* Prefer scan over next for maximal matching. */
3083
3084                 if (n < cc->max) {      /* More greed allowed? */
3085                     cp = regcppush(cc->parenfloor);
3086                     cc->cur = n;
3087                     cc->lastloc = locinput;
3088                     REGCP_SET(lastcp);
3089                     if (regmatch(cc->scan)) {
3090                         regcpblow(cp);
3091                         sayYES;
3092                     }
3093                     REGCP_UNWIND(lastcp);
3094                     regcppop();         /* Restore some previous $<digit>s? */
3095                     PL_reginput = locinput;
3096                     DEBUG_r(
3097                         PerlIO_printf(Perl_debug_log,
3098                                       "%*s  failed, try continuation...\n",
3099                                       REPORT_CODE_OFF+PL_regindent*2, "")
3100                         );
3101                 }
3102                 if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3103                         && !(PL_reg_flags & RF_warned)) {
3104                     PL_reg_flags |= RF_warned;
3105                     Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded",
3106                          "Complex regular subexpression recursion",
3107                          REG_INFTY - 1);
3108                 }
3109
3110                 /* Failed deeper matches of scan, so see if this one works. */
3111                 PL_regcc = cc->oldcc;
3112                 if (PL_regcc)
3113                     ln = PL_regcc->cur;
3114                 if (regmatch(cc->next))
3115                     sayYES;
3116                 if (PL_regcc)
3117                     PL_regcc->cur = ln;
3118                 PL_regcc = cc;
3119                 cc->cur = n - 1;
3120                 cc->lastloc = lastloc;
3121                 sayNO;
3122             }
3123             /* NOT REACHED */
3124         case BRANCHJ:
3125             next = scan + ARG(scan);
3126             if (next == scan)
3127                 next = NULL;
3128             inner = NEXTOPER(NEXTOPER(scan));
3129             goto do_branch;
3130         case BRANCH:
3131             inner = NEXTOPER(scan);
3132           do_branch:
3133             {
3134                 c1 = OP(scan);
3135                 if (OP(next) != c1)     /* No choice. */
3136                     next = inner;       /* Avoid recursion. */
3137                 else {
3138                     I32 lastparen = *PL_reglastparen;
3139                     I32 unwind1;
3140                     re_unwind_branch_t *uw;
3141
3142                     /* Put unwinding data on stack */
3143                     unwind1 = SSNEWt(1,re_unwind_branch_t);
3144                     uw = SSPTRt(unwind1,re_unwind_branch_t);
3145                     uw->prev = unwind;
3146                     unwind = unwind1;
3147                     uw->type = ((c1 == BRANCH)
3148                                 ? RE_UNWIND_BRANCH
3149                                 : RE_UNWIND_BRANCHJ);
3150                     uw->lastparen = lastparen;
3151                     uw->next = next;
3152                     uw->locinput = locinput;
3153                     uw->nextchr = nextchr;
3154 #ifdef DEBUGGING
3155                     uw->regindent = ++PL_regindent;
3156 #endif
3157
3158                     REGCP_SET(uw->lastcp);
3159
3160                     /* Now go into the first branch */
3161                     next = inner;
3162                 }
3163             }
3164             break;
3165         case MINMOD:
3166             minmod = 1;
3167             break;
3168         case CURLYM:
3169         {
3170             I32 l = 0;
3171             CHECKPOINT lastcp;
3172         
3173             /* We suppose that the next guy does not need
3174                backtracking: in particular, it is of constant length,
3175                and has no parenths to influence future backrefs. */
3176             ln = ARG1(scan);  /* min to match */
3177             n  = ARG2(scan);  /* max to match */
3178             paren = scan->flags;
3179             if (paren) {
3180                 if (paren > PL_regsize)
3181                     PL_regsize = paren;
3182                 if (paren > *PL_reglastparen)
3183                     *PL_reglastparen = paren;
3184             }
3185             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3186             if (paren)
3187                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
3188             PL_reginput = locinput;
3189             if (minmod) {
3190                 minmod = 0;
3191                 if (ln && regrepeat_hard(scan, ln, &l) < ln)
3192                     sayNO;
3193                 /* if we matched something zero-length we don't need to
3194                    backtrack - capturing parens are already defined, so
3195                    the caveat in the maximal case doesn't apply
3196
3197                    XXXX if ln == 0, we can redo this check first time
3198                    through the following loop
3199                 */
3200                 if (ln && l == 0)
3201                     n = ln;     /* don't backtrack */
3202                 locinput = PL_reginput;
3203                 if (HAS_TEXT(next) || JUMPABLE(next)) {
3204                     regnode *text_node = next;
3205
3206                     if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3207
3208                     if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3209                     else {
3210                         if (PL_regkind[(U8)OP(text_node)] == REF) {
3211                             I32 n, ln;
3212                             n = ARG(text_node);  /* which paren pair */
3213                             ln = PL_regstartp[n];
3214                             /* assume yes if we haven't seen CLOSEn */
3215                             if (
3216                                 *PL_reglastparen < n ||
3217                                 ln == -1 ||
3218                                 ln == PL_regendp[n]
3219                             ) {
3220                                 c1 = c2 = -1000;
3221                                 goto assume_ok_MM;
3222                             }
3223                             c1 = *(PL_bostr + ln);
3224                         }
3225                         else { c1 = (U8)*STRING(text_node); }
3226                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3227                             c2 = PL_fold[c1];
3228                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3229                             c2 = PL_fold_locale[c1];
3230                         else
3231                             c2 = c1;
3232                     }
3233                 }
3234                 else
3235                     c1 = c2 = -1000;
3236             assume_ok_MM:
3237                 REGCP_SET(lastcp);
3238                 /* This may be improved if l == 0.  */
3239                 while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */
3240                     /* If it could work, try it. */
3241                     if (c1 == -1000 ||
3242                         UCHARAT(PL_reginput) == c1 ||
3243                         UCHARAT(PL_reginput) == c2)
3244                     {
3245                         if (paren) {
3246                             if (ln) {
3247                                 PL_regstartp[paren] =
3248                                     HOPc(PL_reginput, -l) - PL_bostr;
3249                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3250                             }
3251                             else
3252                                 PL_regendp[paren] = -1;
3253                         }
3254                         if (regmatch(next))
3255                             sayYES;
3256                         REGCP_UNWIND(lastcp);
3257                     }
3258                     /* Couldn't or didn't -- move forward. */
3259                     PL_reginput = locinput;
3260                     if (regrepeat_hard(scan, 1, &l)) {
3261                         ln++;
3262                         locinput = PL_reginput;
3263                     }
3264                     else
3265                         sayNO;
3266                 }
3267             }
3268             else {
3269                 n = regrepeat_hard(scan, n, &l);
3270                 /* if we matched something zero-length we don't need to
3271                    backtrack, unless the minimum count is zero and we
3272                    are capturing the result - in that case the capture
3273                    being defined or not may affect later execution
3274                 */
3275                 if (n != 0 && l == 0 && !(paren && ln == 0))
3276                     ln = n;     /* don't backtrack */
3277                 locinput = PL_reginput;
3278                 DEBUG_r(
3279                     PerlIO_printf(Perl_debug_log,
3280                                   "%*s  matched %"IVdf" times, len=%"IVdf"...\n",
3281                                   (int)(REPORT_CODE_OFF+PL_regindent*2), "",
3282                                   (IV) n, (IV)l)
3283                     );
3284                 if (n >= ln) {
3285                     if (HAS_TEXT(next) || JUMPABLE(next)) {
3286                         regnode *text_node = next;
3287
3288                         if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3289
3290                         if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3291                         else {
3292                             if (PL_regkind[(U8)OP(text_node)] == REF) {
3293                                 I32 n, ln;
3294                                 n = ARG(text_node);  /* which paren pair */
3295                                 ln = PL_regstartp[n];
3296                                 /* assume yes if we haven't seen CLOSEn */
3297                                 if (
3298                                     *PL_reglastparen < n ||
3299                                     ln == -1 ||
3300                                     ln == PL_regendp[n]
3301                                 ) {
3302                                     c1 = c2 = -1000;
3303                                     goto assume_ok_REG;
3304                                 }
3305                                 c1 = *(PL_bostr + ln);
3306                             }
3307                             else { c1 = (U8)*STRING(text_node); }
3308
3309                             if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3310                                 c2 = PL_fold[c1];
3311                             else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3312                                 c2 = PL_fold_locale[c1];
3313                             else
3314                                 c2 = c1;
3315                         }
3316                     }
3317                     else
3318                         c1 = c2 = -1000;
3319                 }
3320             assume_ok_REG:
3321                 REGCP_SET(lastcp);
3322                 while (n >= ln) {
3323                     /* If it could work, try it. */
3324                     if (c1 == -1000 ||
3325                         UCHARAT(PL_reginput) == c1 ||
3326                         UCHARAT(PL_reginput) == c2)
3327                     {
3328                         DEBUG_r(
3329                                 PerlIO_printf(Perl_debug_log,
3330                                               "%*s  trying tail with n=%"IVdf"...\n",
3331                                               (int)(REPORT_CODE_OFF+PL_regindent*2), "", (IV)n)
3332                             );
3333                         if (paren) {
3334                             if (n) {
3335                                 PL_regstartp[paren] = HOPc(PL_reginput, -l) - PL_bostr;
3336                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3337                             }
3338                             else
3339                                 PL_regendp[paren] = -1;
3340                         }
3341                         if (regmatch(next))
3342                             sayYES;
3343                         REGCP_UNWIND(lastcp);
3344                     }
3345                     /* Couldn't or didn't -- back up. */
3346                     n--;
3347                     locinput = HOPc(locinput, -l);
3348                     PL_reginput = locinput;
3349                 }
3350             }
3351             sayNO;
3352             break;
3353         }
3354         case CURLYN:
3355             paren = scan->flags;        /* Which paren to set */
3356             if (paren > PL_regsize)
3357                 PL_regsize = paren;
3358             if (paren > *PL_reglastparen)
3359                 *PL_reglastparen = paren;
3360             ln = ARG1(scan);  /* min to match */
3361             n  = ARG2(scan);  /* max to match */
3362             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
3363             goto repeat;
3364         case CURLY:
3365             paren = 0;
3366             ln = ARG1(scan);  /* min to match */
3367             n  = ARG2(scan);  /* max to match */
3368             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3369             goto repeat;
3370         case STAR:
3371             ln = 0;
3372             n = REG_INFTY;
3373             scan = NEXTOPER(scan);
3374             paren = 0;
3375             goto repeat;
3376         case PLUS:
3377             ln = 1;
3378             n = REG_INFTY;
3379             scan = NEXTOPER(scan);
3380             paren = 0;
3381           repeat:
3382             /*
3383             * Lookahead to avoid useless match attempts
3384             * when we know what character comes next.
3385             */
3386
3387             /*
3388             * Used to only do .*x and .*?x, but now it allows
3389             * for )'s, ('s and (?{ ... })'s to be in the way
3390             * of the quantifier and the EXACT-like node.  -- japhy
3391             */
3392
3393             if (HAS_TEXT(next) || JUMPABLE(next)) {
3394                 U8 *s;
3395                 regnode *text_node = next;
3396
3397                 if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3398
3399                 if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3400                 else {
3401                     if (PL_regkind[(U8)OP(text_node)] == REF) {
3402                         I32 n, ln;
3403                         n = ARG(text_node);  /* which paren pair */
3404                         ln = PL_regstartp[n];
3405                         /* assume yes if we haven't seen CLOSEn */
3406                         if (
3407                             *PL_reglastparen < n ||
3408                             ln == -1 ||
3409                             ln == PL_regendp[n]
3410                         ) {
3411                             c1 = c2 = -1000;
3412                             goto assume_ok_easy;
3413                         }
3414                         s = (U8*)PL_bostr + ln;
3415                     }
3416                     else { s = (U8*)STRING(text_node); }
3417
3418                     if (!UTF) {
3419                         c2 = c1 = *s;
3420                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3421                             c2 = PL_fold[c1];
3422                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3423                             c2 = PL_fold_locale[c1];
3424                     }
3425                     else { /* UTF */
3426                         if (OP(text_node) == EXACTF || OP(text_node) == REFF) {
3427                              STRLEN ulen1, ulen2;
3428                              U8 tmpbuf1[UTF8_MAXLEN_UCLC+1];
3429                              U8 tmpbuf2[UTF8_MAXLEN_UCLC+1];
3430
3431                              to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
3432                              to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
3433
3434                              c1 = utf8_to_uvuni(tmpbuf1, 0);
3435                              c2 = utf8_to_uvuni(tmpbuf2, 0);
3436                         }
3437                         else {
3438                             c2 = c1 = utf8_to_uvchr(s, NULL);
3439                         }
3440                     }
3441                 }
3442             }
3443             else
3444                 c1 = c2 = -1000;
3445         assume_ok_easy:
3446             PL_reginput = locinput;
3447             if (minmod) {
3448                 CHECKPOINT lastcp;
3449                 minmod = 0;
3450                 if (ln && regrepeat(scan, ln) < ln)
3451                     sayNO;
3452                 locinput = PL_reginput;
3453                 REGCP_SET(lastcp);
3454                 if (c1 != -1000) {
3455                     char *e; /* Should not check after this */
3456                     char *old = locinput;
3457
3458                     if  (n == REG_INFTY) {
3459                         e = PL_regeol - 1;
3460                         if (do_utf8)
3461                             while (UTF8_IS_CONTINUATION(*(U8*)e))
3462                                 e--;
3463                     }
3464                     else if (do_utf8) {
3465                         int m = n - ln;
3466                         for (e = locinput;
3467                              m >0 && e + UTF8SKIP(e) <= PL_regeol; m--)
3468                             e += UTF8SKIP(e);
3469                     }
3470                     else {
3471                         e = locinput + n - ln;
3472                         if (e >= PL_regeol)
3473                             e = PL_regeol - 1;
3474                     }
3475                     while (1) {
3476                         int count;
3477                         /* Find place 'next' could work */
3478                         if (!do_utf8) {
3479                             if (c1 == c2) {
3480                                 while (locinput <= e &&
3481                                        UCHARAT(locinput) != c1)
3482                                     locinput++;
3483                             } else {
3484                                 while (locinput <= e
3485                                        && UCHARAT(locinput) != c1
3486                                        && UCHARAT(locinput) != c2)
3487                                     locinput++;
3488                             }
3489                             count = locinput - old;
3490                         }
3491                         else {
3492                             STRLEN len;
3493                             if (c1 == c2) {
3494                                 for (count = 0;
3495                                      locinput <= e &&
3496                                          utf8_to_uvchr((U8*)locinput, &len) != c1;
3497                                      count++)
3498                                     locinput += len;
3499                                 
3500                             } else {
3501                                 for (count = 0; locinput <= e; count++) {
3502                                     UV c = utf8_to_uvchr((U8*)locinput, &len);
3503                                     if (c == c1 || c == c2)
3504                                         break;
3505                                     locinput += len;                    
3506                                 }
3507                             }
3508                         }
3509                         if (locinput > e)
3510                             sayNO;
3511                         /* PL_reginput == old now */
3512                         if (locinput != old) {
3513                             ln = 1;     /* Did some */
3514                             if (regrepeat(scan, count) < count)
3515                                 sayNO;
3516                         }
3517                         /* PL_reginput == locinput now */
3518                         TRYPAREN(paren, ln, locinput);
3519                         PL_reginput = locinput; /* Could be reset... */
3520                         REGCP_UNWIND(lastcp);
3521                         /* Couldn't or didn't -- move forward. */
3522                         old = locinput;
3523                         if (do_utf8)
3524                             locinput += UTF8SKIP(locinput);
3525                         else
3526                             locinput++;
3527                     }
3528                 }
3529                 else
3530                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
3531                     UV c;
3532                     if (c1 != -1000) {
3533                         if (do_utf8)
3534                             c = utf8_to_uvchr((U8*)PL_reginput, NULL);
3535                         else
3536                             c = UCHARAT(PL_reginput);
3537                         /* If it could work, try it. */
3538                         if (c == c1 || c == c2)
3539                         {
3540                             TRYPAREN(paren, n, PL_reginput);
3541                             REGCP_UNWIND(lastcp);
3542                         }
3543                     }
3544                     /* If it could work, try it. */
3545                     else if (c1 == -1000)
3546                     {
3547                         TRYPAREN(paren, n, PL_reginput);
3548                         REGCP_UNWIND(lastcp);
3549                     }
3550                     /* Couldn't or didn't -- move forward. */
3551                     PL_reginput = locinput;
3552                     if (regrepeat(scan, 1)) {
3553                         ln++;
3554                         locinput = PL_reginput;
3555                     }
3556                     else
3557                         sayNO;
3558                 }
3559             }
3560             else {
3561                 CHECKPOINT lastcp;
3562                 n = regrepeat(scan, n);
3563                 locinput = PL_reginput;
3564                 if (ln < n && PL_regkind[(U8)OP(next)] == EOL &&
3565                     (!PL_multiline  || OP(next) == SEOL || OP(next) == EOS)) {
3566                     ln = n;                     /* why back off? */
3567                     /* ...because $ and \Z can match before *and* after
3568                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
3569                        We should back off by one in this case. */
3570                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(next) != EOS)
3571                         ln--;
3572                 }
3573                 REGCP_SET(lastcp);
3574                 if (paren) {
3575                     UV c = 0;
3576                     while (n >= ln) {
3577                         if (c1 != -1000) {
3578                             if (do_utf8)
3579                                 c = utf8_to_uvchr((U8*)PL_reginput, NULL);
3580                             else
3581                                 c = UCHARAT(PL_reginput);
3582                         }
3583                         /* If it could work, try it. */
3584                         if (c1 == -1000 || c == c1 || c == c2)
3585                             {
3586                                 TRYPAREN(paren, n, PL_reginput);
3587                                 REGCP_UNWIND(lastcp);
3588                             }
3589                         /* Couldn't or didn't -- back up. */
3590                         n--;
3591                         PL_reginput = locinput = HOPc(locinput, -1);
3592                     }
3593                 }
3594                 else {
3595                     UV c = 0;
3596                     while (n >= ln) {
3597                         if (c1 != -1000) {
3598                             if (do_utf8)
3599                                 c = utf8_to_uvchr((U8*)PL_reginput, NULL);
3600                             else
3601                                 c = UCHARAT(PL_reginput);
3602                         }
3603                         /* If it could work, try it. */
3604                         if (c1 == -1000 || c == c1 || c == c2)
3605                             {
3606                                 TRYPAREN(paren, n, PL_reginput);
3607                                 REGCP_UNWIND(lastcp);
3608                             }
3609                         /* Couldn't or didn't -- back up. */
3610                         n--;
3611                         PL_reginput = locinput = HOPc(locinput, -1);
3612                     }
3613                 }
3614             }
3615             sayNO;
3616             break;
3617         case END:
3618             if (PL_reg_call_cc) {
3619                 re_cc_state *cur_call_cc = PL_reg_call_cc;
3620                 CURCUR *cctmp = PL_regcc;
3621                 regexp *re = PL_reg_re;
3622                 CHECKPOINT cp, lastcp;
3623                 
3624                 cp = regcppush(0);      /* Save *all* the positions. */
3625                 REGCP_SET(lastcp);
3626                 regcp_set_to(PL_reg_call_cc->ss); /* Restore parens of
3627                                                     the caller. */
3628                 PL_reginput = locinput; /* Make position available to
3629                                            the callcc. */
3630                 cache_re(PL_reg_call_cc->re);
3631                 PL_regcc = PL_reg_call_cc->cc;
3632                 PL_reg_call_cc = PL_reg_call_cc->prev;
3633                 if (regmatch(cur_call_cc->node)) {
3634                     PL_reg_call_cc = cur_call_cc;
3635                     regcpblow(cp);
3636                     sayYES;
3637                 }
3638                 REGCP_UNWIND(lastcp);
3639                 regcppop();
3640                 PL_reg_call_cc = cur_call_cc;
3641                 PL_regcc = cctmp;
3642                 PL_reg_re = re;
3643                 cache_re(re);
3644
3645                 DEBUG_r(
3646                     PerlIO_printf(Perl_debug_log,
3647                                   "%*s  continuation failed...\n",
3648                                   REPORT_CODE_OFF+PL_regindent*2, "")
3649                     );
3650                 sayNO_SILENT;
3651             }
3652             if (locinput < PL_regtill) {
3653                 DEBUG_r(PerlIO_printf(Perl_debug_log,
3654                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
3655                                       PL_colors[4],
3656                                       (long)(locinput - PL_reg_starttry),
3657                                       (long)(PL_regtill - PL_reg_starttry),
3658                                       PL_colors[5]));
3659                 sayNO_FINAL;            /* Cannot match: too short. */
3660             }
3661             PL_reginput = locinput;     /* put where regtry can find it */
3662             sayYES_FINAL;               /* Success! */
3663         case SUCCEED:
3664             PL_reginput = locinput;     /* put where regtry can find it */
3665             sayYES_LOUD;                /* Success! */
3666         case SUSPEND:
3667             n = 1;
3668             PL_reginput = locinput;
3669             goto do_ifmatch;    
3670         case UNLESSM:
3671             n = 0;
3672             if (scan->flags) {
3673                 s = HOPBACKc(locinput, scan->flags);
3674                 if (!s)
3675                     goto say_yes;
3676                 PL_reginput = s;
3677             }
3678             else
3679                 PL_reginput = locinput;
3680             goto do_ifmatch;
3681         case IFMATCH:
3682             n = 1;
3683             if (scan->flags) {
3684                 s = HOPBACKc(locinput, scan->flags);
3685                 if (!s)
3686                     goto say_no;
3687                 PL_reginput = s;
3688             }
3689             else
3690                 PL_reginput = locinput;
3691
3692           do_ifmatch:
3693             inner = NEXTOPER(NEXTOPER(scan));
3694             if (regmatch(inner) != n) {
3695               say_no:
3696                 if (logical) {
3697                     logical = 0;
3698                     sw = 0;
3699                     goto do_longjump;
3700                 }
3701                 else
3702                     sayNO;
3703             }
3704           say_yes:
3705             if (logical) {
3706                 logical = 0;
3707                 sw = 1;
3708             }
3709             if (OP(scan) == SUSPEND) {
3710                 locinput = PL_reginput;
3711                 nextchr = UCHARAT(locinput);
3712             }
3713             /* FALL THROUGH. */
3714         case LONGJMP:
3715           do_longjump:
3716             next = scan + ARG(scan);
3717             if (next == scan)
3718                 next = NULL;
3719             break;
3720         default:
3721             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
3722                           PTR2UV(scan), OP(scan));
3723             Perl_croak(aTHX_ "regexp memory corruption");
3724         }
3725       reenter:
3726         scan = next;
3727     }
3728
3729     /*
3730     * We get here only if there's trouble -- normally "case END" is
3731     * the terminating point.
3732     */
3733     Perl_croak(aTHX_ "corrupted regexp pointers");
3734     /*NOTREACHED*/
3735     sayNO;
3736
3737 yes_loud:
3738     DEBUG_r(
3739         PerlIO_printf(Perl_debug_log,
3740                       "%*s  %scould match...%s\n",
3741                       REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],PL_colors[5])
3742         );
3743     goto yes;
3744 yes_final:
3745     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
3746                           PL_colors[4],PL_colors[5]));
3747 yes:
3748 #ifdef DEBUGGING
3749     PL_regindent--;
3750 #endif
3751
3752 #if 0                                   /* Breaks $^R */
3753     if (unwind)
3754         regcpblow(firstcp);
3755 #endif
3756     return 1;
3757
3758 no:
3759     DEBUG_r(
3760         PerlIO_printf(Perl_debug_log,
3761                       "%*s  %sfailed...%s\n",
3762                       REPORT_CODE_OFF+PL_regindent*2, "",PL_colors[4],PL_colors[5])
3763         );
3764     goto do_no;
3765 no_final:
3766 do_no:
3767     if (unwind) {
3768         re_unwind_t *uw = SSPTRt(unwind,re_unwind_t);
3769
3770         switch (uw->type) {
3771         case RE_UNWIND_BRANCH:
3772         case RE_UNWIND_BRANCHJ:
3773         {
3774             re_unwind_branch_t *uwb = &(uw->branch);
3775             I32 lastparen = uwb->lastparen;
3776         
3777             REGCP_UNWIND(uwb->lastcp);
3778             for (n = *PL_reglastparen; n > lastparen; n--)
3779                 PL_regendp[n] = -1;
3780             *PL_reglastparen = n;
3781             scan = next = uwb->next;
3782             if ( !scan ||
3783                  OP(scan) != (uwb->type == RE_UNWIND_BRANCH
3784                               ? BRANCH : BRANCHJ) ) {           /* Failure */
3785                 unwind = uwb->prev;
3786 #ifdef DEBUGGING
3787                 PL_regindent--;
3788 #endif
3789                 goto do_no;
3790             }
3791             /* Have more choice yet.  Reuse the same uwb.  */
3792             /*SUPPRESS 560*/
3793             if ((n = (uwb->type == RE_UNWIND_BRANCH
3794                       ? NEXT_OFF(next) : ARG(next))))
3795                 next += n;
3796             else
3797                 next = NULL;    /* XXXX Needn't unwinding in this case... */
3798             uwb->next = next;
3799             next = NEXTOPER(scan);
3800             if (uwb->type == RE_UNWIND_BRANCHJ)
3801                 next = NEXTOPER(next);
3802             locinput = uwb->locinput;
3803             nextchr = uwb->nextchr;
3804 #ifdef DEBUGGING
3805             PL_regindent = uwb->regindent;
3806 #endif
3807
3808             goto reenter;
3809         }
3810         /* NOT REACHED */
3811         default:
3812             Perl_croak(aTHX_ "regexp unwind memory corruption");
3813         }
3814         /* NOT REACHED */
3815     }
3816 #ifdef DEBUGGING
3817     PL_regindent--;
3818 #endif
3819     return 0;
3820 }
3821
3822 /*
3823  - regrepeat - repeatedly match something simple, report how many
3824  */
3825 /*
3826  * [This routine now assumes that it will only match on things of length 1.
3827  * That was true before, but now we assume scan - reginput is the count,
3828  * rather than incrementing count on every character.  [Er, except utf8.]]
3829  */
3830 STATIC I32
3831 S_regrepeat(pTHX_ regnode *p, I32 max)
3832 {
3833     register char *scan;
3834     register I32 c;
3835     register char *loceol = PL_regeol;
3836     register I32 hardcount = 0;
3837     register bool do_utf8 = PL_reg_match_utf8;
3838
3839     scan = PL_reginput;
3840     if (max != REG_INFTY && max < loceol - scan)
3841       loceol = scan + max;
3842     switch (OP(p)) {
3843     case REG_ANY:
3844         if (do_utf8) {
3845             loceol = PL_regeol;
3846             while (scan < loceol && hardcount < max && *scan != '\n') {
3847                 scan += UTF8SKIP(scan);
3848                 hardcount++;
3849             }
3850         } else {
3851             while (scan < loceol && *scan != '\n')
3852                 scan++;
3853         }
3854         break;
3855     case SANY:
3856         scan = loceol;
3857         break;
3858     case CANY:
3859         scan = loceol;
3860         break;
3861     case EXACT:         /* length of string is 1 */
3862         c = (U8)*STRING(p);
3863         while (scan < loceol && UCHARAT(scan) == c)
3864             scan++;
3865         break;
3866     case EXACTF:        /* length of string is 1 */
3867         c = (U8)*STRING(p);
3868         while (scan < loceol &&
3869                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
3870             scan++;
3871         break;
3872     case EXACTFL:       /* length of string is 1 */
3873         PL_reg_flags |= RF_tainted;
3874         c = (U8)*STRING(p);
3875         while (scan < loceol &&
3876                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
3877             scan++;
3878         break;
3879     case ANYOF:
3880         if (do_utf8) {
3881             loceol = PL_regeol;
3882             while (hardcount < max && scan < loceol &&
3883                    reginclass(p, (U8*)scan, do_utf8)) {
3884                 scan += UTF8SKIP(scan);
3885                 hardcount++;
3886             }
3887         } else {
3888             while (scan < loceol && reginclass(p, (U8*)scan, do_utf8))
3889                 scan++;
3890         }
3891         break;
3892     case ALNUM:
3893         if (do_utf8) {
3894             loceol = PL_regeol;
3895             LOAD_UTF8_CHARCLASS(alnum,"a");
3896             while (hardcount < max && scan < loceol &&
3897                    swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
3898                 scan += UTF8SKIP(scan);
3899                 hardcount++;
3900             }
3901         } else {
3902             while (scan < loceol && isALNUM(*scan))
3903                 scan++;
3904         }
3905         break;
3906     case ALNUML:
3907         PL_reg_flags |= RF_tainted;
3908         if (do_utf8) {
3909             loceol = PL_regeol;
3910             while (hardcount < max && scan < loceol &&
3911                    isALNUM_LC_utf8((U8*)scan)) {
3912                 scan += UTF8SKIP(scan);
3913                 hardcount++;
3914             }
3915         } else {
3916             while (scan < loceol && isALNUM_LC(*scan))
3917                 scan++;
3918         }
3919         break;
3920     case NALNUM:
3921         if (do_utf8) {
3922             loceol = PL_regeol;
3923             LOAD_UTF8_CHARCLASS(alnum,"a");
3924             while (hardcount < max && scan < loceol &&
3925                    !swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
3926                 scan += UTF8SKIP(scan);
3927                 hardcount++;
3928             }
3929         } else {
3930             while (scan < loceol && !isALNUM(*scan))
3931                 scan++;
3932         }
3933         break;
3934     case NALNUML:
3935         PL_reg_flags |= RF_tainted;
3936         if (do_utf8) {
3937             loceol = PL_regeol;
3938             while (hardcount < max && scan < loceol &&
3939                    !isALNUM_LC_utf8((U8*)scan)) {
3940                 scan += UTF8SKIP(scan);
3941                 hardcount++;
3942             }
3943         } else {
3944             while (scan < loceol && !isALNUM_LC(*scan))
3945                 scan++;
3946         }
3947         break;
3948     case SPACE:
3949         if (do_utf8) {
3950             loceol = PL_regeol;
3951             LOAD_UTF8_CHARCLASS(space," ");
3952             while (hardcount < max && scan < loceol &&
3953                    (*scan == ' ' ||
3954                     swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
3955                 scan += UTF8SKIP(scan);
3956                 hardcount++;
3957             }
3958         } else {
3959             while (scan < loceol && isSPACE(*scan))
3960                 scan++;
3961         }
3962         break;
3963     case SPACEL:
3964         PL_reg_flags |= RF_tainted;
3965         if (do_utf8) {
3966             loceol = PL_regeol;
3967             while (hardcount < max && scan < loceol &&
3968                    (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
3969                 scan += UTF8SKIP(scan);
3970                 hardcount++;
3971             }
3972         } else {
3973             while (scan < loceol && isSPACE_LC(*scan))
3974                 scan++;
3975         }
3976         break;
3977     case NSPACE:
3978         if (do_utf8) {
3979             loceol = PL_regeol;
3980             LOAD_UTF8_CHARCLASS(space," ");
3981             while (hardcount < max && scan < loceol &&
3982                    !(*scan == ' ' ||
3983                      swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
3984                 scan += UTF8SKIP(scan);
3985                 hardcount++;
3986             }
3987         } else {
3988             while (scan < loceol && !isSPACE(*scan))
3989                 scan++;
3990             break;
3991         }
3992     case NSPACEL:
3993         PL_reg_flags |= RF_tainted;
3994         if (do_utf8) {
3995             loceol = PL_regeol;
3996             while (hardcount < max && scan < loceol &&
3997                    !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
3998                 scan += UTF8SKIP(scan);
3999                 hardcount++;
4000             }
4001         } else {
4002             while (scan < loceol && !isSPACE_LC(*scan))
4003                 scan++;
4004         }
4005         break;
4006     case DIGIT:
4007         if (do_utf8) {
4008             loceol = PL_regeol;
4009             LOAD_UTF8_CHARCLASS(digit,"0");
4010             while (hardcount < max && scan < loceol &&
4011                    swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4012                 scan += UTF8SKIP(scan);
4013                 hardcount++;
4014             }
4015         } else {
4016             while (scan < loceol && isDIGIT(*scan))
4017                 scan++;
4018         }
4019         break;
4020     case NDIGIT:
4021         if (do_utf8) {
4022             loceol = PL_regeol;
4023             LOAD_UTF8_CHARCLASS(digit,"0");
4024             while (hardcount < max && scan < loceol &&
4025                    !swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4026                 scan += UTF8SKIP(scan);
4027                 hardcount++;
4028             }
4029         } else {
4030             while (scan < loceol && !isDIGIT(*scan))
4031                 scan++;
4032         }
4033         break;
4034     default:            /* Called on something of 0 width. */
4035         break;          /* So match right here or not at all. */
4036     }
4037
4038     if (hardcount)
4039         c = hardcount;
4040     else
4041         c = scan - PL_reginput;
4042     PL_reginput = scan;
4043
4044     DEBUG_r(
4045         {
4046                 SV *prop = sv_newmortal();
4047
4048                 regprop(prop, p);
4049                 PerlIO_printf(Perl_debug_log,
4050                               "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
4051                               REPORT_CODE_OFF+1, "", SvPVX(prop),(IV)c,(IV)max);
4052         });
4053
4054     return(c);
4055 }
4056
4057 /*
4058  - regrepeat_hard - repeatedly match something, report total lenth and length
4059  *
4060  * The repeater is supposed to have constant length.
4061  */
4062
4063 STATIC I32
4064 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp)
4065 {
4066     register char *scan = Nullch;
4067     register char *start;
4068     register char *loceol = PL_regeol;
4069     I32 l = 0;
4070     I32 count = 0, res = 1;
4071
4072     if (!max)
4073         return 0;
4074
4075     start = PL_reginput;
4076     if (PL_reg_match_utf8) {
4077         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
4078             if (!count++) {
4079                 l = 0;
4080                 while (start < PL_reginput) {
4081                     l++;
4082                     start += UTF8SKIP(start);
4083                 }
4084                 *lp = l;
4085                 if (l == 0)
4086                     return max;
4087             }
4088             if (count == max)
4089                 return count;
4090         }
4091     }
4092     else {
4093         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
4094             if (!count++) {
4095                 *lp = l = PL_reginput - start;
4096                 if (max != REG_INFTY && l*max < loceol - scan)
4097                     loceol = scan + l*max;
4098                 if (l == 0)
4099                     return max;
4100             }
4101         }
4102     }
4103     if (!res)
4104         PL_reginput = scan;
4105
4106     return count;
4107 }
4108
4109 /*
4110 - regclass_swash - prepare the utf8 swash
4111 */
4112
4113 SV *
4114 Perl_regclass_swash(pTHX_ register regnode* node, bool doinit, SV** initsvp)
4115 {
4116     SV *sw = NULL;
4117     SV *si = NULL;
4118
4119     if (PL_regdata && PL_regdata->count) {
4120         U32 n = ARG(node);
4121
4122         if (PL_regdata->what[n] == 's') {
4123             SV *rv = (SV*)PL_regdata->data[n];
4124             AV *av = (AV*)SvRV((SV*)rv);
4125             SV **a;
4126         
4127             si = *av_fetch(av, 0, FALSE);
4128             a  =  av_fetch(av, 1, FALSE);
4129         
4130             if (a)
4131                 sw = *a;
4132             else if (si && doinit) {
4133                 sw = swash_init("utf8", "", si, 1, 0);
4134                 (void)av_store(av, 1, sw);
4135             }
4136         }
4137     }
4138         
4139     if (initsvp)
4140         *initsvp = si;
4141
4142     return sw;
4143 }
4144
4145 /*
4146  - reginclass - determine if a character falls into a character class
4147  */
4148
4149 STATIC bool
4150 S_reginclass(pTHX_ register regnode *n, register U8* p, register bool do_utf8)
4151 {
4152     char flags = ANYOF_FLAGS(n);
4153     bool match = FALSE;
4154     UV c;
4155     STRLEN len = 0;
4156
4157     c = do_utf8 ? utf8_to_uvchr(p, &len) : *p;
4158
4159     if (do_utf8 || (flags & ANYOF_UNICODE)) {
4160         if (do_utf8 && !ANYOF_RUNTIME(n)) {
4161             if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
4162                 match = TRUE;
4163         }
4164         if (!match && do_utf8 && (flags & ANYOF_UNICODE_ALL) && c >= 256)
4165             match = TRUE;
4166         if (!match) {
4167             SV *sw = regclass_swash(n, TRUE, 0);
4168         
4169             if (sw) {
4170                 if (swash_fetch(sw, p, do_utf8))
4171                     match = TRUE;
4172                 else if (flags & ANYOF_FOLD) {
4173                     STRLEN ulen;
4174                     U8 tmpbuf[UTF8_MAXLEN_FOLD+1];
4175
4176                     to_utf8_fold(p, tmpbuf, &ulen);
4177                     if (swash_fetch(sw, tmpbuf, do_utf8))
4178                         match = TRUE;
4179                     to_utf8_upper(p, tmpbuf, &ulen);
4180                     if (swash_fetch(sw, tmpbuf, do_utf8))
4181                         match = TRUE;
4182                 }
4183             }
4184         }
4185     }
4186     if (!match && c < 256) {
4187         if (ANYOF_BITMAP_TEST(n, c))
4188             match = TRUE;
4189         else if (flags & ANYOF_FOLD) {
4190           I32 f;
4191
4192             if (flags & ANYOF_LOCALE) {
4193                 PL_reg_flags |= RF_tainted;
4194                 f = PL_fold_locale[c];
4195             }
4196             else
4197                 f = PL_fold[c];
4198             if (f != c && ANYOF_BITMAP_TEST(n, f))
4199                 match = TRUE;
4200         }
4201         
4202         if (!match && (flags & ANYOF_CLASS)) {
4203             PL_reg_flags |= RF_tainted;
4204             if (
4205                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
4206                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
4207                 (ANYOF_CLASS_TEST(n, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
4208                 (ANYOF_CLASS_TEST(n, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
4209                 (ANYOF_CLASS_TEST(n, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
4210                 (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
4211                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
4212                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
4213                 (ANYOF_CLASS_TEST(n, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
4214                 (ANYOF_CLASS_TEST(n, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
4215                 (ANYOF_CLASS_TEST(n, ANYOF_ASCII)   &&  isASCII(c))     ||
4216                 (ANYOF_CLASS_TEST(n, ANYOF_NASCII)  && !isASCII(c))     ||
4217                 (ANYOF_CLASS_TEST(n, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
4218                 (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
4219                 (ANYOF_CLASS_TEST(n, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
4220                 (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
4221                 (ANYOF_CLASS_TEST(n, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
4222                 (ANYOF_CLASS_TEST(n, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
4223                 (ANYOF_CLASS_TEST(n, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
4224                 (ANYOF_CLASS_TEST(n, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
4225                 (ANYOF_CLASS_TEST(n, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
4226                 (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
4227                 (ANYOF_CLASS_TEST(n, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
4228                 (ANYOF_CLASS_TEST(n, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
4229                 (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
4230                 (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c))    ||
4231                 (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC)  &&  isPSXSPC(c))    ||
4232                 (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c))    ||
4233                 (ANYOF_CLASS_TEST(n, ANYOF_BLANK)   &&  isBLANK(c))     ||
4234                 (ANYOF_CLASS_TEST(n, ANYOF_NBLANK)  && !isBLANK(c))
4235                 ) /* How's that for a conditional? */
4236             {
4237                 match = TRUE;
4238             }
4239         }
4240     }
4241
4242     return (flags & ANYOF_INVERT) ? !match : match;
4243 }
4244
4245 STATIC U8 *
4246 S_reghop(pTHX_ U8 *s, I32 off)
4247 {
4248     return S_reghop3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4249 }
4250
4251 STATIC U8 *
4252 S_reghop3(pTHX_ U8 *s, I32 off, U8* lim)
4253 {
4254     if (off >= 0) {
4255         while (off-- && s < lim) {
4256             /* XXX could check well-formedness here */
4257             s += UTF8SKIP(s);
4258         }
4259     }
4260     else {
4261         while (off++) {
4262             if (s > lim) {
4263                 s--;
4264                 if (UTF8_IS_CONTINUED(*s)) {
4265                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4266                         s--;
4267                 }
4268                 /* XXX could check well-formedness here */
4269             }
4270         }
4271     }
4272     return s;
4273 }
4274
4275 STATIC U8 *
4276 S_reghopmaybe(pTHX_ U8 *s, I32 off)
4277 {
4278     return S_reghopmaybe3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4279 }
4280
4281 STATIC U8 *
4282 S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim)
4283 {
4284     if (off >= 0) {
4285         while (off-- && s < lim) {
4286             /* XXX could check well-formedness here */
4287             s += UTF8SKIP(s);
4288         }
4289         if (off >= 0)
4290             return 0;
4291     }
4292     else {
4293         while (off++) {
4294             if (s > lim) {
4295                 s--;
4296                 if (UTF8_IS_CONTINUED(*s)) {
4297                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4298                         s--;
4299                 }
4300                 /* XXX could check well-formedness here */
4301             }
4302             else
4303                 break;
4304         }
4305         if (off <= 0)
4306             return 0;
4307     }
4308     return s;
4309 }
4310
4311 static void
4312 restore_pos(pTHX_ void *arg)
4313 {
4314     if (PL_reg_eval_set) {
4315         if (PL_reg_oldsaved) {
4316             PL_reg_re->subbeg = PL_reg_oldsaved;
4317             PL_reg_re->sublen = PL_reg_oldsavedlen;
4318             RX_MATCH_COPIED_on(PL_reg_re);
4319         }
4320         PL_reg_magic->mg_len = PL_reg_oldpos;
4321         PL_reg_eval_set = 0;
4322         PL_curpm = PL_reg_oldcurpm;
4323     }   
4324 }