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