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