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